MuCheck (empty) → 0.1.0.1
raw patch · 13 files changed
+583/−0 lines, 13 filesdep +HUnitdep +MuCheckdep +QuickChecksetup-changed
Dependencies added: HUnit, MuCheck, QuickCheck, base, filepath, haskell-src-exts, hint, hspec, mtl, syb, time
Files
- LICENSE +1/−0
- MuCheck.cabal +46/−0
- Setup.hs +3/−0
- src/Main.hs +28/−0
- src/MuCheck/Interpreter.hs +140/−0
- src/MuCheck/MuOp.hs +77/−0
- src/MuCheck/Mutation.hs +152/−0
- src/MuCheck/Operators.hs +18/−0
- src/MuCheck/StdArgs.hs +27/−0
- src/MuCheck/Utils/Common.hs +28/−0
- src/MuCheck/Utils/Print.hs +14/−0
- src/MuCheck/Utils/Syb.hs +37/−0
- test/Spec.hs +12/−0
+ LICENSE view
@@ -0,0 +1,1 @@+See GPLv2
+ MuCheck.cabal view
@@ -0,0 +1,46 @@+name: MuCheck+version: 0.1.0.1+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 and HUnit tests.+homepage: https://bitbucket.com/osu-testing/mucheck+license: GPL-2+license-file: LICENSE+author: Duc Lee <ledu@onid.oregonstate.edu>+ Rahul Gopinath <rahul@gopinath.org>+maintainer: ledu@onid.oregonstate.edu+ rahul@gopinath.org+-- copyright: +category: Testing+build-type: Simple+cabal-version: >= 1.10++source-repository head+ type: git+ location: https://rgopinath@bitbucket.org/osu-testing/mucheck.git+ tag: 0.1.0.1++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+ default-language: Haskell2010+ hs-source-dirs: src++library+ exposed-modules: MuCheck.MuOp, MuCheck.StdArgs, MuCheck.Interpreter, MuCheck.Mutation, MuCheck.Operators, MuCheck.Utils.Syb, MuCheck.Utils.Common, MuCheck.Utils.Print+ -- 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+ default-language: Haskell2010+ hs-source-dirs: src++test-suite spec+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ main-is: Spec.hs+ default-language: Haskell2010+ build-depends: base >= 4 && <5, MuCheck, hspec >= 2.0, QuickCheck >= 2.6, filepath+
+ Setup.hs view
@@ -0,0 +1,3 @@+import Distribution.Simple++main = defaultMain
+ src/Main.hs view
@@ -0,0 +1,28 @@+module Main where+import System.Environment++import MuCheck.MuOp+import Language.Haskell.Exts+import MuCheck.StdArgs+import MuCheck.Interpreter+import MuCheck.Mutation+import MuCheck.Operators+import MuCheck.Utils.Common++process :: String -> String -> String -> [String] -> IO ()+process fn file modulename args = do+ numMutants <- genMutants fn file+ checkPropsOnMutants (take numMutants $ genFileNames file) modulename args "./test.log"+ return ()+++main :: IO ()+main = do+ val <- getArgs+ case val of+ ("-help" : _ ) -> help+ (fn : file : modulename : args) -> process fn file modulename args+ _ -> error "Need function file modulename [args]"++help :: IO ()+help = putStrLn "mucheck function file modulename [args]"
+ src/MuCheck/Interpreter.hs view
@@ -0,0 +1,140 @@+{-# LANGUAGE StandaloneDeriving, DeriveDataTypeable #-}+module MuCheck.Interpreter 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 Data.Typeable+import qualified MuCheck.Utils.Print as Mu+import Data.Either+import Data.List((\\), groupBy, sortBy)+import Data.Time.Clock++deriving instance Typeable Qc.Result+deriving instance Typeable HUnit.Counts++type InterpreterOutput a = Either I.InterpreterError (String, a)++checkPropsOnMutants :: [String] -> String -> [String] -> String -> IO [Qc.Result]+checkPropsOnMutants = mutantCheckSummary++checkTestSuiteOnMutants :: [String] -> String -> [String] -> String -> IO [HUnit.Counts]+checkTestSuiteOnMutants = mutantCheckSummary++-- main entry point+mutantCheckSummary :: Summarizable a => [String] -> String -> [String] -> FilePath -> IO [a]+mutantCheckSummary mutantFiles topModule evalSrcLst logFile = do+ results <- mapM (runCodeOnMutants mutantFiles topModule) evalSrcLst+ let delim = "\n" ++ (take 25 (repeat '=')) ++ "\n"+ singleTestSummaries = map (singleSummary mutantFiles) results+ (terminalSummary,logSummary) = multipleSummary results+ evalSrcLst' = map (delim ++) evalSrcLst+ -- print results to terminal+ putStrLn $ delim ++ "Overall Results:"+ putStrLn terminalSummary+ putStrLn $ Mu.showAS $ zipWith (++) evalSrcLst' $ map fst singleTestSummaries+ putStr delim+ -- print results to logfile+ appendFile logFile $ "OVERALL RESULTS:\n" ++ logSummary ++ Mu.showAS (zipWith (++) evalSrcLst' $ map snd 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]++-- Interpreter Functionalities+-- Examples+-- t = runInterpreter (evalMethod "Examples/Quicksort.hs" "Quicksort" "quickCheckResult idEmp")+runCodeOnMutants mutantFiles topModule evalStr = mapM (evalMyStr evalStr) mutantFiles+ where evalMyStr evalStr file = I.runInterpreter (evalMethod file topModule evalStr)++-- Given the filename, modulename, method to evaluate, evaluate, and return+-- result as a pair.+evalMethod :: (I.MonadInterpreter m, Typeable t) => String -> String -> String -> m (String, t)+evalMethod fileName topModule evalStr = do+ I.loadModules [fileName]+ I.setTopLevelModules [topModule]+ I.setImports ["Prelude", "Test.QuickCheck", "Test.HUnit"]+ result <- I.interpret evalStr (I.as :: (Typeable a => IO a)) >>= liftIO+ return (fileName, result)+++-- Class/Instance declaration+type MutantFilename = String+type TerminalSummary = String+type LogSummary = String+class Typeable s => Summarizable s where+ singleSummary :: [MutantFilename] -> [InterpreterOutput s] -> (TerminalSummary, LogSummary)+ multipleSummary :: [[InterpreterOutput s]] -> (TerminalSummary, LogSummary)++instance Summarizable HUnit.Counts where+ singleSummary mutantFiles results = (terminalMsg, logMsg)+ where (loadingErrorCases, executedCases) = partitionEithers results+ loadingErrorFiles = mutantFiles \\ map fst executedCases+ successCases = filter ((\c -> (HUnit.cases c == HUnit.tried c) && HUnit.failures c == 0 && HUnit.errors c == 0) . 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]+ terminalMsg = "\n\nTotal number of mutants: " ++ show r +++ "\n\nFailed to load: " ++ show le +++ "\nSuccesses (not killed): " ++ show s +++ "\nFailures (killed): " ++ show fl +++ "\nError while running: " ++ show re +++ "\nIncompletely tested (may include failures and running errors): " ++ show ftc+ logMsg = terminalMsg ++ "\n\nDetails: \n\nLoading error files:\n" ++ Mu.showA loadingErrorFiles+ ++ "\n\nLoading error messages:\n" ++ Mu.showA loadingErrorCases+ ++ "\n\nSuccesses:\n" ++ Mu.showA successCases+ ++ "\n\nFailures:\n" ++ Mu.showA failuresCases+ ++ "\n\nError while running:\n" ++ Mu.showA runningErrorCases+ ++ "\n\nIncompletely tested (may include failures and running errors):\n"+ ++ Mu.showA failToFullyTryCases ++ "\n"+ multipleSummary = multipleCheckSummary (\c -> (HUnit.cases c == HUnit.tried c) && HUnit.failures c == 0 && HUnit.errors c == 0)++instance Summarizable Qc.Result where+ singleSummary mutantFiles results = (terminalMsg, logMsg)+ where (errorCases, executedCases) = partitionEithers results+ [successCases, failureCases, gaveUpCases] = map (\c -> filter (c . snd) executedCases) [Qc.isSuccess, isFailure, isGaveUp]+ r = length results+ e = length errorCases+ [s,f,g] = map length [successCases, failureCases, gaveUpCases]+ errorFiles = mutantFiles \\ map fst executedCases+ terminalMsg = "\n\nTotal number of mutants: " ++ show r +++ "\n\nErrors: " ++ show e ++ Mu.showPerCent (e `Mu.percent` r) +++ "\nSuccesses (not killed): " ++ show s ++ Mu.showPerCent (s `Mu.percent` r) +++ "\nFailures (killed): " ++ show f ++ Mu.showPerCent (f `Mu.percent` r) +++ "\nGaveups: " ++ show g ++ Mu.showPerCent (g `Mu.percent` r)+ logMsg = terminalMsg ++ "\n\nDetails:\n\nLoading error files:\n" ++ Mu.showA errorFiles+ ++ "\n\nLoading error messages:\n " ++ Mu.showA errorCases+ ++ "\n\nSUCCESSES:\n " ++ Mu.showA successCases+ ++ "\n\nFAILURE:\n " ++ Mu.showA failureCases+ ++ "\n\nGAVEUPs:\n " ++ Mu.showA gaveUpCases ++ "\n"+ isFailure :: Qc.Result -> Bool+ isFailure Qc.Failure{} = True+ isFailure _ = False+ isGaveUp :: Qc.Result -> Bool+ isGaveUp Qc.GaveUp{} = True+ isGaveUp _ = False++ multipleSummary = multipleCheckSummary Qc.isSuccess++-- we assume that checking each prop results in the same number of errorCases and executedCases+multipleCheckSummary :: Show a => (a -> Bool) -> [[InterpreterOutput a]] -> (String, String)+multipleCheckSummary isSuccessFunction results+ | not (checkLength results) = error "Output lengths differ for some properties."+ | otherwise = (terminalMsg, logMsg)+ where executedCases = groupBy (\x y -> fst x == fst y) . sortBy (\x y -> fst x `compare` fst y) . rights $ concat results+ allSuccesses = [rs | rs <- executedCases, length rs == length results, all (isSuccessFunction . snd) rs]+ countAlive = length allSuccesses+ countErrors = countMutants - length executedCases+ terminalMsg = "\nTotal number of mutants: " ++ show countMutants+ ++ "\nTotal number of alive and error-free mutants: " ++ show countAlive+ ++ Mu.showPerCent (countAlive `Mu.percent` countMutants) ++ "\n"+ ++ "Total number of erroneous mutants (failed to be loaded): " ++ show countErrors ++ Mu.showPerCent (countErrors `Mu.percent` countMutants) ++ "\n"+ logMsg = terminalMsg ++ "\nDetails:\n\n" ++ Mu.showA allSuccesses ++ "\n"++ checkLength results = and $ map ((==countMutants) . length) results ++ map ((==countExecutedCases) . length) executedCases+ countExecutedCases = length . head $ executedCases+ countMutants = length . head $ results+
+ src/MuCheck/MuOp.hs view
@@ -0,0 +1,77 @@+module MuCheck.MuOp (MuOp+ , (==>)+ , (==>*)+ , (*==>*)+ , (~~>)+ , mkMp'+ , Mutable+ ) where++import Language.Haskell.Exts (Name, QName, QOp, Exp, Literal, GuardedRhs, Decl)+import qualified Data.Generics as G+import Control.Monad (MonadPlus, mzero)++data MuOp = N (Name, Name)+ | QN (QName, QName)+ | QO (QOp, QOp)+ | E (Exp, Exp)+ | D (Decl, Decl)+ | L (Literal, Literal)+ | G (GuardedRhs, GuardedRhs)++-- boilerplate code+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)++showM (s, t) = "\n" ++ show s ++ " ==> " ++ show t+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++-- end boilerplate code++-- Mutation operation representing translation from one fn to another fn.+class Mutable a where+ (==>) :: a -> a -> MuOp++(==>*) :: Mutable a => a -> [a] -> [MuOp]+(==>*) x lst = map (\i -> x ==> i) lst++(*==>*) :: 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++-- instances++instance Mutable Name where+ (==>) = (N .) . (,)+ +instance Mutable QName where+ (==>) = (QN .) . (,)+ +instance Mutable QOp where+ (==>) = (QO .) . (,)++instance Mutable Exp where+ (==>) = (E .) . (,)+ +instance Mutable Decl where+ (==>) = (D .) . (,)+ +instance Mutable Literal where+ (==>) = (L .) . (,)+ +instance Mutable GuardedRhs where+ (==>) = (G .) . (,)
+ src/MuCheck/Mutation.hs view
@@ -0,0 +1,152 @@+{-# LANGUAGE ImpredicativeTypes #-}+-- Mutation happens here.++module 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,+ Pat(PVar), Match(Match), GuardedRhs(GuardedRhs), + prettyPrint, fromParseResult, parseFileContents)+import Data.Maybe (fromJust)+import Data.Generics (GenericQ, mkQ, Data, Typeable, mkMp)+import Data.List(nub, (\\), permutations)+import Control.Monad (liftM, zipWithM)++import MuCheck.MuOp+import MuCheck.Utils.Syb+import MuCheck.Utils.Common+import MuCheck.Operators+import MuCheck.StdArgs++-- entry point.+genMutants = genMutantsWith stdArgs++genMutantsWith :: StdArgs -> String -> FilePath -> IO Int+genMutantsWith args funcname filename = liftM length $ do+ ast <- getASTFromFile filename+ let f = func funcname ast+ case ops f ++ swapOps f of+ [] -> return [] -- putStrLn "No applicable operator exists!"+ _ -> zipWithM writeFile (genFileNames filename) $ map prettyPrint (programMutants ast)+ where ops f = relevantOps f (muOps args ++ valOps f ++ ifElseNegOps f ++ guardedBoolNegOps f)++ valOps f = if doMutateValues args then selectIntOps f else []+ ifElseNegOps f = if doNegateIfElse args then selectIfElseBoolNegOps f else []+ guardedBoolNegOps f = if doNegateGuards args then selectGuardedBoolNegOps f else []+ swapOps f = if doMutatePatternMatches args then permMatches f ++ removeOnePMatch f else []++ fstOrder = 1 -- first order++ patternMatchMutants, ifElseNegMutants, guardedNegMutants, operatorMutants, allMutants :: Decl -> [Decl]+ patternMatchMutants f = mutatesN (swapOps f) f fstOrder+ ifElseNegMutants f = mutatesN (ifElseNegOps f) f fstOrder+ guardedNegMutants f = mutatesN (guardedBoolNegOps f) f fstOrder+ operatorMutants f = case genMode args of+ FirstOrderOnly -> mutatesN (ops f) f fstOrder+ _ -> mutates (ops f) f++ allMutants f = nub $ patternMatchMutants f ++ operatorMutants 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 (func funcname ast) ]+ myfn ast fn = replace (func funcname ast,fn) (getDecls ast)+ getASTFromFile filename = liftM parseModuleFromFile $ readFile filename++-- Mutating a function's code using a bunch of mutation operators+-- NOTE: 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..]++-- 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)]++-- 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 "<"+mutate :: MuOp -> Decl -> [Decl]+mutate op m = once (mkMp' op) m \\ [m]++isFunction :: Name -> GenericQ Bool+isFunction (Ident n) = False `mkQ` isFunctionD n++isFunctionD :: String -> Decl -> Bool+isFunctionD n (FunBind (Match _ (Ident n') _ _ _ _ : _)) = n == n'+isFunctionD n (FunBind (Match _ (Symbol n') _ _ _ _ : _)) = n == n'+isFunctionD n (PatBind _ (PVar (Ident n')) _ _) = n == n'+isFunctionD _ _ = False++-- generate all operators for permutating pattern matches in+-- a function. We don't deal with permutating guards and case for now.+permMatches :: Decl -> [MuOp]+permMatches d@(FunBind ms) = d ==>* map FunBind (permutations ms \\ [ms])+permMatches _ = []++removeOnePMatch :: Decl -> [MuOp]+removeOnePMatch d@(FunBind ms) = d ==>* map FunBind (removeOneElem ms \\ [ms])+removeOnePMatch _ = []++removeOneElem :: Eq t => [t] -> [[t]]+removeOneElem l = choose l (length l - 1)++-- AST/module-related operations+-- String is the content of the file+parseModuleFromFile :: String -> Module+parseModuleFromFile inp = fromParseResult $ parseFileContents inp++getDecls :: Module -> [Decl]+getDecls (Module _ _ _ _ _ _ decls) = decls++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+ +putDecls :: Module -> [Decl] -> Module+putDecls (Module a b c d e f _) decls = Module a b c d e f decls++getName :: Module -> String+getName (Module _ (ModuleName name) _ _ _ _ _) = name++-- 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' :: (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++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++-- 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+ where isIf If{} = True+ isIf _ = False++-- negating boolean in Guards+selectGuardedBoolNegOps :: (Data a, Eq a) => a -> [MuOp]+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 x = [x]+ negateGuardedRhs (GuardedRhs srcLoc stmts exp) = [GuardedRhs srcLoc s exp | s <- once (mkMp boolNegate) stmts]+
+ src/MuCheck/Operators.hs view
@@ -0,0 +1,18 @@+module MuCheck.Operators where++import MuCheck.MuOp+import Language.Haskell.Exts (Name(Symbol), Exp(Var), QName(UnQual), Name(Ident))++-- all available operators+allOps = concat [comparators, predNums, binAriths, arithLists]++-- classes of code elements+comparators = Symbol <$> ["<", ">", "<=", ">=", "/=", "=="]+predNums = Var . UnQual . Ident <$> ["pred", "id", "succ"]+binAriths = Symbol <$> ["+", "-", "*", "/"]+arithLists = Var . UnQual . Ident <$> ["sum", "product", "maximum", "minimum", "head", "last"] ++-- utilities+infixr 0 <$> -- this might not be the right fixity+f <$> ops = [o1 ==> o2 | o1 <- ops', o2 <- ops', o1 /= o2]+ where ops' = map f ops
+ src/MuCheck/StdArgs.hs view
@@ -0,0 +1,27 @@+module MuCheck.StdArgs where++import MuCheck.MuOp+import MuCheck.Operators++data GenerationMode = FirstOrderOnly+ | FirstAndHigherOrder+ deriving (Eq, Show)++data StdArgs = StdArgs {muOps :: [MuOp]+ , doMutatePatternMatches :: Bool+ , doMutateValues :: Bool+ , doNegateIfElse :: Bool+ , doNegateGuards :: Bool+ , maxNumMutants :: Int+ , genMode :: GenerationMode }+ deriving Show++stdArgs :: StdArgs+stdArgs = StdArgs {muOps = allOps+ , doMutatePatternMatches = True -- False+ , doMutateValues = True+ , doNegateIfElse = True+ , doNegateGuards = True+ , maxNumMutants = 300+ , genMode = FirstOrderOnly }+
+ src/MuCheck/Utils/Common.hs view
@@ -0,0 +1,28 @@+module MuCheck.Utils.Common where++import System.FilePath (splitExtension)++-- choose [1,2,3,4,5] 4+-- = [[2,3,4,5],[1,3,4,5],[1,2,4,5],[1,2,3,5],[1,2,3,4]]+choose :: [b] -> Int -> [[b]]+_ `choose` 0 = [[]]+[] `choose` _ = []+(x:xs) `choose` k = (x:) `fmap` (xs `choose` (k-1)) ++ xs `choose` k++-- generating mutant files names+-- e.g.: "Quicksort.hs" ==> "Quicksort_1.hs", "Quicksort_2.hs", etc.+genFileNames :: String -> [String]+genFileNames s = map newname [1..]+ where (name, ext) = splitExtension s+ newname i= name ++ "_" ++ show i ++ ext++-- replace first element in a list given old and new values+replace :: Eq a => (a,a) -> [a] -> [a]+replace (o,n) lst = map replaceit lst+ where replaceit v+ | v == o = n+ | otherwise = v++safeHead :: [a] -> Maybe a+safeHead [] = Nothing+safeHead (x:xs) = Just x
+ src/MuCheck/Utils/Print.hs view
@@ -0,0 +1,14 @@+module MuCheck.Utils.Print where++import Data.List(intercalate)++-- utils for interpreter+showPerCent x = "(" ++ show x ++ "%)"+n `percent` t = 100 * n `div` t++showAS :: [String] -> String+showAS = intercalate "\n"++showA :: Show a => [a] -> String+showA = showAS . map show+
+ src/MuCheck/Utils/Syb.hs view
@@ -0,0 +1,37 @@+{-# LANGUAGE RankNTypes #-}++module MuCheck.Utils.Syb ( selectMany+ , selectOne+ , relevantOps+ , once+ , once') where++import Data.Generics (Data, Typeable, GenericM, gmapMo, everything, mkQ, mkMp)+import MuCheck.MuOp+import MuCheck.Utils.Common+import Control.Monad (MonadPlus, mplus)+import Data.Maybe(fromMaybe, isJust)++-- SYB functions+-- apply a mutating function on a piece of code once at a time+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 f p = safeHead $ selectMany f p++-- selecting all relevant ops+relevantOps :: (Data a, Eq a) => a -> [MuOp] -> [MuOp]+relevantOps m mlst = filter (relevantOp m) mlst+ -- check if an operator can be applied to a program+ where relevantOp m op = isJust $ once (mkMp' op) m+
+ test/Spec.hs view
@@ -0,0 +1,12 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}+import Test.Hspec++import qualified MuCheck.Util.Common+++main :: IO ()+main = hspec spec++spec :: Spec+spec = do+ describe "Common" MuCheck.Util.Common.spec