mmap 0.5.3 → 0.5.4

raw patch · 6 files changed

+115/−23 lines, 6 files

Files

• System/IO/MMap.hs +13/−4
• cbits/HsMmap.h +2/−0
• cbits/posix.c +7/−8
• cbits/win32.c +10/−0
• mmap.cabal +1/−1
• tests/mmaptest.hs +82/−10

@@ -1,4 +1,4 @@-
+{-# LANGUAGE ForeignFunctionInterface, CPP #-}
 -- |
 -- Module      :  System.IO.MMap
 -- Copyright   :  (c) Gracjan Polak 2009
@@ -47,7 +47,7 @@ import System.IO.Unsafe  (unsafePerformIO)
 import qualified Data.ByteString.Internal as BS (fromForeignPtr)
 import Data.Int (Int64)
-import Control.Monad  (when)
+import Control.Monad  (when,liftM)
 import Control.Exception
 import qualified Data.ByteString as BS (ByteString)
 import qualified Data.ByteString.Lazy as BSL  (ByteString,fromChunks)
@@ -167,8 +167,13 @@     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) 
-    = return region
+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) 
+                 ((throwErrnoIfMinus1 "extend file size" $ c_system_io_extend_file_size handle needsize) >> return ())
+        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
@@ -375,6 +380,10 @@ -- | Get file size in system specific manner
 foreign import ccall unsafe "HsMmap.h system_io_mmap_file_size"
     c_system_io_file_size :: Ptr () -> IO CLLong
+-- | Set file size in system specific manner. It is guaranteed to be called
+-- only with new size being at least current size.
+foreign import ccall unsafe "HsMmap.h system_io_mmap_extend_file_size"
+    c_system_io_extend_file_size :: Ptr () -> CLLong -> IO CInt
 -- | Memory mapping granularity.
 foreign import ccall unsafe "HsMmap.h system_io_mmap_granularity"
     c_system_io_granularity :: CInt

@@ -13,6 +13,8 @@  long long system_io_mmap_file_size(void *handle); +int system_io_mmap_extend_file_size(void *handle, long long size);+ int system_io_mmap_granularity();  // this is only implemented in _DEBUG builds

@@ -82,7 +82,6 @@     int prot;
     int flags;
     int fd = (int)(intptr_t)handle - 1;
-    struct stat st;
 
     switch(mode) {
     case 0:
@@ -105,13 +104,6 @@ 	return NULL;
     }
 
-    if( mode==3 ) {
-	fstat(fd,&st);
-	if( st.st_size<offset+size) {
-	    ftruncate(fd,offset+size);
-	}
-    }
-
     if( size>0 ) {
         ptr = mmap(NULL,size,prot,flags,fd,offset);
 
@@ -158,6 +150,13 @@     fstat(fd,&st);
     return st.st_size;
 }
+
+int system_io_mmap_extend_file_size(void *handle, long long size)
+{
+    int fd = (int)(intptr_t)handle - 1;
+    return ftruncate(fd,size);
+}
+
 
 //foreign import ccall unsafe "system_io_mmap_granularity" c_system_io_granularity :: CInt
 int system_io_mmap_granularity()

@@ -185,6 +185,16 @@     return (long long)lobits + ((long long)hibits << 32);
 }
 
