mmap 0.5.8 → 0.5.9
raw patch · 3 files changed
+103/−95 lines, 3 files
Files
- System/IO/MMap.hs +65/−55
- mmap.cabal +2/−1
- tests/mmaptest.hs +36/−39
System/IO/MMap.hs view
@@ -2,8 +2,8 @@ -- | -- Module : System.IO.MMap -- Copyright : (c) Gracjan Polak 2009--- License : BSD-style --- +-- License : BSD-style+-- -- Stability : experimental -- Portability : portable --@@ -36,23 +36,21 @@ where import System.IO ()-import Foreign.Ptr (Ptr,FunPtr,nullPtr,plusPtr,minusPtr,castPtr)+import Foreign.Ptr (Ptr,FunPtr,nullPtr,plusPtr,castPtr) import Foreign.C.Types (CInt(..),CLLong(..),CSize(..))-import Foreign.C.String (CString(..),withCString)-import Foreign.ForeignPtr (ForeignPtr,withForeignPtr,finalizeForeignPtr,newForeignPtr,newForeignPtrEnv,newForeignPtr_)-import Foreign.Storable( poke )-import Foreign.Marshal.Alloc( malloc, mallocBytes, free )+import Foreign.C.String (CString,withCString)+import Foreign.ForeignPtr (ForeignPtr,withForeignPtr,finalizeForeignPtr,newForeignPtr,newForeignPtrEnv) import Foreign.C.Error-import qualified Foreign.Concurrent( newForeignPtr ) import System.IO.Unsafe (unsafePerformIO) import qualified Data.ByteString.Internal as BS (fromForeignPtr) import Data.Int (Int64)-import Control.Monad (when,liftM)-import Control.Exception+import Control.Monad (when)+import qualified Control.Exception as E (bracketOnError, bracket, finally) import qualified Data.ByteString as BS (ByteString) import qualified Data.ByteString.Lazy as BSL (ByteString,fromChunks)+import Prelude hiding (length) -import Debug.Trace+--import Debug.Trace -- TODO: -- - support native characters (Unicode) in FilePath@@ -167,17 +165,17 @@ deriving (Eq,Ord,Enum,Show,Read) sanitizeFileRegion :: (Integral a,Bounded a) => String -> ForeignPtr () -> Mode -> Maybe (Int64,a) -> IO (Int64,a)-sanitizeFileRegion filepath handle ReadWriteEx (Just region@(offset,length)) = - withForeignPtr handle $ \handle -> do+sanitizeFileRegion filepath handle' ReadWriteEx (Just region@(offset,length)) =+ withForeignPtr handle' $ \handle -> do longsize <- c_system_io_file_size handle let needsize = fromIntegral (offset + fromIntegral length)- when (longsize < needsize) - ((throwErrnoPathIfMinus1 "extend file size" filepath $ + when (longsize < needsize)+ ((throwErrnoPathIfMinus1 "extend file size" filepath $ c_system_io_extend_file_size handle needsize) >> return ())- return region -sanitizeFileRegion filepath handle ReadWriteEx _ + return region+sanitizeFileRegion _filepath _handle ReadWriteEx _ = error "sanitizeRegion given ReadWriteEx with no region, please check earlier for this"-sanitizeFileRegion filepath handle mode region = withForeignPtr handle $ \handle -> do+sanitizeFileRegion filepath handle' mode region = withForeignPtr handle' $ \handle -> do longsize <- c_system_io_file_size handle >>= \x -> return (fromIntegral x) let Just (_,sizetype) = region (offset,size) <- case region of@@ -196,7 +194,7 @@ return (offset,size) checkModeRegion :: FilePath -> Mode -> Maybe a -> IO ()-checkModeRegion filepath ReadWriteEx Nothing = +checkModeRegion filepath ReadWriteEx Nothing = ioError (errnoToIOError "mmap ReadWriteEx must have explicit region" eINVAL Nothing (Just filepath)) checkModeRegion _ _ _ = return () @@ -216,7 +214,7 @@ -- -- Use @munmapFilePtr ptr rawsize@ to unmap memory. ----- Memory mapped files will behave as if they were read lazily +-- Memory mapped files will behave as if they were read lazily -- pages from the file will be loaded into memory on demand. -- @@ -226,16 +224,16 @@ -> IO (Ptr a,Int,Int,Int) -- ^ (ptr,rawsize,offset,size) mmapFilePtr filepath mode offsetsize = do checkModeRegion filepath mode offsetsize- bracket (mmapFileOpen filepath mode)+ E.bracket (mmapFileOpen filepath mode) (finalizeForeignPtr) mmap where- mmap handle = do- (offset,size) <- sanitizeFileRegion filepath handle mode offsetsize+ mmap handle' = do+ (offset,size) <- sanitizeFileRegion filepath handle' mode offsetsize let align = offset `mod` fromIntegral c_system_io_granularity let offsetraw = offset - align let sizeraw = size + fromIntegral align- ptr <- withForeignPtr handle $ \handle ->- c_system_io_mmap_mmap handle (fromIntegral $ fromEnum mode) + ptr <- withForeignPtr handle' $ \handle ->+ c_system_io_mmap_mmap handle (fromIntegral $ fromEnum mode) (fromIntegral offsetraw) (fromIntegral sizeraw) when (ptr == nullPtr) $ throwErrnoPath ("mmap of '" ++ filepath ++ "' failed") filepath@@ -254,14 +252,14 @@ mmapWithFilePtr filepath mode offsetsize action = do checkModeRegion filepath mode offsetsize (ptr,rawsize,offset,size) <- mmapFilePtr filepath mode offsetsize- result <- action (ptr `plusPtr` offset,size) `finally` munmapFilePtr ptr rawsize+ result <- action (ptr `plusPtr` offset,size) `E.finally` munmapFilePtr ptr rawsize return result -- | Maps region of file and returns it as 'ForeignPtr'. See 'mmapFilePtr' for details. mmapFileForeignPtr :: FilePath -- ^ name of file to map -> Mode -- ^ access mode -> Maybe (Int64,Int) -- ^ range to map, maps whole file if Nothing- -> IO (ForeignPtr a,Int,Int) -- ^ foreign pointer to beginning of raw region, + -> IO (ForeignPtr a,Int,Int) -- ^ foreign pointer to beginning of raw region, -- offset to your data and size of your data mmapFileForeignPtr filepath mode range = do checkModeRegion filepath mode range@@ -280,42 +278,54 @@ let bytestring = BS.fromForeignPtr foreignptr offset size return bytestring --- | The 'mmapFileForeignPtrLazy' function maps a file or device into memory,--- returning a list of tuples with the same meaning as in function--- 'mmapFileForeignPtr'.+-- | The 'mmapFileForeignPtrLazy' function maps a file or device into+-- memory, returning a list of tuples with the same meaning as in+-- function 'mmapFileForeignPtr'. --+-- Chunks are really mapped into memory at the first inspection of a+-- chunk. They are kept in memory while they are referenced, garbage+-- collector takes care of the later.+-- mmapFileForeignPtrLazy :: FilePath -- ^ name of file to mmap -> Mode -- ^ access mode -> Maybe (Int64,Int64) -- ^ range to map, maps whole file if Nothing -> IO [(ForeignPtr a,Int,Int)] -- ^ (ptr,offset,size) mmapFileForeignPtrLazy filepath mode offsetsize = do checkModeRegion filepath mode offsetsize- bracketOnError (mmapFileOpen filepath mode)+ E.bracketOnError (mmapFileOpen filepath mode) (finalizeForeignPtr) mmap where mmap handle = do (offset,size) <- sanitizeFileRegion filepath handle mode offsetsize- return $ map (mapChunk handle) (chunks offset size)- -- FIXME: might be we need NOINLINE pragma here, investigate later- mapChunk handle (offset,size) = unsafePerformIO $- withForeignPtr handle $ \handle -> do- let align = offset `mod` fromIntegral c_system_io_granularity- offsetraw = offset - align- sizeraw = size + fromIntegral align- ptr <- c_system_io_mmap_mmap handle (fromIntegral $ fromEnum mode) - (fromIntegral offsetraw) (fromIntegral sizeraw)- when (ptr == nullPtr) $- throwErrnoPath ("lazy mmap of '" ++ filepath ++ - "' chunk(" ++ show offset ++ "," ++ show size ++") failed") filepath- let rawsizeptr = castIntToPtr sizeraw- foreignptr <- newForeignPtrEnv c_system_io_mmap_munmap_funptr rawsizeptr ptr- return (foreignptr,fromIntegral offset,size)+ return $ map (mmapFileForeignPtrLazyChunk filepath mode handle) (chunks offset size) ++{-# NOINLINE mmapFileForeignPtrLazyChunk #-}+mmapFileForeignPtrLazyChunk :: FilePath+ -> Mode+ -> ForeignPtr ()+ -> (Int64, Int)+ -> (ForeignPtr a, Int, Int)+mmapFileForeignPtrLazyChunk filepath mode handle' (offset,size) = unsafePerformIO $+ withForeignPtr handle' $ \handle -> do+ let align = offset `mod` fromIntegral c_system_io_granularity+ offsetraw = offset - align+ sizeraw = size + fromIntegral align+ ptr <- c_system_io_mmap_mmap handle (fromIntegral $ fromEnum mode)+ (fromIntegral offsetraw) (fromIntegral sizeraw)+ when (ptr == nullPtr) $+ throwErrnoPath ("lazy mmap of '" ++ filepath +++ "' chunk(" ++ show offset ++ "," ++ show size ++") failed") filepath+ let rawsizeptr = castIntToPtr sizeraw+ foreignptr <- newForeignPtrEnv c_system_io_mmap_munmap_funptr rawsizeptr ptr+ return (foreignptr,fromIntegral offset,size)+ chunks :: Int64 -> Int64 -> [(Int64,Int)]-chunks offset 0 = []+chunks _offset 0 = [] chunks offset size | size <= fromIntegral chunkSize = [(offset,fromIntegral size)]- | otherwise = let offset2 = ((offset + chunkSize + chunkSize - 1) `div` chunkSize) * chunkSize+ | otherwise = let offset2 = ((offset + chunkSizeLong * 2 - 1) `div` chunkSizeLong) * chunkSizeLong size2 = offset2 - offset+ chunkSizeLong = fromIntegral chunkSize in (offset,fromIntegral size2) : chunks offset2 (size-size2) -- | Maps region of file and returns it as 'BSL.ByteString'. File is@@ -337,20 +347,20 @@ -> IO () munmapFilePtr ptr rawsize = c_system_io_mmap_munmap (castIntToPtr rawsize) ptr -chunkSize :: Num a => a-chunkSize = fromIntegral $ (128*1024 `div` c_system_io_granularity) * c_system_io_granularity+chunkSize :: Int+chunkSize = (128*1024 `div` fromIntegral c_system_io_granularity) * fromIntegral c_system_io_granularity mmapFileOpen :: FilePath -> Mode -> IO (ForeignPtr ())-mmapFileOpen filepath mode = do- ptr <- withCString filepath $ \filepath ->+mmapFileOpen filepath' mode = do+ ptr <- withCString filepath' $ \filepath -> c_system_io_mmap_file_open filepath (fromIntegral $ fromEnum mode) when (ptr == nullPtr) $- throwErrnoPath ("opening of '" ++ filepath ++ "' failed") filepath+ throwErrnoPath ("opening of '" ++ filepath' ++ "' failed") filepath' handle <- newForeignPtr c_system_io_mmap_file_close ptr return handle -castPtrToInt :: Ptr a -> Int-castPtrToInt ptr = ptr `minusPtr` nullPtr+--castPtrToInt :: Ptr a -> Int+--castPtrToInt ptr = ptr `minusPtr` nullPtr castIntToPtr :: Int -> Ptr a castIntToPtr int = nullPtr `plusPtr` int
mmap.cabal view
@@ -1,5 +1,5 @@ Name: mmap-Version: 0.5.8+Version: 0.5.9 Stability: stable License: BSD3 License-File: LICENSE@@ -32,6 +32,7 @@ Exposed-modules: System.IO.MMap Hs-source-dirs: . Include-dirs: cbits+ GHC-options: -Wall if os(mingw32) C-sources: cbits/win32.c else
tests/mmaptest.hs view
@@ -14,15 +14,16 @@ import Control.Concurrent import Test.HUnit import System.Directory -import Foreign.C.Types (CInt,CLLong) +import Foreign.C.Types (CInt(..),CLLong) import Control.Monad import System.IO import Data.Int +import Control.Exception as E #ifdef WINDOWS import qualified System.Win32.File as W #endif -ignoreExceptions doit = (doit >> return ()) `catch` (\e -> return ()) +ignoreExceptions doit = (doit >> return ()) `E.catch` (\(e :: IOError) -> return ()) foreign import ccall unsafe "HsMmap.h system_io_mmap_counters" c_system_io_counters :: IO CInt @@ -76,18 +77,15 @@ test_no_permission_readonly = do let filename = "test_nopermission.bin" - ignoreExceptions $ setPermissions filename (Permissions {readable = True, - writable = True, - executable = True, - searchable = True}) + ignoreExceptions $ setPermissions filename (setOwnerReadable True . + setOwnerWritable True . + setOwnerExecutable True . + setOwnerSearchable True $ emptyPermissions) BSC.writeFile filename content - setPermissions filename (Permissions {readable = False, - writable = False, - executable = False, - searchable = False}) - Permissions {readable = readable} <- getPermissions filename - -- no way to clear read flag under Windows, skip the test - if not readable + setPermissions filename (emptyPermissions) + permissions <- getPermissions filename + -- no way to clear read flag under Windows, skip the test + if not (readable permissions) then ignoreExceptions $ do mmapFileByteString filename Nothing assertFailure "Should throw exception" @@ -162,7 +160,7 @@ BSC.writeFile filename content mmapWithFilePtr filename ReadWriteEx (Just (4,5000)) $ \(ptr,size) -> do size @?= 5000 - bs <- BSC.packCStringLen (castPtr ptr,size) + bs <- BSC.packCStringLen (castPtr ptr,size) bs @?= BSC.take 5000 (BSC.drop 4 (content `BSC.append` BSC.replicate 10000 '\0')) test_delete_while_mmapped = do @@ -170,7 +168,7 @@ BSC.writeFile filename content mmapWithFilePtr filename ReadOnly Nothing $ \(ptr,size) -> do removeFileDelayed filename - bs <- BSC.packCStringLen (castPtr ptr,size) + bs <- BSC.packCStringLen (castPtr ptr,size) bs @?= content v <- doesFileExist filename False @=? v @@ -190,7 +188,7 @@ mmapFileForeignPtrLazy filename ReadWriteEx (Just (0,threegb)) System.Mem.performGC threadDelay 1000 - size <- withFile filename ReadMode hFileSize + size <- withFile filename ReadMode hFileSize size @?= fromIntegral threegb test_create_offset_plus_size_readwriteex = do @@ -198,7 +196,7 @@ ignoreExceptions $ removeFile filename mmapWithFilePtr filename ReadWriteEx (Just (4,5000)) $ \(ptr,size) -> do size @?= 5000 - bs <- BSC.packCStringLen (castPtr ptr,size) + bs <- BSC.packCStringLen (castPtr ptr,size) bs @?= BSC.replicate 5000 '\0' test_create_readwriteex_no_way = do @@ -220,7 +218,7 @@ test_change_two_places = do let filename = "test_normalAB.bin" BSC.writeFile filename content - mmapWithFilePtr filename ReadWrite Nothing $ \(ptr1,size1) -> + mmapWithFilePtr filename ReadWrite Nothing $ \(ptr1,size1) -> do -- this should change one common memory let v1 = 0x41414141::Int32 @@ -229,13 +227,13 @@ v2 @?= v1 bs2 <- mmapFileByteString filename Nothing size1 @?= BSC.length bs2 - bs1 <- BSC.packCStringLen (castPtr ptr1,size1) + bs1 <- BSC.packCStringLen (castPtr ptr1,size1) bs1 @?= bs2 test_change_read_write = do let filename = "test_normalAC.bin" BSC.writeFile filename content - mmapWithFilePtr filename ReadWrite Nothing $ \(ptr1,size1) -> + mmapWithFilePtr filename ReadWrite Nothing $ \(ptr1,size1) -> do poke (castPtr ptr1) (0x41414141::Int32) bs3 <- BSC.readFile filename @@ -244,7 +242,7 @@ test_writecopy = do let filename = "test_normalAD.bin" BSC.writeFile filename content - mmapWithFilePtr filename WriteCopy Nothing $ \(ptr1,size1) -> + mmapWithFilePtr filename WriteCopy Nothing $ \(ptr1,size1) -> do poke (castPtr ptr1) (0x41414141::Int32) -- change should NOT be reflected in file on disk @@ -257,46 +255,46 @@ counters <- c_system_io_counters return (counters @?= 0) -alltests = [ "Normal read only mmap" ~: +alltests = [ "Normal read only mmap" ~: test_normal_readonly - , "Normal read only mmap lazy" ~: + , "Normal read only mmap lazy" ~: test_normal_readonly_lazy - , "Zero length file mmap" ~: + , "Zero length file mmap" ~: test_normal_readonly_zero_length - , "File does not exist" ~: + , "File does not exist" ~: test_non_existing_readonly - , "No permission to read file" ~: + , "No permission to read file" ~: test_no_permission_readonly - , "Signal error when negative offset given" ~: + , "Signal error when negative offset given" ~: test_normal_negative_offset_readonly , "Signal error when negative size given" ~: test_normal_negative_size_readonly - , "Test if we can cut part of file" ~: + , "Test if we can cut part of file" ~: test_normal_offset_size_readonly - , "Test if we can cut zero length part of file" ~: + , "Test if we can cut zero length part of file" ~: test_normal_offset_size_zero_readonly - , "Test if we can cut zero length part of file lazy" ~: + , "Test if we can cut zero length part of file lazy" ~: test_normal_offset_size_zero_readonly_lazy - , "Should throw error if mmaping readonly beyond end of file" ~: + , "Should throw error if mmaping readonly beyond end of file" ~: test_normal_offset_beyond_eof_readonly - , "Should throw error if mmaping readonly beyond end of file lazy" ~: + , "Should throw error if mmaping readonly beyond end of file lazy" ~: test_normal_offset_beyond_eof_readonly_lazy - , "Should throw error if mmaping readonly with size beyond end of file" ~: + , "Should throw error if mmaping readonly with size beyond end of file" ~: test_normal_offset_plus_size_beyond_eof_readonly - , "Should throw error if mmaping readonly with size beyond end of file lazy" ~: + , "Should throw error if mmaping readonly with size beyond end of file lazy" ~: test_normal_offset_plus_size_beyond_eof_readonly_lazy - , "Should ReadWriteEx mmap existing file and resize" ~: + , "Should ReadWriteEx mmap existing file and resize" ~: test_normal_offset_plus_size_beyond_eof_readwriteex , "Should ReadWriteEx mmap new file and resize" ~: test_create_offset_plus_size_readwriteex , "ReadWriteEx must have range specified" ~: test_create_nothing_readwriteex_should_throw , "Report error in file creation" ~: - test_create_readwriteex_no_way + test_create_readwriteex_no_way , "ReadWriteEx in lazy mode should set file size even if not touching" ~: test_readwriteex_lazy_make_dont_touch , "Remove file while mmaped" ~: - test_delete_while_mmapped + test_delete_while_mmapped , "MMap byte string many times" ~: test_normal_readonly_many_times , "Mmap common memory" ~: @@ -307,7 +305,7 @@ test_writecopy --, "ReadWriteEx in lazy should extend file beyond 3GB when mapped in" ~: - -- Test_readwriteex_lazy_make_a_touch + -- Test_readwriteex_lazy_make_a_touch -- insert tests above this line , "Counters should be zero" ~: test_counters_zero @@ -344,4 +342,3 @@ threadDelay 10000 -} -