summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorCamil Staps2017-11-22 17:04:10 +0100
committerCamil Staps2017-11-22 17:04:10 +0100
commit542a29eb1986599d780bacfe92620eaafb03f921 (patch)
tree1c91f3e8aacdcf64722e425a09769e443584d4c3
parentMerge branch '8-quickcheck-property-pinned-pieces-cannot-move' into 'master' (diff)
Add reports on triviality of test cases
-rw-r--r--test/Test.hs15
1 files changed, 8 insertions, 7 deletions
diff --git a/test/Test.hs b/test/Test.hs
index 897c788..dfa3102 100644
--- a/test/Test.hs
+++ b/test/Test.hs
@@ -20,12 +20,13 @@ import Chess.PGN
import ArbitraryMove
-atAnyState :: (Board -> Bool) -> PGN -> Bool
+atAnyState :: (Board -> Bool) -> PGN -> Property
atAnyState = atAnyTwoStates . const
-atAnyTwoStates :: (Board -> Board -> Bool) -> PGN -> Bool
+atAnyTwoStates :: (Board -> Board -> Bool) -> PGN -> Property
atAnyTwoStates ok pgn =
let moveList = seqList [moveSAN m | m <- moves pgn] $ Right defaultBoard in
+ classify True (show (length moveList - 1) ++ " legal move(s)") $
and [ok b1 b2 | Right b1 <- moveList | Right b2 <- tail moveList]
where
seqList :: [r -> Either e r] -> Either e r -> [Either e r]
@@ -84,30 +85,30 @@ pieceCoords clr piece brd = [(i,pc) | (i,Just pc) <- assocs $ board brd, match p
(isJust clr && clr' == fromJust clr || isNothing clr) &&
(isJust piece && piece' == fromJust piece || isNothing piece)
-prop_only_2_kings :: PGN -> Bool
+prop_only_2_kings :: PGN -> Property
prop_only_2_kings = atAnyState (\b ->
length (pieceCoords (Just Black) (Just King) b) == 1 &&
length (pieceCoords (Just White) (Just King) b) == 1)
-prop_no_pawns_on_1_and_8 :: PGN -> Bool
+prop_no_pawns_on_1_and_8 :: PGN -> Property
prop_no_pawns_on_1_and_8 = atAnyState $ all notOn1or8 . pieceCoords Nothing (Just Pawn)
where
notOn1or8 :: ((Int,Int),a) -> Bool
notOn1or8 ((_,r),_) = r /= 0 && r /= 7
-prop_number_of_pieces :: PGN -> Bool
+prop_number_of_pieces :: PGN -> Property
prop_number_of_pieces = atAnyTwoStates (\b1 b2 ->
length (pieceCoords Nothing Nothing b1) == length (pieceCoords Nothing Nothing b2)
||
length (pieceCoords Nothing Nothing b1) - 1 == length (pieceCoords Nothing Nothing b2)
)
-prop_not_in_check_twice :: PGN -> Bool
+prop_not_in_check_twice :: PGN -> Property
prop_not_in_check_twice = atAnyTwoStates (\b1 b2 ->
not (check Black b1 && check Black b2) &&
not (check White b1 && check White b2))
-prop_move_not_result_check :: PGN -> Bool
+prop_move_not_result_check :: PGN -> Property
prop_move_not_result_check = atAnyTwoStates (\b1 b2 ->
case turn b1 of
White -> not (check White b2)