+int system_io_mmap_extend_file_size(void *handle, long long size)
+{
+    DWORD lobits = (DWORD)size, hibits = (DWORD)(size>>32);
+    HANDLE mapping = CreateFileMapping(handle,NULL,PAGE_READWRITE,hibits,lobits,NULL);
+    if(mapping==NULL)
+        return -1;
+    CloseHandle(mapping);
+    return 0;
+}
+
 //foreign import ccall unsafe "system_io_mmap_granularity" c_system_io_granularity :: CInt
 int system_io_mmap_granularity()
 {

@@ -1,5 +1,5 @@ Name: mmap-Version: 0.5.3+Version: 0.5.4 Stability: alpha License: BSD3 License-File: LICENSE

@@ -17,6 +17,7 @@ import Foreign.C.Types (CInt,CLLong)
 import Control.Monad
 import System.IO
+import Data.Int
 #ifdef WINDOWS
 import qualified System.Win32.File as W
 #endif
@@ -49,6 +50,13 @@     bs <- mmapFileByteString "test_normal.bin" Nothing
     bs @?= content
 
+test_normal_readonly_many_times = do
+    BSC.writeFile "test_normal.bin" content
+    bs1 <- mmapFileByteString "test_normal.bin" Nothing
+    bs2 <- mmapFileByteString "test_normal.bin" Nothing
+    bs3 <- mmapFileByteString "test_normal.bin" Nothing
+    BSC.concat [bs1,bs2,bs3] @?= BSC.concat [content, content, content]
+
 test_normal_readonly_lazy = do
     let filename = "test_normalQ.bin"
     BSC.writeFile filename content
@@ -142,12 +150,19 @@         mmapFileByteString filename (Just (4,5000))
         assertFailure "Should throw exception"
 
+test_normal_offset_plus_size_beyond_eof_readonly_lazy = do
+    let filename = "test_normal7.bin"
+    BSC.writeFile filename content
+    ignoreExceptions $ do
+        mmapFileByteStringLazy filename (Just (4,5000))
+        assertFailure "Should throw exception"
+
 test_normal_offset_plus_size_beyond_eof_readwriteex = do
     let filename = "test_normal8.bin"
     BSC.writeFile filename content
     mmapWithFilePtr filename ReadWriteEx (Just (4,5000)) $ \(ptr,size) -> do
         size @?= 5000
-        bs <- BSC.unsafePackCStringLen (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
@@ -155,7 +170,7 @@     BSC.writeFile filename content
     mmapWithFilePtr filename ReadOnly Nothing $ \(ptr,size) -> do
         removeFileDelayed filename
-        bs <- BSC.unsafePackCStringLen (castPtr ptr,size) 
+        bs <- BSC.packCStringLen (castPtr ptr,size) 
         bs @?= content
     v <- doesFileExist filename
     False @=? v
@@ -168,12 +183,22 @@     let size = sum (Prelude.map (\(_,_,s) -> s) ignore)
     size @?= fromIntegral threegb
 
+test_readwriteex_lazy_make_dont_touch = do
+    let filename = "test_normal86.bin"
+    BSC.writeFile filename content
+    let threegb = 3*1000
+    mmapFileForeignPtrLazy filename ReadWriteEx (Just (0,threegb))
+    System.Mem.performGC
+    threadDelay 1000
+    size <- withFile filename ReadMode hFileSize 
+    size @?= fromIntegral threegb
+
 test_create_offset_plus_size_readwriteex = do
     let filename = "test_normal9.bin"
     ignoreExceptions $ removeFile filename
     mmapWithFilePtr filename ReadWriteEx (Just (4,5000)) $ \(ptr,size) -> do
         size @?= 5000
-        bs <- BSC.unsafePackCStringLen (castPtr ptr,size) 
+        bs <- BSC.packCStringLen (castPtr ptr,size) 
         bs @?= BSC.replicate 5000 '\0'
 
 test_create_readwriteex_no_way = do
@@ -186,12 +211,46 @@     ignoreExceptions $ removeFile filename
     ignoreExceptions $ mmapWithFilePtr filename ReadWriteEx Nothing $ \(ptr,size) -> do
         size @?= 5000
-        bs <- BSC.unsafePackCStringLen (castPtr ptr,size)
+        bs <- BSC.packCStringLen (castPtr ptr,size)
         bs @?= BSC.replicate 5000 '\0'
         assertFailure "Should throw exception"
     x <- doesFileExist filename
     x @?= False
 
+test_change_two_places = do
+    let filename = "test_normalAB.bin"
+    BSC.writeFile filename content
+    mmapWithFilePtr filename ReadWrite Nothing $ \(ptr1,size1) -> 
+        do
+          -- this should change one common memory
+          let v1 = 0x41414141::Int32
+          poke (castPtr ptr1) v1
+          v2 <- peek (castPtr ptr1)
+          v2 @?= v1
+          bs2 <- mmapFileByteString filename Nothing
+          size1 @?= BSC.length bs2
+          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) -> 
+        do
+          poke (castPtr ptr1) (0x41414141::Int32)
+    bs3 <- BSC.readFile filename
+    bs3 @?= BSC.pack "\x41\x41\x41\x41" `BSC.append` BSC.drop 4 content
+
+test_writecopy = do
+    let filename = "test_normalAD.bin"
+    BSC.writeFile filename content
+    mmapWithFilePtr filename WriteCopy Nothing $ \(ptr1,size1) -> 
+        do
+          poke (castPtr ptr1) (0x41414141::Int32)
+    -- change should NOT be reflected in file on disk
+    bs3 <- BSC.readFile filename
+    bs3 @?= content
+
 test_counters_zero = do
     System.Mem.performGC
     threadDelay 1000
@@ -220,10 +279,12 @@              test_normal_offset_size_zero_readonly_lazy
            , "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" ~: 
+           , "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 lazy" ~: 
+           , "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" ~: 
+             test_normal_offset_plus_size_beyond_eof_readonly_lazy
            , "Should ReadWriteEx mmap existing file and resize" ~: 
              test_normal_offset_plus_size_beyond_eof_readwriteex
            , "Should ReadWriteEx mmap new file and resize" ~:
@@ -232,11 +293,21 @@              test_create_nothing_readwriteex_should_throw
            , "Report error in file creation" ~:
              test_create_readwriteex_no_way  
-           , "ReadWriteEx in lazy should extend file beyond 3GB when mapped in" ~:
-             test_readwriteex_lazy_make_a_touch 
+           , "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 
+           , "MMap byte string many times" ~:
+             test_normal_readonly_many_times
+           , "Mmap common memory" ~:
+             test_change_two_places
+           , "Mmap read write memory" ~:
+             test_change_read_write
+           , "Mmap WriteCopy mode" ~:
+             test_writecopy
 
+           --, "ReadWriteEx in lazy should extend file beyond 3GB when mapped in" ~:
+           --  Test_readwriteex_lazy_make_a_touch 
            -- insert tests above this line
            , "Counters should be zero" ~:
              test_counters_zero
@@ -262,7 +333,7 @@     E.catch (do
               bs3 <- mmapFileByteString "test.bin" Nothing
               print (fromIntegral l==BSC.length bs3 + 5 ))
-          (\e -> print True -- exception here is also ok
+          (\E -> print True -- exception here is also ok
           )
     bs4 <- mmapFileByteStringLazy "test.bin" Nothing
     print (BSL.fromChunks [content] == BSL.take (fromIntegral $ BSC.length content) bs4)
@@ -272,4 +343,5 @@     System.Mem.performGC
     threadDelay 10000
 
--}+-}
+