MuCheck 0.1.3.0 → 0.2.0.0

raw patch · 17 files changed

+255/−344 lines, 17 filesdep +directorydep −HUnitdep −QuickCheckdep ~haskell-src-extsPVP ok

version bump matches the API change (PVP)

Dependencies added: directory

Dependencies removed: HUnit, QuickCheck

Dependency ranges changed: haskell-src-exts

API changes (from Hackage documentation)

Files

• MuCheck.cabal +11/−32
• changes.md +7/−0
• src/Main.hs +0/−42
• src/Test/MuCheck.hs +16/−0
• src/Test/MuCheck/Config.hs +43/−2
• src/Test/MuCheck/Interpreter.hs +63/−58
• src/Test/MuCheck/MuOp.hs +20/−4
• src/Test/MuCheck/Mutation.hs +21/−39
• src/Test/MuCheck/Operators.hs +2/−0
• src/Test/MuCheck/Run/Common.hs +0/−19
• src/Test/MuCheck/Run/HUnit.hs +0/−38
• src/Test/MuCheck/Run/Hspec.hs +0/−34
• src/Test/MuCheck/Run/QuickCheck.hs +0/−39
• src/Test/MuCheck/TestAdapter.hs +17/−0
• src/Test/MuCheck/Utils/Common.hs +21/−11
• src/Test/MuCheck/Utils/Print.hs +23/−1
• src/Test/MuCheck/Utils/Syb.hs +11/−25

@@ -1,13 +1,12 @@ name:                MuCheck-version:             0.1.3.0+version:             0.2.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                      replacing a few of the common haskell functions and operators                      with other, but similar operators and functions, and running                      the testsuite to check whether the difference has been-                     detected. Currently, it supports QuickCheck, HUnit and Hspec-                     tests.+                     detected. homepage:            https://bitbucket.com/osu-testing/mucheck license:             GPL-2 license-file:        LICENSE@@ -26,27 +25,11 @@ source-repository    this   type:              git   location:          https://bitbucket.org/osu-testing/mucheck.git-  tag:               0.1.3.0--executable mucheck-  main-is:          Main.hs-  build-depends:    base >=4 && <5,-                    haskell-src-exts >=1.13,-                    syb >= 0.4.0,-                    time >= 1.4.0.1,-                    QuickCheck>=2.6,-                    hint >= 0.3.1.0,-                    mtl>=2.1.2,-                    HUnit >= 1.0,-                    filepath >= 1.1.0,-                    hspec >= 2.0,-                    hspec-core >= 2.0,-                    random >= 1.0.0-  default-language: Haskell2010-  hs-source-dirs:   src+  tag:               0.2.0.0  library-  exposed-modules:  Test.MuCheck.MuOp,+  exposed-modules:  Test.MuCheck,+                    Test.MuCheck.MuOp,                     Test.MuCheck.Config,                     Test.MuCheck.Interpreter,                     Test.MuCheck.Mutation,@@ -54,23 +37,20 @@                     Test.MuCheck.Utils.Syb,                     Test.MuCheck.Utils.Common,                     Test.MuCheck.Utils.Print,-                    Test.MuCheck.Run.Common,-                    Test.MuCheck.Run.QuickCheck,-                    Test.MuCheck.Run.HUnit,-                    Test.MuCheck.Run.Hspec+                    Test.MuCheck.TestAdapter+  ghc-options:     -Wall   -- other-modules:          build-depends:    base >=4 && <5,                     haskell-src-exts >=1.13,                     syb >= 0.4.0,                     time >= 1.4.0.1,-                    QuickCheck>=2.6,                     hint >= 0.3.1.0,                     mtl>=2.1.2,-                    HUnit >= 1.0,                     filepath >= 1.1.0,                     hspec>= 2.0,                     hspec-core >= 2.0,-                    random >= 1.0.0+                    random >= 1.0.0,+                    directory >= 1.2.1.0   default-language: Haskell2010   hs-source-dirs:   src @@ -83,13 +63,12 @@                     haskell-src-exts >=1.13,                     syb >= 0.4.0,                     time >= 1.4.0.1,-                    QuickCheck>=2.6,                     hint >= 0.3.1.0,                     mtl>=2.1.2,-                    HUnit >= 1.0,                     filepath >= 1.1.0,                     hspec>= 2.0,                     hspec-core >= 2.0,                     MuCheck,-                    random >= 1.0.0+                    random >= 1.0.0,+                    directory >= 1.2.1.0 

