diff options
author | James Crayne <jim.crayne@gmail.com> | 2019-09-28 13:43:29 -0400 |
---|---|---|
committer | Joe Crayne <joe@jerkface.net> | 2020-01-01 19:27:53 -0500 |
commit | 11987749fc6e6d3e53ea737d46d5ab13a16faeb8 (patch) | |
tree | 5716463275c2d3e902889db619908ded2a73971c /dht/bittorrent/tests/System/Torrent/FileMapSpec.hs | |
parent | add2c76bced51fde5e9917e7449ef52be70faf87 (diff) |
Factor out some new libraries
word64-map:
Data.Word64Map
network-addr:
Network.Address
tox-crypto:
Crypto.Tox
lifted-concurrent:
Control.Concurrent.Lifted.Instrument
Control.Concurrent.Async.Lifted.Instrument
psq-wrap:
Data.Wrapper.PSQInt
Data.Wrapper.PSQ
minmax-psq:
Data.MinMaxPSQ
tasks:
Control.Concurrent.Tasks
kad:
Network.Kademlia
Network.Kademlia.Bootstrap
Network.Kademlia.Routing
Network.Kademlia.CommonAPI
Network.Kademlia.Persistence
Network.Kademlia.Search
Diffstat (limited to 'dht/bittorrent/tests/System/Torrent/FileMapSpec.hs')
-rw-r--r-- | dht/bittorrent/tests/System/Torrent/FileMapSpec.hs | 116 |
1 files changed, 116 insertions, 0 deletions
diff --git a/dht/bittorrent/tests/System/Torrent/FileMapSpec.hs b/dht/bittorrent/tests/System/Torrent/FileMapSpec.hs new file mode 100644 index 00000000..29252925 --- /dev/null +++ b/dht/bittorrent/tests/System/Torrent/FileMapSpec.hs | |||
@@ -0,0 +1,116 @@ | |||
1 | -- this is test string used in the 'spec' --- don't touch me! | ||
2 | module System.Torrent.FileMapSpec (spec) where | ||
3 | |||
4 | import Control.Monad.Loops | ||
5 | import Data.List as L | ||
6 | import Data.ByteString.Lazy as BL | ||
7 | import System.Directory | ||
8 | import System.FilePath | ||
9 | import System.IO.Temp | ||
10 | import Test.Hspec | ||
11 | |||
12 | import Data.Torrent | ||
13 | import System.Torrent.FileMap as FM | ||
14 | |||
15 | |||
16 | withLayout :: (FileLayout FileSize -> IO ()) -> IO () | ||
17 | withLayout f = do | ||
18 | tmp <- getTemporaryDirectory | ||
19 | withTempDirectory tmp "bittorrentTestDir" $ \dir -> | ||
20 | f [ (dir </> "a", 2) | ||
21 | , (dir </> "b", 3) | ||
22 | , (dir </> "c", 2) | ||
23 | ] `seq` return () | ||
24 | |||
25 | spec :: Spec | ||
26 | spec = do | ||
27 | describe "mmapFiles" $ do | ||
28 | it "creates new files" $ withLayout $ \layout -> do | ||
29 | m <- mmapFiles ReadWriteEx layout | ||
30 | unmapFiles m | ||
31 | |||
32 | (doesFileExist . fst) `allM` layout | ||
33 | `shouldReturn` True | ||
34 | |||
35 | describe "size" $ do | ||
36 | it "is equal to the layout size" $ withLayout $ \layout -> do | ||
37 | m <- mmapFiles ReadOnly layout | ||
38 | FM.size m `shouldBe` L.sum (L.map snd layout) | ||
39 | unmapFiles m | ||
40 | |||
41 | describe "readBytes" $ do | ||
42 | it "read from files" $ do | ||
43 | let thisFile = [("tests/System/Torrent/FileMapSpec.hs", 15)] | ||
44 | m <- mmapFiles ReadOnly thisFile | ||
45 | readBytes 3 15 m `shouldReturn` "this is test" | ||
46 | unmapFiles m | ||
47 | |||
48 | it "ignore underflow reads" $ withLayout $ \layout -> do | ||
49 | m <- mmapFiles ReadOnly layout | ||
50 | readBytes (-1) 1 m `shouldReturn` "" | ||
51 | readBytes (-5) 12 m `shouldReturn` "" | ||
52 | unmapFiles m | ||
53 | |||
54 | it "crop overflow reads" $ withLayout $ \layout -> do | ||
55 | _m <- mmapFiles ReadWrite layout | ||
56 | writeBytes 5 "cc" _m | ||
57 | unmapFiles _m | ||
58 | |||
59 | m <- mmapFiles ReadOnly layout | ||
60 | readBytes 5 10 m `shouldReturn` "cc" | ||
61 | unmapFiles m | ||
62 | |||
63 | describe "writeBytes" $ do | ||
64 | it "writes to files" $ withLayout $ \layout -> do | ||
65 | m <- mmapFiles ReadWriteEx layout | ||
66 | writeBytes 0 "a" m | ||
67 | readBytes 0 1 m `shouldReturn` "a" | ||
68 | writeBytes 1 "ab" m | ||
69 | readBytes 1 2 m `shouldReturn` "ab" | ||
70 | writeBytes 3 "b" m | ||
71 | readBytes 3 1 m `shouldReturn` "b" | ||
72 | writeBytes 4 "bc" m | ||
73 | readBytes 4 2 m `shouldReturn` "bc" | ||
74 | writeBytes 6 "c" m | ||
75 | readBytes 6 1 m `shouldReturn` "c" | ||
76 | readBytes 0 7 m `shouldReturn` "aabbbcc" | ||
77 | unmapFiles m | ||
78 | |||
79 | BL.readFile (fst (layout !! 0)) `shouldReturn` "aa" | ||
80 | BL.readFile (fst (layout !! 1)) `shouldReturn` "bbb" | ||
81 | BL.readFile (fst (layout !! 2)) `shouldReturn` "cc" | ||
82 | |||
83 | let max_page_size = 4 * 1024 * 1024 | ||
84 | let long_bs = BL.replicate (fromIntegral max_page_size) 0 | ||
85 | |||
86 | it "no buffer underflow errors" $ withLayout $ \layout -> do | ||
87 | m <- mmapFiles ReadWrite layout | ||
88 | writeBytes (1 - max_page_size) long_bs m | ||
89 | unmapFiles m | ||
90 | |||
91 | it "no buffer overflow errors" $ withLayout $ \layout -> do | ||
92 | m <- mmapFiles ReadWrite layout | ||
93 | writeBytes 5 long_bs m | ||
94 | unmapFiles m | ||
95 | |||
96 | it "ignore underflow writes" $ withLayout $ \layout -> do | ||
97 | _m <- mmapFiles ReadWrite layout | ||
98 | writeBytes 0 "aa" _m | ||
99 | unmapFiles _m | ||
100 | |||
101 | m <- mmapFiles ReadWrite layout | ||
102 | writeBytes (-1) "hhh" m | ||
103 | unmapFiles m | ||
104 | BL.readFile (fst (layout !! 0)) `shouldReturn` "aa" | ||
105 | |||
106 | it "crop overflow writes" $ withLayout $ \layout -> do | ||
107 | m <- mmapFiles ReadWrite layout | ||
108 | writeBytes 5 "ddddddddd" m | ||
109 | unmapFiles m | ||
110 | BL.readFile (fst (layout !! 2)) `shouldReturn` "dd" | ||
111 | |||
112 | describe "from/to lazy bytestring" $ do | ||
113 | it "isomorphic to lazy bytestring" $ withLayout $ \layout -> do | ||
114 | m <- mmapFiles ReadOnly layout | ||
115 | fromLazyByteString (toLazyByteString m) `shouldBe` m | ||
116 | unmapFiles m | ||