Add tests from testsuite/tests/h98

[ghc-base.git] / GHC / ForeignPtr.hs

diff --git a/GHC/ForeignPtr.hs b/GHC/ForeignPtr.hs
index 3cd7609..dbf6c2c 100644 (file)
--- a/GHC/ForeignPtr.hs
+++ b/GHC/ForeignPtr.hs
@@ -1,5 +1,12 @@
-{-# OPTIONS_GHC -XNoImplicitPrelude #-}
+{-# LANGUAGE CPP
+           , NoImplicitPrelude
+           , BangPatterns
+           , MagicHash
+           , UnboxedTuples
+  #-}
 {-# OPTIONS_HADDOCK hide #-}
+{-# LANGUAGE DeriveDataTypeable, StandaloneDeriving #-}
+
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  GHC.ForeignPtr
@@ -42,7 +49,6 @@ import Data.Typeable
 import GHC.Show
 import GHC.List         ( null )
 import GHC.Base
--- import GHC.IO
 import GHC.IORef
 import GHC.STRef        ( STRef(..) )
 import GHC.Ptr          ( Ptr(..), FunPtr(..) )
@@ -100,7 +106,7 @@ instance Show (ForeignPtr a) where
     showsPrec p f = showsPrec p (unsafeForeignPtrToPtr f)
 
 
--- |A Finalizer is represented as a pointer to a foreign function that, at
+-- |A finalizer is represented as a pointer to a foreign function that, at
 -- finalisation time, gets as an argument a plain pointer variant of the
 -- foreign pointer that the finalizer is associated with.
 -- 
@@ -150,7 +156,9 @@ mallocForeignPtr :: Storable a => IO (ForeignPtr a)
 -- 
 mallocForeignPtr = doMalloc undefined
   where doMalloc :: Storable b => b -> IO (ForeignPtr b)
-        doMalloc a = do
+        doMalloc a
+          | I# size < 0 = error "mallocForeignPtr: size must be >= 0"
+          | otherwise = do
           r <- newIORef (NoFinalizers, [])
           IO $ \s ->
             case newAlignedPinnedByteArray# size align s of { (# s', mbarr# #) ->
@@ -163,6 +171,8 @@ mallocForeignPtr = doMalloc undefined
 -- | This function is similar to 'mallocForeignPtr', except that the
 -- size of the memory required is given explicitly as a number of bytes.
 mallocForeignPtrBytes :: Int -> IO (ForeignPtr a)
+mallocForeignPtrBytes size | size < 0 =
+  error "mallocForeignPtrBytes: size must be >= 0"
 mallocForeignPtrBytes (I# size) = do 
   r <- newIORef (NoFinalizers, [])
   IO $ \s ->
@@ -187,7 +197,9 @@ mallocForeignPtrBytes (I# size) = do
 mallocPlainForeignPtr :: Storable a => IO (ForeignPtr a)
 mallocPlainForeignPtr = doMalloc undefined
   where doMalloc :: Storable b => b -> IO (ForeignPtr b)
-        doMalloc a = IO $ \s ->
+        doMalloc a
+          | I# size < 0 = error "mallocForeignPtr: size must be >= 0"
+          | otherwise = IO $ \s ->
             case newAlignedPinnedByteArray# size align s of { (# s', mbarr# #) ->
              (# s', ForeignPtr (byteArrayContents# (unsafeCoerce# mbarr#))
                                (PlainPtr mbarr#) #)
@@ -200,6 +212,8 @@ mallocPlainForeignPtr = doMalloc undefined
 -- finalizer is used. Attempts to add a finalizer will cause an
 -- exception to be thrown.
 mallocPlainForeignPtrBytes :: Int -> IO (ForeignPtr a)
+mallocPlainForeignPtrBytes size | size < 0 =
+  error "mallocPlainForeignPtrBytes: size must be >= 0"
 mallocPlainForeignPtrBytes (I# size) = IO $ \s ->
     case newPinnedByteArray# size s      of { (# s', mbarr# #) ->
        (# s', ForeignPtr (byteArrayContents# (unsafeCoerce# mbarr#))
@@ -224,7 +238,7 @@ addForeignPtrFinalizer (FunPtr fp) (ForeignPtr p c) = case c of
 
 addForeignPtrFinalizerEnv ::
   FinalizerEnvPtr env a -> Ptr env -> ForeignPtr a -> IO ()
--- ^ like 'addForeignPtrFinalizerEnv' but allows the finalizer to be
+-- ^ Like 'addForeignPtrFinalizerEnv' but allows the finalizer to be
 -- passed an additional environment parameter to be passed to the
 -- finalizer.  The environment passed to the finalizer is fixed by the
 -- second argument to 'addForeignPtrFinalizerEnv'
@@ -349,7 +363,7 @@ unsafeForeignPtrToPtr :: ForeignPtr a -> Ptr a
 -- To avoid subtle coding errors, hand written marshalling code
 -- should preferably use 'Foreign.ForeignPtr.withForeignPtr' rather
 -- than combinations of 'unsafeForeignPtrToPtr' and
--- 'touchForeignPtr'.  However, the later routines
+-- 'touchForeignPtr'.  However, the latter routines
 -- are occasionally preferred in tool generated marshalling code.
 unsafeForeignPtrToPtr (ForeignPtr fo _) = Ptr fo