@@ -1,5 +1,12 @@ # Changelog +## [0.2.0.0] (Rahul Gopinath)+  * Better documentation+  * Add tests for SYB once+  * Split it to a library and adapter modules+  * Simplify adapter interface+  * Capture stdout and stderr of test runs.+ ## [0.1.3.0] (Rahul Gopinath)   * Migrate mucheck to Test namespace   * Add more tests

@@ -1,42 +0,0 @@-module Main where-import System.Environment (getArgs, withArgs)-import Control.Monad (void)--import Test.MuCheck.MuOp-import Test.MuCheck.Config-import Test.MuCheck.Mutation-import Test.MuCheck.Operators-import Test.MuCheck.Utils.Common-import Test.MuCheck.Utils.Print-import Test.MuCheck.Interpreter-import Test.MuCheck.Run.QuickCheck-import Test.MuCheck.Run.HUnit-import Test.MuCheck.Run.Hspec--process :: String -> String -> String -> String -> [String] -> IO ()-process t fn file modulename args = do-  numMutants <- genMutants fn file-  let muts = take numMutants $ genFileNames file-      l = "./" ++ t ++ ".log"-      fn f = void $ f muts modulename args l-  case t of-    "qcheck" -> fn checkQuickCheckOnMutants-    "hspec" ->  fn checkHspecOnMutants-    "hunit" ->  fn checkHUnitOnMutants-    _ -> error "Unexpected test type"---main :: IO ()-main = do-  val <- getArgs-  case val of-    ("-h" : _ ) -> help-    (t: fn : file : modulename : args) -> withArgs [] $ process t fn file modulename args-    _ -> error "Need [qcheck|hunit|hspec] function file modulename [args]\n\tUse -h to get help"--help :: IO ()-help = putStrLn $ "mucheck type function file modulename [args]\n" ++ showAS ["E.g:",-       " ./mucheck qcheck qsort Examples/QuickCheckTest.hs Examples.QuickCheckTest 'quickCheckResult idEmpProp' 'quickCheckResult revProp' 'quickCheckResult modelProp'",-       " ./mucheck hunit  qsort Examples/HUnitTest.hs Examples.HUnitTest 'runTestTT tests'",-       " ./mucheck hspec  qsort Examples/HspecTest.hs Examples.HspecTest 'spec (with \\\"qsort1\\\")'"]-

@@ -0,0 +1,16 @@+-- | MuCheck base module+module Test.MuCheck (mucheck) where+import Control.Monad (void)++import Test.MuCheck.Mutation+import Test.MuCheck.Utils.Common+import Test.MuCheck.Interpreter (mutantCheckSummary)+import Test.MuCheck.TestAdapter++-- | Perform mutation analysis+mucheck :: (Summarizable a, Show a) => ([String] -> [InterpreterOutput a] -> Summary) -> String -> FilePath -> String -> [String] -> IO ()+mucheck resFn mFn file modulename args = do+  numMutants <- genMutants mFn file+  let muts = take numMutants $ genFileNames file+  void $ mutantCheckSummary resFn muts modulename args ("./mucheck-" ++ mFn ++ ".log")+

