MuCheck 0.2.0.0 → 0.2.1.0

raw patch · 12 files changed

+291/−159 lines, 12 filesdep +MissingHdep +temporarydep −hspec-corePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: MissingH, temporary

Dependencies removed: hspec-core

API changes (from Hackage documentation)

Files

• MuCheck.cabal +9/−7
• changes.md +9/−0
• src/Test/MuCheck.hs +6/−6
• src/Test/MuCheck/Config.hs +15/−0
• src/Test/MuCheck/Interpreter.hs +26/−16
• src/Test/MuCheck/MuOp.hs +49/−40
• src/Test/MuCheck/Mutation.hs +114/−64
• src/Test/MuCheck/Operators.hs +2/−1
• src/Test/MuCheck/TestAdapter.hs +14/−3
• src/Test/MuCheck/Utils/Common.hs +23/−6
• src/Test/MuCheck/Utils/Print.hs +22/−14
• src/Test/MuCheck/Utils/Syb.hs +2/−2

@@ -1,5 +1,5 @@ name:                MuCheck-version:             0.2.0.0+version:             0.2.1.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.0.0+  tag:               0.2.1.0  library   exposed-modules:  Test.MuCheck,@@ -47,10 +47,10 @@                     hint >= 0.3.1.0,                     mtl>=2.1.2,                     filepath >= 1.1.0,-                    hspec>= 2.0,-                    hspec-core >= 2.0,                     random >= 1.0.0,-                    directory >= 1.2.1.0+                    directory >= 1.2.1.0,+                    temporary >= 1.1,+                    MissingH >= 1.3   default-language: Haskell2010   hs-source-dirs:   src @@ -67,8 +67,10 @@                     mtl>=2.1.2,                     filepath >= 1.1.0,                     hspec>= 2.0,-                    hspec-core >= 2.0,                     MuCheck,                     random >= 1.0.0,-                    directory >= 1.2.1.0+                    directory >= 1.2.1.0,+                    temporary >= 1.1,+                    MissingH >= 1.3+  default-language: Haskell2010 

@@ -1,5 +1,14 @@ # Changelog +## [0.2.1.0] (Rahul Gopinath)+  * Remove need to pass in module name+  * Add new literal mutators including booleans+  * Refactor Mutation so that IO and Rand are pushed further out, and a sampler is introduced that user can override.+  * Fix the bug where maxMutants were just the first n mutants, rather than n being randomly sampled.+  * Move writefile to front where more choices about it can be made.+  * We no longer require modulename to be passed in.+  * Fix bug in replaceFst+ ## [0.2.0.0] (Rahul Gopinath)   * Better documentation   * Add tests for SYB once

@@ -3,14 +3,14 @@ import Control.Monad (void)  import Test.MuCheck.Mutation+import Test.MuCheck.Config import Test.MuCheck.Utils.Common-import Test.MuCheck.Interpreter (mutantCheckSummary)+import Test.MuCheck.Interpreter (evaluateMutants) 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")+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") 

@@ -4,6 +4,7 @@ import Test.MuCheck.MuOp import Test.MuCheck.Operators (allOps) +-- | The knob controlling if we want first order mutation. data GenerationMode   = FirstOrderOnly   | FirstAndHigherOrder@@ -66,4 +67,18 @@   , doNegateGuards = 1.0   , maxNumMutants = 300   , genMode = FirstOrderOnly }++-- | Enumeration of different kinds of mutations+data MuVars = MutatePatternMatch+            | MutateValues+            | MutateNegateIfElse+            | MutateNegateGuards++-- | getSample returns the fraction in config corresponding to the enum passed+-- in+getSample :: MuVars -> Config -> Rational+getSample MutatePatternMatch = doMutatePatternMatches+getSample MutateValues       = doMutateValues+getSample MutateNegateIfElse = doNegateIfElse+getSample MutateNegateGuards = doNegateGuards 

@@ -1,21 +1,24 @@ -- | The entry point for mucheck-module Test.MuCheck.Interpreter (mutantCheckSummary) where+module Test.MuCheck.Interpreter (evaluateMutants) where  import qualified Language.Haskell.Interpreter as I-import Control.Monad.Trans ( liftIO )+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 System.Directory (createDirectoryIfMissing)+import Data.Hash.MD5 (md5s, Str(..))  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] -> [InterpreterOutput a] -> Summary) -> [String] -> String -> [String] -> FilePath -> IO ()-mutantCheckSummary testSummaryFn mutantFiles topModule evalSrcLst logFile  = do-  results <- mapM (runCodeOnMutants mutantFiles topModule) evalSrcLst+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@@ -51,7 +54,7 @@                   tsumOthers::Int,                   tsumLog::String} -mySummaryFn :: (Summarizable b, Eq a1) => ([a1] -> [Either a (a1, b)] -> Summary) -> [a1] -> [Either a (a1, b)] -> TSum+mySummaryFn :: Summarizable a => ([Mutant] -> [InterpreterOutput a] -> Summary) -> [Mutant] -> [InterpreterOutput a] -> TSum mySummaryFn testSummaryFn mutantFiles results = TSum {     tsumNumMutants = r,     tsumLoadError = l,@@ -69,22 +72,29 @@   -- | Run one test suite on all mutants-runCodeOnMutants :: Typeable t => [String] -> String -> String -> IO [InterpreterOutput t]-runCodeOnMutants mutantFiles topModule evalStr = mapM (evalMyStr evalStr) mutantFiles-  where evalMyStr eStr file = do putStrLn $ ">" ++ ":" ++ file ++ ":" ++ topModule ++ ":" ++ evalStr-                                 (res,_) <- catchOutput (I.runInterpreter (evalMethod file topModule eStr))-                                 return res+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))  -- | 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+-- >        "quickCheckResult idEmp")+evalMethod :: (I.MonadInterpreter m, Typeable t) => String -> String -> m (String, t)+evalMethod fileName evalStr = do   I.loadModules [fileName]-  I.setTopLevelModules [topModule]+  ms <- I.getLoadedModules+  I.setTopLevelModules ms   result <- I.interpret evalStr (I.as :: (Typeable a => IO a)) >>= liftIO   return (fileName, result) 

