Skip to content

Commit a0e802f

Browse files
simonmarsimonmar
committed
Speed up tests
We typically run each test case on at least 4 different DB flavours (memory, rocksdb, memory/stacked and rocksdb/stacked), and for each test we were recreating the exact same test DBs. To speed things up when there are multiple tests, this creates the test DBs once and shares them between all tests. Also: moved StringTest into AngleTest, it was a bit strange to have that one test case in a test by itself.
1 parent a42509f commit a0e802f

9 files changed

Lines changed: 149 additions & 138 deletions

File tree

‎glean/test/lib/TestDB.hs‎

Lines changed: 51 additions & 20 deletions
Original file line numberDiff line numberDiff line change
@@ -7,14 +7,19 @@
77
-}
88

99
module TestDB (
10+
WithDB,
1011
withTestDB, withWritableTestDB, withStackedTestDB,
11-
dbTestCase, dbTestCaseWritable, dbTestCaseSettings, createTestDB
12+
dbTestCase, dbTestCaseWritable, dbTestCaseSettings, createTestDB,
13+
withDbTests,
1214
) where
1315

1416
import Data.Default
1517
import Data.Either
18+
import Foreign.Marshal.Utils
1619
import Test.HUnit
1720

21+
import Util.IO
22+
1823
import Glean.Database.Storage (DBVersion(..), currentVersion, writableVersions)
1924
import Glean.Database.Test
2025
import Glean.Database.Types
@@ -29,25 +34,28 @@ import qualified Glean.Schema.Sys as Sys
2934

3035
import TestData
3136

32-
afterComplete :: (Env -> Thrift.Repo -> IO a) -> Env -> Thrift.Repo -> IO a
37+
-- | An action that runs on a test DB
38+
type WithDB a = Env -> Thrift.Repo -> IO a
39+
40+
afterComplete :: WithDB a -> WithDB a
3341
afterComplete action env repo = do
3442
completeTestDB env repo
3543
action env repo
3644

37-
withTestDB :: [Setting] -> (Env -> Thrift.Repo -> IO a) -> IO a
45+
withTestDB :: [Setting] -> WithDB a -> IO a
3846
withTestDB settings = withWritableTestDB settings . afterComplete
3947

40-
createTestDB :: Env -> Thrift.Repo -> IO ()
48+
createTestDB :: WithDB ()
4149
createTestDB env repo = do
4250
kickOffTestDB env repo id
4351
writeTestDB env repo testFacts
4452

45-
withWritableTestDB :: [Setting] -> (Env -> Thrift.Repo -> IO a) -> IO a
53+
withWritableTestDB :: [Setting] -> WithDB a -> IO a
4654
withWritableTestDB settings action = withEmptyTestDB settings $ \env repo -> do
4755
writeTestDB env repo testFacts
4856
action env repo
4957

50-
withStackedTestDB :: [Setting] -> (Env -> Thrift.Repo -> IO a) -> IO a
58+
withStackedTestDB :: [Setting] -> WithDB a -> IO a
5159
withStackedTestDB settings action = withTestEnv settings $ \env -> do
5260
kickOffTestDB env repo1 id
5361
writeTestDB env repo1 testFacts1
@@ -62,30 +70,53 @@ withStackedTestDB settings action = withTestEnv settings $ \env -> do
6270
repo1 = Thrift.Repo "dbtest-repo" "1"
6371
repo2 = Thrift.Repo "dbtest-repo" "2"
6472

