diff options
Diffstat (limited to 'test')
| -rw-r--r-- | test/WorldTypesTest.hs | 96 |
1 files changed, 94 insertions, 2 deletions
diff --git a/test/WorldTypesTest.hs b/test/WorldTypesTest.hs index 5a45418..e151fed 100644 --- a/test/WorldTypesTest.hs +++ b/test/WorldTypesTest.hs @@ -9,6 +9,7 @@ import World.Types , LatticeProposal (..) , LatticePropList (..) , AgentProposal (..) + , AgentPropList (..) , Proposal (..) ) @@ -16,6 +17,7 @@ import World.Types suite :: TestTree suite = testGroup "world types tests" $ [ latticePropTests + , agentPropTests ] @@ -30,12 +32,102 @@ latticePropTests = testGroup "lattice proposal tests" $ , LatticeProposal (1, 1) (Just 0) Nothing Nothing ] in combine identity propList @?= propList - , testCase "conditionally combine proposal lists" $ + , testCase "incompatible proposal lists are not combinable" $ let a :: [LatticeProposal (Maybe Int) (Maybe Int)] a = [ LatticeProposal (0, 0) (Just 0) Nothing Nothing ] a' :: [LatticeProposal (Maybe Int) (Maybe Int)] - a' = [ LatticeProposal(0, 0) (Just 4) Nothing Nothing ] + a' = [ LatticeProposal (0, 0) (Just 4) Nothing Nothing ] in combinable (LatticePropList a) (LatticePropList a') @?= False + , testCase "compatible proposal lists are combinable" $ + let + a :: [LatticeProposal (Maybe Int) (Maybe Int)] + a = [ LatticeProposal (0, 0) (Just 0) Nothing Nothing ] + a' :: [LatticeProposal (Maybe Int) (Maybe Int)] + a' = [ LatticeProposal (0, 0) (Just 0) (Just 4) (Just 2) ] + in + combinable (LatticePropList a) (LatticePropList a') @?= True + , testCase "otherwise incompatible proposal lists are still compatible for different cells" $ + let + a :: [LatticeProposal (Maybe Int) (Maybe Int)] + a = [ LatticeProposal (0, 1) (Just 0) Nothing Nothing ] + a' :: [LatticeProposal (Maybe Int) (Maybe Int)] + a' = [ LatticeProposal (0, 0) (Just 4) Nothing Nothing ] + in + combinable (LatticePropList a) (LatticePropList a') @?= True + , testCase "a single incompatible proposal results in overall incompatibility" $ + let + a :: [LatticeProposal (Maybe Int) (Maybe Int)] + a = [ LatticeProposal (0, 0) (Just 0) Nothing Nothing + , LatticeProposal (0, 1) (Just 0) Nothing Nothing + ] + a' :: [LatticeProposal (Maybe Int) (Maybe Int)] + a' = [ LatticeProposal (0, 0) (Just 4) Nothing Nothing ] + in + combinable (LatticePropList a) (LatticePropList a') @?= False + ] + + +agentPropTests :: TestTree +agentPropTests = testGroup "lattice proposal tests" $ + [ testCase "combine AgentPropList with identity" $ + let + propList :: AgentPropList (Maybe Int) + propList = AgentPropList + [ AgentProposal 0 (Just (0, 0)) (Just 0) + , AgentProposal 0 (Just (0, 1)) Nothing + , AgentProposal 0 (Just (1, 1)) Nothing + ] + in combine identity propList @?= propList + , testCase "incompatible proposal lists are not combinable" $ + let + a :: [AgentProposal (Maybe Int)] + a = [ AgentProposal 0 (Just (0, 0)) (Just 0) ] + a' :: [AgentProposal (Maybe Int)] + a' = [ AgentProposal 0 (Just (0, 0)) (Just 4) ] + in + combinable (AgentPropList a) (AgentPropList a') @?= False + , testCase "compatible proposal lists are combinable" $ + let + a :: [AgentProposal (Maybe Int)] + a = [ AgentProposal 0 (Just (0, 0)) (Just 0) ] + a' :: [AgentProposal (Maybe Int) ] + a' = [ AgentProposal 0 (Just (0, 0)) (Just 0) ] + in + combinable (AgentPropList a) (AgentPropList a') @?= True + , testCase "trying to move an agent to two different locations is incompatible" $ + let + a :: [AgentProposal (Maybe Int)] + a = [ AgentProposal 0 (Just (0, 1)) (Just 0) ] + a' :: [AgentProposal (Maybe Int)] + a' = [ AgentProposal 0 (Just (0, 0)) (Just 0) ] + in + combinable (AgentPropList a) (AgentPropList a') @?= False + , testCase "a single incompatible proposal results in overall incompatibility" $ + let + a :: [AgentProposal (Maybe Int)] + a = [ AgentProposal 0 (Just (0, 0)) (Just 0) + , AgentProposal 0 (Just (0, 1)) (Just 0) + ] + a' :: [AgentProposal (Maybe Int)] + a' = [ AgentProposal 0 (Just (0, 0)) (Just 4) ] + in + combinable (AgentPropList a) (AgentPropList a') @?= False + , testCase "two updates moving different agents to the same location are incompatible" $ + let + a :: [AgentProposal (Maybe Int)] + a = [ AgentProposal 0 (Just (0, 0)) Nothing ] + a' :: [AgentProposal (Maybe Int)] + a' = [ AgentProposal 1 (Just (0, 0)) Nothing ] + in + combinable (AgentPropList a) (AgentPropList a') @?= False + , testCase "two updates moving the same agent to the same location are compatible" $ + let + a :: [AgentProposal (Maybe Int)] + a = [ AgentProposal 0 (Just (0, 0)) Nothing ] + a' :: [AgentProposal (Maybe Int)] + a' = [ AgentProposal 0 (Just (0, 0)) Nothing ] + in + combinable (AgentPropList a) (AgentPropList a') @?= True ] |