module MuCheck.Interpreter where
import qualified Language.Haskell.Interpreter as I
import Control.Monad.Trans ( liftIO )
import qualified Test.QuickCheck.Test as Qc
import qualified Test.HUnit as HUnit
import qualified Test.Hspec.Core.Runner as Hspec
import Data.Typeable
import MuCheck.Utils.Print (showA, showAS, (./.))
import Data.Either (partitionEithers, rights)
import Data.List((\\), groupBy, sortBy, intercalate, isInfixOf)
import Data.Time.Clock
deriving instance Typeable Qc.Result
deriving instance Typeable HUnit.Counts
deriving instance Typeable Hspec.Summary
type InterpreterOutput a = Either I.InterpreterError (String, a)
checkQuickCheckOnMutants :: [String] -> String -> [String] -> String -> IO [Qc.Result]
checkQuickCheckOnMutants = mutantCheckSummary
checkHUnitOnMutants :: [String] -> String -> [String] -> String -> IO [HUnit.Counts]
checkHUnitOnMutants = mutantCheckSummary
checkHspecOnMutants :: [String] -> String -> [String] -> String -> IO [Hspec.Summary]
checkHspecOnMutants = mutantCheckSummary
mutantCheckSummary :: Summarizable a => [String] -> String -> [String] -> FilePath -> IO [a]
mutantCheckSummary mutantFiles topModule evalSrcLst logFile = do
results <- mapM (runCodeOnMutants mutantFiles topModule) evalSrcLst
let singleTestSummaries = zip evalSrcLst $ map (testSummary mutantFiles) results
tssum = suiteSummary results
putStrLn $ delim ++ "Overall Results:"
putStrLn $ terminalSummary tssum
putStrLn $ showAS $ map showBrief singleTestSummaries
putStr delim
appendFile logFile $ "OVERALL RESULTS:\n" ++ (tssum_log tssum) ++ (showAS $ map showDetail singleTestSummaries)
return $ tail [head $ (map snd) $ snd $ partitionEithers $ head results]
where showDetail (method, msum) = delim ++ showBrief (method, msum) ++ "\n" ++ detail msum
showBrief (method, msum) = showAS [method,
"\tTotal number of mutants:\t" ++ show (tsum_numMutants msum),
"\tFailed to Load:\t" ++ show (tsum_loadError msum),
"\tNot Killed:\t" ++ show (tsum_notKilled msum),
"\tKilled:\t" ++ show (tsum_killed msum),
"\tOthers:\t" ++ show (tsum_others msum),
""]
detail msum = tsum_log msum
terminalSummary tssum = showAS ["Total number of mutants:\t" ++ show (tssum_numMutants tssum),
"Total number of alive mutants:\t" ++ show (tssum_alive tssum),
"Total number of load errors:\t" ++ show (tssum_errors tssum),
""]
delim = "\n" ++ (take 25 (repeat '=')) ++ "\n"
runCodeOnMutants mutantFiles topModule evalStr = mapM (evalMyStr evalStr) mutantFiles
where evalMyStr evalStr file = do putStrLn $ ">" ++ ":" ++ file ++ ":" ++ topModule ++ ":" ++ evalStr ++ ">"
x <- I.runInterpreter (evalMethod file topModule evalStr)
return x
evalMethod :: (I.MonadInterpreter m, Typeable t) => String -> String -> String -> m (String, t)
evalMethod fileName topModule evalStr = do
I.loadModules [fileName]
I.setTopLevelModules [topModule]
result <- I.interpret evalStr (I.as :: (Typeable a => IO a)) >>= liftIO
return (fileName, result)
data TSum = TSum {tsum_numMutants::Int, tsum_loadError::Int, tsum_notKilled::Int, tsum_killed::Int, tsum_others::Int, tsum_log::String}
data TSSum = TSSum {tssum_numMutants::Int, tssum_alive::Int, tssum_errors::Int, tssum_log::String}
type MutantFilename = String
class Typeable s => Summarizable s where
testSummary :: [MutantFilename] -> [InterpreterOutput s] -> TSum
suiteSummary :: [[InterpreterOutput s]] -> TSSum
isSuccess :: s -> Bool
instance Summarizable HUnit.Counts where
testSummary mutantFiles results = TSum {
tsum_numMutants = r,
tsum_loadError = le,
tsum_notKilled = s,
tsum_killed = fl,
tsum_others = re + ftc,
tsum_log = logMsg}
where (loadingErrorCases, executedCases) = partitionEithers results
loadingErrorFiles = mutantFiles \\ map fst executedCases
successCases = filter (isSuccess . snd) executedCases
failuresCases = filter ((>0) . HUnit.failures . snd) executedCases
runningErrorCases = (filter ((>0) . HUnit.errors . snd) executedCases) \\ failuresCases
failToFullyTryCases = filter ((\c -> HUnit.cases c > HUnit.tried c) . snd) executedCases
r = length results
le = length loadingErrorCases
[s, fl, re, ftc] = map length [successCases, failuresCases, runningErrorCases, failToFullyTryCases]
logMsg = showAS ["Details:",
"Loading error files:",showA loadingErrorFiles,
"Loading error messages:",showA loadingErrorCases,
"Successes:", showA successCases,
"Failures:", showA failuresCases,
"Error while running:", showA runningErrorCases,
"Incompletely tested (may include failures and running errors):",showA failToFullyTryCases]
suiteSummary = multipleCheckSummary (isSuccess . snd)
isSuccess = (\c -> (HUnit.cases c == HUnit.tried c) && HUnit.failures c == 0 && HUnit.errors c == 0)
instance Summarizable Qc.Result where
testSummary mutantFiles results = TSum {
tsum_numMutants = r,
tsum_loadError = e,
tsum_notKilled = s,
tsum_killed = f,
tsum_others = g,
tsum_log = logMsg}
where (errorCases, executedCases) = partitionEithers results
[successCases, failureCases, gaveUpCases] = map (\c -> filter (c . snd) executedCases) [isSuccess, isFailure, isGaveUp]
r = length results
e = length errorCases
[s,f,g] = map length [successCases, failureCases, gaveUpCases]
errorFiles = mutantFiles \\ map fst executedCases
logMsg = showAS ["Details:",
"Loading error files:", showA errorFiles,
"Loading error messages:", showA errorCases,
"Successes:", showA successCases,
"Failure:", showA failureCases,
"Gaveups:", showA gaveUpCases]
isFailure :: Qc.Result -> Bool
isFailure Qc.Failure{} = True
isFailure _ = False
isGaveUp :: Qc.Result -> Bool
isGaveUp Qc.GaveUp{} = True
isGaveUp _ = False
suiteSummary = multipleCheckSummary (isSuccess . snd)
isSuccess = Qc.isSuccess
instance Summarizable Hspec.Summary where
testSummary mutantFiles results = TSum {
tsum_numMutants = r,
tsum_loadError = e,
tsum_notKilled = s,
tsum_killed = f,
tsum_others = 0,
tsum_log = logMsg}
where (errorCases, executedCases) = partitionEithers results
r = length results
e = length errorCases
[successCases, failureCases] = map (\c -> filter (c . snd) executedCases) [isSuccess, isFailure]
[s,f] = map length [successCases, failureCases]
errorFiles = mutantFiles \\ map fst executedCases
logMsg = showAS ["Details:",
"Loading error files:", showA errorFiles,
"Loading error messages:", showA errorCases,
"Successes:", showA successCases,
"Failure:", showA failureCases]
isFailure = not . isSuccess
suiteSummary = multipleCheckSummary (isSuccess . snd)
isSuccess (Hspec.Summary { Hspec.summaryExamples = se, Hspec.summaryFailures = sf } ) = sf == 0
multipleCheckSummary isSuccessFunction results
| not (checkLength results) = error "Output lengths differ for some properties."
| otherwise = TSSum {tssum_numMutants = countMutants, tssum_alive = countAlive, tssum_errors= countErrors, tssum_log = logMsg}
where executedCases = groupBy (\x y -> fst x == fst y) . sortBy (\x y -> fst x `compare` fst y) . rights $ concat results
allSuccesses = [rs | rs <- executedCases, length rs == length results, all isSuccessFunction rs]
countAlive = length allSuccesses
countErrors = countMutants length executedCases
logMsg = showA allSuccesses
checkLength results = and $ map ((==countMutants) . length) results ++ map ((==countExecutedCases) . length) executedCases
countExecutedCases = length . head $ executedCases
countMutants = length . head $ results