Skip to content

Commit 0e3e8c4

Browse files
jeltschjeltsch
committed
Finish switching of index-using tests to ordinary indexes
1 parent 008dbce commit 0e3e8c4

File tree

12 files changed

+89
-66
lines changed

12 files changed

+89
-66
lines changed

‎src-extras/Database/LSMTree/Extras/Generators.hs

+29-14
Original file line numberDiff line numberDiff line change
@@ -36,6 +36,7 @@ module Database.LSMTree.Extras.Generators (
3636
, LargeRawBytes (..)
3737
, isKeyForIndexCompact
3838
, KeyForIndexCompact (..)
39+
, BiasedKey (..)
3940
, BiasedKeyForIndexCompact (..)
4041
-- * helpers
4142
, shrinkVec
@@ -564,26 +565,40 @@ instance Arbitrary KeyForIndexCompact where
564565

565566
deriving newtype instance SerialiseKey KeyForIndexCompact
566567

568+
-- we try to make collisions and close keys more likely (very crudely)
569+
arbitraryBiasedKey :: (RawBytes -> k) -> Gen RawBytes -> Gen k
570+
arbitraryBiasedKey fromRB genUnbiased = fromRB <$> frequency
571+
[ (6, genUnbiased)
572+
, (1, do
573+
lastByte <- QC.sized $ skewedWithMax . fromIntegral
574+
return (RB.pack ([1,3,3,7,0,1,7] <> [lastByte]))
575+
)
576+
]
577+
where
578+
-- generates a value in range from 0 to ub, but skewed towards low end
579+
skewedWithMax ub0 = do
580+
ub1 <- QC.chooseBoundedIntegral (0, ub0)
581+
ub2 <- QC.chooseBoundedIntegral (0, ub1)
582+
QC.chooseBoundedIntegral (0, ub2)
583+
584+
newtype BiasedKey = BiasedKey { getBiasedKey :: RawBytes }
585+
deriving stock (Eq, Ord, Show)
586+
deriving newtype NFData
587+
588+
instance Arbitrary BiasedKey where
589+
arbitrary = arbitraryBiasedKey BiasedKey arbitrary
590+
591+
shrink (BiasedKey rb) = [BiasedKey rb' | rb' <- shrink rb]
592+
593+
deriving newtype instance SerialiseKey BiasedKey
594+
567595
newtype BiasedKeyForIndexCompact =
568596
BiasedKeyForIndexCompact { getBiasedKeyForIndexCompact :: RawBytes }
569597
deriving stock (Eq, Ord, Show)
570598
deriving newtype NFData
571599

572600
instance Arbitrary BiasedKeyForIndexCompact where
573-
-- we try to make collisions and close keys more likely (very crudely)
574-
arbitrary = BiasedKeyForIndexCompact <$> frequency
575-
[ (6, genKeyForIndexCompact)
576-
, (1, do
577-
lastByte <- QC.sized $ skewedWithMax . fromIntegral
578-
return (RB.pack ([1,3,3,7,0,1,7] <> [lastByte]))
579-
)
580-
]
581-
where
582-
-- generates a value in range from 0 to ub, but skewed towards low end
583-
skewedWithMax ub0 = do
584-
ub1 <- QC.chooseBoundedIntegral (0, ub0)
585-
ub2 <- QC.chooseBoundedIntegral (0, ub1)
586-
QC.chooseBoundedIntegral (0, ub2)
601+
arbitrary = arbitraryBiasedKey BiasedKeyForIndexCompact genKeyForIndexCompact
587602

588603
shrink (BiasedKeyForIndexCompact rb) =
589604
[ BiasedKeyForIndexCompact rb'

‎test/Test/Database/LSMTree/Generators.hs

+16-5
Original file line numberDiff line numberDiff line change
@@ -3,7 +3,7 @@ module Test.Database.LSMTree.Generators (
33
) where
44

55
import Data.Bifoldable (bifoldMap)
6-
import Data.Coerce (coerce)
6+
import Data.Coerce (Coercible, coerce)
77
import qualified Data.Map.Strict as Map
88
import qualified Data.Vector.Primitive as VP
99
import Data.Word (Word64, Word8)
@@ -70,8 +70,15 @@ tests = testGroup "Test.Database.LSMTree.Generators" [
7070
prop_arbitraryAndShrinkPreserveInvariant noTags $
7171
isKeyForIndexCompact . getBiasedKeyForIndexCompact
7272
, testGroup "lists of key/op pairs" $
73-
prop_arbitraryAndShrinkPreserveInvariant labelTestKOps $
74-
deepseqInvariant
73+
[ testGroup "BiasedKey" $
74+
prop_arbitraryAndShrinkPreserveInvariant
75+
(labelTestKOps @BiasedKey)
76+
deepseqInvariant
77+
, testGroup "BiasedKeyForIndexCompact" $
78+
prop_arbitraryAndShrinkPreserveInvariant
79+
(labelTestKOps @BiasedKeyForIndexCompact)
80+
deepseqInvariant
81+
]
7582
, testGroup "helpers"
7683
[ testProperty "prop_shrinkVec" $ \vec ->
7784
shrinkVec (QC.shrink @Int) vec === map VP.fromList (QC.shrink (VP.toList vec))
@@ -127,9 +134,13 @@ labelRawBytes rb =
127134
QC.tabulate "size" [showPowersOf 2 (RB.size rb)]
128135

129136
type TestEntry = Entry SerialisedValue BlobSpan
130-
type TestKOp = (BiasedKeyForIndexCompact, TestEntry)
137+
type TestKOp k = (k, TestEntry)
131138

132-
labelTestKOps :: [TestKOp] -> Property -> Property
139+
labelTestKOps ::
140+
Coercible k SerialisedKey
141+
=> [TestKOp k]
142+
-> Property
143+
-> Property
133144
labelTestKOps kops' =
134145
QC.tabulate "key occurrences (>1 is collision)" (map (show . snd) (Map.assocs keyCounts))
135146
. QC.tabulate "key sizes" (map (showPowersOf 4 . sizeofKey) keys)

‎test/Test/Database/LSMTree/Internal.hs

+7-7
Original file line numberDiff line numberDiff line change
@@ -17,7 +17,7 @@ import qualified Data.Map.Strict as Map
1717
import Data.Maybe (isJust, mapMaybe)
1818
import qualified Data.Vector as V
1919
import Data.Word
20-
import Database.LSMTree.Extras.Generators (KeyForIndexCompact (..))
20+
import Database.LSMTree.Extras.Generators ()
2121
import Database.LSMTree.Internal
2222
import Database.LSMTree.Internal.BlobRef
2323
import Database.LSMTree.Internal.Config
@@ -132,9 +132,9 @@ showLeft x = \case
132132
-- == takeWhile ((<= ub) . key) . dropWhile ((< lb) . key)
133133
-- @
134134
prop_roundtripCursor ::
135-
Maybe KeyForIndexCompact -- ^ Inclusive lower bound
136-
-> Maybe KeyForIndexCompact -- ^ Inclusive upper bound
137-
-> V.Vector (KeyForIndexCompact, Entry SerialisedValue SerialisedBlob)
135+
Maybe SerialisedKey -- ^ Inclusive lower bound
136+
-> Maybe SerialisedKey -- ^ Inclusive upper bound
137+
-> V.Vector (SerialisedKey, Entry SerialisedValue SerialisedBlob)
138138
-> Property
139139
prop_roundtripCursor lb ub kops = ioProperty $
140140
withTempIOHasBlockIO "prop_roundtripCursor" $ \hfs hbio -> do
@@ -171,17 +171,17 @@ prop_roundtripCursor lb ub kops = ioProperty $
171171
Mupdate v -> Just (v, Nothing)
172172
Delete -> Nothing
173173

174-
duplicates :: Map.Map KeyForIndexCompact Int
174+
duplicates :: Map.Map SerialisedKey Int
175175
duplicates =
176176
Map.filter (> 1) $
177177
Map.fromListWith (+) . map (\(k, _) -> (k, 1)) $
178178
V.toList kops
179179

180180
readCursorUntil ::
181181
ResolveSerialisedValue
182-
-> Maybe KeyForIndexCompact -- Inclusive upper bound
182+
-> Maybe SerialisedKey -- Inclusive upper bound
183183
-> Cursor IO h
184-
-> IO (V.Vector (KeyForIndexCompact,
184+
-> IO (V.Vector (SerialisedKey,
185185
(SerialisedValue,
186186
Maybe (WeakBlobRef IO h))))
187187
readCursorUntil resolve ub cursor = go V.empty

‎test/Test/Database/LSMTree/Internal/Lookup.hs

+3-3
Original file line numberDiff line numberDiff line change
@@ -47,7 +47,7 @@ import Database.LSMTree.Extras.RunData (RunData (..),
4747
import Database.LSMTree.Internal.BlobRef
4848
import Database.LSMTree.Internal.Entry as Entry
4949
import Database.LSMTree.Internal.Index (Index, IndexType)
50-
import qualified Database.LSMTree.Internal.Index as Index (IndexType (Compact),
50+
import qualified Database.LSMTree.Internal.Index as Index (IndexType (Ordinary),
5151
search)
5252
import Database.LSMTree.Internal.Lookup
5353
import Database.LSMTree.Internal.Page (PageNo (PageNo), PageSpan (..))
@@ -309,7 +309,7 @@ prop_roundtripFromWriteBufferLookupIO ::
309309
prop_roundtripFromWriteBufferLookupIO (SmallList dats) =
310310
ioProperty $
311311
withTempIOHasBlockIO "prop_roundtripFromWriteBufferLookupIO" $ \hfs hbio ->
312-
withWbAndRuns hfs hbio Index.Compact dats $ \wb wbblobs runs -> do
312+
withWbAndRuns hfs hbio Index.Ordinary dats $ \wb wbblobs runs -> do
313313
let model :: Map SerialisedKey (Entry SerialisedValue SerialisedBlob)
314314
model = Map.unionsWith (Entry.combine resolveV) (map runData dats)
315315
keys = V.fromList [ k | InMemLookupData{lookups} <- dats
@@ -433,7 +433,7 @@ mkTestRun dat = (rawPages, b, ic)
433433

434434
-- one-shot run construction
435435
(pages, b, ic) = runST $ do
436-
racc <- Run.new nentries (RunAllocFixed 10) Index.Compact
436+
racc <- Run.new nentries (RunAllocFixed 10) Index.Ordinary
437437
let kops = Map.toList dat
438438
psopss <- traverse (uncurry (Run.addKeyOp racc)) kops
439439
(mp, _ , b', ic', _) <- Run.unsafeFinalise racc

‎test/Test/Database/LSMTree/Internal/Merge.hs

+4-5
Original file line numberDiff line numberDiff line change
@@ -10,11 +10,10 @@ import qualified Data.Map.Strict as Map
1010
import Data.Maybe (isJust)
1111
import qualified Data.Vector as V
1212
import Database.LSMTree.Extras
13-
import Database.LSMTree.Extras.Generators (KeyForIndexCompact)
1413
import Database.LSMTree.Extras.RunData
1514
import qualified Database.LSMTree.Internal.BlobFile as BlobFile
1615
import qualified Database.LSMTree.Internal.Entry as Entry
17-
import qualified Database.LSMTree.Internal.Index as Index (IndexType (Compact))
16+
import qualified Database.LSMTree.Internal.Index as Index (IndexType (Ordinary))
1817
import Database.LSMTree.Internal.Merge (MergeType (..))
1918
import qualified Database.LSMTree.Internal.Merge as Merge
2019
import Database.LSMTree.Internal.PageAcc (entryWouldFitInPage)
@@ -65,7 +64,7 @@ runParams =
6564
RunBuilder.RunParams {
6665
runParamCaching = RunBuilder.CacheRunData,
6766
runParamAlloc = RunAcc.RunAllocFixed 10,
68-
runParamIndex = Index.Compact
67+
runParamIndex = Index.Ordinary
6968
}
7069

7170
-- | Creating multiple runs from write buffers and merging them leads to the
@@ -77,7 +76,7 @@ prop_MergeDistributes ::
7776
FS.HasBlockIO IO h ->
7877
MergeType ->
7978
StepSize ->
80-
SmallList (RunData KeyForIndexCompact SerialisedValue SerialisedBlob) ->
79+
SmallList (RunData SerialisedKey SerialisedValue SerialisedBlob) ->
8180
IO Property
8281
prop_MergeDistributes fs hbio mergeType stepSize (SmallList rds) = do
8382
let path = FS.mkFsPath []
@@ -153,7 +152,7 @@ prop_AbortMerge ::
153152
FS.HasBlockIO IO h ->
154153
MergeType ->
155154
StepSize ->
156-
SmallList (RunData KeyForIndexCompact SerialisedValue SerialisedBlob) ->
155+
SmallList (RunData SerialisedKey SerialisedValue SerialisedBlob) ->
157156
IO Property
158157
prop_AbortMerge fs hbio mergeType (Positive stepSize) (SmallList wbs) = do
159158
let path = FS.mkFsPath []

‎test/Test/Database/LSMTree/Internal/Run.hs

+6-7
Original file line numberDiff line numberDiff line change
@@ -14,12 +14,11 @@ import Data.Coerce (coerce)
1414
import qualified Data.Map.Strict as Map
1515
import Data.Maybe (fromJust)
1616
import qualified Data.Primitive.ByteArray as BA
17-
import Database.LSMTree.Extras.Generators (KeyForIndexCompact (..))
1817
import Database.LSMTree.Extras.RunData
1918
import Database.LSMTree.Internal.BlobRef (BlobSpan (..))
2019
import qualified Database.LSMTree.Internal.CRC32C as CRC
2120
import Database.LSMTree.Internal.Entry
22-
import qualified Database.LSMTree.Internal.Index as Index (IndexType (Compact))
21+
import qualified Database.LSMTree.Internal.Index as Index (IndexType (Ordinary))
2322
import Database.LSMTree.Internal.Paths (RunFsPaths (..),
2423
WriteBufferFsPaths (..))
2524
import qualified Database.LSMTree.Internal.Paths as Paths
@@ -96,7 +95,7 @@ runParams =
9695
RunBuilder.RunParams {
9796
runParamCaching = RunBuilder.CacheRunData,
9897
runParamAlloc = RunAcc.RunAllocFixed 10,
99-
runParamIndex = Index.Compact
98+
runParamIndex = Index.Ordinary
10099
}
101100

102101
-- | Runs in IO, with a real file system.
@@ -186,7 +185,7 @@ readBlobFromBS bs (BlobSpan off sz) =
186185
prop_WriteNumEntries ::
187186
FS.HasFS IO h
188187
-> FS.HasBlockIO IO h
189-
-> RunData KeyForIndexCompact SerialisedValue SerialisedBlob
188+
-> RunData SerialisedKey SerialisedValue SerialisedBlob
190189
-> IO Property
191190
prop_WriteNumEntries fs hbio wb@(RunData m) =
192191
withRunAt fs hbio runParams (simplePath 42) wb' $ \run -> do
@@ -204,7 +203,7 @@ prop_WriteNumEntries fs hbio wb@(RunData m) =
204203
prop_WriteAndOpen ::
205204
FS.HasFS IO h
206205
-> FS.HasBlockIO IO h
207-
-> RunData KeyForIndexCompact SerialisedValue SerialisedBlob
206+
-> RunData SerialisedKey SerialisedValue SerialisedBlob
208207
-> IO Property
209208
prop_WriteAndOpen fs hbio wb =
210209
withRunAt fs hbio runParams (simplePath 1337) (serialiseRunData wb) $ \written ->
@@ -237,7 +236,7 @@ prop_WriteAndOpen fs hbio wb =
237236
prop_WriteAndOpenWriteBuffer ::
238237
FS.HasFS IO h
239238
-> FS.HasBlockIO IO h
240-
-> RunData KeyForIndexCompact SerialisedValue SerialisedBlob
239+
-> RunData SerialisedKey SerialisedValue SerialisedBlob
241240
-> IO Property
242241
prop_WriteAndOpenWriteBuffer hfs hbio rd = do
243242
-- Serialise run data as write buffer:
@@ -261,7 +260,7 @@ prop_WriteAndOpenWriteBuffer hfs hbio rd = do
261260
prop_WriteRunEqWriteWriteBuffer ::
262261
FS.HasFS IO h
263262
-> FS.HasBlockIO IO h
264-
-> RunData KeyForIndexCompact SerialisedValue SerialisedBlob
263+
-> RunData SerialisedKey SerialisedValue SerialisedBlob
265264
-> IO Property
266265
prop_WriteRunEqWriteWriteBuffer hfs hbio rd = do
267266
-- Serialise run data as run:

‎test/Test/Database/LSMTree/Internal/RunAcc.hs

+2-2
Original file line numberDiff line numberDiff line change
@@ -15,7 +15,7 @@ import Data.Maybe
1515
import qualified Data.Vector.Primitive as VP
1616
import Database.LSMTree.Internal.BlobRef (BlobSpan (..))
1717
import Database.LSMTree.Internal.Entry
18-
import qualified Database.LSMTree.Internal.Index as Index (IndexType (Compact),
18+
import qualified Database.LSMTree.Internal.Index as Index (IndexType (Ordinary),
1919
search)
2020
import Database.LSMTree.Internal.Page (PageNo (PageNo), singlePage)
2121
import qualified Database.LSMTree.Internal.PageAcc as PageAcc
@@ -57,7 +57,7 @@ test_singleKeyRun = do
5757
!e = InsertWithBlob (SerialisedValue' (VP.fromList [48, 19])) (BlobSpan 55 77)
5858

5959
(addRes, (mp, mc, b, ic, _numEntries)) <- stToIO $ do
60-
racc <- new (NumEntries 1) (RunAllocFixed 10) Index.Compact
60+
racc <- new (NumEntries 1) (RunAllocFixed 10) Index.Ordinary
6161
addRes <- addKeyOp racc k e
6262
(addRes,) <$> unsafeFinalise racc
6363

‎test/Test/Database/LSMTree/Internal/RunBuilder.hs

+1-1
Original file line numberDiff line numberDiff line change
@@ -47,7 +47,7 @@ runParams =
4747
RunBuilder.RunParams {
4848
runParamCaching = RunBuilder.CacheRunData,
4949
runParamAlloc = RunAcc.RunAllocFixed 10,
50-
runParamIndex = Index.Compact
50+
runParamIndex = Index.Ordinary
5151
}
5252

5353
-- | 'new' in an existing directory should be succesfull.

‎test/Test/Database/LSMTree/Internal/RunReader.hs

+10-11
Original file line numberDiff line numberDiff line change
@@ -8,12 +8,11 @@ module Test.Database.LSMTree.Internal.RunReader (
88
import Control.RefCount
99
import Data.Coerce (coerce)
1010
import qualified Data.Map as Map
11-
import Database.LSMTree.Extras.Generators
12-
(BiasedKeyForIndexCompact (..))
11+
import Database.LSMTree.Extras.Generators (BiasedKey (..))
1312
import Database.LSMTree.Extras.RunData
1413
import Database.LSMTree.Internal.BlobRef
1514
import Database.LSMTree.Internal.Entry (Entry)
16-
import qualified Database.LSMTree.Internal.Index as Index (IndexType (Compact))
15+
import qualified Database.LSMTree.Internal.Index as Index (IndexType (Ordinary))
1716
import Database.LSMTree.Internal.Run (Run)
1817
import qualified Database.LSMTree.Internal.RunAcc as RunAcc
1918
import qualified Database.LSMTree.Internal.RunBuilder as RunBuilder
@@ -71,7 +70,7 @@ runParams =
7170
RunBuilder.RunParams {
7271
runParamCaching = RunBuilder.CacheRunData,
7372
runParamAlloc = RunAcc.RunAllocFixed 10,
74-
runParamIndex = Index.Compact
73+
runParamIndex = Index.Ordinary
7574
}
7675

7776
-- | Creating a run from a write buffer and reading from the run yields the
@@ -86,8 +85,8 @@ runParams =
8685
prop_readAtOffset ::
8786
FS.HasFS IO h
8887
-> FS.HasBlockIO IO h
89-
-> RunData BiasedKeyForIndexCompact SerialisedValue SerialisedBlob
90-
-> Maybe BiasedKeyForIndexCompact
88+
-> RunData BiasedKey SerialisedValue SerialisedBlob
89+
-> Maybe BiasedKey
9190
-> IO Property
9291
prop_readAtOffset fs hbio rd offsetKey =
9392
withRunAt fs hbio runParams (simplePath 42) rd' $ \run -> do
@@ -109,15 +108,15 @@ prop_readAtOffset fs hbio rd offsetKey =
109108
prop_readAtOffsetExisting ::
110109
FS.HasFS IO h
111110
-> FS.HasBlockIO IO h
112-
-> RunData BiasedKeyForIndexCompact SerialisedValue SerialisedBlob
111+
-> RunData BiasedKey SerialisedValue SerialisedBlob
113112
-> NonNegative Int
114113
-> IO Property
115114
prop_readAtOffsetExisting fs hbio rd (NonNegative index)
116115
| null kops = pure discard
117116
| otherwise =
118117
prop_readAtOffset fs hbio rd (Just (keys !! (index `mod` length keys)))
119118
where
120-
keys :: [BiasedKeyForIndexCompact]
119+
keys :: [BiasedKey]
121120
keys = coerce (fst <$> kops)
122121
kops = Map.toList (unRunData rd)
123122

@@ -130,8 +129,8 @@ prop_readAtOffsetExisting fs hbio rd (NonNegative index)
130129
prop_readAtOffsetIdempotence ::
131130
FS.HasFS IO h
132131
-> FS.HasBlockIO IO h
133-
-> RunData BiasedKeyForIndexCompact SerialisedValue SerialisedBlob
134-
-> Maybe BiasedKeyForIndexCompact
132+
-> RunData BiasedKey SerialisedValue SerialisedBlob
133+
-> Maybe BiasedKey
135134
-> IO Property
136135
prop_readAtOffsetIdempotence fs hbio rd offsetKey =
137136
withRunAt fs hbio runParams (simplePath 42) rd' $ \run -> do
@@ -155,7 +154,7 @@ prop_readAtOffsetIdempotence fs hbio rd offsetKey =
155154
prop_readAtOffsetReadHead ::
156155
FS.HasFS IO h
157156
-> FS.HasBlockIO IO h
158-
-> RunData BiasedKeyForIndexCompact SerialisedValue SerialisedBlob
157+
-> RunData BiasedKey SerialisedValue SerialisedBlob
159158
-> IO Property
160159
prop_readAtOffsetReadHead fs hbio rd =
161160
withRunAt fs hbio runParams (simplePath 42) rd' $ \run -> do

0 commit comments

Comments
 (0)