about summary refs log tree commit diff
path: root/test
diff options
context:
space:
mode:
Diffstat (limited to 'test')
-rw-r--r--test/Spec.hs2
-rw-r--r--test/Xanthous/Data/EntityMapSpec.hs6
-rw-r--r--test/Xanthous/Util/GraphicsSpec.hs39
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)
+    ]
+  ]