65-
testCases :: [Setting] -> (Env -> Thrift.Repo -> IO ()) -> Test
66-
testCases testCaseSettings action = TestList
67-
[ TestLabel (label1 ++ label2) $
68-
TestCase $ with (settings <> testCaseSettings) action
69-
| (label1, with) <-
70-
[ ("", withWritableTestDB)
71-
, ("stacked/", withStackedTestDB) ]
72-
, (label2, settings) <-
73+
newtype RunTest = RunTest (forall a . WithDB a -> IO a)
74+
75+
toTestCases :: [(String, RunTest)] -> WithDB () -> Test
76+
toTestCases testCases action = TestList
77+
[ TestLabel label $ TestCase $ with action
78+
| (label, RunTest with) <- testCases
79+
]
80+
81+
dbFlavours :: [Setting] -> [(String, RunTest)]
82+
dbFlavours testCaseSettings =
83+
[ (label1 ++ label2, run)
84+
| (label2, settings) <-
7385
[ ("memory", [setMemoryStorage])
7486
, ("rocksdb", [])
7587
]
7688
++
7789
[ ("rocksdb-" ++ show (unDBVersion v), [setDBVersion v])
7890
| v <- writableVersions, v /= currentVersion ]
91+
, let allSettings = settings <> testCaseSettings
92+
, (label1, run) <-
93+
[ ("", RunTest (withWritableTestDB allSettings))
94+
, ("stacked/", RunTest (withStackedTestDB allSettings)) ]
7995
]
8096

81-
dbTestCase :: (Env -> Thrift.Repo -> IO ()) -> Test
82-
dbTestCase = testCases [] . afterComplete
97+
-- | Run a test on several flavour of test DB. For a test suite
98+
-- with multiple tests, use 'withDbTests' instead.
99+
dbTestCase :: WithDB () -> Test
100+
dbTestCase = toTestCases (dbFlavours []) . afterComplete
101+
102+
-- | Like dbTestCase, but the test DBs are shared between multiple
103+
-- tests, rather than being created afresh for each test. Useful
104+
-- for speeding up test suites that have many individual tests.
105+
withDbTests :: ((WithDB () -> Test) -> IO a) -> IO a
106+
withDbTests fn =
107+
withMany lazify (dbFlavours []) $ fn . toTestCases
108+
where
109+
lazify :: (String, RunTest) -> ((String, RunTest) -> IO a) -> IO a
110+
lazify (label, RunTest run) fn =
111+
withLazy (run . afterComplete . curry) $ \get ->
112+
fn (label, RunTest (\with -> do (env, repo) <- get; with env repo))
83113

84-
dbTestCaseWritable :: (Env -> Thrift.Repo -> IO ()) -> Test
85-
dbTestCaseWritable = testCases []
114+
dbTestCaseWritable :: WithDB () -> Test
115+
dbTestCaseWritable = toTestCases (dbFlavours [])
86116

87-
dbTestCaseSettings :: [Setting] -> (Env -> Thrift.Repo -> IO ()) -> Test
88-
dbTestCaseSettings settings action = testCases settings (afterComplete action)
117+
dbTestCaseSettings :: [Setting] -> WithDB () -> Test
118+
dbTestCaseSettings settings action =
119+
toTestCases (dbFlavours settings) (afterComplete action)
89120

90121
writeTestDB :: Env -> Thrift.Repo -> (forall m. NewFact m => m ()) -> IO ()
91122
writeTestDB env repo facts = do

‎glean/test/tests/Angle/AngleTest.hs‎

Lines changed: 36 additions & 19 deletions
Original file line numberDiff line numberDiff line change
@@ -34,24 +34,24 @@ import TestData
3434
import TestDB
3535

3636
main :: IO ()
37-
main = withUnitTest $ testRunner $ TestList
38-
[ TestLabel "angle" $ angleTest id
39-
, TestLabel "angle/page" $ angleTest (limit 1)
40-
, TestLabel "angleDot" angleDotTest
41-
, TestLabel "angleNegation" $ angleNegationTest id
42-
, TestLabel "angleNegation/page" $ angleNegationTest (limit 1)
43-
, TestLabel "angleIfThenElse" $ angleIfThenElse id
44-
, TestLabel "angleIfThenElse/page" $ angleIfThenElse (limit 1)
45-
, TestLabel "angleTypeTest" angleTypeTest
37+
main = withUnitTest $ withDbTests $ \dbTestCase -> testRunner $ TestList
38+
[ TestLabel "angle" $ angleTest dbTestCase id
39+
, TestLabel "angle/page" $ angleTest dbTestCase (limit 1)
40+
, TestLabel "angleDot" $ angleDotTest dbTestCase
41+
, TestLabel "angleNegation" $ angleNegationTest dbTestCase id
42+
, TestLabel "angleNegation/page" $ angleNegationTest dbTestCase (limit 1)
43+
, TestLabel "angleIfThenElse" $ angleIfThenElse dbTestCase id
44+
, TestLabel "angleIfThenElse/page" $ angleIfThenElse dbTestCase (limit 1)
45+
, TestLabel "angleTypeTest" $ angleTypeTest dbTestCase
4646
]
4747

4848
ignorePredK :: Glean.Test.KitchenSink -> Glean.Test.KitchenSink
4949
ignorePredK k = k {
5050
Glean.Test.kitchenSink_pred = def,
5151
Glean.Test.kitchenSink_sum_ = def }
5252

53-
angleTest :: (forall a . Query a -> Query a) -> Test
54-
angleTest modify = dbTestCase $ \env repo -> do
53+
angleTest :: (WithDB () -> Test) -> (forall a . Query a -> Query a) -> Test
54+
angleTest dbTestCase modify = dbTestCase $ \env repo -> do
5555
-- match zero results
5656
results <- runQuery_ env repo $ modify $ angle @Sys.Blob
5757
[s|
@@ -469,6 +469,17 @@ angleTest modify = dbTestCase $ \env repo -> do
469469
(Nat 6, Nat 2),
470470
(Nat 8, Nat 3), (Nat 12, Nat 3), (Nat 15, Nat 3)] ] r
471471

472+
-- Test prim.reverse
473+
results <- runQuery_ env repo $ modify $ angle @Glean.Test.Predicate
474+
[s|
475+
glean.test.Predicate {
476+
string_ = X
477+
} where
478+
X = prim.reverse (prim.reverse X)
479+
|]
480+
print results
481+
assertEqual "angle - string reverse" 4 (length results)
482+
472483
-- Test numeric comparison primitives
473484
r <- runQuery_ env repo $ angleData @() "prim.gtNat 2 1"
474485
print r
@@ -597,8 +608,8 @@ angleTest modify = dbTestCase $ \env repo -> do
597608
[[Nat 1, Nat 2, Nat 1, Nat 2]] r
598609

599610

600-
angleDotTest :: Test
601-
angleDotTest = dbTestCase $ \env repo -> do
611+
angleDotTest :: (WithDB () -> Test) -> Test
612+
angleDotTest dbTestCase = dbTestCase $ \env repo -> do
602613

603614
-- record selection
604615
r <- runQuery_ env repo $ angleData @Text
@@ -697,8 +708,11 @@ angleDotTest = dbTestCase $ \env repo -> do
697708

698709

699710
-- if statements
700-
angleIfThenElse :: (forall a . Query a -> Query a) -> Test
701-
angleIfThenElse modify = dbTestCase $ \env repo -> do
711+
angleIfThenElse
712+
:: (WithDB () -> Test)
713+
-> (forall a . Query a -> Query a)
714+
-> Test
715+
angleIfThenElse dbTestCase modify = dbTestCase $ \env repo -> do
702716

703717
r <- runQuery_ env repo $ modify $ angleData @Nat
704718
"if never : {} then 1 else 2"
@@ -812,8 +826,11 @@ angleIfThenElse modify = dbTestCase $ \env repo -> do
812826
assertEqual "reordering disjunctions" 5 (length r)
813827

814828

815-
angleNegationTest :: (forall a . Query a -> Query a) -> Test
816-
angleNegationTest modify = dbTestCase $ \env repo -> do
829+
angleNegationTest
830+
:: (WithDB () -> Test)
831+
-> (forall a . Query a -> Query a)
832+
-> Test
833+
angleNegationTest dbTestCase modify = dbTestCase $ \env repo -> do
817834
-- Negation
818835

819836
-- negating a term fails
@@ -918,8 +935,8 @@ angleNegationTest modify = dbTestCase $ \env repo -> do
918935
assertEqual "negation - 3" 1 (length r)
919936

920937
-- type checking
921-
angleTypeTest :: Test
922-
angleTypeTest = dbTestCase $ \env repo -> do
938+
angleTypeTest :: (WithDB () -> Test) -> Test
939+
angleTypeTest dbTestCase = dbTestCase $ \env repo -> do
923940
-- Test for correct handling of maybe, bool, and enums in the type checker
924941
r <- runQuery_ env repo $ recursive $ angleData @Nat
925942
[s|

‎glean/test/tests/Angle/ArrayTest.hs‎

Lines changed: 15 additions & 11 deletions
Original file line numberDiff line numberDiff line change
@@ -26,19 +26,21 @@ import Glean.Types
2626
import TestDB
2727

2828
main :: IO ()
29-
main = withUnitTest $ testRunner $ TestList
30-
[ TestLabel "array" $ angleArray id
31-
, TestLabel "array/page" $ angleArray (limit 1)
29+
main = withUnitTest $ withDbTests $ \dbTestCase -> testRunner $ TestList
30+
[ TestLabel "array" $ angleArray dbTestCase id
31+
, TestLabel "array/page" $ angleArray dbTestCase (limit 1)
3232
]
3333

34-
angleArray :: (forall a . Query a -> Query a) -> Test
35-
angleArray modify = TestList
36-
[ TestLabel "generators" $ angleArrayGenerator modify
37-
, TestLabel "prefix" $ angleArrayPrefix modify
34+
angleArray :: (WithDB () -> Test) -> (forall a . Query a -> Query a) -> Test
35+
angleArray dbTestCase modify = TestList
36+
[ TestLabel "generators" $ angleArrayGenerator dbTestCase modify
37+
, TestLabel "prefix" $ angleArrayPrefix dbTestCase modify
3838
]
3939

40-
angleArrayGenerator :: (forall a . Query a -> Query a) -> Test
41-
angleArrayGenerator modify = TestList
40+
angleArrayGenerator
41+
:: (WithDB () -> Test)
42+
-> (forall a . Query a -> Query a) -> Test
43+
angleArrayGenerator dbTestCase modify = TestList
4244
[ TestLabel "array of pred" $
4345
dbTestCase $ \env repo -> do
4446
-- fetch all elements of an array
@@ -95,8 +97,10 @@ angleArrayGenerator modify = TestList
9597
(sort [Byte 1, Byte (fromIntegral (255 :: Word8))]) (sort results)
9698
]
9799

98-
angleArrayPrefix :: (forall a . Query a -> Query a) -> Test
99-
angleArrayPrefix modify = TestList
100+
angleArrayPrefix
101+
:: (WithDB () -> Test)
102+
-> (forall a . Query a -> Query a) -> Test
103+
angleArrayPrefix dbTestCase modify = TestList
100104
[ TestLabel "nat" $ TestList
101105
[ TestLabel "nested" $ dbTestCase $ \env repo -> do
102106
results <- runQuery_ env repo $ modify $ angle @Glean.Test.Predicate

‎glean/test/tests/Angle/DataTest.hs‎

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -24,13 +24,13 @@ import Glean.Types
2424
import TestDB
2525

2626
main :: IO ()
27-
main = withUnitTest $ testRunner $ TestList
27+
main = withUnitTest $ withDbTests $ \dbTestCase -> testRunner $ TestList
2828
[ TestLabel "angleData" $ angleDataTest id
2929
, TestLabel "angleData/page" $ angleDataTest (limit 1)
3030
]
3131

32-
angleDataTest :: (forall a . Query a -> Query a) -> Test
33-
angleDataTest modify = dbTestCase $ \env repo -> do
32+
angleDataTest :: (WithDB () -> Test) -> (forall a . Query a -> Query a) -> Test
33+
angleDataTest dbTestCase modify = dbTestCase $ \env repo -> do
3434
results <- runQuery_ env repo $ modify $ angleData
3535
[s| { 3, false } : { x : nat, y : bool } |]
3636
assertEqual "angleData 1" [(Nat 3, False)] results

‎glean/test/tests/Angle/MiscTest.hs‎

Lines changed: 23 additions & 23 deletions
Original file line numberDiff line numberDiff line change
@@ -37,17 +37,17 @@ import Glean.Types
3737
import TestDB
3838

3939
main :: IO ()
40-
main = withUnitTest $ testRunner $ TestList
41-
[ TestLabel "justKeys" $ justKeys id
42-
, TestLabel "justKeys/page" $ justKeys (limit 1)
43-
, TestLabel "reorder" reorderTest
44-
, TestLabel "scoping" scopingTest
45-
, TestLabel "queryOptions" angleQueryOptions
46-
, TestLabel "limitBytes" limitTest
40+
main = withUnitTest $ withDbTests $ \dbTestCase -> testRunner $ TestList
41+
[ TestLabel "justKeys" $ justKeys dbTestCase id
42+
, TestLabel "justKeys/page" $ justKeys dbTestCase (limit 1)
43+
, TestLabel "reorder" $ reorderTest dbTestCase
44+
, TestLabel "scoping" $ scopingTest dbTestCase
45+
, TestLabel "queryOptions" $ angleQueryOptions dbTestCase
46+
, TestLabel "limitBytes" $ limitTest dbTestCase
4747
, TestLabel "fullScans" fullScansTest
4848
, TestLabel "newold" $ newOldTest id
49-
, TestLabel "justCheck" justCheckTest
50-
, TestLabel "warnDiag" warnDiagTest
49+
, TestLabel "justCheck" $ justCheckTest dbTestCase
50+
, TestLabel "warnDiag" $ warnDiagTest dbTestCase
5151
]
5252

5353
newOldTest :: (forall a . Query a -> Query a) -> Test
@@ -64,8 +64,8 @@ newOldTest modify = TestCase $ withStackedTestDB [] $ \env repo -> do
6464
[ "abba", "anonymous", "azimuth", "blubber", "book", "foo" ]
6565
results
6666

67-
warnDiagTest :: Test
68-
warnDiagTest = dbTestCase $ \env repo -> do
67+
warnDiagTest :: (WithDB () -> Test) -> Test
68+
warnDiagTest dbTestCase = dbTestCase $ \env repo -> do
6969
let (Query q1) = dbgPredHasFacts $ Angle.query $
7070
predicate @Glean.Test.EmptyPred wild
7171
(Query q2) = Angle.query $ predicate @Cxx.Name wild
@@ -78,8 +78,8 @@ warnDiagTest = dbTestCase $ \env repo -> do
7878
where getWarns r = filter (\d -> "Warning" `isPrefixOf` Text.unpack d)
7979
$ userQueryResults_diagnostics r
8080

81-
scopingTest :: Test
82-
scopingTest = dbTestCase $ \env repo -> do
81+
scopingTest :: (WithDB () -> Test) -> Test
82+
scopingTest dbTestCase = dbTestCase $ \env repo -> do
8383
r <- try $ runQuery_ env repo $ angle @Glean.Test.Predicate
8484
[s|
8585
cxx1.Name X
@@ -142,8 +142,8 @@ scopingTest = dbTestCase $ \env repo -> do
142142
print (r :: [Glean.Test.NothingTest])
143143
assertEqual "angle - nothingTest" 1 (length r)
144144

145-
justKeys :: (forall a . Query a -> Query a) -> Test
146-
justKeys modify = dbTestCase $ \env repo -> do
145+
justKeys :: (WithDB () -> Test) -> (forall a . Query a -> Query a) -> Test
146+
justKeys dbTestCase modify = dbTestCase $ \env repo -> do
147147
results <- runQuery_ env repo $ modify $ keys $ allFacts @Cxx.Name
148148
assertEqual "angle - justKeys" 11 (length results)
149149
assertBool "angle - justKeys" $ "abba" `elem` results
@@ -189,8 +189,8 @@ factsSearched ref lookupPid maybeStats = do
189189
\ /
190190
"d"
191191
-}
192-
reorderTest :: Test
193-
reorderTest = dbTestCase $ \env repo -> do
192+
reorderTest :: (WithDB () -> Test) -> Test
193+
reorderTest dbTestCase = dbTestCase $ \env repo -> do
194194
si <- getSchemaInfo env (Just repo) def { getSchemaInfo_omit_source = True }
195195
let lookupPid = Map.fromList
196196
[ (ref,pid) | (pid,ref) <- Map.toList (schemaInfo_predicateIds si) ]
@@ -391,8 +391,8 @@ reorderTest = dbTestCase $ \env repo -> do
391391
|]
392392
assertEqual "reorder unbound choice" 3 (length results)
393393

394-
angleQueryOptions :: Test
395-
angleQueryOptions = dbTestCase $ \env repo -> do
394+
angleQueryOptions :: (WithDB () -> Test) -> Test
395+
angleQueryOptions dbTestCase = dbTestCase $ \env repo -> do
396396
let omitResults :: Bool -> Query q -> Query q
397397
omitResults omit (Query query) = Query q
398398
where
@@ -421,8 +421,8 @@ angleQueryOptions = dbTestCase $ \env repo -> do
421421
assertEqual "queryOptions - not omitting results" (counts r) (2, 2)
422422

423423

424-
limitTest :: Test
425-
limitTest = dbTestCase $ \env repo -> do
424+
limitTest :: (WithDB () -> Test) -> Test
425+
limitTest dbTestCase = dbTestCase $ \env repo -> do
426426
(results, truncated) <- runQuery env repo $ limitBytes 30 $ recursive $
427427
Angle.query $ predicate @Glean.Test.Edge wild
428428
-- each Edge will be
@@ -437,8 +437,8 @@ limitTest = dbTestCase $ \env repo -> do
437437
Angle.query $ predicate @Glean.Test.Edge wild
438438
assertBool "limitBytes" (length results == 2 && truncated)
439439

440-
justCheckTest :: Test
441-
justCheckTest = dbTestCase $ \env repo -> do
440+
justCheckTest :: (WithDB () -> Test) -> Test
441+
justCheckTest dbTestCase = dbTestCase $ \env repo -> do
442442
results <- runQuery_ env repo $ justCheck $ Angle.query $
443443
predicate @Cxx.Name wild
444444
assertEqual "just check" 0 (length results)

0 commit comments

Comments
 (0)