From d51871a7329ac0762d2748f22131f708eba4d085 Mon Sep 17 00:00:00 2001 From: Joris Dral Date: Mon, 18 Nov 2024 11:37:50 +0100 Subject: [PATCH] Move `D.L.Normal.*` test modules to `D.L.*` --- lsm-tree.cabal | 8 ++++---- test/Main.hs | 12 ++++++------ .../LSMTree/{Normal => }/StateMachine.hs | 10 +++++----- .../LSMTree/{Normal => }/StateMachine/DL.hs | 8 ++++---- .../LSMTree/{Normal => }/StateMachine/Op.hs | 2 +- .../Database/LSMTree/{Normal => }/UnitTests.hs | 16 ++++++++++------ 6 files changed, 30 insertions(+), 26 deletions(-) rename test/Test/Database/LSMTree/{Normal => }/StateMachine.hs (99%) rename test/Test/Database/LSMTree/{Normal => }/StateMachine/DL.hs (93%) rename test/Test/Database/LSMTree/{Normal => }/StateMachine/Op.hs (99%) rename test/Test/Database/LSMTree/{Normal => }/UnitTests.hs (92%) diff --git a/lsm-tree.cabal b/lsm-tree.cabal index ddc971715..29c461bb3 100644 --- a/lsm-tree.cabal +++ b/lsm-tree.cabal @@ -378,10 +378,10 @@ test-suite lsm-tree-test Test.Database.LSMTree.Internal.Vector.Growing Test.Database.LSMTree.Model.Table Test.Database.LSMTree.Monoidal - Test.Database.LSMTree.Normal.StateMachine - Test.Database.LSMTree.Normal.StateMachine.DL - Test.Database.LSMTree.Normal.StateMachine.Op - Test.Database.LSMTree.Normal.UnitTests + Test.Database.LSMTree.StateMachine + Test.Database.LSMTree.StateMachine.DL + Test.Database.LSMTree.StateMachine.Op + Test.Database.LSMTree.UnitTests Test.System.Posix.Fcntl.NoCache Test.Util.FS Test.Util.Orphans diff --git a/test/Main.hs b/test/Main.hs index f59c3f74a..0b7c90b0d 100644 --- a/test/Main.hs +++ b/test/Main.hs @@ -32,9 +32,9 @@ import qualified Test.Database.LSMTree.Internal.Vector import qualified Test.Database.LSMTree.Internal.Vector.Growing import qualified Test.Database.LSMTree.Model.Table import qualified Test.Database.LSMTree.Monoidal -import qualified Test.Database.LSMTree.Normal.StateMachine -import qualified Test.Database.LSMTree.Normal.StateMachine.DL -import qualified Test.Database.LSMTree.Normal.UnitTests +import qualified Test.Database.LSMTree.StateMachine +import qualified Test.Database.LSMTree.StateMachine.DL +import qualified Test.Database.LSMTree.UnitTests import qualified Test.System.Posix.Fcntl.NoCache import Test.Tasty @@ -69,9 +69,9 @@ main = defaultMain $ testGroup "lsm-tree" , Test.Database.LSMTree.Internal.Vector.Growing.tests , Test.Database.LSMTree.Model.Table.tests , Test.Database.LSMTree.Monoidal.tests - , Test.Database.LSMTree.Normal.UnitTests.tests - , Test.Database.LSMTree.Normal.StateMachine.tests - , Test.Database.LSMTree.Normal.StateMachine.DL.tests + , Test.Database.LSMTree.UnitTests.tests + , Test.Database.LSMTree.StateMachine.tests + , Test.Database.LSMTree.StateMachine.DL.tests , Test.System.Posix.Fcntl.NoCache.tests , Test.Data.Arena.tests ] diff --git a/test/Test/Database/LSMTree/Normal/StateMachine.hs b/test/Test/Database/LSMTree/StateMachine.hs similarity index 99% rename from test/Test/Database/LSMTree/Normal/StateMachine.hs rename to test/Test/Database/LSMTree/StateMachine.hs index 9b6245fc3..14cefeca4 100644 --- a/test/Test/Database/LSMTree/Normal/StateMachine.hs +++ b/test/Test/Database/LSMTree/StateMachine.hs @@ -47,7 +47,7 @@ TODO: it is currently not correctly modelled what happens if blob references are retrieved from an incorrect table. -} -module Test.Database.LSMTree.Normal.StateMachine ( +module Test.Database.LSMTree.StateMachine ( tests , labelledExamples -- * Properties @@ -108,8 +108,8 @@ import qualified System.FS.Sim.MockFS as MockFS import System.FS.Sim.MockFS (MockFS) import System.IO.Temp (createTempDirectory, getCanonicalTemporaryDirectory) -import Test.Database.LSMTree.Normal.StateMachine.Op - (HasBlobRef (getBlobRef), Op (..)) +import Test.Database.LSMTree.StateMachine.Op (HasBlobRef (getBlobRef), + Op (..)) import qualified Test.QuickCheck as QC import Test.QuickCheck (Arbitrary, Gen, Property) import qualified Test.QuickCheck.Extras as QD @@ -132,7 +132,7 @@ import Test.Util.TypeFamilyWrappers (WrapBlob (..), WrapBlobRef (..), -------------------------------------------------------------------------------} tests :: TestTree -tests = testGroup "Normal.StateMachine" [ +tests = testGroup "Test.Database.LSMTree.StateMachine" [ testProperty "propLockstep_ModelIOImpl" propLockstep_ModelIOImpl @@ -498,7 +498,7 @@ instance ( Show (Class.TableConfig h) -- TODO: show instance does not show key-value-blob types. Example: -- --- Normal.StateMachine +-- StateMachine -- prop_lockstepIO_ModelIOImpl: FAIL -- *** Failed! Exception: 'open: inappropriate type (table type mismatch)' (after 25 tests and 2 shrinks): -- do action $ New TableConfig diff --git a/test/Test/Database/LSMTree/Normal/StateMachine/DL.hs b/test/Test/Database/LSMTree/StateMachine/DL.hs similarity index 93% rename from test/Test/Database/LSMTree/Normal/StateMachine/DL.hs rename to test/Test/Database/LSMTree/StateMachine/DL.hs index 457f20550..f988bd6ca 100644 --- a/test/Test/Database/LSMTree/Normal/StateMachine/DL.hs +++ b/test/Test/Database/LSMTree/StateMachine/DL.hs @@ -1,7 +1,7 @@ {-# OPTIONS_GHC -Wno-unused-do-bind #-} {-# OPTIONS_GHC -Wno-orphans #-} -module Test.Database.LSMTree.Normal.StateMachine.DL ( +module Test.Database.LSMTree.StateMachine.DL ( tests ) where @@ -12,8 +12,8 @@ import Database.LSMTree as R import qualified Database.LSMTree.Model.Session as Model (fromSomeTable, tables) import qualified Database.LSMTree.Model.Table as Model (values) import Prelude -import Test.Database.LSMTree.Normal.StateMachine hiding (tests) -import Test.Database.LSMTree.Normal.StateMachine.Op +import Test.Database.LSMTree.StateMachine hiding (tests) +import Test.Database.LSMTree.StateMachine.Op import Test.QuickCheck as QC import Test.QuickCheck.DynamicLogic import qualified Test.QuickCheck.Gen as QC @@ -23,7 +23,7 @@ import Test.Tasty (TestTree, testGroup) import Test.Util.PrettyProxy tests :: TestTree -tests = testGroup "Test.Database.LSMTree.Normal.StateMachine.DL" [ +tests = testGroup "Test.Database.LSMTree.StateMachine.DL" [ -- This one is not actually enabled, because it runs for rather a long time -- and it's not in itself a very import property. -- QC.testProperty "prop_example" prop_example diff --git a/test/Test/Database/LSMTree/Normal/StateMachine/Op.hs b/test/Test/Database/LSMTree/StateMachine/Op.hs similarity index 99% rename from test/Test/Database/LSMTree/Normal/StateMachine/Op.hs rename to test/Test/Database/LSMTree/StateMachine/Op.hs index 26611e999..866f9e14f 100644 --- a/test/Test/Database/LSMTree/Normal/StateMachine/Op.hs +++ b/test/Test/Database/LSMTree/StateMachine/Op.hs @@ -6,7 +6,7 @@ {-# LANGUAGE MultiParamTypeClasses #-} -- | SumProd Op extended with BlobRef extraction -module Test.Database.LSMTree.Normal.StateMachine.Op ( +module Test.Database.LSMTree.StateMachine.Op ( -- * 'Op' Op (..) , intOpId diff --git a/test/Test/Database/LSMTree/Normal/UnitTests.hs b/test/Test/Database/LSMTree/UnitTests.hs similarity index 92% rename from test/Test/Database/LSMTree/Normal/UnitTests.hs rename to test/Test/Database/LSMTree/UnitTests.hs index ad391e08e..7ea7fb60a 100644 --- a/test/Test/Database/LSMTree/Normal/UnitTests.hs +++ b/test/Test/Database/LSMTree/UnitTests.hs @@ -3,7 +3,7 @@ {- HLINT ignore "Use void" -} -module Test.Database.LSMTree.Normal.UnitTests (tests) where +module Test.Database.LSMTree.UnitTests (tests) where import Control.Tracer (nullTracer) import Data.ByteString (ByteString) @@ -13,8 +13,8 @@ import qualified Data.Vector as V import Data.Word import qualified System.FS.API as FS +import Database.LSMTree as R import Database.LSMTree.Internal.Snapshot (SnapshotLabel (..)) -import Database.LSMTree.Normal as R import Control.Exception (Exception, try) import Database.LSMTree.Extras.Generators (KeyForIndexCompact) @@ -26,7 +26,7 @@ import Test.Util.FS (withTempIOHasBlockIO) tests :: TestTree tests = - testGroup "Normal.UnitTests" + testGroup "Test.Database.LSMTree.UnitTests" [ testCaseSteps "unit_blobs" unit_blobs , testCase "unit_closed_table" unit_closed_table , testCase "unit_closed_cursor" unit_closed_cursor @@ -38,15 +38,15 @@ unit_blobs :: (String -> IO ()) -> Assertion unit_blobs info = withTempIOHasBlockIO "test" $ \hfs hbio -> withSession nullTracer hfs hbio (FS.mkFsPath []) $ \sess -> do - table <- new @_ @ByteString @ByteString @ByteString sess defaultTableConfig - inserts table [("key1", "value1", Just "blob1")] + table <- new @_ @ByteString @(ResolveAsFirst ByteString) @ByteString sess defaultTableConfig + inserts table [("key1", ResolveAsFirst "value1", Just "blob1")] res <- lookups table ["key1"] info (show res) case res of [FoundWithBlob val bref] -> do - val @?= "value1" + val @?= ResolveAsFirst "value1" blob <- retrieveBlobs sess [bref] info (show blob) blob @?= ["blob1"] @@ -167,6 +167,8 @@ newtype Value1 = Value1 Word64 deriving stock (Show, Eq, Ord) deriving newtype (SerialiseValue) +deriving via ResolveAsFirst Word64 instance ResolveValue Value1 + newtype Blob1 = Blob1 Word64 deriving stock (Show, Eq, Ord) deriving newtype (SerialiseValue) @@ -182,6 +184,8 @@ newtype Value2 = Value2 BS.ByteString deriving stock (Show, Eq, Ord) deriving newtype (QC.Arbitrary, SerialiseValue) +deriving via ResolveAsFirst BS.ByteString instance ResolveValue Value2 + newtype Blob2 = Blob2 BS.ByteString deriving stock (Show, Eq, Ord) deriving newtype (SerialiseValue)