Skip to content

Add more labels to the quickcheck-lockstep StateMachine tests #431

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
dcoutts merged 6 commits into from
Oct 21, 2024
Merged

Add more labels to the quickcheck-lockstep StateMachine tests #431

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
6 commits
Select commit Hold shift + click to select a range
07ee7b8
QLS tests: change model's SomeTable type rep to use existentials
dcoutts Oct 10, 2024
3d2a346
QLS tests: label the number of tables and number of actions per table
dcoutts Oct 11, 2024
356d988
QLS tests: label the logical size of tables
dcoutts Oct 14, 2024
1670b50
QLS tests: label the per-run number of actions
dcoutts Oct 14, 2024
56024c6
QLS tests: label failing actions with the exception raised
dcoutts Oct 14, 2024
28c4890
QLS tests: label action interleaving depth on duplicate tables
dcoutts Oct 14, 2024
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
5 changes: 5 additions & 0 deletions test/Database/LSMTree/Model/Normal.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -30,6 +30,8 @@ module Database.LSMTree.Model.Normal (
, snapshot
-- * Multiple writable table handles
, duplicate
-- * Testing
, size
) where

import qualified Crypto.Hash.SHA256 as SHA256
Expand Down Expand Up @@ -61,6 +63,9 @@ type role Table nominal nominal nominal
empty :: Table k v blob
empty = Table Map.empty

size :: Table k v blob -> Int
size (Table m) = Map.size m

-- | This instance is for testing and debugging only.
instance
(SerialiseKey k, SerialiseValue v, SerialiseValue blob)
Expand Down
21 changes: 17 additions & 4 deletions test/Database/LSMTree/Model/Normal/Session.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -24,10 +24,14 @@ module Database.LSMTree.Model.Normal.Session (
Model (..)
, initModel
, UpdateCounter (..)
-- ** SomeTable
-- ** SomeTable, for testing
, SomeTable (..)
, toSomeTable
, fromSomeTable
, withSomeTable
, TableHandleID
, tableHandleID
, Model.size
-- ** Constraints
, C
, C_
Expand Down Expand Up @@ -118,7 +122,9 @@ newtype UpdateCounter = UpdateCounter Word64
deriving stock (Show, Eq, Ord)
deriving newtype (Num)

newtype SomeTable = SomeTable Dynamic
data SomeTable where
SomeTable :: (Typeable k, Typeable v, Typeable blob)
=> Model.Table k v blob -> SomeTable

instance Show SomeTable where
show (SomeTable table) = show table
Expand All @@ -127,13 +133,20 @@ toSomeTable ::
(Typeable k, Typeable v, Typeable blob)
=> Model.Table k v blob
-> SomeTable
toSomeTable = SomeTable . toDyn
toSomeTable = SomeTable

fromSomeTable ::
(Typeable k, Typeable v, Typeable blob)
=> SomeTable
-> Maybe (Model.Table k v blob)
fromSomeTable (SomeTable tbl) = fromDynamic tbl
fromSomeTable (SomeTable tbl) = cast tbl

withSomeTable ::
(forall k v blob. (Typeable k, Typeable v, Typeable blob)
=> Model.Table k v blob -> a)
-> SomeTable
-> a
withSomeTable f (SomeTable tbl) = f tbl

newtype SomeCursor = SomeCursor Dynamic

Expand Down
Loading