blob: 29252925a0ce7adb8b09cac4262447ba6fcdc4ae (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
|
-- this is test string used in the 'spec' --- don't touch me!
module System.Torrent.FileMapSpec (spec) where
import Control.Monad.Loops
import Data.List as L
import Data.ByteString.Lazy as BL
import System.Directory
import System.FilePath
import System.IO.Temp
import Test.Hspec
import Data.Torrent
import System.Torrent.FileMap as FM
withLayout :: (FileLayout FileSize -> IO ()) -> IO ()
withLayout f = do
tmp <- getTemporaryDirectory
withTempDirectory tmp "bittorrentTestDir" $ \dir ->
f [ (dir </> "a", 2)
, (dir </> "b", 3)
, (dir </> "c", 2)
] `seq` return ()
spec :: Spec
spec = do
describe "mmapFiles" $ do
it "creates new files" $ withLayout $ \layout -> do
m <- mmapFiles ReadWriteEx layout
unmapFiles m
(doesFileExist . fst) `allM` layout
`shouldReturn` True
describe "size" $ do
it "is equal to the layout size" $ withLayout $ \layout -> do
m <- mmapFiles ReadOnly layout
FM.size m `shouldBe` L.sum (L.map snd layout)
unmapFiles m
describe "readBytes" $ do
it "read from files" $ do
let thisFile = [("tests/System/Torrent/FileMapSpec.hs", 15)]
m <- mmapFiles ReadOnly thisFile
readBytes 3 15 m `shouldReturn` "this is test"
unmapFiles m
it "ignore underflow reads" $ withLayout $ \layout -> do
m <- mmapFiles ReadOnly layout
readBytes (-1) 1 m `shouldReturn` ""
readBytes (-5) 12 m `shouldReturn` ""
unmapFiles m
it "crop overflow reads" $ withLayout $ \layout -> do
_m <- mmapFiles ReadWrite layout
writeBytes 5 "cc" _m
unmapFiles _m
m <- mmapFiles ReadOnly layout
readBytes 5 10 m `shouldReturn` "cc"
unmapFiles m
describe "writeBytes" $ do
it "writes to files" $ withLayout $ \layout -> do
m <- mmapFiles ReadWriteEx layout
writeBytes 0 "a" m
readBytes 0 1 m `shouldReturn` "a"
writeBytes 1 "ab" m
readBytes 1 2 m `shouldReturn` "ab"
writeBytes 3 "b" m
readBytes 3 1 m `shouldReturn` "b"
writeBytes 4 "bc" m
readBytes 4 2 m `shouldReturn` "bc"
writeBytes 6 "c" m
readBytes 6 1 m `shouldReturn` "c"
readBytes 0 7 m `shouldReturn` "aabbbcc"
unmapFiles m
BL.readFile (fst (layout !! 0)) `shouldReturn` "aa"
BL.readFile (fst (layout !! 1)) `shouldReturn` "bbb"
BL.readFile (fst (layout !! 2)) `shouldReturn` "cc"
let max_page_size = 4 * 1024 * 1024
let long_bs = BL.replicate (fromIntegral max_page_size) 0
it "no buffer underflow errors" $ withLayout $ \layout -> do
m <- mmapFiles ReadWrite layout
writeBytes (1 - max_page_size) long_bs m
unmapFiles m
it "no buffer overflow errors" $ withLayout $ \layout -> do
m <- mmapFiles ReadWrite layout
writeBytes 5 long_bs m
unmapFiles m
it "ignore underflow writes" $ withLayout $ \layout -> do
_m <- mmapFiles ReadWrite layout
writeBytes 0 "aa" _m
unmapFiles _m
m <- mmapFiles ReadWrite layout
writeBytes (-1) "hhh" m
unmapFiles m
BL.readFile (fst (layout !! 0)) `shouldReturn` "aa"
it "crop overflow writes" $ withLayout $ \layout -> do
m <- mmapFiles ReadWrite layout
writeBytes 5 "ddddddddd" m
unmapFiles m
BL.readFile (fst (layout !! 2)) `shouldReturn` "dd"
describe "from/to lazy bytestring" $ do
it "isomorphic to lazy bytestring" $ withLayout $ \layout -> do
m <- mmapFiles ReadOnly layout
fromLazyByteString (toLazyByteString m) `shouldBe` m
unmapFiles m
|
