fitspec-0.4.8: test/showmutable.hs
-- Copyright (c) 2015-2017 Rudy Matela.
-- Distributed under the 3-Clause BSD licence (see the file LICENSE).
{-# LANGUAGE NoMonomorphismRestriction #-}
import System.Exit (exitFailure)
import System.Environment (getArgs)
import Data.List (elemIndices, sort)
import Data.Tuple (swap)
import Test.FitSpec
import Test.FitSpec.ShowMutable
import Test.FitSpec.PrettyPrint
import Test.LeanCheck.Error (errorToNothing)
import Test.LeanCheck.Utils.TypeBinding
main :: IO ()
main = do
as <- System.Environment.getArgs
let n = case as of [] -> 10
(s:_) -> read s
-- n == 10 -- 1s on zero
-- n == 32 -- 4s on zero
-- n == 100 -- 15s on zero
-- n == 200 -- 30s on zero
case elemIndices False (tests n) of
[] -> putStrLn "Tests passed!"
is -> do putStrLn ("Failed tests:" ++ show is)
exitFailure
-- Below, some of the tests are marked as failing:
-- They simply fail because there are too many values
-- being tested (the showMutant function only approximates
-- the printing of a mutant)
-- There is a TODO in the other file related to this
-- to allow configuration of how many values should be
-- tried when enumerating the mutants.
tests n =
[ True
, holds n $ prop_0 -:> int
, holds n $ prop_0 -:> bool
, holds n $ prop_0 -:> char
, holds n $ prop_0 -:> string
, fails n $ prop_0 -:> (int,int)
, holds n $ prop_00 -:> (int,int)
, holds n $ prop_00 -:> (bool,int)
, holds n $ prop_00 -:> (int,bool)
, holds n $ prop_00 -:> (string,char)
, holds n $ prop_00 -:> (char,string)
, h1 $ id -:> int
, h1 $ id -:> bool
, h1 $ id -:> (int,int)
, h1 $ id -:> (bool,int)
, h1 $ id -:> (int,bool)
, h1 $ id -:> (bool,bool)
, h1 $ id -:> (int,int,int)
, h1 $ id -:> (int,(int,int))
, h1 $ id -:> ((int,int),int)
, h1 $ const True -:> int -- fails (500 tests)!
, h1 $ const (0::Int) -:> bool
, h1 $ swap -:> (int,bool)
, h1 $ swap -:> (bool,int)
, h1 $ swap -:> (int,(int,int))
, h1 $ swap -:> ((int,int),int)
, h2 $ const -: int >- int >- und
, h2 $ const -: int >- bool >- und
, h2 $ const -: bool >- int >- und -- fails (1000 tests)!
, h2 $ (+) -:> int
, hI $ (+) -:> int
, h2 $ (*) -:> int
, h2 $ (&&)
, h2 $ (||)
, h2 $ (:) -:> int -- fails (2000 tests)!
, h2 $ (++) -:> [int] -- fails (3000 tests)!
, h11 (id -:> int) (id ->: bool)
, h11 (id -:> bool) (id ->: int)
, h11 (swap -:> ((int,int),int)) (swap ->: (int,(int,int)))
, h111 (id -:> int) (id ->: bool) (id ->: char)
, h111 (id -:> bool) (id ->: char) (id ->: int)
, h111 (swap -:> ((int,int),(int,int)))
(swap -:> ((int,int),int))
(swap -:> (int,(int,int)))
, h11' (id -:> int) (id ->: bool) (id ->: char)
, h11' (id -:> bool) (id ->: char) (id ->: int)
, h11' (swap -:> ((int,int),(int,int)))
(swap -:> ((int,int),int))
(swap -:> (int,(int,int)))
]
where h1 = holds n . prop_1
h2 = holds n . prop_2
hI = holds n . prop_I
h11 f = holds n . prop_11 f
h111 f g = holds n . prop_111 f g
h11' f g = holds n . prop_11' f g
-- prop_N, asserts the format of a mutation of a value of N arguments
-- prop_MN, asserts the format of a pair of values of M and N arguments
-- prop_MNO, asserts the format of a triple of values
prop_0 :: (Eq a, Show a, Listable a, ShowMutable a)
=> a -> a -> Bool
prop_0 x x' | x == x' = s == "x"
| otherwise = s == show x'
where s = showMutantAsTuple ["x"] x x'
prop_00 :: ( Eq a, Show a, Listable a, ShowMutable a
, Eq b, Show b, Listable b, ShowMutable b )
=> (a,b) -> (a,b) -> Bool
prop_00 (x,y) (x',y') | x == x' && y == y' = s == "(x,y)"
| x == x' = s == "(x," ++ show y' ++ ")"
| y == y' = s == "(" ++ show x' ++ ",y)"
| otherwise = s == "(" ++ show x'
++ "," ++ show y' ++ ")"
where s = showMutantAsTuple ["x","y"] (x,y) (x',y')
prop_1 :: ( Eq a, Show a, Listable a, ShowMutable a
, Eq b, Show b, Listable b, ShowMutable b )
=> (a->b) -> a -> b -> Bool
prop_1 f x fx = fx /= f x
==> showMutantAsTuple ["f x"] f (mutate f x fx) == showMutantF "f" x fx
&& showMutantDefinition ["f x"] f (mutate f x fx) == showMutantB "f" x fx
prop_11 :: ( Eq a, Show a, Listable a, ShowMutable a
, Eq b, Show b, Listable b, ShowMutable b
, Eq c, Show c, Listable c, ShowMutable c
, Eq d, Show d, Listable d, ShowMutable d )
=> (a->b) -> (c->d) -> a -> b -> c -> d -> Bool
prop_11 f g x fx y gy = fx /= f x && gy /= g y
==> showMutantAsTuple ["f x","g x"] (f,g) (mutate f x fx, mutate g y gy)
== showTuple [showMutantF "f" x fx, showMutantF "g" y gy]
&& showMutantDefinition ["f x","g x"] (f,g) (mutate f x fx, mutate g y gy)
== concat [showMutantB "f" x fx, showMutantB "g" y gy]
prop_111 :: ( Eq a, Show a, Listable a, ShowMutable a
, Eq b, Show b, Listable b, ShowMutable b
, Eq c, Show c, Listable c, ShowMutable c
, Eq d, Show d, Listable d, ShowMutable d
, Eq e, Show e, Listable e, ShowMutable e
, Eq f, Show f, Listable f, ShowMutable f )
=> (a->b) -> (c->d) -> (e->f) -> a -> b -> c -> d -> e -> f -> Bool
prop_111 f g h x fx y gy z hz = fx /= f x
&& gy /= g y
&& hz /= h z
==> showMutantAsTuple ["f x","g x","h x"] (f,g,h)
( mutate f x fx
, mutate g y gy
, mutate h z hz )
== showTuple [ showMutantF "f" x fx
, showMutantF "g" y gy
, showMutantF "h" z hz ]
&& showMutantDefinition ["f x","g x","h x"] (f,g,h)
( mutate f x fx
, mutate g y gy
, mutate h z hz )
== concat [ showMutantB "f" x fx
, showMutantB "g" y gy
, showMutantB "h" z hz ]
prop_11' :: ( Eq a, Show a, Listable a, ShowMutable a
, Eq b, Show b, Listable b, ShowMutable b
, Eq c, Show c, Listable c, ShowMutable c
, Eq d, Show d, Listable d, ShowMutable d
, Eq e, Show e, Listable e, ShowMutable e
, Eq f, Show f, Listable f, ShowMutable f )
=> (a->b) -> (c->d) -> (e->f) -> a -> b -> c -> d -> e -> f -> Bool
prop_11' f g h x fx y gy z hz = fx /= f x
&& gy /= g y
&& hz /= h z
==> showMutantAsTuple ["f x","g x","h x"] (f,(g,h))
( mutate f x fx
, ( mutate g y gy
, mutate h z hz ) )
== showTuple [ showMutantF "f" x fx
, showTuple [ showMutantF "(??)" y gy
, showMutantF "(??)" z hz ] ]
&& showMutantDefinition ["f x","g x","h x"] (f,(g,h))
( mutate f x fx
, ( mutate g y gy
, mutate h z hz ) )
== concat [ showMutantB "f" x fx
, "g' = "
`beside` showTuple [ showMutantF "(??)" y gy
, showMutantF "(??)" z hz ] ]
prop_2 :: ( Eq a, Show a, Listable a, ShowMutable a
, Eq b, Show b, Listable b, ShowMutable b
, Eq c, Show c, Listable c, ShowMutable c )
=> (a->b->c) -> a -> b -> c -> Bool
prop_2 f x y fxy = fxy /= f x y ==>
showMutantAsTuple ["f x y"] f (mutate2 f x y fxy) == showMutantF2 "f" x y fxy &&
showMutantDefinition ["f x y"] f (mutate2 f x y fxy) == showMutantB2 "f" x y fxy
prop_I :: ( Eq a, Show a, Listable a, ShowMutable a
, Eq b, Show b, Listable b, ShowMutable b
, Eq c, Show c, Listable c, ShowMutable c )
=> (a->b->c) -> a -> b -> c -> Bool
prop_I f x y fxy = fxy /= f x y ==>
showMutantAsTuple ["x + y"] f (mutate2 f x y fxy) == showMutantI "+" x y fxy &&
showMutantDefinition ["x + y"] f (mutate2 f x y fxy) == showMutantBI "+" x y fxy
mutate :: Eq a => (a -> b) -> a -> b -> (a -> b)
mutate f x y x' | x' == x = y
| otherwise = f x'
mutate2 :: (Eq a, Eq b) => (a -> b -> c) -> a -> b -> c -> (a -> b -> c)
mutate2 f x y z = curry (mutate (uncurry f) (x,y) z)
-- | Show a mutant of a function of one argument
showMutantF :: (Show a, Show b)
=> String -> a -> b -> String
showMutantF f x y = "\\x -> case x of\n"
++ " " ++ show x ++ " -> " ++ show y ++ "\n"
++ " _ -> " ++ f ++ " x\n"
-- | Show a mutant of a function of two arguments
showMutantF2 :: (Show a, Show b, Show c)
=> String -> a -> b -> c -> String
showMutantF2 f x y z = "\\x y -> case (x,y) of\n"
++ " (" ++ show x ++ "," ++ show y ++ ") -> "
++ show z ++ "\n"
++ " _ -> " ++ f ++ " x y\n"
showMutantB :: (Show a, Show b)
=> String -> a -> b -> String
showMutantB f x fx = table " "
[ [f ++ "'", show x, "=", show fx]
, [f ++ "'", "x", "=", f ++ " x"] ]
showMutantB2 :: (Show a, Show b, Show c)
=> String -> a -> b -> c -> String
showMutantB2 f x y fxy = table " "
[ [f ++ "'", show x, show y, "=", show fxy]
, [f ++ "'", "x", "y", "=", f ++ " x y"] ]
-- | Show a mutant of an infix
showMutantI :: (Show a, Show b, Show c)
=> String -> a -> b -> c -> String
showMutantI o x y z = "\\x y -> case (x,y) of\n"
++ " (" ++ show x ++ "," ++ show y ++ ") -> "
++ show z ++ "\n"
++ " _ -> x " ++ o ++ " y\n"
showMutantBI :: (Show a, Show b, Show c)
=> String -> a -> b -> c -> String
showMutantBI o x y fxy = table " "
[ [show x, o ++ "-", show y, "=", show fxy]
, ["x", o ++ "-", "y", "=", "x " ++ o ++ " y"] ]