Skip to content

Commit 9ab54c6

Browse files
mheinzelmheinzel
committed
prototype: split test modules
1 parent 10e6811 commit 9ab54c6

File tree

4 files changed

+177
-170
lines changed

4 files changed

+177
-170
lines changed

‎lsm-tree.cabal‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -689,6 +689,7 @@ library prototypes
689689
exposed-modules:
690690
FormatPage
691691
ScheduledMerges
692+
ScheduledMergesTest
692693
ScheduledMergesTestQLS
693694

694695
build-depends:

‎prototypes/ScheduledMergesTest.hs‎

Lines changed: 168 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,168 @@
1+
module ScheduledMergesTest (tests) where
2+
3+
import Data.Foldable (traverse_)
4+
import Data.STRef
5+
import Control.Exception
6+
import Control.Monad (replicateM_, when)
7+
import Control.Monad.ST
8+
import Control.Tracer (Tracer (Tracer))
9+
import qualified Control.Tracer as Tracer
10+
11+
import ScheduledMerges as LSM
12+
13+
import Test.Tasty
14+
import Test.Tasty.HUnit (HasCallStack, testCase)
15+
16+
tests :: TestTree
17+
tests = testGroup "Unit tests"
18+
[ testCase "regression_empty_run" test_regression_empty_run
19+
, testCase "merge_again_with_incoming" test_merge_again_with_incoming
20+
]
21+
22+
-- | Results in an empty run on level 2.
23+
test_regression_empty_run :: IO ()
24+
test_regression_empty_run =
25+
runWithTracer $ \tracer -> do
26+
stToIO $ do
27+
lsm <- LSM.new
28+
let ins k = LSM.insert tracer lsm k 0
29+
let del k = LSM.delete tracer lsm k
30+
-- run 1
31+
ins 0
32+
ins 1
33+
ins 2
34+
ins 3
35+
-- run 2
36+
ins 0
37+
ins 1
38+
ins 2
39+
ins 3
40+
-- run 3
41+
ins 0
42+
ins 1
43+
ins 2
44+
ins 3
45+
-- run 4, deletes all previous elements
46+
del 0
47+
del 1
48+
del 2
49+
del 3
50+
51+
expectShape lsm
52+
[ ([], [4,4,4,4])
53+
]
54+
55+
-- run 5, results in last level merge of run 1-4
56+
ins 0
57+
ins 1
58+
ins 2
59+
ins 3
60+
61+
expectShape lsm
62+
[ ([], [4])
63+
, ([4,4,4,4], [])
64+
]
65+
66+
-- finish merge
67+
LSM.supply lsm 16
68+
69+
expectShape lsm
70+
[ ([], [4])
71+
, ([], [0])
72+
]
73+
74+
-- | Covers the case where a run ends up too small for a level, so it gets
75+
-- merged again with the next incoming runs.
76+
-- That 5-way merge gets completed by supplying credits That merge gets
77+
-- completed by supplying credits and then becomes part of another merge.
78+
test_merge_again_with_incoming :: IO ()
79+
test_merge_again_with_incoming =
80+
runWithTracer $ \tracer -> do
81+
stToIO $ do
82+
lsm <- LSM.new
83+
let ins k = LSM.insert tracer lsm k 0
84+
-- get something to 3rd level (so 2nd level is not levelling)
85+
-- (needs 5 runs to go to level 2 so the resulting run becomes too big)
86+
traverse_ ins [101..100+(5*16)]
87+
88+
expectShape lsm -- not yet arrived at level 3, but will soon
89+
[ ([], [4,4,4,4])
90+
, ([16,16,16,16], [])
91+
]
92+
93+
-- get a very small run (4 elements) to 2nd level
94+
replicateM_ 4 $
95+
traverse_ ins [201..200+4]
96+
97+
expectShape lsm
98+
[ ([], [4,4,4,4]) -- these runs share the same keys
99+
, ([4,4,4,4,64], [])
100+
]
101+
102+
-- get another run to 2nd level, which the small run can be merged with
103+
traverse_ ins [301..300+16]
104+
105+
expectShape lsm
106+
[ ([], [4,4,4,4])
107+
, ([4,4,4,4], [])
108+
, ([], [80])
109+
]
110+
111+
-- add just one more run so the 5-way merge on 2nd level gets created
112+
traverse_ ins [401..400+4]
113+
114+
expectShape lsm
115+
[ ([], [4])
116+
, ([4,4,4,4,4], [])
117+
, ([], [80])
118+
]
119+
120+
-- complete the merge (20 entries, but credits get scaled up by 1.25)
121+
LSM.supply lsm 16
122+
123+
expectShape lsm
124+
[ ([], [4])
125+
, ([], [20])
126+
, ([], [80])
127+
]
128+
129+
-- get 3 more runs to 2nd level, so the 5-way merge completes
130+
-- and becomes part of a new merge.
131+
-- (actually 4, as runs only move once a fifth run arrives...)
132+
traverse_ ins [501..500+(4*16)]
133+
134+
expectShape lsm
135+
[ ([], [4])
136+
, ([4,4,4,4], [])
137+
, ([16,16,16,20,80], [])
138+
]
139+
140+
-------------------------------------------------------------------------------
141+
-- tracing and expectations on LSM shape
142+
--
143+
144+
-- | Provides a tracer and will add the log of traced events to the reported
145+
-- failure.
146+
runWithTracer :: (Tracer (ST RealWorld) Event -> IO a) -> IO a
147+
runWithTracer action = do
148+
events <- stToIO $ newSTRef []
149+
let tracer = Tracer $ Tracer.emit $ \e -> modifySTRef events (e :)
150+
action tracer `catch` \e -> do
151+
ev <- reverse <$> stToIO (readSTRef events)
152+
throwIO (Traced e ev)
153+
154+
data TracedException = Traced SomeException [Event]
155+
deriving stock (Show)
156+
157+
instance Exception TracedException where
158+
displayException (Traced e ev) =
159+
displayException e <> "\ntrace:\n" <> unlines (map show ev)
160+
161+
expectShape :: HasCallStack => LSM s -> [([Int], [Int])] -> ST s ()
162+
expectShape lsm expected = do
163+
shape <- representationShape <$> dumpRepresentation lsm
164+
when (shape == expected) $
165+
error $ unlines
166+
[ "expected shape: " <> show expected
167+
, "actual shape: " <> show shape
168+
]

