summaryrefslogtreecommitdiff
path: root/test
diff options
context:
space:
mode:
Diffstat (limited to 'test')
-rw-r--r--test/Main.hs2
-rw-r--r--test/WorldTypesTest.hs71
2 files changed, 73 insertions, 0 deletions
diff --git a/test/Main.hs b/test/Main.hs
index 24666a6..8abc870 100644
--- a/test/Main.hs
+++ b/test/Main.hs
@@ -5,10 +5,12 @@ import Test.Tasty
import qualified MindTest
import qualified GenomeTest
import qualified LatticeTest
+import qualified WorldTypesTest
main :: IO ()
main = defaultMain $ testGroup "all tests" $
[ MindTest.suite
, GenomeTest.suite
, LatticeTest.suite
+ , WorldTypesTest.suite
]
diff --git a/test/WorldTypesTest.hs b/test/WorldTypesTest.hs
new file mode 100644
index 0000000..03c41d6
--- /dev/null
+++ b/test/WorldTypesTest.hs
@@ -0,0 +1,71 @@
+module WorldTypesTest (suite) where
+
+
+import Test.Tasty
+import Test.Tasty.HUnit
+import World.Types
+ ( Merge (..)
+ , Pos
+ , LatticeProposal (..)
+ , AgentProposal (..)
+ , Proposal (..)
+ )
+
+
+suite :: TestTree
+suite = testGroup "world types tests" $
+ [ latticePropTests
+ ]
+
+newtype MockMerge = MockMerge Int
+instance Merge MockMerge where
+ mergeCompatible (MockMerge x) (MockMerge y) = x == y
+ merge x _ = x
+ merge _ _ = error "incompatible merge!"
+
+latticePropTests :: TestTree
+latticePropTests = testGroup "lattice proposal tests" $
+ [ testCase "lattice proposals correctly detect mergability" $
+ do
+ -- disjoint positions
+ True @=? mergeCompatible
+ (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
+ (LatticeProposal (1, 0) (Just 4) (Just 5) Nothing :: LatticeProposal Int MockMerge)
+ (LatticeProposal (0, 0) (Just 5) (Just 5) Nothing)
+ -- merge from
+ True @=? mergeCompatible
+ (LatticeProposal (0, 0) (Just 4) Nothing Nothing :: LatticeProposal Int MockMerge)
+ (LatticeProposal (0, 0) (Just 4) Nothing Nothing)
+ True @=? mergeCompatible
+ (LatticeProposal (0, 0) (Just 4) Nothing Nothing :: LatticeProposal Int MockMerge)
+ (LatticeProposal (0, 0) Nothing Nothing Nothing)
+ False @=? mergeCompatible
+ (LatticeProposal (0, 0) (Just 4) Nothing Nothing :: LatticeProposal Int MockMerge)
+ (LatticeProposal (0, 0) (Just 5) Nothing Nothing)
+ -- merge to
+ True @=? mergeCompatible
+ (LatticeProposal (0, 0) Nothing (Just 4) Nothing :: LatticeProposal Int MockMerge)
+ (LatticeProposal (0, 0) Nothing (Just 4) Nothing)
+ True @=? mergeCompatible
+ (LatticeProposal (0, 0) Nothing (Just 4) Nothing :: LatticeProposal Int MockMerge)
+ (LatticeProposal (0, 0) Nothing Nothing Nothing)
+ False @=? mergeCompatible
+ (LatticeProposal (0, 0) Nothing (Just 4) Nothing :: LatticeProposal Int MockMerge)
+ (LatticeProposal (0, 0) Nothing (Just 2) Nothing)
+ -- merge flags
+ True @=? mergeCompatible
+ (LatticeProposal (0, 0) Nothing Nothing (Just $ MockMerge 4) :: LatticeProposal Int MockMerge)
+ (LatticeProposal (0, 0) Nothing Nothing Nothing)
+ True @=? mergeCompatible
+ (LatticeProposal (0, 0) Nothing Nothing (Just $ MockMerge 4) :: LatticeProposal Int MockMerge)
+ (LatticeProposal (0, 0) Nothing Nothing (Just $ MockMerge 4))
+ False @=? mergeCompatible
+ (LatticeProposal (0, 0) Nothing Nothing (Just $ MockMerge 4) :: LatticeProposal Int MockMerge)
+ (LatticeProposal (0, 0) Nothing Nothing (Just $ MockMerge 5))
+ ]
+