summaryrefslogtreecommitdiff
path: root/dht/bittorrent/tests/System/Torrent/FileMapSpec.hs
diff options
context:
space:
mode:
authorJames Crayne <jim.crayne@gmail.com>2019-09-28 13:43:29 -0400
committerJoe Crayne <joe@jerkface.net>2020-01-01 19:27:53 -0500
commit11987749fc6e6d3e53ea737d46d5ab13a16faeb8 (patch)
tree5716463275c2d3e902889db619908ded2a73971c /dht/bittorrent/tests/System/Torrent/FileMapSpec.hs
parentadd2c76bced51fde5e9917e7449ef52be70faf87 (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.hs116
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!
2module System.Torrent.FileMapSpec (spec) where
3
4import Control.Monad.Loops
5import Data.List as L
6import Data.ByteString.Lazy as BL
7import System.Directory
8import System.FilePath
9import System.IO.Temp
10import Test.Hspec
11
12import Data.Torrent
13import System.Torrent.FileMap as FM
14
15
16withLayout :: (FileLayout FileSize -> IO ()) -> IO ()
17withLayout 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
25spec :: Spec
26spec = 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