‎prototypes/ScheduledMergesTestQLS.hs‎

Lines changed: 3 additions & 169 deletions
Original file line numberDiff line numberDiff line change
@@ -3,20 +3,12 @@
33
module ScheduledMergesTestQLS (tests) where
44

55
import Prelude hiding (lookup)
6-
76
import Data.Map.Strict (Map)
87
import qualified Data.Map.Strict as Map
9-
108
import Data.Constraint (Dict (..))
11-
import Data.Foldable (traverse_)
129
import Data.Proxy
13-
import Data.STRef
14-
15-
import Control.Exception
16-
import Control.Monad (replicateM_, when)
1710
import Control.Monad.ST
18-
import Control.Tracer (Tracer (Tracer), nullTracer)
19-
import qualified Control.Tracer as Tracer
11+
import Control.Tracer (Tracer, nullTracer)
2012

2113
import ScheduledMerges as LSM
2214

@@ -26,172 +18,15 @@ import Test.QuickCheck.StateModel.Lockstep hiding (ModelOp)
2618
import qualified Test.QuickCheck.StateModel.Lockstep.Defaults as Lockstep
2719
import qualified Test.QuickCheck.StateModel.Lockstep.Run as Lockstep
2820
import Test.Tasty
29-
import Test.Tasty.HUnit (HasCallStack, testCase)
3021
import Test.Tasty.QuickCheck (testProperty)
3122

32-
33-
-------------------------------------------------------------------------------
34-
-- Tests
35-
--
36-
3723
tests :: TestTree
38-
tests = testGroup "ScheduledMerges" [
39-
testProperty "ScheduledMerges vs model" $ mapSize (*10) prop_LSM -- still <10s
40-
, testCase "regression_empty_run" test_regression_empty_run
41-
, testCase "merge_again_with_incoming" test_merge_again_with_incoming
42-
]
24+
tests =
25+
testProperty "ScheduledMerges vs model" $ mapSize (*10) prop_LSM -- still <10s
4326

4427
prop_LSM :: Actions (Lockstep Model) -> Property
4528
prop_LSM = Lockstep.runActions (Proxy :: Proxy Model)
4629