@@ -1,9 +1,11 @@+{-#  LANGUAGE Rank2Types #-}+-- | Mutation operators module Test.MuCheck.MuOp (MuOp           , Mutable(..)           , (==>*)           , (*==>*)           , (~~>)-          , mkMp'+          , mkMpMuOp           , same           ) where @@ -11,6 +13,7 @@ import qualified Data.Generics as G import Control.Monad (MonadPlus, mzero) +-- | MuOp constructor used to specify mutation transformation data MuOp = N  (Name, Name)           | QN (QName, QName)           | QO (QOp, QOp)@@ -22,73 +25,79 @@  -- boilerplate code +apply :: (forall a. (Eq a, G.Typeable a, Show a) => (a,a) -> c) -> MuOp -> c+apply f (N  m) = f m+apply f (QN m) = f m+apply f (QO m) = f m+apply f (E  m) = f m+apply f (D  m) = f m+apply f (L  m) = f m+apply f (G  m) = f m+ -- | 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+same = apply $ uncurry (==) -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)-mkMp' (E (s,t))  = G.mkMp (s ~~> t)-mkMp' (D (s,t))  = G.mkMp (s ~~> t)-mkMp' (L (s,t))  = G.mkMp (s ~~> t)-mkMp' (G (s,t))  = G.mkMp (s ~~> t)+-- | A wrapper over mkMp+mkMpMuOp :: (MonadPlus m, G.Typeable a) => MuOp -> a -> m a+mkMpMuOp = apply $ G.mkMp . (uncurry (~~>)) +-- | Show a specified mutation showM :: (Show a1, Show a) => (a, a1) -> String showM (s, t) = "\n" ++ show s ++ " ==> " ++ show t +-- | MuOp instance for Show instance Show MuOp where-    show (N a)  = showM a-    show (QN a) = showM a-    show (QO a) = showM a-    show (E a)  = showM a-    show (D a)  = showM a-    show (L a)  = showM a-    show (G a)  = showM a+  show = apply showM  -- end boilerplate code --- Mutation operation representing translation from one fn to another fn.+-- | Mutation operation representing translation from one fn to another fn. class Mutable a where-    (==>) :: a -> a -> MuOp+  (==>) :: a -> a -> MuOp +-- | The function `==>*` pairs up the given element with all elements of the+-- second list, and applies `==>` on them. (==>*) :: Mutable a => a -> [a] -> [MuOp]-(==>*) x lst = map (\i -> x ==> i) lst+(==>*) x lst = map (x ==>) lst +-- | The function `*==>*` pairs up all elements of first list with all elements+-- of second list and applies `==>` between them. (*==>*) :: Mutable a => [a] -> [a] -> [MuOp] xs *==>* ys = concatMap (==>* ys) xs +-- | The function `~~>` accepts two values, and returns a function+-- that if given a value equal to first, returns second -- 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-+-- | Name instance for Mutable instance Mutable Name where-    (==>) = (N .) . (,)-    +  (==>) = (N .) . (,)++-- | QName instance for Mutable instance Mutable QName where-    (==>) = (QN .) . (,)-    +  (==>) = (QN .) . (,)++-- | QOp instance for Mutable instance Mutable QOp where-    (==>) = (QO .) . (,)+  (==>) = (QO .) . (,) +-- | Exp instance for Mutable instance Mutable Exp where-    (==>) = (E .) . (,)-    +  (==>) = (E .) . (,)++-- | Exp instance for Mutable instance Mutable Decl where-    (==>) = (D .) . (,)-    +  (==>) = (D .) . (,)++-- | Literal instance for Mutable instance Mutable Literal where-    (==>) = (L .) . (,)-    +  (==>) = (L .) . (,)++-- | GuardedRhs instance for Mutable instance Mutable GuardedRhs where-    (==>) = (G .) . (,)+  (==>) = (G .) . (,)+

@@ -2,45 +2,61 @@ -- | Mutation happens here. module Test.MuCheck.Mutation where -import Language.Haskell.Exts(Literal(Int), Exp(App, Var, If), QName(UnQual),+import Language.Haskell.Exts(Literal(Int, Char, Frac, String, PrimInt, PrimChar, PrimFloat, PrimDouble, PrimWord, PrimString),+        Exp(App, Var, If), QName(UnQual),         Stmt(Qualifier), Module(Module),         Name(Ident, Symbol), Decl(FunBind, PatBind),-        Pat(PVar), Match(Match), GuardedRhs(GuardedRhs), +        Pat(PVar), Match(Match), GuardedRhs(GuardedRhs),         prettyPrint, fromParseResult, parseFileContents)-import Data.Generics (Data, Typeable, mkMp, listify)+import Data.Generics (Typeable, mkMp, listify) import Data.List(nub, (\\), permutations)-import Control.Monad (liftM, zipWithM)-import System.Random-import Data.Time.Clock.POSIX+import System.Random (RandomGen)  import Test.MuCheck.MuOp import Test.MuCheck.Utils.Syb import Test.MuCheck.Utils.Common import Test.MuCheck.Config+import Test.MuCheck.TestAdapter  -- | The `genMutants` function is a wrapper to genMutantsWith with standard -- configuraton-genMutants :: String -> FilePath -> IO Int+genMutants :: String -> FilePath -> IO [Mutant] genMutants = genMutantsWith defaultConfig  -- | The `genMutantsWith` function takes configuration function to mutate, -- filename the function is defined in, and produces mutants in the same -- directory as the filename, and returns the number of mutants produced.-genMutantsWith :: Config -> String -> FilePath -> IO Int-genMutantsWith args funcname filename  = liftM length $ do-    ast <- getASTFromFile filename-    g <- liftM (mkStdGen . round) getPOSIXTime-    let f = getFunc funcname ast+genMutantsWith :: Config -> String -> FilePath -> IO [Mutant]+genMutantsWith args func filename  = do+      g <- genRandomSeed+      f <- readFile filename+      return $ genMutantsForSrc defaultConfig func f (sampler args g) +-- | Wrapper around sampleF that returns correct sampling ratios according to+-- configuration passed.+sampler :: RandomGen g => Config -> g -> MuVars -> [t] -> [t]+sampler args g m = sampleF g (getSample m args)++-- | The `genMutantsForSrc` takes the function name to mutate, source where it+-- is defined, and a sampling function, and returns the mutated sources selected+-- using sampling function.+genMutantsForSrc :: Config -> String -> String -> (MuVars -> [MuOp] -> [MuOp]) -> [Mutant]+genMutantsForSrc args funcname src sampleFn = map prettyPrint programMutants+  where astMod = getASTFromStr src+        f = getFunc funcname astMod+         ops, swapOps, valOps, ifElseNegOps, guardedBoolNegOps :: [MuOp]         ops = relevantOps f (muOps args ++ valOps ++ ifElseNegOps ++ guardedBoolNegOps)-        swapOps = sampleF g (doMutatePatternMatches args) $ permMatches f ++ removeOnePMatch f-        valOps = sampleF g (doMutateValues args) $ selectIntOps f-        ifElseNegOps = sampleF g (doNegateIfElse args) $ selectIfElseBoolNegOps f-        guardedBoolNegOps = sampleF g (doNegateGuards args) $ selectGuardedBoolNegOps f+        swapOps = sampleFn MutatePatternMatch $ permMatches f ++ removeOnePMatch f+        valOps = sampleFn MutateValues $ selectLitOps f ++ selectBLitOps f+        ifElseNegOps = sampleFn MutateNegateIfElse $ selectIfElseBoolNegOps f+        guardedBoolNegOps = sampleFn MutateNegateGuards $ selectGuardedBoolNegOps f          patternMatchMutants, ifElseNegMutants, guardedNegMutants, operatorMutants, allMutants :: [Decl]-        allMutants = nub $ patternMatchMutants ++ operatorMutants ++ ifElseNegMutants ++ guardedNegMutants+        allMutants = nub $ patternMatchMutants +++                           operatorMutants +++                           ifElseNegMutants +++                           guardedNegMutants          patternMatchMutants = mutatesN swapOps f fstOrder         ifElseNegMutants = mutatesN ifElseNegOps f fstOrder@@ -49,40 +65,48 @@             FirstOrderOnly -> mutatesN ops f fstOrder             _              -> mutates ops f -        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')+        programMutants :: [Module]+        programMutants =  map (putDecls astMod) [replaceDef f fn astMod | fn <- allMutants] -    case ops ++ swapOps of-      [] -> return [] --  putStrLn "No applicable operator exists!"-      _  -> zipWithM writeFile (genFileNames filename) $ map prettyPrint (programMutants ast)-  where fstOrder = 1 -- first order-        getASTFromFile fname = liftM parseModuleFromFile $ readFile fname+        fstOrder = 1 -- first order --- | Mutating a function's code using a bunch of mutation operators--- (In all the three mutate functions, we assume working+-- | Replace old function definition with a new one in the AST+replaceDef :: Decl -> Decl -> Module -> [Decl]+replaceDef oldf newf (Module _ _ _ _ _ _ decls) = replaceFst (oldf, newf) decls++-- | Fetch the function definition from module+getFunc :: String -> Module -> Decl+getFunc fname ast = head $ listify (isFunctionD fname) ast++-- | Higher order mutation of a function's code using a bunch of mutation+-- operators (In all the three mutate functions, we assume working -- with functions declaration.) mutates :: [MuOp] -> Decl -> [Decl]-mutates ops m = filter (/= m) $ concatMap (mutatesN ops m) [1..]+mutates ops m = filter (/= m) $ concat [mutatesN ops m x | x <- enumFrom 1] --- the third argument specifies whether it's first order or higher order+-- | First and higher order mutation.+-- The third argument specifies whether it's first order or higher order mutatesN :: [MuOp] -> Decl -> Int -> [Decl] 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)]+mutatesN ops ms c = concat [mutatesN ops m 1 | m <- mutatesN ops ms $ pred c] --- | Given a function, generate all mutants after applying applying --- op once (op might be applied at different places).E.g.:--- op = "<" ==> ">" and there are two instances of "<"+-- | Given a function, generate all mutants after applying applying+-- op once (op might be applied at different places).+-- E.g.: if the operator is (op = "<" ==> ">") and there are two instances of+-- "<" in the AST, then it will return two AST with each replaced. mutate :: MuOp -> Decl -> [Decl]-mutate op m = once (mkMp' op) m \\ [m]+mutate op m = once (mkMpMuOp 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'+-- we also consider where clauses isFunctionD n (PatBind _ (PVar (Ident n')) _ _)          = n == n' isFunctionD _ _                                  = False+-- but not let, because it has a different type, and for our purposes+-- this is sufficient.+-- (Let Binds Exp) :: Exp  -- | Generate all operators for permutating pattern matches in -- a function. We don't deal with permutating guards and case for now.@@ -90,56 +114,82 @@ permMatches d@(FunBind ms) = d ==>* map FunBind (permutations ms \\ [ms]) permMatches _  = [] --- | generates transformations that removes one pattern match from a function+-- | Generates transformations that removes one pattern match from a function -- definition. removeOnePMatch :: Decl -> [MuOp] removeOnePMatch (FunBind [_]) = [] removeOnePMatch d@(FunBind ms) = d ==>* map FunBind (removeOneElem ms \\ [ms]) removeOnePMatch _  = [] --- | generate sub-arrays with one less element+-- | Generate sub-arrays with one less element removeOneElem :: Eq t => [t] -> [[t]] removeOneElem l = choose l (length l - 1)  -- AST/module-related operations --- | Parse a module. Input is the content of the file-parseModuleFromFile :: String -> Module-parseModuleFromFile inp = fromParseResult $ parseFileContents inp--getDecls :: Module -> [Decl]-getDecls (Module _ _ _ _ _ _ decls) = decls+-- | Returns the AST from the file+getASTFromStr :: String -> Module+getASTFromStr fname = fromParseResult $ parseFileContents fname +-- | Set the declaration in a module 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 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' predicate f m = concatMap (\x -> x ==>* f x) vals+-- | For valops, unlike functions, we specify how any given literal value might+-- change. So we take a predicate specifying how to recognize the literal+-- value, a list of mappings specifying how the literal can change, and the+-- AST, and recurse over the AST looking for literals that match our predicate.+-- When we find any, we apply the given list of mappings to them, and produce+-- a MuOp mapping between the original value and transformed value. This list+-- of MuOp mappings are then returned.+selectValOps :: (Typeable b, Mutable b) => (b -> Bool) -> (b -> [b]) -> Decl -> [MuOp]+selectValOps predicate f m = concat [ x ==>* f x |  x <- vals ]   where vals = listify predicate m -selectIntOps :: (Data a, Eq a) => a -> [MuOp]-selectIntOps m = selectValOps isInt [-      \(Int i) -> Int (i + 1),-      \(Int i) -> Int (i - 1),-      \(Int i) -> if abs i /= 1 then Int 0 else Int i,-      \(Int i) -> if abs (i-1) /= 1 then Int 1 else Int i] m-  where isInt (Int _) = True-        isInt _       = False+-- | Look for literal values in AST, and return applicable MuOp transforms.+-- Unfortunately booleans are not handled here.+selectLitOps :: Decl -> [MuOp]+selectLitOps m = selectValOps isLit convert m+  where isLit (Int _) = True+        isLit (PrimInt _) = True+        isLit (Char _) = True+        isLit (PrimChar _) = True+        isLit (Frac _) = True+        isLit (PrimFloat _) = True+        isLit (PrimDouble _) = True+        isLit (String _) = True+        isLit (PrimString _) = True+        isLit (PrimWord _) = True+        convert (Int i) = map Int $ nub [i + 1, i - 1, 0, 1]+        convert (PrimInt i) = map PrimInt $ nub [i + 1, i - 1, 0, 1]+        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 (String _) = map String $ nub [""]+        convert (PrimString _) = map PrimString $ nub [""]+        convert (PrimWord i) = map PrimWord $ nub [i + 1, i - 1, 0, 1] --- | negating boolean in if/else statements-selectIfElseBoolNegOps :: (Data a, Eq a) => a -> [MuOp]-selectIfElseBoolNegOps m = selectValOps isIf [\(If e1 e2 e3) -> If (App (Var (UnQual (Ident "not"))) e1) e2 e3] m+-- | Convert Boolean Literals+selectBLitOps :: Decl -> [MuOp]+selectBLitOps m = selectValOps isLit convert m+  where isLit (Ident "True") = True+        isLit (Ident "False") = True+        isLit _ = False+        convert (Ident "True") = [Ident "False"]+        convert (Ident "False") = [Ident "True"]+        convert _ = []++-- | Negating boolean in if/else statements+selectIfElseBoolNegOps :: Decl -> [MuOp]+selectIfElseBoolNegOps m = selectValOps isIf (\(If e1 e2 e3) -> [If e1 e3 e2]) m   where isIf If{} = True         isIf _    = False --- | negating boolean in Guards-selectGuardedBoolNegOps :: (Data a, Eq a) => a -> [MuOp]-selectGuardedBoolNegOps m = selectValOps' isGuardedRhs negateGuardedRhs m+-- | Negating boolean in Guards+selectGuardedBoolNegOps :: Decl -> [MuOp]+selectGuardedBoolNegOps m = selectValOps isGuardedRhs negateGuardedRhs m   where isGuardedRhs GuardedRhs{} = True         boolNegate e@(Qualifier (Var (UnQual (Ident "otherwise")))) = [e]         boolNegate (Qualifier expr) = [Qualifier (App (Var (UnQual (Ident "not"))) expr)]

