Commit 0a1855ae authored by Hans-Peter Deifel's avatar Hans-Peter Deifel
Browse files

tests: Add some tests for splitBlock

parent cae572e8
......@@ -6,6 +6,7 @@ module MA.Algorithm.Split
-- * Internal functions, exported only for testing
, collectTouchedBlocks
, updateBlock
, splitBlock
) where
import Prelude hiding (pred)
......@@ -82,6 +83,8 @@ updateBlock b v0 = ask >>= \(as, _) -> lift $ do
then Partition.unmark (partition as) x
else VM.write (h3Cache as) x $! vx
-- | Split block according to marked/unmarked status and saved H3s.
--
-- b must have at least one marked state
splitBlock :: RefinementInterface h => Block -> SplitM s h ()
splitBlock b = ask >>= \(as, queue) -> lift $ do
......
......@@ -30,6 +30,7 @@ spec :: Spec
spec = do
collectTouchedBlocksSpec
updateBlockSpec
splitBlockSpec
collectTouchedBlocksSpec :: Spec
collectTouchedBlocksSpec = describe "collectTouchedBlocks" $ do
......@@ -150,6 +151,28 @@ updateBlockSpec = describe "updateBlock" $ do
in res `shouldBe` (MonoidH3 0 0 1)
splitBlockSpec :: Spec
splitBlockSpec = describe "splitBlock" $ do
it "handles the simple case of a one-element block"
$ let res = withState @Powerset (enc [True, False] [(0, (), 1)]) $ do
[(b, v0)] <- collectTouchedBlocks (Block 1)
updateBlock b v0
view _2 >>= lift . Queue.clear
splitBlock b
view _2 >>= lift . Queue.toList
in res `shouldBe` []
it "splits blocks into marked and unmaked" $
let res = withState @Powerset (enc [True, True, False] [(0, (), 2), (1, (), 0)]) $ do
[(b, v0)] <- collectTouchedBlocks (Block 1)
updateBlock b v0
view _2 >>= lift . Queue.clear
splitBlock b
view _2 >>= lift . Queue.toList
in res `shouldBe` [Block 0]
withState
:: RefinementInterface h
=> Encoding (Label h) (H1 h)
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment