diff --git a/MuCheck.cabal b/MuCheck.cabal --- a/MuCheck.cabal +++ b/MuCheck.cabal @@ -1,5 +1,5 @@ name: MuCheck -version: 0.2.1.0 +version: 0.3.0.0 synopsis: Automated Mutation Testing description: This package defines a mutation analysis library for haskell programs. It does this by parsing the haskell source, and @@ -25,7 +25,7 @@ source-repository this type: git location: https://bitbucket.org/osu-testing/mucheck.git - tag: 0.2.1.0 + tag: 0.3.0.0 library exposed-modules: Test.MuCheck, @@ -38,6 +38,7 @@ Test.MuCheck.Utils.Common, Test.MuCheck.Utils.Print, Test.MuCheck.TestAdapter + Test.MuCheck.AnalysisSummary ghc-options: -Wall -- other-modules: build-depends: base >=4 && <5, @@ -46,11 +47,10 @@ time >= 1.4.0.1, hint >= 0.3.1.0, mtl>=2.1.2, - filepath >= 1.1.0, random >= 1.0.0, directory >= 1.2.1.0, temporary >= 1.1, - MissingH >= 1.3 + hashable >= 1.2 default-language: Haskell2010 hs-source-dirs: src @@ -65,12 +65,11 @@ time >= 1.4.0.1, hint >= 0.3.1.0, mtl>=2.1.2, - filepath >= 1.1.0, hspec>= 2.0, MuCheck, random >= 1.0.0, directory >= 1.2.1.0, temporary >= 1.1, - MissingH >= 1.3 + hashable >= 1.2 default-language: Haskell2010 diff --git a/changes.md b/changes.md --- a/changes.md +++ b/changes.md @@ -1,5 +1,13 @@ # Changelog +## [0.3.0.0] (Rahul Gopinath) + * Heavy refacoring, now summary is based on mutations rather than tests. + * Mutation fails fast on either load errors or test failures + +## [0.2.1.1] (Rahul Gopinath) + * Make it usable from d-mucheck + * Include logfile name for captured output (or the log string otherwise). + ## [0.2.1.0] (Rahul Gopinath) * Remove need to pass in module name * Add new literal mutators including booleans diff --git a/src/Test/MuCheck.hs b/src/Test/MuCheck.hs --- a/src/Test/MuCheck.hs +++ b/src/Test/MuCheck.hs @@ -1,16 +1,16 @@ -- | MuCheck base module module Test.MuCheck (mucheck) where -import Control.Monad (void) import Test.MuCheck.Mutation import Test.MuCheck.Config import Test.MuCheck.Utils.Common -import Test.MuCheck.Interpreter (evaluateMutants) +import Test.MuCheck.Interpreter (evaluateMutants, MutantSummary(..)) import Test.MuCheck.TestAdapter +import Test.MuCheck.AnalysisSummary -- | Perform mutation analysis -mucheck :: (Summarizable a, Show a) => ([Mutant] -> [InterpreterOutput a] -> Summary) -> String -> FilePath -> [String] -> IO () -mucheck resFn mFn file args = do - mutants <- genMutants mFn file >>= rSample (maxNumMutants defaultConfig) - void $ evaluateMutants resFn mutants args ("./mucheck-" ++ mFn ++ ".log") +mucheck :: (Summarizable a, Show a) => (Mutant -> TestStr -> InterpreterOutput a -> Summary) -> String -> String -> [TestStr] -> IO (MAnalysisSummary, [MutantSummary]) +mucheck resFn mutatingFn moduleFile tests = do + mutants <- genMutants mutatingFn moduleFile >>= rSample (maxNumMutants defaultConfig) + evaluateMutants resFn mutants tests diff --git a/src/Test/MuCheck/AnalysisSummary.hs b/src/Test/MuCheck/AnalysisSummary.hs new file mode 100644 --- /dev/null +++ b/src/Test/MuCheck/AnalysisSummary.hs @@ -0,0 +1,19 @@ +module Test.MuCheck.AnalysisSummary where + +import Test.MuCheck.Utils.Print + +-- | Datatype to hold results of the entire run +data MAnalysisSummary = MAnalysisSummary { + maNumMutants::Int, + maAlive::Int, + maKilled::Int, + maErrors::Int} + +instance Show MAnalysisSummary where + show ma = let total = maNumMutants ma + noerrors = total - maErrors ma + in showAS ["Total mutants: " ++ show total, + "\terrors: " ++ show (maErrors ma) ++ " "++ maErrors ma ./. total, + "\talive: " ++ show (maAlive ma) ++ "/" ++ show noerrors, + "\tkilled: " ++ show (maKilled ma) ++ "/" ++ show noerrors ++ " " ++ maKilled ma ./. noerrors] + diff --git a/src/Test/MuCheck/Interpreter.hs b/src/Test/MuCheck/Interpreter.hs --- a/src/Test/MuCheck/Interpreter.hs +++ b/src/Test/MuCheck/Interpreter.hs @@ -1,124 +1,100 @@ +{-# LANGUAGE TupleSections, MultiWayIf, DeriveDataTypeable #-} -- | The entry point for mucheck -module Test.MuCheck.Interpreter (evaluateMutants) where +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 (showA, showAS, (./.), catchOutput) -import Data.Either (partitionEithers, rights) -import Data.List(groupBy, sortBy) -import Data.Function (on) +import Test.MuCheck.Utils.Print (catchOutput) +import Data.Either (partitionEithers) import System.Directory (createDirectoryIfMissing) -import Data.Hash.MD5 (md5s, Str(..)) +import System.Environment (withArgs) import Test.MuCheck.TestAdapter +import Test.MuCheck.Utils.Common +import Test.MuCheck.AnalysisSummary --- | Given the list of tests suites to check, run one test suite at a time on --- all mutants. -evaluateMutants :: (Summarizable a, Show a) => ([Mutant] -> [InterpreterOutput a] -> Summary) -> [Mutant] -> [String] -> FilePath -> IO () -evaluateMutants testSummaryFn mutantFiles evalSrcLst logFile = do - results <- mapM (runCodeOnMutants mutantFiles) evalSrcLst - let singleTestSummaries = zip evalSrcLst $ map (mySummaryFn testSummaryFn mutantFiles) results - tssum = multipleCheckSummary (isSuccess . snd) results - -- print results to terminal - putStrLn $ delim ++ "Overall Results:" - putStrLn $ terminalSummary tssum - putStrLn $ showAS $ map showBrief singleTestSummaries - putStr delim - -- print results to logfile - appendFile logFile $ "OVERALL RESULTS:\n" ++ tssumLog tssum ++ showAS (map showDetail singleTestSummaries) - return () - where showDetail (method, msum) = delim ++ showBrief (method, msum) ++ "\n" ++ tsumLog msum - showBrief (method, msum) = showAS [method, - "\tTotal number of mutants:\t" ++ show (tsumNumMutants msum), - "\tFailed to Load:\t" ++ cpx tsumLoadError, - "\tNot Killed:\t" ++ cpx tsumNotKilled, - "\tKilled:\t" ++ cpx tsumKilled, - "\tOthers:\t" ++ cpx tsumOthers, - ""] - where cpx fn = show (fn msum) ++ " " ++ fn msum ./. tsumNumMutants msum - terminalSummary tssum = showAS [ - "Total number of mutants:\t" ++ show (tssumNumMutants tssum), - "Total number of alive mutants:\t" ++ cpx tssumAlive, - "Total number of load errors:\t" ++ cpx tssumErrors, - ""] - where cpx fn = show (fn tssum) ++ " " ++ fn tssum ./. tssumNumMutants tssum - delim = "\n" ++ replicate 25 '=' ++ "\n" +-- | Data type to hold results of a single test execution +data MutantSummary = MSumError Mutant String [Summary] -- errorStr + | MSumAlive Mutant [Summary] + | MSumKilled Mutant [Summary] + | MSumOther Mutant [Summary] + deriving (Show, Typeable) -data TSum = TSum {tsumNumMutants::Int, - tsumLoadError::Int, - tsumNotKilled::Int, - tsumKilled::Int, - tsumOthers::Int, - tsumLog::String} +-- | Given the list of tests suites to check, run the test suite on mutants. +evaluateMutants :: (Summarizable a, Show a) => (Mutant -> TestStr -> InterpreterOutput a -> Summary) -> [Mutant] -> [String] -> IO (MAnalysisSummary, [MutantSummary]) +evaluateMutants testSummaryFn mutants tests = do + results <- mapM (evalMutant tests) mutants -- [InterpreterOutput t] + let singleTestSummaries = map (summarizeResults testSummaryFn tests) $ zip mutants results + ma = fullSummary tests results + return (ma, singleTestSummaries) -mySummaryFn :: Summarizable a => ([Mutant] -> [InterpreterOutput a] -> Summary) -> [Mutant] -> [InterpreterOutput a] -> TSum -mySummaryFn testSummaryFn mutantFiles results = TSum { - tsumNumMutants = r, - tsumLoadError = l, - tsumNotKilled = s, - tsumKilled = f, - tsumOthers = g, - tsumLog = logStr} - where (errorCases, executedCases) = partitionEithers results - [successCases, failureCases, otherCases] = map (\c -> filter (c . snd) executedCases) [isSuccess, isFailure, isOther] - r = length results - l = length errorCases - [s,f,g] = map length [successCases, failureCases, otherCases] - -- errorFiles = mutantFiles \\ map fst executedCases - Summary logStr = testSummaryFn mutantFiles results +summarizeResults :: Summarizable a => (Mutant -> TestStr -> InterpreterOutput a -> Summary) -> [String] -> (Mutant, [InterpreterOutput a]) -> MutantSummary +summarizeResults testSummaryFn tests (mutant, ioresults) = case last results of -- the last result should indicate status because we dont run if there is error. + 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 +-- | Run all tests on a mutant +evalMutant :: (Typeable t, Summarizable t) => [TestStr] -> Mutant -> IO [InterpreterOutput t] +evalMutant tests mutant = do + -- Hint does not provide us a way to evaluate the module without + -- writing it to disk first, so we go for this hack. + -- We write the temporary file to disk, run interpreter on it, get + -- the result (we dont remove the file now, but can be added) + createDirectoryIfMissing True ".mutants" + let mutantFile = ".mutants/" ++ hash mutant ++ ".hs" + writeFile mutantFile mutant + let logF = mutantFile ++ ".log" + stopFast (evalTest mutantFile logF) tests --- | Run one test suite on all mutants -runCodeOnMutants :: Typeable t => [Mutant] -> String -> IO [InterpreterOutput t] -runCodeOnMutants mutantFiles evalStr = mapM (evalMyStr evalStr) mutantFiles - where evalMyStr eStr m = liftM fst $ do - createDirectoryIfMissing True ".mutants" - let fPath = ".mutants/" ++ md5s (Str m) ++ ".hs" - -- Hint does not provide us a way to evaluate the module without - -- writing it to disk first, so we go for this hack. - -- We write the temporary file to disk, run interpreter on it, get - -- the result and remove the file - writeFile fPath m - putStrLn $ "> " ++ fPath ++ " " ++ evalStr - catchOutput (I.runInterpreter (evalMethod fPath eStr)) +-- | Stop mutant runs at the first sign of problems. +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] -- load error + Right out -> if isSuccess out + then liftM (v :) $ stopFast fn xs + else return [v] -- test failed (mutant detected) +-- | Run one single test on a mutant +evalTest :: (Typeable a, Summarizable a) => String -> String -> String -> IO (InterpreterOutput a) +evalTest mutantFile logF test = do + val <- withArgs [] $ catchOutput logF $ I.runInterpreter (evalMethod mutantFile test) + return Io {_io = val, _ioLog = logF} + -- | Given the filename, modulename, test to evaluate, evaluate, and return result as a pair. -- -- > t = I.runInterpreter (evalMethod -- > "Examples/QuickCheckTest.hs" -- > "quickCheckResult idEmp") -evalMethod :: (I.MonadInterpreter m, Typeable t) => String -> String -> m (String, t) +evalMethod :: (I.MonadInterpreter m, Typeable t) => String -> String -> m t evalMethod fileName evalStr = do I.loadModules [fileName] ms <- I.getLoadedModules I.setTopLevelModules ms - result <- I.interpret evalStr (I.as :: (Typeable a => IO a)) >>= liftIO - return (fileName, result) + I.interpret evalStr (I.as :: (Typeable a => IO a)) >>= liftIO --- | Datatype to hold results of the entire run -data TSSum = TSSum {tssumNumMutants::Int, - tssumAlive::Int, - tssumErrors::Int, - tssumLog::String} --- | Summarize the entire run -multipleCheckSummary :: Show b => ((String, b) -> Bool) -> [[InterpreterOutput b]] -> TSSum -multipleCheckSummary isSuccessFunction results - -- we assume that checking each prop results in the same number of errorCases and executedCases - | not (checkLength results) = error "Output lengths differ for some properties." - | otherwise = TSSum {tssumNumMutants = countMutants, - tssumAlive = countAlive, - tssumErrors= countErrors, - tssumLog = logMsg} - where executedCases = groupBy ((==) `on` fst) . sortBy (compare `on` fst) . 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 res = and $ map ((==countMutants) . length) res ++ map ((==countExecutedCases) . length) executedCases - countExecutedCases = length . head $ executedCases - countMutants = length . head $ results +-- | Summarize the entire run. Passed results are per mutant +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 -- get the last test runs + (errors, completed) = partitionEithers lasts + fails = filter isFailure completed -- look if others failed or not + alive = filter isSuccess completed diff --git a/src/Test/MuCheck/MuOp.hs b/src/Test/MuCheck/MuOp.hs --- a/src/Test/MuCheck/MuOp.hs +++ b/src/Test/MuCheck/MuOp.hs @@ -41,7 +41,7 @@ -- | A wrapper over mkMp mkMpMuOp :: (MonadPlus m, G.Typeable a) => MuOp -> a -> m a -mkMpMuOp = apply $ G.mkMp . (uncurry (~~>)) +mkMpMuOp = apply $ G.mkMp . uncurry (~~>) -- | Show a specified mutation showM :: (Show a1, Show a) => (a, a1) -> String diff --git a/src/Test/MuCheck/Mutation.hs b/src/Test/MuCheck/Mutation.hs --- a/src/Test/MuCheck/Mutation.hs +++ b/src/Test/MuCheck/Mutation.hs @@ -165,8 +165,8 @@ convert (Char c) = map Char [pred c, succ c] convert (PrimChar c) = map Char [pred c, succ c] convert (Frac f) = map Frac $ nub [f + 1.0, f - 1.0, 0.0, 1.1] - convert (PrimFloat f) = map PrimFloat $ nub [f + 1.0, f - 1.0, 0.0, 1.1] - convert (PrimDouble f) = map PrimDouble $ nub [f + 1.0, f - 1.0, 0.0, 1.1] + convert (PrimFloat f) = map PrimFloat $ nub [f + 1.0, f - 1.0, 0.0, 1.0] + convert (PrimDouble f) = map PrimDouble $ nub [f + 1.0, f - 1.0, 0.0, 1.0] convert (String _) = map String $ nub [""] convert (PrimString _) = map PrimString $ nub [""] convert (PrimWord i) = map PrimWord $ nub [i + 1, i - 1, 0, 1] @@ -183,16 +183,18 @@ -- | Negating boolean in if/else statements selectIfElseBoolNegOps :: Decl -> [MuOp] -selectIfElseBoolNegOps m = selectValOps isIf (\(If e1 e2 e3) -> [If e1 e3 e2]) m +selectIfElseBoolNegOps m = selectValOps isIf convert m where isIf If{} = True isIf _ = False + convert (If e1 e2 e3) = [If e1 e3 e2] + convert _ = [] -- | Negating boolean in Guards selectGuardedBoolNegOps :: Decl -> [MuOp] -selectGuardedBoolNegOps m = selectValOps isGuardedRhs negateGuardedRhs m +selectGuardedBoolNegOps m = selectValOps isGuardedRhs convert m where isGuardedRhs GuardedRhs{} = True + convert (GuardedRhs srcLoc stmts expr) = [GuardedRhs srcLoc s expr | s <- once (mkMp boolNegate) stmts] boolNegate e@(Qualifier (Var (UnQual (Ident "otherwise")))) = [e] boolNegate (Qualifier expr) = [Qualifier (App (Var (UnQual (Ident "not"))) expr)] boolNegate x = [x] - negateGuardedRhs (GuardedRhs srcLoc stmts expr) = [GuardedRhs srcLoc s expr | s <- once (mkMp boolNegate) stmts] diff --git a/src/Test/MuCheck/TestAdapter.hs b/src/Test/MuCheck/TestAdapter.hs --- a/src/Test/MuCheck/TestAdapter.hs +++ b/src/Test/MuCheck/TestAdapter.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE DeriveDataTypeable #-} -- | Module for adapting test framekworks module Test.MuCheck.TestAdapter where @@ -5,18 +6,22 @@ import Data.Typeable -- | Wrapper for interpreter output -type InterpreterOutput a = Either I.InterpreterError (String, a) +data Summarizable a => InterpreterOutput a = Io {_io :: Either I.InterpreterError a, _ioLog::String} -- | Holding mutant information type Mutant = String +-- | Holding test information +type TestStr = String + -- | Summary of test run newtype Summary = Summary String + deriving (Show, Typeable) -- | Interface to be implemented by a test framework class Typeable s => Summarizable s where - -- | Summary of a test run - testSummary :: [Mutant] -> [InterpreterOutput s] -> Summary + -- | Summary of test suite on a single mutant + testSummary :: Mutant -> TestStr -> InterpreterOutput s -> Summary -- | Was the test run a success isSuccess :: s -> Bool -- | Was the test run a failure diff --git a/src/Test/MuCheck/Utils/Common.hs b/src/Test/MuCheck/Utils/Common.hs --- a/src/Test/MuCheck/Utils/Common.hs +++ b/src/Test/MuCheck/Utils/Common.hs @@ -1,11 +1,11 @@ -- | Common functions used by MuCheck module Test.MuCheck.Utils.Common where -import System.FilePath (splitExtension) import System.Random import Data.List import Data.Time.Clock.POSIX (getPOSIXTime) import Control.Monad (liftM) +import qualified Data.Hashable as H -- | The `choose` function generates subsets of a given size choose :: [a] -> Int -> [[a]] @@ -16,14 +16,6 @@ coupling :: Eq a => (a -> a -> t) -> [a] -> [t] coupling fn ops = [fn o1 o2 | o1 <- ops, o2 <- ops, o1 /= o2] - --- | The `genFileNames` function lazily generates filenames of mutants -genFileNames :: String -> [String] -genFileNames s = map newname [1..] - where (name, ext) = splitExtension s - newname :: Int -> String - newname i= name ++ "_" ++ show i ++ ext - -- | The `replaceFst` function replaces first matching element in a list given old and new values as a pair replaceFst :: Eq a => (a,a) -> [a] -> [a] replaceFst _ [] = [] @@ -77,4 +69,9 @@ -- a pair curryM :: (t1 -> t2 -> m t) -> (t1, t2) -> m t curryM fn (a,b) = fn a b + +-- | A simple hash +hash :: String -> String +hash s = (if h < 0 then "x" else "y") ++ show (abs h) + where h = H.hash s diff --git a/src/Test/MuCheck/Utils/Print.hs b/src/Test/MuCheck/Utils/Print.hs --- a/src/Test/MuCheck/Utils/Print.hs +++ b/src/Test/MuCheck/Utils/Print.hs @@ -7,6 +7,7 @@ import GHC.IO.Handle import System.IO +import System.Directory import System.Environment import System.IO.Temp (withSystemTempFile) @@ -27,20 +28,31 @@ tt v = trace (">" ++ show v) v -- | Capture output and err of an IO action -catchOutput :: IO a -> IO (a,String) -catchOutput f = do +catchOutputStr :: IO a -> IO (a,String) +catchOutputStr f = do isdebug <- lookupEnv "MuDEBUG" case isdebug of Just _ -> liftM (,"") f Nothing -> withSystemTempFile "_mucheck" $ \tmpf tmph -> do - stdout_dup <- hDuplicate stdout - stderr_dup <- hDuplicate stderr - hDuplicateTo tmph stdout - hDuplicateTo tmph stderr - hClose tmph - res <- f - hDuplicateTo stdout_dup stdout - hDuplicateTo stderr_dup stderr + res <- redirectToHandle f tmph str <- readFile tmpf + removeFile tmpf return (res,str) + +-- | Capture output and err of an IO action to a file +catchOutput :: String -> IO a -> IO a +catchOutput fn f = withFile fn WriteMode (redirectToHandle f) + +-- | Redirect out and err to handle +redirectToHandle :: IO b -> Handle -> IO b +redirectToHandle f tmph = do + stdout_dup <- hDuplicate stdout + stderr_dup <- hDuplicate stderr + hDuplicateTo tmph stdout + hDuplicateTo tmph stderr + hClose tmph + res <- f + hDuplicateTo stdout_dup stdout + hDuplicateTo stderr_dup stderr + return res