X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=GHC%2FForeignPtr.hs;h=416c595dc84b24734bef1f685985f2d2260c00e2;hb=fde8cdfd9c57da52b2116884dba6d2b3c7c2fb14;hp=3cd760930f5b97ee6a3ddf4abcb4fd76c8496877;hpb=47954c351109f0868c716e4c9552b973ce7a53aa;p=ghc-base.git diff --git a/GHC/ForeignPtr.hs b/GHC/ForeignPtr.hs index 3cd7609..416c595 100644 --- a/GHC/ForeignPtr.hs +++ b/GHC/ForeignPtr.hs @@ -42,11 +42,11 @@ 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(..) ) import GHC.Err +import GHC.Num ( fromInteger ) #include "Typeable.h" @@ -100,7 +100,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 +150,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 +165,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 +191,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 +206,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#)) @@ -349,7 +357,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