justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Check whether tests compile in ghcid

Browse Source
This commit is contained in:
justin
2026-03-29 15:50:58 +01:00
parent 7b9635fe53
commit d278083947
11 changed files with 95 additions and 84 deletions
Download Patch File Download Diff File Expand all files Collapse all files
test/Spec.hs
+20 -10
View File
@@ -2,23 +2,27 @@
import Test.Tasty
import qualified Test.Tasty.QuickCheck as QC
import Test.Tasty.HUnit
import Dodge.Room.CheckConsistency
--import Dodge.Room.CheckConsistency
--import Geometry
import Dodge.LevelGen.StaticWalls
--import Dodge.LevelGen.StaticWalls
import Geometry
import Data.Maybe
main :: IO ()
main = defaultMain $
testGroup "Tests"
[testGroup "Geometry tests" geometryTests]
[testGroup "Geometry tests" geometryTests
,testGroup "angleVV" angleVVTests
]
geometryTests :: [TestTree]
geometryTests =
[ testGroup "(HUnit)" geometryUnitTests
, testGroup "(QuickCheck)" geometryQuickCheckTests
]
geometryUnitTests :: [TestTree]
geometryUnitTests =
[ testCase "intersectSegSegTest cross intersect" $
intersectSegSegTest (V2 1 0) (V2 1 2) (V2 0 1) (V2 2 1)
@@ -30,28 +34,29 @@ geometryUnitTests =
intersectSegSegTest (V2 1 0) (V2 1 2) (V2 0 0) (V2 0 2)
@?= False
, testCase "circOnSeg endpoint1" $
circOnSeg (V2 0 0) (V2 10 10) (V2 (-1) (-1)) 2
circOnSeg (V2 (-1) (-1)) 2 (V2 0 0) (V2 10 10)
@?= True
, testCase "circOnSeg endpoint2" $
circOnSeg (V2 0 0) (V2 10 10) (V2 11 10) 2
circOnSeg (V2 11 10) 2 (V2 0 0) (V2 10 10)
@?= True
, testCase "circOnSeg mid" $
circOnSeg (V2 0 0) (V2 10 10) (V2 5 5) 2
circOnSeg (V2 5 5) 2 (V2 0 0) (V2 10 10)
@?= True
, testCase "circOnSeg mid" $
circOnSeg (V2 0 0) (V2 10 10) (V2 5 4) 2
circOnSeg (V2 5 4) 2 (V2 0 0) (V2 10 10)
@?= True
, testCase "circOnSeg miss endpoint1" $
circOnSeg (V2 0 0) (V2 10 10) (V2 (-1) (-1)) 1
circOnSeg (V2 (-1) (-1)) 1 (V2 0 0) (V2 10 10)
@?= False
, testCase "circOnSeg miss endpoint2" $
circOnSeg (V2 0 0) (V2 10 10) (V2 11 10) 0.9
circOnSeg (V2 11 10) 0.9 (V2 0 0) (V2 10 10)
@?= False
, testCase "circOnSeg miss mid" $
circOnSeg (V2 0 0) (V2 10 10) (V2 7 3) 0.9
circOnSeg (V2 7 3) 0.9 (V2 0 0) (V2 10 10)
@?= False
]
geometryQuickCheckTests :: [TestTree]
geometryQuickCheckTests =
[ QC.testProperty "intersectSegSeg--intersectSegSegTest" $
\(x1,y1,x2,y2,x3,y3,x4,y4) ->
@@ -59,6 +64,11 @@ geometryQuickCheckTests =
== intersectSegSegTest (V2 x1 y1) (V2 x2 y2) (V2 x3 y3) (V2 x4 y4)
]
angleVVTests :: [TestTree]
angleVVTests = [QC.testProperty "random vectors give positive result" $
\(x,y,a,b) -> 0 <= angleVV (V2 x y) (V2 a b)
]
--nextPair :: Eq a => (a,a) -> [(a,a)] -> [(a,a)]
--nextPair (_,y) = filter (\(x,_) -> x == y)
--