diff options
Diffstat (limited to 'users/glittershark/xanthous/test/Xanthous')
| -rw-r--r-- | users/glittershark/xanthous/test/Xanthous/Generators/UtilSpec.hs | 23 | ||||
| -rw-r--r-- | users/glittershark/xanthous/test/Xanthous/Util/GraphicsSpec.hs | 41 |
2 files changed, 39 insertions, 25 deletions
diff --git a/users/glittershark/xanthous/test/Xanthous/Generators/UtilSpec.hs b/users/glittershark/xanthous/test/Xanthous/Generators/UtilSpec.hs index c82c385987b5..cdfadc06f505 100644 --- a/users/glittershark/xanthous/test/Xanthous/Generators/UtilSpec.hs +++ b/users/glittershark/xanthous/test/Xanthous/Generators/UtilSpec.hs @@ -1,7 +1,7 @@ {-# LANGUAGE PackageImports #-} - +-------------------------------------------------------------------------------- module Xanthous.Generators.UtilSpec (main, test) where - +-------------------------------------------------------------------------------- import Test.Prelude import System.Random (mkStdGen) import Control.Monad.Random (runRandT) @@ -11,18 +11,23 @@ import Data.Array.MArray (newArray, readArray, writeArray) import Data.Array (Array, range, listArray, Ix) import Control.Monad.ST (ST, runST) import "checkers" Test.QuickCheck.Instances.Array () - +import Linear.V2 +-------------------------------------------------------------------------------- import Xanthous.Util import Xanthous.Data (width, height) import Xanthous.Generators.Util +-------------------------------------------------------------------------------- main :: IO () main = defaultMain test +-------------------------------------------------------------------------------- + newtype GenArray a b = GenArray (Array a b) deriving stock (Show, Eq) -instance (Ix a, Arbitrary a, CoArbitrary a, Arbitrary b) => Arbitrary (GenArray a b) where +instance (Ix a, Arbitrary a, CoArbitrary a, Arbitrary b) + => Arbitrary (GenArray a b) where arbitrary = GenArray <$> do (mkElem :: a -> b) <- arbitrary minDims <- arbitrary @@ -33,16 +38,18 @@ instance (Ix a, Arbitrary a, CoArbitrary a, Arbitrary b) => Arbitrary (GenArray test :: TestTree test = testGroup "Xanthous.Generators.Util" [ testGroup "randInitialize" - [ testProperty "returns an array of the correct dimensions" $ \dims seed aliveChance -> + [ testProperty "returns an array of the correct dimensions" + $ \dims seed aliveChance -> let gen = mkStdGen seed res = runSTUArray $ fmap fst $ flip runRandT gen $ randInitialize dims aliveChance - in bounds res === ((0, 0), (dims ^. width, dims ^. height)) + in bounds res === (0, V2 (dims ^. width) (dims ^. height)) ] , testGroup "numAliveNeighborsM" - [ testProperty "maxes out at 8" $ \(GenArray (arr :: Array (Word, Word) Bool)) loc -> + [ testProperty "maxes out at 8" + $ \(GenArray (arr :: Array (V2 Word) Bool)) loc -> let act :: forall s. ST s Word act = do @@ -53,7 +60,7 @@ test = testGroup "Xanthous.Generators.Util" ] , testGroup "numAliveNeighbors" [ testProperty "is equivalient to runST . numAliveNeighborsM . thaw" $ - \(GenArray (arr :: Array (Word, Word) Bool)) loc -> + \(GenArray (arr :: Array (V2 Word) Bool)) loc -> let act :: forall s. ST s Word act = do diff --git a/users/glittershark/xanthous/test/Xanthous/Util/GraphicsSpec.hs b/users/glittershark/xanthous/test/Xanthous/Util/GraphicsSpec.hs index ff99d1073840..61e589280362 100644 --- a/users/glittershark/xanthous/test/Xanthous/Util/GraphicsSpec.hs +++ b/users/glittershark/xanthous/test/Xanthous/Util/GraphicsSpec.hs @@ -2,10 +2,13 @@ module Xanthous.Util.GraphicsSpec (main, test) where -------------------------------------------------------------------------------- import Test.Prelude hiding (head) -------------------------------------------------------------------------------- +import Data.List (nub, head) +import Data.Set (isSubsetOf) +import Linear.V2 +-------------------------------------------------------------------------------- import Xanthous.Util.Graphics import Xanthous.Util -import Data.List (head) -import Data.Set (isSubsetOf) +import Xanthous.Orphans () -------------------------------------------------------------------------------- main :: IO () @@ -23,24 +26,28 @@ test = testGroup "Xanthous.Util.Graphics" | 2 | | x | | x | | 3 | | | x | | -} - $ (sort . unique @[] @[_]) (circle @Int (2, 2) 1) - @?= [ (1, 2) - , (2, 1), (2, 3) - , (3, 2) + $ (sort . unique @[] @[_]) (circle @Int (V2 2 2) 1) + @?= [ V2 1 2 + , V2 2 1, V2 2 3 + , V2 3 2 ] , testCase "radius 12, origin 0" - $ (sort . unique @[] @[_]) (circle @Int (0, 0) 12) - @?= [ (-12,-4),(-12,-3),(-12,-2),(-12,-1),(-12,0),(-12,1),(-12,2) - , (-12,3),(-12,4),(-11,-6),(-11,-5),(-11,5),(-11,6),(-10,-7),(-10,7) - , (-9,-9),(-9,-8),(-9,8),(-9,9),(-8,-9),(-8,9),(-7,-10),(-7,10) - , (-6,-11),(-6,11),(-5,-11),(-5 ,11),(-4,-12),(-4,12),(-3,-12),(-3,12) - , (-2,-12),(-2,12),(-1,-12),(-1,12),(0,-12),(0,12),(1,-12),(1,12) - , (2,-12),(2,12),(3,-12),(3,12),(4,-12),(4,12),(5,-11),(5 ,11),(6,-11) - , (6,11),(7,-10),(7,10),(8,-9),(8,9),(9,-9),(9,-8),(9,8),(9,9),(10,-7) - , (10,7),(11,-6),(11,-5),(11,5),(11,6),(12,-4),(12,-3),(12,-2),(12,-1) - , (12,0), (12,1),(12,2),(12,3),(12,4) + $ (sort . nub) (circle @Int 0 12) + @?= (sort . nub) + [ V2 (-12) (-4), V2 (-12) (-3), V2 (-12) (-2), V2 (-12) (-1) + , V2 (-12) 0, V2 (-12) 1, V2 (-12) 2, V2 (-12) 3, V2 (-12) 4 + , V2 (-11) (-6), V2 (-11) (-5), V2 (-11) 5, V2 (-11) 6, V2 (-10) (-7) + , V2 (-10) 7, V2 (-9) (-9), V2 (-9) (-8), V2 (-9) 8, V2 (-9) 9 + , V2 (-8) (-9), V2 (-8) 9, V2 (-7) (-10), V2 (-7) 10, V2 (-6) (-11) + , V2 (-6) 11, V2 (-5) (-11), V2 (-5) 11, V2 (-4) (-12), V2 (-4) 12 + , V2 (-3) (-12), V2 (-3) 12, V2 (-2) (-12), V2 (-2) 12, V2 (-1) (-12) + , V2 (-1) 12, V2 0 (-12), V2 0 12, V2 1 (-12), V2 1 12, V2 2 (-12) + , V2 2 12, V2 3 (-12), V2 3 12, V2 4 (-12), V2 4 12, V2 5 (-11) + , V2 5 11, V2 6 (-11), V2 6 11, V2 7 (-10), V2 7 10, V2 8 (-9), V2 8 9 + , V2 9 (-9), V2 9 (-8), V2 9 8, V2 9 9, V2 10 (-7), V2 10 7 + , V2 11 (-6), V2 11 (-5), V2 11 5, V2 11 6, V2 12 (-4), V2 12 (-3) + , V2 12 (-2), V2 12 (-1), V2 12 0, V2 12 1, V2 12 2, V2 12 3, V2 12 4 ] - ] , testGroup "filledCircle" [ testProperty "is a superset of circle" $ \center radius -> |