From 587cbadb3e6388c29454ab41c120757f108918fa Mon Sep 17 00:00:00 2001 From: sanine Date: Wed, 29 Nov 2023 20:48:46 -0600 Subject: implement updateLattice --- test/LatticeTest.hs | 37 +++++++++++++++++++++++++++++++++++++ test/Main.hs | 2 ++ 2 files changed, 39 insertions(+) create mode 100644 test/LatticeTest.hs (limited to 'test') diff --git a/test/LatticeTest.hs b/test/LatticeTest.hs new file mode 100644 index 0000000..a7d67d8 --- /dev/null +++ b/test/LatticeTest.hs @@ -0,0 +1,37 @@ +module LatticeTest (suite) where + +import Test.Tasty +import Test.Tasty.HUnit +import Lattice + +suite :: TestTree +suite = testGroup "lattice tests" $ + [ latticeGrowth + ] + + +data GrowKind = Empty | Plant deriving (Show, Enum, Eq) +data GrowFlags = None deriving (Show, Eq) + + +latticeGrowth :: TestTree +latticeGrowth = testCase "growth update rule" $ + let + plant = LatticeCell Plant None + empty = LatticeCell Empty None + lattice = [[ empty, empty, plant ]] + rules = + [ + -- empty + \l x y -> + if kind ((l !! y) !! (x+1)) == Plant + then LatticeCell Plant None + else LatticeCell Empty None + -- plant + , \_ _ _ -> LatticeCell Plant None + ] :: [LatticeRule GrowKind GrowFlags] + lattice' = updateLattice lattice rules + lattice'' = updateLattice lattice' rules + in do + lattice' @?= [[ empty, plant, plant ]] + lattice'' @?= [[ plant, plant, plant ]] diff --git a/test/Main.hs b/test/Main.hs index 907bbdd..24666a6 100644 --- a/test/Main.hs +++ b/test/Main.hs @@ -4,9 +4,11 @@ import Test.Tasty import qualified MindTest import qualified GenomeTest +import qualified LatticeTest main :: IO () main = defaultMain $ testGroup "all tests" $ [ MindTest.suite , GenomeTest.suite + , LatticeTest.suite ] -- cgit v1.2.1