Skip to content

Commit a1818a3

Browse files
jorisdraljorisdral
committed
Add mupserts and table union to the state machine tests
1 parent 8239796 commit a1818a3

File tree

1 file changed

+57
-4
lines changed

1 file changed

+57
-4
lines changed

‎test/Test/Database/LSMTree/Normal/StateMachine.hs‎

Lines changed: 57 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -29,6 +29,7 @@
2929
{- HLINT ignore "Evaluate" -}
3030
{- HLINT ignore "Use camelCase" -}
3131
{- HLINT ignore "Redundant fmap" -}
32+
{- HLINT ignore "Short-circuited list comprehension" -} -- TODO: remove once table union is implemented
3233

3334
{-
3435
TODO: improve generation and shrinking of dependencies. See
@@ -464,6 +465,9 @@ instance ( Show (Class.TableConfig h)
464465
Deletes :: C k v blob
465466
=> V.Vector k -> Var h (WrapTable h IO k v blob)
466467
-> Act h ()
468+
Mupserts :: C k v blob
469+
=> V.Vector (k, v) -> Var h (WrapTable h IO k v blob)
470+
-> Act h ()
467471
-- Blobs
468472
RetrieveBlobs :: B blob
469473
=> Var h (V.Vector (WrapBlobRef h IO blob))
@@ -481,6 +485,11 @@ instance ( Show (Class.TableConfig h)
481485
Duplicate :: C k v blob
482486
=> Var h (WrapTable h IO k v blob)
483487
-> Act h (WrapTable h IO k v blob)
488+
-- Table union
489+
Union :: C k v blob
490+
=> Var h (WrapTable h IO k v blob)
491+
-> Var h (WrapTable h IO k v blob)
492+
-> Act h (WrapTable h IO k v blob)
484493

485494
initialState = Lockstep.Defaults.initialState initModelState
486495
nextState = Lockstep.Defaults.nextState
@@ -527,6 +536,8 @@ instance ( Eq (Class.TableConfig h)
527536
Just inss1 == cast inss2 && Just var1 == cast var2
528537
go (Deletes ks1 var1) (Deletes ks2 var2) =
529538
Just ks1 == cast ks2 && Just var1 == cast var2
539+
go (Mupserts mups1 var1) (Mupserts mups2 var2) =
540+
Just mups1 == cast mups2 && Just var1 == cast var2
530541
go (RetrieveBlobs vars1) (RetrieveBlobs vars2) =
531542
Just vars1 == cast vars2
532543
go (CreateSnapshot label1 name1 var1) (CreateSnapshot label2 name2 var2) =
@@ -539,6 +550,8 @@ instance ( Eq (Class.TableConfig h)
539550
True
540551
go (Duplicate var1) (Duplicate var2) =
541552
Just var1 == cast var2
553+
go (Union var1_1 var1_2) (Union var2_1 var2_2) =
554+
Just var1_1 == cast var2_1 && Just var1_2 == cast var2_2
542555
go _ _ = False
543556

544557
_coveredAllCases :: LockstepAction (ModelState h) a -> ()
@@ -553,12 +566,14 @@ instance ( Eq (Class.TableConfig h)
553566
Updates{} -> ()
554567
Inserts{} -> ()
555568
Deletes{} -> ()
569+
Mupserts{} -> ()
556570
RetrieveBlobs{} -> ()
557571
CreateSnapshot{} -> ()
558572
OpenSnapshot{} -> ()
559573
DeleteSnapshot{} -> ()
560574
ListSnapshots{} -> ()
561575
Duplicate{} -> ()
576+
Union{} -> ()
562577

563578
{-------------------------------------------------------------------------------
564579
InLockstep
@@ -658,12 +673,14 @@ instance ( Eq (Class.TableConfig h)
658673
Updates _ tableVar -> [SomeGVar tableVar]
659674
Inserts _ tableVar -> [SomeGVar tableVar]
660675
Deletes _ tableVar -> [SomeGVar tableVar]
676+
Mupserts _ tableVar -> [SomeGVar tableVar]
661677
RetrieveBlobs blobsVar -> [SomeGVar blobsVar]
662678
CreateSnapshot _ _ tableVar -> [SomeGVar tableVar]
663679
OpenSnapshot _ _ -> []
664680
DeleteSnapshot _ -> []
665681
ListSnapshots -> []
666682
Duplicate tableVar -> [SomeGVar tableVar]
683+
Union table1Var table2Var -> [SomeGVar table1Var, SomeGVar table2Var]
667684

668685
arbitraryWithVars ::
669686
ModelVarContext (ModelState h)
@@ -769,12 +786,14 @@ instance ( Eq (Class.TableConfig h)
769786
Updates{} -> OEither $ bimap OId OId result
770787
Inserts{} -> OEither $ bimap OId OId result
771788
Deletes{} -> OEither $ bimap OId OId result
789+
Mupserts{} -> OEither $ bimap OId OId result
772790
RetrieveBlobs{} -> OEither $ bimap OId (OVector . fmap OBlob) result
773791
CreateSnapshot{} -> OEither $ bimap OId OId result
774792
OpenSnapshot{} -> OEither $ bimap OId (const OTable) result
775793
DeleteSnapshot{} -> OEither $ bimap OId OId result
776794
ListSnapshots{} -> OEither $ bimap OId (OList . fmap OId) result
777795
Duplicate{} -> OEither $ bimap OId (const OTable) result
796+
Union{} -> OEither $ bimap OId (const OTable) result
778797

779798
showRealResponse ::
780799
Proxy (RealMonad h IO)
@@ -791,12 +810,14 @@ instance ( Eq (Class.TableConfig h)
791810
Updates{} -> Just Dict
792811
Inserts{} -> Just Dict
793812
Deletes{} -> Just Dict
813+
Mupserts{} -> Just Dict
794814
RetrieveBlobs{} -> Just Dict
795815
CreateSnapshot{} -> Just Dict
796816
OpenSnapshot{} -> Nothing
797817
DeleteSnapshot{} -> Just Dict
798818
ListSnapshots -> Just Dict
799819
Duplicate{} -> Nothing
820+
Union{} -> Nothing
800821

801822
instance ( Eq (Class.TableConfig h)
802823
, Class.IsTable h
@@ -823,12 +844,14 @@ instance ( Eq (Class.TableConfig h)
823844
Updates{} -> OEither $ bimap OId OId result
824845
Inserts{} -> OEither $ bimap OId OId result
825846
Deletes{} -> OEither $ bimap OId OId result
847+
Mupserts{} -> OEither $ bimap OId OId result
826848
RetrieveBlobs{} -> OEither $ bimap OId (OVector . fmap OBlob) result
827849
CreateSnapshot{} -> OEither $ bimap OId OId result
828850
OpenSnapshot{} -> OEither $ bimap OId (const OTable) result
829851
DeleteSnapshot{} -> OEither $ bimap OId OId result
830852
ListSnapshots{} -> OEither $ bimap OId (OList . fmap OId) result
831853
Duplicate{} -> OEither $ bimap OId (const OTable) result
854+
Union{} -> OEither $ bimap OId (const OTable) result
832855

833856
showRealResponse ::
834857
Proxy (RealMonad h (IOSim s))
@@ -845,12 +868,14 @@ instance ( Eq (Class.TableConfig h)
845868
Updates{} -> Just Dict
846869
Inserts{} -> Just Dict
847870
Deletes{} -> Just Dict
871+
Mupserts{} -> Just Dict
848872
RetrieveBlobs{} -> Just Dict
849873
CreateSnapshot{} -> Just Dict
850874
OpenSnapshot{} -> Nothing
851875
DeleteSnapshot{} -> Just Dict
852876
ListSnapshots -> Just Dict
853877
Duplicate{} -> Nothing
878+
Union{} -> Nothing
854879

855880
{-------------------------------------------------------------------------------
856881
RunModel
@@ -916,6 +941,9 @@ runModel lookUp = \case
916941
Deletes kdels tableVar ->
917942
wrap MUnit
918943
. Model.runModelM (Model.deletes Model.getResolve kdels (getTable $ lookUp tableVar))
944+
Mupserts kmups tableVar ->
945+
wrap MUnit
946+
. Model.runModelM (Model.mupserts Model.getResolve kmups (getTable $ lookUp tableVar))
919947
RetrieveBlobs blobsVar ->
920948
wrap (MVector . fmap (MBlob . WrapBlob))
921949
. Model.runModelM (Model.retrieveBlobs (getBlobRefs . lookUp $ blobsVar))
@@ -934,6 +962,9 @@ runModel lookUp = \case
934962
Duplicate tableVar ->
935963
wrap MTable
936964
. Model.runModelM (Model.duplicate (getTable $ lookUp tableVar))
965+
Union table1Var table2Var ->
966+
wrap MTable
967+
. Model.runModelM (Model.union Model.getResolve (getTable $ lookUp table1Var) (getTable $ lookUp table2Var))
937968
where
938969
getTable ::
939970
ModelValue (ModelState h) (WrapTable h IO k v blob)
@@ -996,6 +1027,8 @@ runIO action lookUp = ReaderT $ \(session, handler) -> do
9961027
Class.inserts (unwrapTable $ lookUp' tableVar) kins
9971028
Deletes kdels tableVar -> catchErr handler $
9981029
Class.deletes (unwrapTable $ lookUp' tableVar) kdels
1030+
Mupserts kmups tableVar -> catchErr handler $
1031+
Class.mupserts (unwrapTable $ lookUp' tableVar) kmups
9991032
RetrieveBlobs blobRefsVar -> catchErr handler $
10001033
fmap WrapBlob <$> Class.retrieveBlobs (Proxy @h) session (unwrapBlobRef <$> lookUp' blobRefsVar)
10011034
CreateSnapshot label name tableVar -> catchErr handler $
@@ -1008,6 +1041,8 @@ runIO action lookUp = ReaderT $ \(session, handler) -> do
10081041
Class.listSnapshots session
10091042
Duplicate tableVar -> catchErr handler $
10101043
WrapTable <$> Class.duplicate (unwrapTable $ lookUp' tableVar)
1044+
Union table1Var table2Var -> catchErr handler $
1045+
WrapTable <$> Class.union (unwrapTable $ lookUp' table1Var) (unwrapTable $ lookUp' table2Var)
10111046

10121047
lookUp' :: Var h x -> Realized IO x
10131048
lookUp' = lookUpGVar (Proxy @(RealMonad h IO)) lookUp
@@ -1046,6 +1081,8 @@ runIOSim action lookUp = ReaderT $ \(session, handler) ->
10461081
Class.inserts (unwrapTable $ lookUp' tableVar) kins
10471082
Deletes kdels tableVar -> catchErr handler $
10481083
Class.deletes (unwrapTable $ lookUp' tableVar) kdels
1084+
Mupserts kmups tableVar -> catchErr handler $
1085+
Class.mupserts (unwrapTable $ lookUp' tableVar) kmups
10491086
RetrieveBlobs blobRefsVar -> catchErr handler $
10501087
fmap WrapBlob <$> Class.retrieveBlobs (Proxy @h) session (unwrapBlobRef <$> lookUp' blobRefsVar)
10511088
CreateSnapshot label name tableVar -> catchErr handler $
@@ -1058,6 +1095,8 @@ runIOSim action lookUp = ReaderT $ \(session, handler) ->
10581095
Class.listSnapshots session
10591096
Duplicate tableVar -> catchErr handler $
10601097
WrapTable <$> Class.duplicate (unwrapTable $ lookUp' tableVar)
1098+
Union table1Var table2Var -> catchErr handler $
1099+
WrapTable <$> Class.union (unwrapTable $ lookUp' table1Var) (unwrapTable $ lookUp' table2Var)
10611100

10621101
lookUp' :: Var h x -> Realized (IOSim s) x
10631102
lookUp' = lookUpGVar (Proxy @(RealMonad h (IOSim s))) lookUp
@@ -1108,12 +1147,14 @@ arbitraryActionWithVars _ label ctx (ModelState st _stats) =
11081147
Updates{} -> ()
11091148
Inserts{} -> ()
11101149
Deletes{} -> ()
1150+
Mupserts{} -> ()
11111151
RetrieveBlobs{} -> ()
11121152
CreateSnapshot{} -> ()
11131153
DeleteSnapshot{} -> ()
11141154
ListSnapshots{} -> ()
11151155
OpenSnapshot{} -> ()
11161156
Duplicate{} -> ()
1157+
Union{} -> ()
11171158

11181159
genTableVar = QC.elements tableVars
11191160

@@ -1188,6 +1229,7 @@ arbitraryActionWithVars _ label ctx (ModelState st _stats) =
11881229
, (10, fmap Some $ Updates <$> genUpdates <*> genTableVar)
11891230
, (10, fmap Some $ Inserts <$> genInserts <*> genTableVar)
11901231
, (10, fmap Some $ Deletes <$> genDeletes <*> genTableVar)
1232+
, (10, fmap Some $ Mupserts <$> genMupserts <*> genTableVar)
11911233
]
11921234
++ [ (3, fmap Some $ NewCursor <$> QC.arbitrary <*> genTableVar)
11931235
| length cursorVars <= 5 -- no more than 5 cursors at once
@@ -1198,6 +1240,10 @@ arbitraryActionWithVars _ label ctx (ModelState st _stats) =
11981240
++ [ (5, fmap Some $ Duplicate <$> genTableVar)
11991241
| length tableVars <= 5 -- no more than 5 tables at once
12001242
]
1243+
++ [ (2, fmap Some $ Union <$> genTableVar <*> genTableVar)
1244+
| length tableVars <= 5 -- no more than 5 tables at once
1245+
, False -- TODO: enable once table union is implemented
1246+
]
12011247

12021248
genActionsCursor :: [(Int, Gen (Any (LockstepAction (ModelState h))))]
12031249
genActionsCursor
@@ -1244,6 +1290,9 @@ arbitraryActionWithVars _ label ctx (ModelState st _stats) =
12441290
genDeletes :: Gen (V.Vector k)
12451291
genDeletes = QC.arbitrary
12461292

1293+
genMupserts :: Gen (V.Vector (k, v))
1294+
genMupserts = QC.liftArbitrary ((,) <$> QC.arbitrary <*> QC.arbitrary)
1295+
12471296
genBlob :: Gen (Maybe blob)
12481297
genBlob = QC.arbitrary
12491298

@@ -1429,10 +1478,10 @@ updateStats action lookUp modelBefore _modelAfter result =
14291478
-> (k, R.Update v blob)
14301479
-> (Int, Int, Int, Int)
14311480
count (i, iwb, d, m) (_, upd) = case upd of
1432-
R.Insert _ Nothing -> (i+1, iwb , d , m )
1433-
R.Insert _ Just{} -> (i , iwb+1, d , m )
1434-
R.Delete{} -> (i , iwb , d+1, m )
1435-
R.Mupsert{} -> (i , iwb , d , m + 1)
1481+
R.Insert _ Nothing -> (i+1, iwb , d , m )
1482+
R.Insert _ Just{} -> (i , iwb+1, d , m )
1483+
R.Delete{} -> (i , iwb , d+1, m )
1484+
R.Mupsert{} -> (i , iwb , d , m+1)
14361485
in V.foldl' count (numUpdates stats) upds
14371486

14381487
updSuccessActions stats = case result of
@@ -1458,6 +1507,9 @@ updateStats action lookUp modelBefore _modelAfter result =
14581507
Duplicate{}
14591508
| MEither (Right (MTable table)) <- result -> initCount table
14601509
| otherwise -> stats
1510+
Union{}
1511+
| MEither (Right (MTable table)) <- result -> initCount table
1512+
| otherwise -> stats
14611513

14621514
-- Note that for the other actions we don't count success vs failure.
14631515
-- We don't need that level of detail. We just want to see the
@@ -1468,6 +1520,7 @@ updateStats action lookUp modelBefore _modelAfter result =
14681520
Updates _ tableVar -> updateCount tableVar
14691521
Inserts _ tableVar -> updateCount tableVar
14701522
Deletes _ tableVar -> updateCount tableVar
1523+
Mupserts _ tableVar -> updateCount tableVar
14711524
-- Note that we don't remove tracking map entries for tables that get
14721525
-- closed. We want to know actions per table of all tables used, not
14731526
-- just those that were still open at the end of the sequence of

0 commit comments

Comments
 (0)