module Test.MuCheck.Interpreter (evaluateMutants, evalMethod, evalMutant, evalTest, summarizeResults, MutantSummary(..)) where
import qualified Language.Haskell.Interpreter as I
import Control.Monad.Trans (liftIO)
import Control.Monad (liftM)
import Data.Typeable
import Test.MuCheck.Utils.Print (catchOutput)
import Data.Either (partitionEithers)
import System.Directory (createDirectoryIfMissing)
import System.Environment (withArgs)
import Test.MuCheck.TestAdapter
import Test.MuCheck.Utils.Common
import Test.MuCheck.AnalysisSummary
data MutantSummary = MSumError Mutant String [Summary]
| MSumAlive Mutant [Summary]
| MSumKilled Mutant [Summary]
| MSumOther Mutant [Summary]
deriving (Show, Typeable)
evaluateMutants :: (Summarizable a, Show a) =>
(Mutant -> TestStr -> InterpreterOutput a -> Summary)
-> [Mutant]
-> [TestStr]
-> IO (MAnalysisSummary, [MutantSummary])
evaluateMutants testSummaryFn mutants tests = do
results <- mapM (evalMutant tests) mutants
let singleTestSummaries = map (summarizeResults testSummaryFn tests) $ zip mutants results
ma = fullSummary tests results
return (ma, singleTestSummaries)
summarizeResults :: Summarizable a =>
(Mutant -> TestStr -> InterpreterOutput a -> Summary)
-> [TestStr]
-> (Mutant, [InterpreterOutput a])
-> MutantSummary
summarizeResults testSummaryFn tests (mutant, ioresults) = case last results of
Left err -> MSumError mutant (show err) logS
Right out -> myresult out
where results = map _io ioresults
myresult out | isSuccess out = MSumAlive mutant logS
| isFailure out = MSumKilled mutant logS
| otherwise = MSumOther mutant logS
logS :: [Summary]
logS = zipWith (testSummaryFn mutant) tests ioresults
evalMutant :: (Typeable t, Summarizable t) =>
[TestStr]
-> Mutant
-> IO [InterpreterOutput t]
evalMutant tests mutant = do
createDirectoryIfMissing True ".mutants"
let mutantFile = ".mutants/" ++ hash mutant ++ ".hs"
writeFile mutantFile mutant
let logF = mutantFile ++ ".log"
stopFast (evalTest mutantFile logF) tests
stopFast :: (Typeable t, Summarizable t) =>
(String -> IO (InterpreterOutput t))
-> [TestStr]
-> IO [InterpreterOutput t]
stopFast _ [] = return []
stopFast fn (x:xs) = do
v <- fn x
case _io v of
Left _ -> return [v]
Right out -> if isSuccess out
then liftM (v :) $ stopFast fn xs
else return [v]
evalTest :: (Typeable a, Summarizable a) =>
String
-> String
-> TestStr
-> IO (InterpreterOutput a)
evalTest mutantFile logF test = do
val <- withArgs [] $ catchOutput logF $ I.runInterpreter (evalMethod mutantFile test)
return Io {_io = val, _ioLog = logF}
evalMethod :: (I.MonadInterpreter m, Typeable t) =>
String
-> TestStr
-> m t
evalMethod fileName evalStr = do
I.loadModules [fileName]
ms <- I.getLoadedModules
I.setTopLevelModules ms
I.interpret evalStr (I.as :: (Typeable a => IO a)) >>= liftIO
fullSummary :: (Show b, Summarizable b) =>
[TestStr]
-> [[InterpreterOutput b]]
-> MAnalysisSummary
fullSummary _tests results = MAnalysisSummary {
_maNumMutants = length results,
_maAlive = length alive,
_maKilled = length fails,
_maErrors= length errors}
where res = map (map _io) results
lasts = map last res
(errors, completed) = partitionEithers lasts
fails = filter isFailure completed
alive = filter isSuccess completed