diff options
| author | Camil Staps | 2017-11-20 13:49:21 +0100 |
|---|---|---|
| committer | Camil Staps | 2017-11-20 13:49:21 +0100 |
| commit | 0bf15486522fdf0c71265446ae9ae1a2e340dc38 (patch) | |
| tree | ca15392ebfa83a5c10051511bf0077ded9567cc6 /test | |
| parent | Add pieceCoords (diff) | |
| parent | Fix issues in number of pieces property (diff) | |
Merge branch '1-quickcheck-property-niet-meer-stukken-op-het-bord-na-een-zet' into 'master'
Resolve "QuickCheck property: niet meer stukken op het bord na een zet"
Closes #1
See merge request eveen/Testing-Techniques!3
Diffstat (limited to 'test')
| -rw-r--r-- | test/Test.hs | 20 |
1 files changed, 19 insertions, 1 deletions
diff --git a/test/Test.hs b/test/Test.hs index 4aa3197..6741e70 100644 --- a/test/Test.hs +++ b/test/Test.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TemplateHaskell, ParallelListComp #-} -- vim: sw=2 ts=2 et ai: module Test where @@ -28,6 +28,17 @@ atAnyState ok pgn = and [ok b | Right b <- seqList [moveSAN m | m <- moves pgn] seqList _ (Left _) = [] seqList [] _ = [] +atAnyTwoStates :: (Board -> Board -> Bool) -> PGN -> Bool +atAnyTwoStates ok pgn = + let moveList = seqList [moveSAN m | m <- moves pgn] $ Right defaultBoard in + and [ok b1 b2 | Right b1 <- moveList | Right b2 <- tail moveList] + where + seqList :: [r -> Either e r] -> Either e r -> [Either e r] + seqList (f:fs) (Right io) = f io:seqList fs (f io) + seqList _ (Left _) = [] + seqList [] _ = [] + + prop_checkPGN :: PGN -> Bool prop_checkPGN pgn | isLeft parsed = False @@ -83,5 +94,12 @@ prop_only_2_kings = atAnyState (\b -> length (pieceCoords (Just Black) (Just King) b) == 1 && length (pieceCoords (Just White) (Just King) b) == 1) +prop_number_of_pieces :: PGN -> Bool +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) + ) + return [] main = $forAllProperties (quickCheckWithResult (stdArgs {maxSuccess=10000})) |