@@ -1,22 +1,63 @@+-- | Configuration module module Test.MuCheck.Config where  import Test.MuCheck.MuOp-import Test.MuCheck.Operators+import Test.MuCheck.Operators (allOps)  data GenerationMode   = FirstOrderOnly   | FirstAndHigherOrder   deriving (Eq, Show) -data Config = Config { muOps :: [MuOp]+-- | The configuration options+-- if 1 is provided, all mutants are selected for that kind, and 0 ensures that+-- no mutants are picked for that kind. Any fraction in between causes that+-- many mutants to be picked randomly from the available pool++data Config = Config {+-- | Mutation operators on operator or function replacement+  muOps :: [MuOp]+-- | Mutate pattern matches for functions?+-- for example+--+-- > first [] = Nothing+-- > first (x:_) = Just x+--+-- is mutated to+--+-- > first (x:_) = Just x+-- > first [] = Nothing   , doMutatePatternMatches :: Rational+-- | Mutates integer values by +1 or -1 or by replacing it with 0 or 1   , doMutateValues :: Rational+-- | negate if conditions, that is+--+-- > if True then 1 else 0+--+-- becomes+--+-- > if (not True) then 1 else 0   , doNegateIfElse :: Rational+-- | negate guarded booleans in case statements, that is+--+-- > case v of+-- >   True -> 1+-- >   otherwise -> 0+--+-- becomes+--+-- > case v of+-- >  (not True) -> 1+-- >  otherwise -> 0   , doNegateGuards :: Rational+-- | Maximum number of mutants to generate.   , maxNumMutants :: Int+-- | Generation mode, can be traditional (firstOrder) and+-- higher order (higher order is experimental)   , genMode :: GenerationMode }   deriving Show +-- | The default configuration defaultConfig :: Config defaultConfig = Config {muOps = allOps   , doMutatePatternMatches = 1.0

@@ -1,46 +1,22 @@-{-# LANGUAGE StandaloneDeriving, DeriveDataTypeable #-}-module Test.MuCheck.Interpreter where+-- | The entry point for mucheck+module Test.MuCheck.Interpreter (mutantCheckSummary) 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 Test.MuCheck.Utils.Print (showA, showAS, (./.))+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.Run.Common-import Test.MuCheck.Run.QuickCheck-import Test.MuCheck.Run.HUnit-import Test.MuCheck.Run.Hspec---- | run quickcheck test suite on mutants--- > numMutants <- genMutants "qsort" "Examples/QuickCheckTest.hs"--- > checkQuickCheckOnMutants (take numMutants $ genFileNames --  "Examples/QuickCheckTest.hs") "Examples.QuickCheckTest" ["quickCheckResult idEmpProp", "quickCheckResult revProp", "quickCheckResult modelProp"] "./quickcheck.log"-checkQuickCheckOnMutants :: [String] -> String -> [String] -> String -> IO [Qc.Result]-checkQuickCheckOnMutants = mutantCheckSummary---- | run hunit test suite on mutants--- > numMutants <- genMutants "qsort" "Examples/HUnitTest.hs"--- > checkHUnitOnMutants (take numMutants $ genFileNames "Examples/HUnitTest.hs") "Examples.HUnitTest" ["runTestTT tests"] "./hunit.log"-checkHUnitOnMutants :: [String] -> String -> [String] -> String -> IO [HUnit.Counts]-checkHUnitOnMutants = mutantCheckSummary---- | run hspec test suite on mutants--- > numMutants <- genMutants "qsort" "Examples/HspecTest.hs"--- > checkHspecOnMutants (take numMutants $ genFileNames "Examples/HspecTest.hs") "Examples.HspecTest" ["spec (with \"qsort1\")"] "./hspec.log"-checkHspecOnMutants :: [String] -> String -> [String] -> String -> IO [Hspec.Summary]-checkHspecOnMutants = mutantCheckSummary+import Test.MuCheck.TestAdapter  -- | Given the list of tests suites to check, run one test suite at a time on -- all mutants.-mutantCheckSummary :: (Summarizable a, Show a) => [String] -> String -> [String] -> FilePath -> IO [a]-mutantCheckSummary mutantFiles topModule evalSrcLst logFile  = do+mutantCheckSummary :: (Summarizable a, Show a) => ([String] -> [InterpreterOutput a] -> Summary) -> [String] -> String -> [String] -> FilePath -> IO ()+mutantCheckSummary testSummaryFn mutantFiles topModule evalSrcLst logFile  = do   results <- mapM (runCodeOnMutants mutantFiles topModule) evalSrcLst-  let singleTestSummaries = zip evalSrcLst $ map (testSummary mutantFiles) results+  let singleTestSummaries = zip evalSrcLst $ map (mySummaryFn testSummaryFn mutantFiles) results       tssum  = multipleCheckSummary (isSuccess . snd) results   -- print results to terminal   putStrLn $ delim ++ "Overall Results:"@@ -48,35 +24,63 @@   putStrLn $ showAS $ map showBrief singleTestSummaries   putStr delim   -- print results to logfile-  appendFile logFile $ "OVERALL RESULTS:\n" ++ tssum_log tssum ++ showAS (map showDetail singleTestSummaries)-  -- hacky solution to avoid printing entire results to stdout and to give-  -- guidance to the type checker in picking specific Summarizable instances-  return $ tail [head $ map snd $ snd $ partitionEithers $ head results]-  where showDetail (method, msum) = delim ++ showBrief (method, msum) ++ "\n" ++ tsum_log msum+  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 (tsum_numMutants msum),-           "\tFailed to Load:\t" ++ (cpx tsum_loadError),-           "\tNot Killed:\t" ++ (cpx tsum_notKilled),-           "\tKilled:\t" ++ (cpx tsum_killed),-           "\tOthers:\t" ++ (cpx tsum_others),+           "\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) ./. (tsum_numMutants msum)+           where cpx fn = show (fn msum) ++ " " ++ fn msum ./. tsumNumMutants msum         terminalSummary tssum = showAS [-          "Total number of mutants:\t" ++ show (tssum_numMutants tssum),-          "Total number of alive mutants:\t" ++ (cpx tssum_alive),-          "Total number of load errors:\t" ++ (cpx tssum_errors),+          "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) ./. (tssum_numMutants tssum)+           where cpx fn = show (fn tssum) ++ " " ++ fn tssum ./. tssumNumMutants tssum         delim = "\n" ++ replicate 25 '=' ++ "\n"  +data TSum = TSum {tsumNumMutants::Int,+                  tsumLoadError::Int,+                  tsumNotKilled::Int,+                  tsumKilled::Int,+                  tsumOthers::Int,+                  tsumLog::String}++mySummaryFn :: (Summarizable b, Eq a1) => ([a1] -> [Either a (a1, b)] -> Summary) -> [a1] -> [Either a (a1, b)] -> 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++ -- | Run one test suite on all mutants--- > t = runInterpreter (evalMethod "Examples/QuickCheckTest.hs" "Examples.QuickCheckTest" "quickCheckResult idEmp")+runCodeOnMutants :: Typeable t => [String] -> String -> String -> IO [InterpreterOutput t] runCodeOnMutants mutantFiles topModule evalStr = mapM (evalMyStr evalStr) mutantFiles-  where evalMyStr evalStr file = do putStrLn $ ">" ++ ":" ++ file ++ ":" ++ topModule ++ ":" ++ evalStr-                                    I.runInterpreter (evalMethod file topModule evalStr)+  where evalMyStr eStr file = do putStrLn $ ">" ++ ":" ++ file ++ ":" ++ topModule ++ ":" ++ evalStr+                                 (res,_) <- catchOutput (I.runInterpreter (evalMethod file topModule eStr))+                                 return res  -- | Given the filename, modulename, test to evaluate, evaluate, and return result as a pair.+--+-- > t = I.runInterpreter (evalMethod+-- >        "Examples/QuickCheckTest.hs"+-- >        "Examples.QuickCheckTest"+-- >        "quickCheckResult idEmp) evalMethod :: (I.MonadInterpreter m, Typeable t) => String -> String -> String -> m (String, t) evalMethod fileName topModule evalStr = do   I.loadModules [fileName]@@ -85,25 +89,26 @@   return (fileName, result)  -- | Datatype to hold results of the entire run-data TSSum = TSSum {tssum_numMutants::Int,-                    tssum_alive::Int,-                    tssum_errors::Int,-                    tssum_log::String}+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 {tssum_numMutants = countMutants,-                       tssum_alive = countAlive,-                       tssum_errors= countErrors,-                       tssum_log = logMsg}+  | 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 results = and $ map ((==countMutants) . length) results ++ map ((==countExecutedCases) . length) executedCases+        checkLength res = and $ map ((==countMutants) . length) res ++ map ((==countExecutedCases) . length) executedCases         countExecutedCases = length . head $ executedCases         countMutants = length . head $ results 

@@ -1,10 +1,10 @@ module Test.MuCheck.MuOp (MuOp-          , (==>)+          , Mutable(..)           , (==>*)           , (*==>*)           , (~~>)           , mkMp'-          , Mutable+          , same           ) where  import Language.Haskell.Exts (Name, QName, QOp, Exp, Literal, GuardedRhs, Decl)@@ -21,6 +21,19 @@   deriving Eq  -- boilerplate code++-- | The function `same` applies on a `MuOP` determining if transformation is+-- between same values.+same :: MuOp -> Bool+same (N (a,b)) = a == b+same (QN (a,b)) = a == b+same (QO (a,b)) = a == b+same (E (a,b)) = a == b+same (D (a,b)) = a == b+same (L (a,b)) = a == b+same (G (a,b)) = a == b++mkMp' :: (MonadPlus m, G.Typeable a) => MuOp -> a -> m a mkMp' (N (s,t))  = G.mkMp (s ~~> t) mkMp' (QN (s,t)) = G.mkMp (s ~~> t) mkMp' (QO (s,t)) = G.mkMp (s ~~> t)@@ -29,7 +42,9 @@ mkMp' (L (s,t))  = G.mkMp (s ~~> t) mkMp' (G (s,t))  = G.mkMp (s ~~> t) +showM :: (Show a1, Show a) => (a, a1) -> String showM (s, t) = "\n" ++ show s ++ " ==> " ++ show t+ instance Show MuOp where     show (N a)  = showM a     show (QN a) = showM a@@ -51,8 +66,9 @@ (*==>*) :: Mutable a => [a] -> [a] -> [MuOp] xs *==>* ys = concatMap (==>* ys) xs -(~~>) :: (MonadPlus m, Eq a) => a -> a -> (a -> m a)-x ~~> y = \z -> if z == x && x /= y then return y else mzero+-- we handle x ~~> x separately+(~~>) :: (MonadPlus m, Eq a) => a -> a -> a -> m a+x ~~> y = \z -> if z == x then return y else mzero  -- instances 

@@ -3,12 +3,11 @@ module Test.MuCheck.Mutation where  import Language.Haskell.Exts(Literal(Int), Exp(App, Var, If), QName(UnQual),-        Stmt(Qualifier), Module(Module), ModuleName(..),-        Name(Ident, Symbol), Decl(FunBind, PatBind), Match,+        Stmt(Qualifier), Module(Module),+        Name(Ident, Symbol), Decl(FunBind, PatBind),         Pat(PVar), Match(Match), GuardedRhs(GuardedRhs),          prettyPrint, fromParseResult, parseFileContents)-import Data.Maybe (fromJust)-import Data.Generics (GenericQ, mkQ, Data, Typeable, mkMp)+import Data.Generics (Data, Typeable, mkMp, listify) import Data.List(nub, (\\), permutations) import Control.Monad (liftM, zipWithM) import System.Random@@ -17,11 +16,11 @@ import Test.MuCheck.MuOp import Test.MuCheck.Utils.Syb import Test.MuCheck.Utils.Common-import Test.MuCheck.Operators import Test.MuCheck.Config  -- | The `genMutants` function is a wrapper to genMutantsWith with standard -- configuraton+genMutants :: String -> FilePath -> IO Int genMutants = genMutantsWith defaultConfig  -- | The `genMutantsWith` function takes configuration function to mutate,@@ -31,7 +30,7 @@ genMutantsWith args funcname filename  = liftM length $ do     ast <- getASTFromFile filename     g <- liftM (mkStdGen . round) getPOSIXTime-    let f = func funcname ast+    let f = getFunc funcname ast          ops, swapOps, valOps, ifElseNegOps, guardedBoolNegOps :: [MuOp]         ops = relevantOps f (muOps args ++ valOps ++ ifElseNegOps ++ guardedBoolNegOps)@@ -41,7 +40,7 @@         guardedBoolNegOps = sampleF g (doNegateGuards args) $ selectGuardedBoolNegOps f          patternMatchMutants, ifElseNegMutants, guardedNegMutants, operatorMutants, allMutants :: [Decl]-        allMutants = nub $ patternMatchMutants ++ operatorMutants+        allMutants = nub $ patternMatchMutants ++ operatorMutants ++ ifElseNegMutants ++ guardedNegMutants          patternMatchMutants = mutatesN swapOps f fstOrder         ifElseNegMutants = mutatesN ifElseNegOps f fstOrder@@ -50,16 +49,16 @@             FirstOrderOnly -> mutatesN ops f fstOrder             _              -> mutates ops f -        func fname ast = fromJust $ selectOne (isFunctionD fname) ast-        programMutants ast =  map (putDecls ast) $ mylst ast-        mylst ast = [myfn ast x | x <- take (maxNumMutants args) allMutants]-        myfn ast fn = replace (func funcname ast,fn) (getDecls ast)+        getFunc fname ast' = head $ listify (isFunctionD fname) ast'+        programMutants ast' =  map (putDecls ast) $ mylst ast'+        mylst ast' = [myfn ast' x | x <- take (maxNumMutants args) allMutants]+        myfn ast' fn = replace (getFunc funcname ast', fn) (getDecls ast')      case ops ++ swapOps of       [] -> return [] --  putStrLn "No applicable operator exists!"       _  -> zipWithM writeFile (genFileNames filename) $ map prettyPrint (programMutants ast)   where fstOrder = 1 -- first order-        getASTFromFile filename = liftM parseModuleFromFile $ readFile filename+        getASTFromFile fname = liftM parseModuleFromFile $ readFile fname  -- | Mutating a function's code using a bunch of mutation operators -- (In all the three mutate functions, we assume working@@ -69,8 +68,8 @@  -- the third argument specifies whether it's first order or higher order mutatesN :: [MuOp] -> Decl -> Int -> [Decl]-mutatesN ops m 1 = concat [mutate op m | op <- ops ]-mutatesN ops m c =  concat [mutatesN ops m 1 | m <- mutatesN ops m (c-1)]+mutatesN ops ms 1 = concat [mutate op ms | op <- ops ]+mutatesN ops ms c = concat [mutatesN ops m 1 | m <- mutatesN ops ms (c-1)]  -- | Given a function, generate all mutants after applying applying  -- op once (op might be applied at different places).E.g.:@@ -78,6 +77,7 @@ mutate :: MuOp -> Decl -> [Decl] mutate op m = once (mkMp' op) m \\ [m] +-- | is the parsed expression the function we are looking for? isFunctionD :: String -> Decl -> Bool isFunctionD n (FunBind (Match _ (Ident n') _ _ _ _ : _)) = n == n' isFunctionD n (FunBind (Match _ (Symbol n') _ _ _ _ : _)) = n == n'@@ -93,7 +93,7 @@ -- | generates transformations that removes one pattern match from a function -- definition. removeOnePMatch :: Decl -> [MuOp]-removeOnePMatch d@(FunBind [x]) = []+removeOnePMatch (FunBind [_]) = [] removeOnePMatch d@(FunBind ms) = d ==>* map FunBind (removeOneElem ms \\ [ms]) removeOnePMatch _  = [] @@ -110,35 +110,17 @@ getDecls :: Module -> [Decl] getDecls (Module _ _ _ _ _ _ decls) = decls -{--isFunction :: Name -> GenericQ Bool-isFunction (Ident n) = False `mkQ` isFunctionD n--extractStrings :: [Match] -> [String] -extractStrings [] = []-extractStrings (Match _ (Symbol name) _ _ _ _:xs) = name : extractStrings xs-extractStrings (Match _ (Ident name) _ _ _ _:xs) = name : extractStrings xs--getFuncNames :: [Decl] -> [String]-getFuncNames [] = []-getFuncNames (FunBind m:xs) = extractStrings m ++ getFuncNames xs-getFuncNames (_:xs) = getFuncNames xs-  -getName :: Module -> String-getName (Module _ (ModuleName name) _ _ _ _ _) = name--}- putDecls :: Module -> [Decl] -> Module putDecls (Module a b c d e f _) decls = Module a b c d e f decls  -- Define all operations on a value selectValOps :: (Data a, Eq a, Typeable b, Mutable b, Eq b) => (b -> Bool) -> [b -> b] -> a -> [MuOp]-selectValOps pred fs m = concatMap (\x -> x ==>* map (\f -> f x) fs) vals-  where vals = nub $ selectMany pred m+selectValOps predicate fs m = concatMap (\x -> x ==>* map (\f -> f x) fs) vals+  where vals = nub $ listify predicate m  selectValOps' :: (Data a, Eq a, Typeable b, Mutable b) => (b -> Bool) -> (b -> [b]) -> a -> [MuOp]-selectValOps' pred f m = concatMap (\x -> x ==>* f x) vals-  where vals = selectMany pred m+selectValOps' predicate f m = concatMap (\x -> x ==>* f x) vals+  where vals = listify predicate m  selectIntOps :: (Data a, Eq a) => a -> [MuOp] selectIntOps m = selectValOps isInt [@@ -160,7 +142,7 @@ selectGuardedBoolNegOps m = selectValOps' isGuardedRhs negateGuardedRhs m   where isGuardedRhs GuardedRhs{} = True         boolNegate e@(Qualifier (Var (UnQual (Ident "otherwise")))) = [e]-        boolNegate (Qualifier exp) = [Qualifier (App (Var (UnQual (Ident "not"))) exp)]+        boolNegate (Qualifier expr) = [Qualifier (App (Var (UnQual (Ident "not"))) expr)]         boolNegate x = [x]-        negateGuardedRhs (GuardedRhs srcLoc stmts exp) = [GuardedRhs srcLoc s exp | s <- once (mkMp boolNegate) stmts]+        negateGuardedRhs (GuardedRhs srcLoc stmts expr) = [GuardedRhs srcLoc s expr | s <- once (mkMp boolNegate) stmts] 

@@ -9,6 +9,7 @@ import Language.Haskell.Exts (Name(Symbol), Exp(Var), QName(UnQual), Name(Ident))  -- | all available operators+allOps,comparators,predNums,binAriths,arithLists :: [MuOp] allOps = concat [comparators, predNums, binAriths, arithLists]  -- | comparison operators ["<", ">", "<=", ">=", "/=", "=="]@@ -24,5 +25,6 @@ arithLists = coupling (==>) $ map varfn ["sum", "product", "maximum", "minimum", "head", "last"]  -- utilities+varfn :: String -> Exp varfn = Var . UnQual . Ident 

@@ -1,19 +0,0 @@-module Test.MuCheck.Run.Common where--import qualified Language.Haskell.Interpreter as I-import Data.Typeable-type InterpreterOutput a = Either I.InterpreterError (String, a)--data TSum = TSum {tsum_numMutants::Int,-                  tsum_loadError::Int,-                  tsum_notKilled::Int,-                  tsum_killed::Int,-                  tsum_others::Int,-                  tsum_log::String}---- Class/Instance declaration-type MutantFilename = String-class Typeable s => Summarizable s where-  testSummary :: [MutantFilename] -> [InterpreterOutput s] -> TSum-  isSuccess :: s -> Bool-

@@ -1,38 +0,0 @@-{-# LANGUAGE StandaloneDeriving, DeriveDataTypeable #-}-module Test.MuCheck.Run.HUnit where-import qualified Test.HUnit as HUnit-import Test.MuCheck.Run.Common-import Test.MuCheck.Utils.Print (showA, showAS)--import Data.Typeable-import Data.List((\\))-import Data.Either (partitionEithers)--deriving instance Typeable HUnit.Counts--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]-  isSuccess c = (HUnit.cases c == HUnit.tried c) && HUnit.failures c == 0 && HUnit.errors c == 0-

@@ -1,34 +0,0 @@-{-# LANGUAGE StandaloneDeriving, DeriveDataTypeable #-}-module Test.MuCheck.Run.Hspec where-import qualified Test.Hspec.Core.Runner as Hspec-import Test.MuCheck.Run.Common-import Test.MuCheck.Utils.Print (showA, showAS)--import Data.Typeable-import Data.Either (partitionEithers)-import Data.List((\\))--deriving instance Typeable Hspec.Summary--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-  isSuccess (Hspec.Summary { Hspec.summaryExamples = se, Hspec.summaryFailures = sf } ) = sf == 0-

@@ -1,39 +0,0 @@-{-# LANGUAGE StandaloneDeriving, DeriveDataTypeable #-}-module Test.MuCheck.Run.QuickCheck where-import qualified Test.QuickCheck.Test as Qc-import Test.MuCheck.Run.Common-import Test.MuCheck.Utils.Print (showA, showAS)--import Data.Typeable-import Data.List((\\))-import Data.Either (partitionEithers)--deriving instance Typeable Qc.Result--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-  isSuccess = Qc.isSuccess

@@ -0,0 +1,17 @@+module Test.MuCheck.TestAdapter where++import qualified Language.Haskell.Interpreter as I+import Data.Typeable+type InterpreterOutput a = Either I.InterpreterError (String, a)++-- Class/Instance declaration+type MutantFilename = String+newtype Summary = Summary String+class Typeable s => Summarizable s where+  testSummary :: [MutantFilename] -> [InterpreterOutput s] -> Summary+  isSuccess :: s -> Bool+  isFailure :: s -> Bool+  isFailure = not . isSuccess+  isOther :: s -> Bool+  isOther x = not (isSuccess x) && not (isFailure x)+

@@ -1,9 +1,9 @@+-- | Common functions used by MuCheck module Test.MuCheck.Utils.Common where  import System.FilePath (splitExtension) import System.Random import Data.List-import Control.Applicative  -- | The `choose` function generates subsets of a given size choose :: [a] -> Int -> [[a]]@@ -11,13 +11,15 @@  -- | The `coupling` function produces all possible pairings, and applies the -- given function to each-coupling fn ops = [(fn o1 o2) | o1 <- ops, o2 <- ops, o1 /= o2]+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 `replace` function replaces first element in a list given old and new values as a pair@@ -27,27 +29,35 @@           | v == o = n           | otherwise = v --- | The `safeHead` function safely extracts head of a list using Maybe-safeHead :: [a] -> Maybe a-safeHead [] = Nothing-safeHead (x:xs) = Just x- -- | The `sample` function takes a random generator and chooses a random sample -- subset of given size.-sample :: (RandomGen g, Num n, Eq n) => g -> n -> [t] -> [t]-sample g 0 xs = []+sample :: (RandomGen g) => g -> Int -> [t] -> [t]+sample _ 0 _ = [] sample g n xs = val : sample g' (n - 1) (remElt idx xs)   where val = xs !! idx         (idx,g')  = randomR (0, length xs - 1) g  -- | The `sampleF` function takes a random generator, and a fraction and -- returns subset of size given by fraction-sampleF :: (RandomGen g, Num n) => g -> Rational -> [t] -> [t]+sampleF :: (RandomGen g) => g -> Rational -> [t] -> [t] sampleF g f xs = sample g l xs     where l = round $ f * fromIntegral (length xs)  -- | The `remElt` function removes element at index specified from a list remElt :: Int -> [a] -> [a] remElt idx xs = front ++ ack-  where (front,b:ack) = splitAt idx xs+  where (front,_:ack) = splitAt idx xs++-- | The `swapElts` function swaps two elements in a list given their indices+swapElts :: Int -> Int -> [t] -> [t]+swapElts i j ls = [get k x | (k, x) <- zip [0..length ls - 1] ls]+  where get k x | k == i = ls !! j+                | k == j = ls !! i+                | otherwise = x++-- | The `genSwapped` generates a list of lists where each element has been+-- swapped by another+genSwapped :: [t] -> [[t]]+genSwapped lst = map (\(x:y:_) -> swapElts x y lst) swaplst+  where swaplst = choose [0..length lst - 1] 2 

@@ -2,7 +2,12 @@ import Debug.Trace import Data.List(intercalate) +import GHC.IO.Handle+import System.IO+import System.Directory+ -- | simple wrapper for adding a % at the end.+(./.) :: (Show a, Integral a) => a -> a -> String n ./. t =  "(" ++ show (n * 100 `div` t) ++ "%)"  -- | join lines together@@ -13,4 +18,21 @@ showA :: Show a => [a] -> String showA =  showAS . map show -tt v = trace (">" ++ (show v)) v+tt :: Show a => a -> a+tt v = trace (">" ++ show v) v++catchOutput :: IO a -> IO (a,String)+catchOutput f = do+  tmpd <- getTemporaryDirectory+  (tmpf, tmph) <- openTempFile tmpd "haskell_stdout"+  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+  str <- readFile tmpf+  removeFile tmpf+  return (res,str)

@@ -1,37 +1,23 @@ {-# LANGUAGE RankNTypes #-} -- | SYB functions-module Test.MuCheck.Utils.Syb ( selectMany-                     , selectOne-                     , relevantOps-                     , once-                     , once') where+module Test.MuCheck.Utils.Syb (relevantOps, once) where -import Data.Generics (Data, Typeable, GenericM, gmapMo, everything, mkQ, mkMp)-import Test.MuCheck.MuOp (mkMp', MuOp)-import Test.MuCheck.Utils.Common (safeHead)+import Data.Generics (Data, GenericM, gmapMo)+import Test.MuCheck.MuOp (mkMp', MuOp, same) import Control.Monad (MonadPlus, mplus)-import Data.Maybe(fromMaybe, isJust)+import Data.Maybe(isJust)  -- | apply a mutating function on a piece of code one at a time+-- like somewhere (from so) once :: MonadPlus m => GenericM m -> GenericM m once f x = f x `mplus` gmapMo (once f) x -once' :: (forall a. Data a => a -> Maybe a) -> (forall a. Data a => a -> a)-once' f x = fromMaybe x $ once f x---- | select all code components satisfying a certain predicate-selectMany :: (Data a, Typeable b) => (b -> Bool) -> a -> [b]-selectMany f = everything (++) ([] `mkQ` keep f)-   where keep fn x = [x | fn x]---- | special case of selectMany, which selects the first components satisfying--- a predicate-selectOne :: (Typeable a, Data a1) => (a -> Bool) -> a1 -> Maybe a-selectOne f p = safeHead $ selectMany f p---- | selecting all relevant ops+-- | The function `relevantOps` does two filters. For the first, it+-- removes spurious transformations like "Int 1 ~~> Int 1". Secondly, it+-- tries to apply the transformation to the given program on some element +-- if it does not succeed, then we discard that transformation. relevantOps :: (Data a, Eq a) => a -> [MuOp] -> [MuOp]-relevantOps m mlst = filter (relevantOp m) mlst+relevantOps m oplst = filter (relevantOp m) $ filter (not . same) oplst   -- check if an operator can be applied to a program-  where relevantOp m op = isJust $ once (mkMp' op) m+  where relevantOp m' op = isJust $ once (mkMp' op) m'