diff options
Diffstat (limited to 'test')
-rw-r--r-- | test/Spec.hs | 2 | ||||
-rw-r--r-- | test/Xanthous/Data/EntityMapSpec.hs | 6 | ||||
-rw-r--r-- | test/Xanthous/Util/GraphicsSpec.hs | 39 |
3 files changed, 46 insertions, 1 deletions
diff --git a/test/Spec.hs b/test/Spec.hs index dd4212c2eb70..cac474053ccb 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -6,6 +6,7 @@ import qualified Xanthous.GameSpec import qualified Xanthous.Generators.UtilSpec import qualified Xanthous.MessageSpec import qualified Xanthous.OrphansSpec +import qualified Xanthous.Util.GraphicsSpec main :: IO () main = defaultMain test @@ -19,4 +20,5 @@ test = testGroup "Xanthous" , Xanthous.MessageSpec.test , Xanthous.OrphansSpec.test , Xanthous.DataSpec.test + , Xanthous.Util.GraphicsSpec.test ] diff --git a/test/Xanthous/Data/EntityMapSpec.hs b/test/Xanthous/Data/EntityMapSpec.hs index c08b568d9eca..00bf1500466a 100644 --- a/test/Xanthous/Data/EntityMapSpec.hs +++ b/test/Xanthous/Data/EntityMapSpec.hs @@ -11,8 +11,12 @@ main :: IO () main = defaultMain test test :: TestTree -test = testGroup "Xanthous.Data.EntityMap" +test = localOption (QuickCheckTests 20) + $ testGroup "Xanthous.Data.EntityMap" [ testBatch $ monoid @(EntityMap Int) mempty + , testGroup "Deduplicate" + [ testBatch $ monoid @(Deduplicate Int) mempty + ] , testGroup "Eq laws" [ testProperty "reflexivity" $ \(em :: EntityMap Int) -> em == em diff --git a/test/Xanthous/Util/GraphicsSpec.hs b/test/Xanthous/Util/GraphicsSpec.hs new file mode 100644 index 000000000000..4b761dc51fe9 --- /dev/null +++ b/test/Xanthous/Util/GraphicsSpec.hs @@ -0,0 +1,39 @@ +module Xanthous.Util.GraphicsSpec (main, test) where +-------------------------------------------------------------------------------- +import Test.Prelude hiding (head) +-------------------------------------------------------------------------------- +import Xanthous.Util.Graphics +import Xanthous.Util +import Data.List (head) +-------------------------------------------------------------------------------- + +main :: IO () +main = defaultMain test + +test :: TestTree +test = testGroup "Xanthous.Util.Graphics" + [ testGroup "circle" + [ testCase "radius 12, origin 0" + $ (sort . unique @[] @[_]) (circle @Int (0, 0) 12) + @?= (sort . unique) ( + let quadrant = + [ (0, 12) , (1, 12) , (2, 12) , (3, 12) + , (4, 12) , (5, 11) , (6, 11) , (7, 10) + , (8, 9) , (9, 9) , (9, 8) , (10, 7) + , (11, 6) , (11, 5) , (12, 4) , (12, 3) + , (12, 2) , (12, 1) , (12, 0) + ] + in quadrant + <> (quadrant <&> _1 %~ negate) + <> (quadrant <&> _2 %~ negate) + <> (quadrant <&> both %~ negate) + ) + ] + + , testGroup "line" + [ testProperty "starts and ends at the start and end points" $ \start end -> + let ℓ = line @Int start end + in counterexample ("line: " <> show ℓ) + $ length ℓ > 2 ==> (head ℓ === start) .&&. (head (reverse ℓ) === end) + ] + ] |