module Test.FitSpec.Report
( report
, reportWith
, reportWithExtra
, Args(..)
, args
, fixargs
, Property
, ShowMutantAs(..)
)
where
import Data.List (intercalate, intersperse)
import Data.Maybe (fromMaybe)
import Test.FitSpec.Engine
import Test.FitSpec.Mutable
import Test.FitSpec.ShowMutable
import Test.FitSpec.Utils
import Test.FitSpec.PrettyPrint
data ShowMutantAs = Tuple | NestedTuple
| Definition | Bindings
data Args = Args
{ nMutants :: Int
, nTests :: Int
, timeout :: Int
, names :: [String]
, verbose :: Bool
, showMutantAs :: ShowMutantAs
, rows :: Maybe Int
, extra :: [String]
}
args :: Args
args = Args { nMutants = 500
, nTests = 1000
, timeout = 5
, names = []
, verbose = False
, showMutantAs = Tuple
, rows = Nothing
, extra = []
}
fixargs :: Int -> Int -> Args
fixargs nm nt = args
{ nMutants = nm
, nTests = nt
, timeout = 0
}
showMutant :: ShowMutable a => Args -> a -> a -> String
showMutant as = showMutantByType (showMutantAs as) (names as)
where
showMutantByType Tuple = showMutantAsTuple
showMutantByType NestedTuple = showMutantNested
showMutantByType Definition = showMutantDefinition
showMutantByType Bindings = showMutantBindings
report :: (Mutable a, ShowMutable a)
=> a -> (a -> [Property]) -> IO ()
report = reportWith args
reportWith :: (Mutable a, ShowMutable a)
=> Args -> a -> (a -> [Property]) -> IO ()
reportWith = reportWithExtra []
reportWithExtra :: (Mutable a, ShowMutable a)
=> [a] -> Args -> a -> (a -> [Property]) -> IO ()
reportWithExtra extraMutants args f properties = do
let nm = nMutants args
nt = nTests args
case propertiesCE nt (properties f) of
Nothing -> reportWithExtra' extraMutants args f properties
Just ce -> do
putStrLn $ "ERROR: The original function-set does not follow property set for "
++ show nt ++ " tests"
putStrLn $ "Counter-example to property " ++ ce
putStrLn $ "Aborting."
reportWithExtra' :: (Mutable a, ShowMutable a)
=> [a] -> Args -> a -> (a -> [Property]) -> IO ()
reportWithExtra' extraMutants args f properties = do
results <- getResultsExtraTimeout (timeout args)
extraMutants
f properties
(nMutants args) (nTests args)
let nm = totalMutants $ head results
nt = maxTests $ head results
nts = propertiesNTests nt (properties f)
tex = and $ propertiesTestsExhausted nt (properties f)
mex = mutantsExhausted $ head results
apparent | tex && mex = ""
| otherwise = "apparent "
putStrLn . headToUpper $ apparent ++ qualifyCM results ++ " specification based on"
putStrLn $ showNumberOfTestsAndMutants tex mex nts nm False
let showR | verbose args = showDetailedResults
| otherwise = showResults
putStrLn $ showR (rows args) (showMutant args f) results
showResults :: Maybe Int -> (a -> String)
-> [Result a] -> String
showResults mlimit showMutant rs@(r:_) = completeness
++ "\n" ++ minimality
where
showMutants ms = init . unlines $ map showMutant ms
completeness = show (nSurvivors r) ++ " survivors ("
++ show (score r) ++ "% killed)"
++ case take (fromMaybe 1 mlimit) $ survivors r of
[] -> ".\n"
[m] -> ", smallest:\n"
++ " " `beside` showMutant m
ms -> ", " ++ show (length ms) ++ " smallest:\n"
++ " " `beside` showMutants ms
minimality = "apparent minimal property subsets: "
++ (unwords . map showPropertySet $ sets r) ++ "\n"
++ case showConjectures False rs of
"" -> "No conjectures.\n"
cs -> "conjectures: " `beside` cs
showDetailedResults :: Maybe Int -> (a -> String)
-> [Result a] -> String
showDetailedResults mlimit showMutant rs = completeness
++ "\n" ++ minimality
where
completeness = table " " . intersperse ["\n"]
. ([ "Property\n sets"
, "#Survivors\n (%Killed)"
, "Smallest or simplest\n surviving mutant"
]:)
. map showResult
. maybe id take mlimit
$ rs
showResult r = [ unwords . map showPropertySet $ sets r
, show (nSurvivors r) ++ " (" ++ show (score r) ++ "%)"
, maybe "" showMutant $ smallestSurvivor r
]
minimality = case showConjectures True rs of
"" -> "No conjectures.\n"
cs -> "Conjectures:\n" ++ cs
showNumberOfTestsAndMutants :: Bool -> Bool -> [Int] -> Int -> Bool -> String
showNumberOfTestsAndMutants tex mex nts nm ssum = numTests ++ numMutants
where
mexS | mex = " (exhausted)"
| otherwise = ""
numMutants = "for each of " ++ showQuantity nm "mutant variation" ++ mexS ++ ".\n"
numTests | ssum = showQuantity (sum nts) "test case"
++ (if tex then " (exhausted)" else "")
++ "\n"
| otherwise = unlines
. (++ ["(test cases exhausted)" | tex])
. sortGroupAndCollapse fst snd testsForProps
$ zip nts [1..]
testsForProps n ps = showQuantity n "test case"
++ " for " ++ showEach "property" ps
showPropertySet :: Show i => [i] -> String
showPropertySet = (\s -> "{" ++ s ++ "}") . intercalate "," . map show
showConjectures :: Bool -> [Result a] -> String
showConjectures showVeryWeak = table " "
. map showConjecture
. filter (\r -> showVeryWeak
|| cnKilled r /= 0
&& cnSurvivors r /= 0)
. conjectures
showConjecture :: Conjecture -> [String]
showConjecture Conjecture {isEq=eq, cleft=l, cright=r, cscore=s} =
[ showPropertySet l
, if eq then " = " else "==>"
, showPropertySet r
, " "
, show s ++ "% killed"
, sMeaning
]
where sMeaning | s < 1 || 99 < s = "(very weak)"
| s < 11 || 89 < s = "(weak)"
| s < 33 || 67 < s = "(mild)"
| otherwise = "(strong)"
qualifyCM :: Results a -> String
qualifyCM rs | c && m = "complete and minimal"
| c = "complete but non-minimal"
| m = "minimal but incomplete"
| otherwise = "incomplete and non-minimal"
where c = complete rs
m = minimal rs