summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--bittorrent.cabal1
-rw-r--r--tests/System/Torrent/FileMapSpec.hs38
2 files changed, 20 insertions, 19 deletions
diff --git a/bittorrent.cabal b/bittorrent.cabal
index dea8642b..c9ff7108 100644
--- a/bittorrent.cabal
+++ b/bittorrent.cabal
@@ -253,6 +253,7 @@ test-suite spec
253 , bencoding 253 , bencoding
254 , krpc >= 0.6.1 254 , krpc >= 0.6.1
255 , bittorrent 255 , bittorrent
256 , temporary
256 ghc-options: -Wall -fno-warn-orphans 257 ghc-options: -Wall -fno-warn-orphans
257 258
258 259
diff --git a/tests/System/Torrent/FileMapSpec.hs b/tests/System/Torrent/FileMapSpec.hs
index 85180c0a..29252925 100644
--- a/tests/System/Torrent/FileMapSpec.hs
+++ b/tests/System/Torrent/FileMapSpec.hs
@@ -6,26 +6,26 @@ import Data.List as L
6import Data.ByteString.Lazy as BL 6import Data.ByteString.Lazy as BL
7import System.Directory 7import System.Directory
8import System.FilePath 8import System.FilePath
9import System.IO.Unsafe 9import System.IO.Temp
10import Test.Hspec 10import Test.Hspec
11 11
12import Data.Torrent 12import Data.Torrent
13import System.Torrent.FileMap as FM 13import System.Torrent.FileMap as FM
14 14
15 15
16layout :: FileLayout FileSize 16withLayout :: (FileLayout FileSize -> IO ()) -> IO ()
17layout = 17withLayout f = do
18 [ (dir </> "a", 2) 18 tmp <- getTemporaryDirectory
19 , (dir </> "b", 3) 19 withTempDirectory tmp "bittorrentTestDir" $ \dir ->
20 , (dir </> "c", 2) 20 f [ (dir </> "a", 2)
21 ] 21 , (dir </> "b", 3)
22 where 22 , (dir </> "c", 2)
23 dir = unsafePerformIO $ getTemporaryDirectory 23 ] `seq` return ()
24 24
25spec :: Spec 25spec :: Spec
26spec = do 26spec = do
27 describe "mmapFiles" $ do 27 describe "mmapFiles" $ do
28 it "creates new files" $ do 28 it "creates new files" $ withLayout $ \layout -> do
29 m <- mmapFiles ReadWriteEx layout 29 m <- mmapFiles ReadWriteEx layout
30 unmapFiles m 30 unmapFiles m
31 31
@@ -33,7 +33,7 @@ spec = do
33 `shouldReturn` True 33 `shouldReturn` True
34 34
35 describe "size" $ do 35 describe "size" $ do
36 it "is equal to the layout size" $ do 36 it "is equal to the layout size" $ withLayout $ \layout -> do
37 m <- mmapFiles ReadOnly layout 37 m <- mmapFiles ReadOnly layout
38 FM.size m `shouldBe` L.sum (L.map snd layout) 38 FM.size m `shouldBe` L.sum (L.map snd layout)
39 unmapFiles m 39 unmapFiles m
@@ -45,13 +45,13 @@ spec = do
45 readBytes 3 15 m `shouldReturn` "this is test" 45 readBytes 3 15 m `shouldReturn` "this is test"
46 unmapFiles m 46 unmapFiles m
47 47
48 it "ignore underflow reads" $ do 48 it "ignore underflow reads" $ withLayout $ \layout -> do
49 m <- mmapFiles ReadOnly layout 49 m <- mmapFiles ReadOnly layout
50 readBytes (-1) 1 m `shouldReturn` "" 50 readBytes (-1) 1 m `shouldReturn` ""
51 readBytes (-5) 12 m `shouldReturn` "" 51 readBytes (-5) 12 m `shouldReturn` ""
52 unmapFiles m 52 unmapFiles m
53 53
54 it "crop overflow reads" $ do 54 it "crop overflow reads" $ withLayout $ \layout -> do
55 _m <- mmapFiles ReadWrite layout 55 _m <- mmapFiles ReadWrite layout
56 writeBytes 5 "cc" _m 56 writeBytes 5 "cc" _m
57 unmapFiles _m 57 unmapFiles _m
@@ -61,7 +61,7 @@ spec = do
61 unmapFiles m 61 unmapFiles m
62 62
63 describe "writeBytes" $ do 63 describe "writeBytes" $ do
64 it "writes to files" $ do 64 it "writes to files" $ withLayout $ \layout -> do
65 m <- mmapFiles ReadWriteEx layout 65 m <- mmapFiles ReadWriteEx layout
66 writeBytes 0 "a" m 66 writeBytes 0 "a" m
67 readBytes 0 1 m `shouldReturn` "a" 67 readBytes 0 1 m `shouldReturn` "a"
@@ -83,17 +83,17 @@ spec = do
83 let max_page_size = 4 * 1024 * 1024 83 let max_page_size = 4 * 1024 * 1024
84 let long_bs = BL.replicate (fromIntegral max_page_size) 0 84 let long_bs = BL.replicate (fromIntegral max_page_size) 0
85 85
86 it "no buffer underflow errors" $ do 86 it "no buffer underflow errors" $ withLayout $ \layout -> do
87 m <- mmapFiles ReadWrite layout 87 m <- mmapFiles ReadWrite layout
88 writeBytes (1 - max_page_size) long_bs m 88 writeBytes (1 - max_page_size) long_bs m
89 unmapFiles m 89 unmapFiles m
90 90
91 it "no buffer overflow errors" $ do 91 it "no buffer overflow errors" $ withLayout $ \layout -> do
92 m <- mmapFiles ReadWrite layout 92 m <- mmapFiles ReadWrite layout
93 writeBytes 5 long_bs m 93 writeBytes 5 long_bs m
94 unmapFiles m 94 unmapFiles m
95 95
96 it "ignore underflow writes" $ do 96 it "ignore underflow writes" $ withLayout $ \layout -> do
97 _m <- mmapFiles ReadWrite layout 97 _m <- mmapFiles ReadWrite layout
98 writeBytes 0 "aa" _m 98 writeBytes 0 "aa" _m
99 unmapFiles _m 99 unmapFiles _m
@@ -103,14 +103,14 @@ spec = do
103 unmapFiles m 103 unmapFiles m
104 BL.readFile (fst (layout !! 0)) `shouldReturn` "aa" 104 BL.readFile (fst (layout !! 0)) `shouldReturn` "aa"
105 105
106 it "crop overflow writes" $ do 106 it "crop overflow writes" $ withLayout $ \layout -> do
107 m <- mmapFiles ReadWrite layout 107 m <- mmapFiles ReadWrite layout
108 writeBytes 5 "ddddddddd" m 108 writeBytes 5 "ddddddddd" m
109 unmapFiles m 109 unmapFiles m
110 BL.readFile (fst (layout !! 2)) `shouldReturn` "dd" 110 BL.readFile (fst (layout !! 2)) `shouldReturn` "dd"
111 111
112 describe "from/to lazy bytestring" $ do 112 describe "from/to lazy bytestring" $ do
113 it "isomorphic to lazy bytestring" $ do 113 it "isomorphic to lazy bytestring" $ withLayout $ \layout -> do
114 m <- mmapFiles ReadOnly layout 114 m <- mmapFiles ReadOnly layout
115 fromLazyByteString (toLazyByteString m) `shouldBe` m 115 fromLazyByteString (toLazyByteString m) `shouldBe` m
116 unmapFiles m 116 unmapFiles m