diff options
Diffstat (limited to 'test')
| -rw-r--r-- | test/WorldTypesTest.hs | 41 |
1 files changed, 24 insertions, 17 deletions
diff --git a/test/WorldTypesTest.hs b/test/WorldTypesTest.hs index 03c41d6..3c48c4e 100644 --- a/test/WorldTypesTest.hs +++ b/test/WorldTypesTest.hs @@ -5,6 +5,7 @@ import Test.Tasty import Test.Tasty.HUnit import World.Types ( Merge (..) + , Compatible (..) , Pos , LatticeProposal (..) , AgentProposal (..) @@ -17,9 +18,9 @@ suite = testGroup "world types tests" $ [ latticePropTests ] -newtype MockMerge = MockMerge Int +newtype MockMerge = MockMerge Int deriving (Show, Eq) instance Merge MockMerge where - mergeCompatible (MockMerge x) (MockMerge y) = x == y + mergable (MockMerge x) (MockMerge y) = x == y merge x _ = x merge _ _ = error "incompatible merge!" @@ -28,44 +29,50 @@ latticePropTests = testGroup "lattice proposal tests" $ [ testCase "lattice proposals correctly detect mergability" $ do -- disjoint positions - True @=? mergeCompatible + True @=? compatible (LatticeProposal (0, 0) Nothing Nothing Nothing :: LatticeProposal Int MockMerge) (LatticeProposal (0, 1) Nothing Nothing Nothing) - True @=? mergeCompatible - (LatticeProposal (0, 0) Nothing Nothing Nothing :: LatticeProposal Int MockMerge) - (LatticeProposal (0, 0) Nothing Nothing Nothing) - True @=? mergeCompatible + True @=? compatible (LatticeProposal (1, 0) (Just 4) (Just 5) Nothing :: LatticeProposal Int MockMerge) (LatticeProposal (0, 0) (Just 5) (Just 5) Nothing) -- merge from - True @=? mergeCompatible + True @=? mergable (LatticeProposal (0, 0) (Just 4) Nothing Nothing :: LatticeProposal Int MockMerge) (LatticeProposal (0, 0) (Just 4) Nothing Nothing) - True @=? mergeCompatible + True @=? mergable (LatticeProposal (0, 0) (Just 4) Nothing Nothing :: LatticeProposal Int MockMerge) (LatticeProposal (0, 0) Nothing Nothing Nothing) - False @=? mergeCompatible + False @=? mergable (LatticeProposal (0, 0) (Just 4) Nothing Nothing :: LatticeProposal Int MockMerge) (LatticeProposal (0, 0) (Just 5) Nothing Nothing) -- merge to - True @=? mergeCompatible + True @=? mergable (LatticeProposal (0, 0) Nothing (Just 4) Nothing :: LatticeProposal Int MockMerge) (LatticeProposal (0, 0) Nothing (Just 4) Nothing) - True @=? mergeCompatible + True @=? mergable (LatticeProposal (0, 0) Nothing (Just 4) Nothing :: LatticeProposal Int MockMerge) (LatticeProposal (0, 0) Nothing Nothing Nothing) - False @=? mergeCompatible + False @=? mergable (LatticeProposal (0, 0) Nothing (Just 4) Nothing :: LatticeProposal Int MockMerge) (LatticeProposal (0, 0) Nothing (Just 2) Nothing) -- merge flags - True @=? mergeCompatible + True @=? mergable (LatticeProposal (0, 0) Nothing Nothing (Just $ MockMerge 4) :: LatticeProposal Int MockMerge) (LatticeProposal (0, 0) Nothing Nothing Nothing) - True @=? mergeCompatible + True @=? mergable (LatticeProposal (0, 0) Nothing Nothing (Just $ MockMerge 4) :: LatticeProposal Int MockMerge) (LatticeProposal (0, 0) Nothing Nothing (Just $ MockMerge 4)) - False @=? mergeCompatible + False @=? mergable (LatticeProposal (0, 0) Nothing Nothing (Just $ MockMerge 4) :: LatticeProposal Int MockMerge) (LatticeProposal (0, 0) Nothing Nothing (Just $ MockMerge 5)) + + + , testCase "merge lattice proposals" $ + do + LatticeProposal (0, 0) Nothing Nothing (Just $ MockMerge 4) @?= merge + (LatticeProposal (0, 0) Nothing Nothing Nothing :: LatticeProposal Int MockMerge) + (LatticeProposal (0, 0) Nothing Nothing (Just $ MockMerge 4)) + LatticeProposal (0, 0) (Just 2) (Just 4) (Just $ MockMerge 4) @?= merge + (LatticeProposal (0, 0) (Just 2) Nothing Nothing) + (LatticeProposal (0, 0) Nothing (Just 4) (Just $ MockMerge 4)) ] - |