diff --git a/System/IO/MMap.hs b/System/IO/MMap.hs --- a/System/IO/MMap.hs +++ b/System/IO/MMap.hs @@ -73,7 +73,7 @@ -- user. Otherwise referential transparency may be or may be not -- compromised. Sadly semantics differ much between operating systems. -- --- In case of IO errors all function use 'throwErrno'. +-- In case of IO errors all function use 'throwErrno' or 'throwErrnoPath'. -- -- In case of 'ForeignPtr' or 'BS.ByteString' functions the storage -- manager is used to free the mapped memory. When the garbage @@ -172,7 +172,8 @@ 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 ()) + ((throwErrnoPathIfMinus1 "extend file size" filepath $ + 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" @@ -182,15 +183,15 @@ (offset,size) <- case region of Just (offset,size) -> do when (size<0) $ - throwErrno $ "mmap of '" ++ filepath ++ "' failed, negative size reguested" + ioError (errnoToIOError "mmap negative size reguested" eINVAL Nothing (Just filepath)) when (offset<0) $ - throwErrno $ "mmap of '" ++ filepath ++ "' failed, negative offset reguested" + ioError (errnoToIOError "mmap negative offset reguested" eINVAL Nothing (Just filepath)) when (mode/=ReadWriteEx && (longsize do when (longsize > fromIntegral (maxBound `asTypeOf` sizetype)) $ - throwErrno $ "mmap of '" ++ filepath ++ "' failed, size is greater then maxBound" + ioError (errnoToIOError "mmap requested size is greater then maxBound" eINVAL Nothing (Just filepath)) return (0,fromIntegral longsize) return (offset,size) @@ -237,7 +238,7 @@ c_system_io_mmap_mmap handle (fromIntegral $ fromEnum mode) (fromIntegral offsetraw) (fromIntegral sizeraw) when (ptr == nullPtr) $ - throwErrno $ "mmap of '" ++ filepath ++ "' failed" + throwErrnoPath ("mmap of '" ++ filepath ++ "' failed") filepath return (castPtr ptr,sizeraw,fromIntegral align,size) -- | Memory map region of file using autounmap semantics. See @@ -304,8 +305,8 @@ ptr <- c_system_io_mmap_mmap handle (fromIntegral $ fromEnum mode) (fromIntegral offsetraw) (fromIntegral sizeraw) when (ptr == nullPtr) $ - throwErrno $ "lazy mmap of '" ++ filepath ++ - "' chunk(" ++ show offset ++ "," ++ show size ++") failed" + 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) @@ -344,7 +345,7 @@ ptr <- withCString filepath $ \filepath -> c_system_io_mmap_file_open filepath (fromIntegral $ fromEnum mode) when (ptr == nullPtr) $ - throwErrno $ "opening of '" ++ filepath ++ "' failed" + throwErrnoPath ("opening of '" ++ filepath ++ "' failed") filepath handle <- newForeignPtr c_system_io_mmap_file_close ptr return handle @@ -353,6 +354,7 @@ castIntToPtr :: Int -> Ptr a castIntToPtr int = nullPtr `plusPtr` int + -- | Should open file given as CString in mode given as CInt foreign import ccall unsafe "HsMmap.h system_io_mmap_file_open" diff --git a/mmap.cabal b/mmap.cabal --- a/mmap.cabal +++ b/mmap.cabal @@ -1,5 +1,5 @@ Name: mmap -Version: 0.5.4 +Version: 0.5.5 Stability: alpha License: BSD3 License-File: LICENSE diff --git a/tests/mmaptest.hs b/tests/mmaptest.hs --- a/tests/mmaptest.hs +++ b/tests/mmaptest.hs @@ -162,7 +162,7 @@ BSC.writeFile filename content mmapWithFilePtr filename ReadWriteEx (Just (4,5000)) $ \(ptr,size) -> do size @?= 5000 - bs <- BSC.packCStringLen (castPtr ptr,size) + bs <- BSC.unsafePackCStringLen (castPtr ptr,size) bs @?= BSC.take 5000 (BSC.drop 4 (content `BSC.append` BSC.replicate 10000 '\0')) test_delete_while_mmapped = do @@ -170,7 +170,7 @@ BSC.writeFile filename content mmapWithFilePtr filename ReadOnly Nothing $ \(ptr,size) -> do removeFileDelayed filename - bs <- BSC.packCStringLen (castPtr ptr,size) + bs <- BSC.unsafePackCStringLen (castPtr ptr,size) bs @?= content v <- doesFileExist filename False @=? v @@ -198,7 +198,7 @@ ignoreExceptions $ removeFile filename mmapWithFilePtr filename ReadWriteEx (Just (4,5000)) $ \(ptr,size) -> do size @?= 5000 - bs <- BSC.packCStringLen (castPtr ptr,size) + bs <- BSC.unsafePackCStringLen (castPtr ptr,size) bs @?= BSC.replicate 5000 '\0' test_create_readwriteex_no_way = do @@ -211,38 +211,31 @@ ignoreExceptions $ removeFile filename ignoreExceptions $ mmapWithFilePtr filename ReadWriteEx Nothing $ \(ptr,size) -> do size @?= 5000 - bs <- BSC.packCStringLen (castPtr ptr,size) + bs <- BSC.unsafePackCStringLen (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" + let filename = "test_normalA.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 + -- this should change one common memory poke (castPtr ptr1) (0x41414141::Int32) + bs1 <- BSC.unsafePackCStringLen (castPtr ptr1,size1) + bs1 @?= bs2 + System.Mem.performGC + threadDelay 1000 + -- change should be reflected in file on disk 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" + let filename = "test_normalA.bin" BSC.writeFile filename content mmapWithFilePtr filename WriteCopy Nothing $ \(ptr1,size1) -> do @@ -301,13 +294,11 @@ 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 + -- test_readwriteex_lazy_make_a_touch -- insert tests above this line , "Counters should be zero" ~: test_counters_zero @@ -333,7 +324,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)