diff options
author | Camil Staps | 2017-11-22 17:04:10 +0100 |
---|---|---|
committer | Camil Staps | 2017-11-22 17:04:10 +0100 |
commit | 542a29eb1986599d780bacfe92620eaafb03f921 (patch) | |
tree | 1c91f3e8aacdcf64722e425a09769e443584d4c3 | |
parent | Merge branch '8-quickcheck-property-pinned-pieces-cannot-move' into 'master' (diff) |
Add reports on triviality of test cases
-rw-r--r-- | test/Test.hs | 15 |
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) |