diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,1 @@ +See GPLv2 diff --git a/MuCheck.cabal b/MuCheck.cabal new file mode 100644 --- /dev/null +++ b/MuCheck.cabal @@ -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 + Rahul Gopinath +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 + diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,3 @@ +import Distribution.Simple + +main = defaultMain diff --git a/src/Main.hs b/src/Main.hs new file mode 100644 --- /dev/null +++ b/src/Main.hs @@ -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]" diff --git a/src/MuCheck/Interpreter.hs b/src/MuCheck/Interpreter.hs new file mode 100644 --- /dev/null +++ b/src/MuCheck/Interpreter.hs @@ -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 + diff --git a/src/MuCheck/MuOp.hs b/src/MuCheck/MuOp.hs new file mode 100644 --- /dev/null +++ b/src/MuCheck/MuOp.hs @@ -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 .) . (,) diff --git a/src/MuCheck/Mutation.hs b/src/MuCheck/Mutation.hs new file mode 100644 --- /dev/null +++ b/src/MuCheck/Mutation.hs @@ -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] + diff --git a/src/MuCheck/Operators.hs b/src/MuCheck/Operators.hs new file mode 100644 --- /dev/null +++ b/src/MuCheck/Operators.hs @@ -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 diff --git a/src/MuCheck/StdArgs.hs b/src/MuCheck/StdArgs.hs new file mode 100644 --- /dev/null +++ b/src/MuCheck/StdArgs.hs @@ -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 } + diff --git a/src/MuCheck/Utils/Common.hs b/src/MuCheck/Utils/Common.hs new file mode 100644 --- /dev/null +++ b/src/MuCheck/Utils/Common.hs @@ -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 diff --git a/src/MuCheck/Utils/Print.hs b/src/MuCheck/Utils/Print.hs new file mode 100644 --- /dev/null +++ b/src/MuCheck/Utils/Print.hs @@ -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 + diff --git a/src/MuCheck/Utils/Syb.hs b/src/MuCheck/Utils/Syb.hs new file mode 100644 --- /dev/null +++ b/src/MuCheck/Utils/Syb.hs @@ -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 + diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 --- /dev/null +++ b/test/Spec.hs @@ -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