From 0a1855ae52108e90c8e7cf50ed8b5607ea19cddf Mon Sep 17 00:00:00 2001
From: Hans-Peter Deifel <hpd@hpdeifel.de>
Date: Sun, 9 Sep 2018 08:56:27 +0200
Subject: [PATCH] tests: Add some tests for splitBlock
---
src/MA/Algorithm/Split.hs | 3 +++
tests/MA/Algorithm/SplitSpec.hs | 23 +++++++++++++++++++++++
2 files changed, 26 insertions(+)
diff --git a/src/MA/Algorithm/Split.hs b/src/MA/Algorithm/Split.hs
index e9e220f..a85469d 100644
--- a/src/MA/Algorithm/Split.hs
+++ b/src/MA/Algorithm/Split.hs
@@ -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
diff --git a/tests/MA/Algorithm/SplitSpec.hs b/tests/MA/Algorithm/SplitSpec.hs
index 2b1786d..e37b843 100644
--- a/tests/MA/Algorithm/SplitSpec.hs
+++ b/tests/MA/Algorithm/SplitSpec.hs
@@ -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)
--
GitLab