diff --git a/tests/MA/Algorithm/SplitSpec.hs b/tests/MA/Algorithm/SplitSpec.hs index 59799ef74208c797879c2b29b3f089f593c8c733..4bd366b5d897e7cfbe93bf866afcb47ed1a4903c 100644 --- a/tests/MA/Algorithm/SplitSpec.hs +++ b/tests/MA/Algorithm/SplitSpec.hs @@ -4,6 +4,7 @@ import Test.Hspec import Control.Monad.ST import Data.STRef +import Data.List ( sort ) import Control.Monad.Reader import qualified Data.Vector as V @@ -12,7 +13,7 @@ import Lens.Micro.Platform import MA.Algorithm.Types import MA.Algorithm.Split -import Data.BlockQueue +import Data.BlockQueue ( BlockQueue ) import Data.Partition.Common import Data.MorphismEncoding ( fromEdgeRef , Encoding @@ -25,6 +26,8 @@ import qualified Data.BlockQueue as Queue import MA.Functors.Powerset import MA.Functors.MonoidValued import qualified Data.RefinablePartition as Partition +import qualified Data.Partition as Partition + ( toBlocks ) spec :: Spec spec = do @@ -32,6 +35,7 @@ spec = do updateBlockSpec splitBlockSpec addBlocksToQueueSpec + splitSpec collectTouchedBlocksSpec :: Spec @@ -226,6 +230,56 @@ addBlocksToQueueSpec = describe "addBlocksToQueue" $ do in res `shouldMatchList` (map Block [0, 1, 2]) +splitSpec :: Spec +splitSpec = describe "split" $ do + let encoding = + (enc + [10, 10, 10, 1, 1, 20, 20, 0] + [ (0, 1 , 7) + , (0, 9 , 0) + , (1, 2 , 7) + , (1, 8 , 1) + , (2, 3 , 7) + , (2, 7 , 2) + , (3, 1 , 7) + , (4, 1 , 4) + , (5, 20, 6) + , (6, 20, 5) + ] + ) + + it "splits all touched blocks correctly" + $ let res = withState @(MonoidValued Int) encoding $ do + p <- view (_1 . partitionL) + b <- lift (Partition.blockOfState p 7) + split b + Partition.toBlocks <$> lift (Partition.freeze p) + in (map sort res) + `shouldMatchList` [[0], [1], [2], [3], [4], [5, 6], [7]] + + it "adds the correct blocks to the queue" + $ let + res = withState @(MonoidValued Int) encoding $ do + p <- view (_1 . partitionL) + b <- lift (Partition.blockOfState p 7) + b3 <- lift (Partition.blockOfState p 3) + (lift . Queue.delete b) =<< view _2 + (lift . Queue.delete b3) =<< view _2 + split b + queuedBlocks <- lift . Queue.toList =<< view _2 + lift (mapM (fmap VU.toList . Partition.statesOfBlock p) queuedBlocks) + in + res + `shouldSatisfy` (\l -> + ([0] `elem` l) + && ([1] `elem` l) + && ([2] `elem` l) + && ([5, 6] `elem` l) + && ( ([3] `elem` l && not ([4] `elem` l)) + || ([4] `elem` l && not ([3] `elem` l)) + ) + ) + withState :: RefinementInterface h => Encoding (Label h) (H1 h)