diff options
Diffstat (limited to 'users/aspen/xanthous/test/Xanthous/Util')
3 files changed, 129 insertions, 0 deletions
diff --git a/users/aspen/xanthous/test/Xanthous/Util/GraphSpec.hs b/users/aspen/xanthous/test/Xanthous/Util/GraphSpec.hs new file mode 100644 index 0000000000..35ff090b28 --- /dev/null +++ b/users/aspen/xanthous/test/Xanthous/Util/GraphSpec.hs @@ -0,0 +1,39 @@ +module Xanthous.Util.GraphSpec (main, test) where +-------------------------------------------------------------------------------- +import Test.Prelude +-------------------------------------------------------------------------------- +import Xanthous.Util.Graph +import Data.Graph.Inductive.Basic +import Data.Graph.Inductive.Graph (labNodes, size, order) +import Data.Graph.Inductive.PatriciaTree +import Data.Graph.Inductive.Arbitrary +-------------------------------------------------------------------------------- + +main :: IO () +main = defaultMain test + +test :: TestTree +test = testGroup "Xanthous.Util.Graph" + [ testGroup "mstSubGraph" + [ testProperty "always produces a subgraph" + $ \(CG _ (graph :: Gr Int Int)) -> + let msg = mstSubGraph $ undir graph + in counterexample (show msg) + $ msg `isSubGraphOf` undir graph + , testProperty "returns a graph with the same nodes" + $ \(CG _ (graph :: Gr Int Int)) -> + let msg = mstSubGraph graph + in counterexample (show msg) + $ labNodes msg === labNodes graph + , testProperty "has nodes - 1 edges" + $ \(CG _ (graph :: Gr Int Int)) -> + order graph > 1 ==> + let msg = mstSubGraph graph + in counterexample (show msg) + $ size msg === order graph - 1 + , testProperty "always produces a simple graph" + $ \(CG _ (graph :: Gr Int Int)) -> + let msg = mstSubGraph graph + in counterexample (show msg) $ isSimple msg + ] + ] diff --git a/users/aspen/xanthous/test/Xanthous/Util/GraphicsSpec.hs b/users/aspen/xanthous/test/Xanthous/Util/GraphicsSpec.hs new file mode 100644 index 0000000000..61e5892803 --- /dev/null +++ b/users/aspen/xanthous/test/Xanthous/Util/GraphicsSpec.hs @@ -0,0 +1,72 @@ +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 Xanthous.Orphans () +-------------------------------------------------------------------------------- + +main :: IO () +main = defaultMain test + +test :: TestTree +test = testGroup "Xanthous.Util.Graphics" + [ testGroup "circle" + [ testCase "radius 1, origin 2,2" + {- + | | 0 | 1 | 2 | 3 | + |---+---+---+---+---| + | 0 | | | | | + | 1 | | | x | | + | 2 | | x | | x | + | 3 | | | x | | + -} + $ (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 . 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 -> + let circ = circle @Int center radius + filledCirc = filledCircle center radius + in counterexample ( "circle: " <> show circ + <> "\nfilledCircle: " <> show filledCirc) + $ setFromList circ `isSubsetOf` setFromList filledCirc + -- TODO later + -- , testProperty "is always contiguous" $ \center radius -> + -- let filledCirc = filledCircle center radius + -- in counterexample (renderBooleanGraphics filledCirc) $ + ] + , 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) + ] + ] + +-------------------------------------------------------------------------------- diff --git a/users/aspen/xanthous/test/Xanthous/Util/InflectionSpec.hs b/users/aspen/xanthous/test/Xanthous/Util/InflectionSpec.hs new file mode 100644 index 0000000000..fad8410431 --- /dev/null +++ b/users/aspen/xanthous/test/Xanthous/Util/InflectionSpec.hs @@ -0,0 +1,18 @@ +module Xanthous.Util.InflectionSpec (main, test) where + +import Test.Prelude +import Xanthous.Util.Inflection + +main :: IO () +main = defaultMain test + +test :: TestTree +test = testGroup "Xanthous.Util.Inflection" + [ testGroup "toSentence" + [ testCase "empty" $ toSentence [] @?= "" + , testCase "single" $ toSentence ["x"] @?= "x" + , testCase "two" $ toSentence ["x", "y"] @?= "x and y" + , testCase "three" $ toSentence ["x", "y", "z"] @?= "x, y, and z" + , testCase "four" $ toSentence ["x", "y", "z", "w"] @?= "x, y, z, and w" + ] + ] |