@@ -1,3 +1,4 @@+-- | Available mutation operators module Test.MuCheck.Operators (comparators,                           predNums,                           binAriths,@@ -24,7 +25,7 @@ -- | functions on lists ["sum", "product", "maximum", "minimum", "head", "last"] arithLists = coupling (==>) $ map varfn ["sum", "product", "maximum", "minimum", "head", "last"] --- utilities+-- | wrapper to produce Function from String varfn :: String -> Exp varfn = Var . UnQual . Ident 

@@ -1,17 +1,28 @@+-- | Module for adapting test framekworks module Test.MuCheck.TestAdapter where  import qualified Language.Haskell.Interpreter as I import Data.Typeable++-- | Wrapper for interpreter output type InterpreterOutput a = Either I.InterpreterError (String, a) --- Class/Instance declaration-type MutantFilename = String+-- | Holding mutant information+type Mutant = String++-- | Summary of test run newtype Summary = Summary String++-- | Interface to be implemented by a test framework class Typeable s => Summarizable s where-  testSummary :: [MutantFilename] -> [InterpreterOutput s] -> Summary+  -- | Summary of a test run+  testSummary :: [Mutant] -> [InterpreterOutput s] -> Summary+  -- | Was the test run a success   isSuccess :: s -> Bool+  -- | Was the test run a failure   isFailure :: s -> Bool   isFailure = not . isSuccess+  -- | Was the test run neither (gaveup/timedout)   isOther :: s -> Bool   isOther x = not (isSuccess x) && not (isFailure x) 

@@ -4,6 +4,8 @@ import System.FilePath (splitExtension) import System.Random import Data.List+import Data.Time.Clock.POSIX (getPOSIXTime)+import Control.Monad (liftM)  -- | The `choose` function generates subsets of a given size choose :: [a] -> Int -> [[a]]@@ -22,21 +24,27 @@           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-replace :: Eq a => (a,a) -> [a] -> [a]-replace (o,n) lst = map replaceit lst-  where replaceit v-          | v == o = n-          | otherwise = v+-- | 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 _ [] = []+replaceFst (o, n) (v:vs)+  | v == o = n : vs+  | otherwise   = v : replaceFst (o,n) vs  -- | The `sample` function takes a random generator and chooses a random sample -- subset of given size. sample :: (RandomGen g) => g -> Int -> [t] -> [t] sample _ 0 _ = []+sample _ n xs | length xs <= n = xs sample g n xs = val : sample g' (n - 1) (remElt idx xs)   where val = xs !! idx         (idx,g')  = randomR (0, length xs - 1) g +-- | Wrapper around sample providing the random seed+rSample :: Int -> [t] -> IO [t]+rSample n t = do g <- genRandomSeed+                 return $ sample g n t+ -- | The `sampleF` function takes a random generator, and a fraction and -- returns subset of size given by fraction sampleF :: (RandomGen g) => g -> Rational -> [t] -> [t]@@ -60,4 +68,13 @@ genSwapped :: [t] -> [[t]] genSwapped lst = map (\(x:y:_) -> swapElts x y lst) swaplst   where swaplst = choose [0..length lst - 1] 2++-- | Generate a random seed from the time.+genRandomSeed :: IO StdGen+genRandomSeed = liftM (mkStdGen . round) getPOSIXTime++-- | take a function of two args producing a monadic result, and apply it to+-- a pair+curryM :: (t1 -> t2 -> m t) -> (t1, t2) -> m t+curryM fn (a,b) = fn a b 

