MuCheck 0.2.1.0 → 0.3.0.0

raw patch · 10 files changed

+154/−136 lines, 10 filesdep +hashabledep −MissingHdep −filepathPVP ok

version bump matches the API change (PVP)

Dependencies added: hashable

Dependencies removed: MissingH, filepath

API changes (from Hackage documentation)

Files

• MuCheck.cabal +5/−6
• changes.md +8/−0
• src/Test/MuCheck.hs +6/−6
• src/Test/MuCheck/AnalysisSummary.hs +19/−0
• src/Test/MuCheck/Interpreter.hs +72/−96
• src/Test/MuCheck/MuOp.hs +1/−1
• src/Test/MuCheck/Mutation.hs +7/−5
• src/Test/MuCheck/TestAdapter.hs +8/−3
• src/Test/MuCheck/Utils/Common.hs +6/−9
• src/Test/MuCheck/Utils/Print.hs +22/−10

@@ -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 

@@ -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

@@ -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 

@@ -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]+

@@ -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 

@@ -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

@@ -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] 

@@ -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

@@ -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 

@@ -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