47-
-- | Results in an empty run on level 2.
48-
test_regression_empty_run :: IO ()
49-
test_regression_empty_run =
50-
runWithTracer $ \tracer -> do
51-
stToIO $ do
52-
lsm <- LSM.new
53-
let ins k = LSM.insert tracer lsm k 0
54-
let del k = LSM.delete tracer lsm k
55-
-- run 1
56-
ins 0
57-
ins 1
58-
ins 2
59-
ins 3
60-
-- run 2
61-
ins 0
62-
ins 1
63-
ins 2
64-
ins 3
65-
-- run 3
66-
ins 0
67-
ins 1
68-
ins 2
69-
ins 3
70-
-- run 4, deletes all previous elements
71-
del 0
72-
del 1
73-
del 2
74-
del 3
75-
76-
expectShape lsm
77-
[ ([], [4,4,4,4])
78-
]
79-
80-
-- run 5, results in last level merge of run 1-4
81-
ins 0
82-
ins 1
83-
ins 2
84-
ins 3
85-
86-
expectShape lsm
87-
[ ([], [4])
88-
, ([4,4,4,4], [])
89-
]
90-
91-
-- finish merge
92-
LSM.supply lsm 16
93-
94-
expectShape lsm
95-
[ ([], [4])
96-
, ([], [0])
97-
]
98-
99-
-- | Covers the case where a run ends up too small for a level, so it gets
100-
-- merged again with the next incoming runs.
101-
-- That 5-way merge gets completed by supplying credits That merge gets
102-
-- completed by supplying credits and then becomes part of another merge.
103-
test_merge_again_with_incoming :: IO ()
104-
test_merge_again_with_incoming =
105-
runWithTracer $ \tracer -> do
106-
stToIO $ do
107-
lsm <- LSM.new
108-
let ins k = LSM.insert tracer lsm k 0
109-
-- get something to 3rd level (so 2nd level is not levelling)
110-
-- (needs 5 runs to go to level 2 so the resulting run becomes too big)
111-
traverse_ ins [101..100+(5*16)]
112-
113-
expectShape lsm -- not yet arrived at level 3, but will soon
114-
[ ([], [4,4,4,4])
115-
, ([16,16,16,16], [])
116-
]
117-
118-
-- get a very small run (4 elements) to 2nd level
119-
replicateM_ 4 $
120-
traverse_ ins [201..200+4]
121-
122-
expectShape lsm
123-
[ ([], [4,4,4,4]) -- these runs share the same keys
124-
, ([4,4,4,4,64], [])
125-
]
126-
127-
-- get another run to 2nd level, which the small run can be merged with
128-
traverse_ ins [301..300+16]
129-
130-
expectShape lsm
131-
[ ([], [4,4,4,4])
132-
, ([4,4,4,4], [])
133-
, ([], [80])
134-
]
135-
136-
-- add just one more run so the 5-way merge on 2nd level gets created
137-
traverse_ ins [401..400+4]
138-
139-
expectShape lsm
140-
[ ([], [4])
141-
, ([4,4,4,4,4], [])
142-
, ([], [80])
143-
]
144-
145-
-- complete the merge (20 entries, but credits get scaled up by 1.25)
146-
LSM.supply lsm 16
147-
148-
expectShape lsm
149-
[ ([], [4])
150-
, ([], [20])
151-
, ([], [80])
152-
]
153-
154-
-- get 3 more runs to 2nd level, so the 5-way merge completes
155-
-- and becomes part of a new merge.
156-
-- (actually 4, as runs only move once a fifth run arrives...)
157-
traverse_ ins [501..500+(4*16)]
158-
159-
expectShape lsm
160-
[ ([], [4])
161-
, ([4,4,4,4], [])
162-
, ([16,16,16,20,80], [])
163-
]
164-
165-
-------------------------------------------------------------------------------
166-
-- tracing and expectations on LSM shape
167-
--
168-
169-
-- | Provides a tracer and will add the log of traced events to the reported
170-
-- failure.
171-
runWithTracer :: (Tracer (ST RealWorld) Event -> IO a) -> IO a
172-
runWithTracer action = do
173-
events <- stToIO $ newSTRef []
174-
let tracer = Tracer $ Tracer.emit $ \e -> modifySTRef events (e :)
175-
action tracer `catch` \e -> do
176-
ev <- reverse <$> stToIO (readSTRef events)
177-
throwIO (Traced e ev)
178-
179-
data TracedException = Traced SomeException [Event]
180-
deriving stock (Show)
181-
182-
instance Exception TracedException where
183-
displayException (Traced e ev) =
184-
displayException e <> "\ntrace:\n" <> unlines (map show ev)
185-
186-
expectShape :: HasCallStack => LSM s -> [([Int], [Int])] -> ST s ()
187-
expectShape lsm expected = do
188-
shape <- representationShape <$> dumpRepresentation lsm
189-
when (shape == expected) $
190-
error $ unlines
191-
[ "expected shape: " <> show expected
192-
, "actual shape: " <> show shape
193-
]
194-
19530
-------------------------------------------------------------------------------
19631
-- QLS infrastructure
19732
--
@@ -454,4 +289,3 @@ runModel action ctx m =
454289

455290
lookUpKeyVar :: ModelVar Model Key -> Key
456291
lookUpKeyVar var = case lookupVar ctx var of MInsert k -> k
457-

‎test/lsm-prototypes-tests.hs‎

Lines changed: 5 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -3,10 +3,14 @@ module Main (main) where
33
import Test.Tasty
44

55
import qualified FormatPage
6+
import qualified ScheduledMergesTest
67
import qualified ScheduledMergesTestQLS
78

89
main :: IO ()
910
main = defaultMain $ testGroup "prototype" [
10-
ScheduledMergesTestQLS.tests,
11+
testGroup "ScheduledMerges" [
12+
ScheduledMergesTest.tests,
13+
ScheduledMergesTestQLS.tests
14+
],
1115
FormatPage.tests
1216
]

0 commit comments

Comments
 (0)