@@ -1,10 +1,14 @@+{-# LANGUAGE TupleSections #-}+-- | Common print utilities module Test.MuCheck.Utils.Print where import Debug.Trace import Data.List(intercalate)+import Control.Monad (liftM)  import GHC.IO.Handle import System.IO-import System.Directory+import System.Environment+import System.IO.Temp (withSystemTempFile)  -- | simple wrapper for adding a % at the end. (./.) :: (Show a, Integral a) => a -> a -> String@@ -18,21 +22,25 @@ showA :: Show a => [a] -> String showA =  showAS . map show +-- | convenience function for debug tt :: Show a => a -> a tt v = trace (">" ++ show v) v +-- | Capture output and err of an IO action 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)+  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+        str <- readFile tmpf+        return (res,str)+

@@ -3,7 +3,7 @@ module Test.MuCheck.Utils.Syb (relevantOps, once) where  import Data.Generics (Data, GenericM, gmapMo)-import Test.MuCheck.MuOp (mkMp', MuOp, same)+import Test.MuCheck.MuOp (mkMpMuOp, MuOp, same) import Control.Monad (MonadPlus, mplus) import Data.Maybe(isJust) @@ -19,5 +19,5 @@ relevantOps :: (Data a, Eq a) => a -> [MuOp] -> [MuOp] 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 (mkMpMuOp op) m'