MuCheck 0.1.2.2 → 0.1.3.0

raw patch · 28 files changed

+722/−667 lines, 28 filesdep ~filepathdep ~randomPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: filepath, random

API changes (from Hackage documentation)

Files

• MuCheck.cabal +52/−7
• changes.md +9/−0
• src/Main.hs +10/−10
• src/MuCheck/Config.hs +0/−28
• src/MuCheck/Interpreter.hs +0/−117
• src/MuCheck/MuOp.hs +0/−77
• src/MuCheck/Mutation.hs +0/−163
• src/MuCheck/Operators.hs +0/−28
• src/MuCheck/Run/Common.hs +0/−19
• src/MuCheck/Run/HUnit.hs +0/−38
• src/MuCheck/Run/Hspec.hs +0/−34
• src/MuCheck/Run/QuickCheck.hs +0/−39
• src/MuCheck/Utils/Common.hs +0/−53
• src/MuCheck/Utils/Print.hs +0/−15
• src/MuCheck/Utils/Syb.hs +0/−37
• src/Test/MuCheck/Config.hs +28/−0
• src/Test/MuCheck/Interpreter.hs +109/−0
• src/Test/MuCheck/MuOp.hs +78/−0
• src/Test/MuCheck/Mutation.hs +166/−0
• src/Test/MuCheck/Operators.hs +28/−0
• src/Test/MuCheck/Run/Common.hs +19/−0
• src/Test/MuCheck/Run/HUnit.hs +38/−0
• src/Test/MuCheck/Run/Hspec.hs +34/−0
• src/Test/MuCheck/Run/QuickCheck.hs +39/−0
• src/Test/MuCheck/Utils/Common.hs +53/−0
• src/Test/MuCheck/Utils/Print.hs +16/−0
• src/Test/MuCheck/Utils/Syb.hs +37/−0
• test/Spec.hs +6/−2

@@ -1,5 +1,5 @@ name:                MuCheck-version:             0.1.2.2+version:             0.1.3.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@@ -11,7 +11,7 @@ homepage:            https://bitbucket.com/osu-testing/mucheck license:             GPL-2 license-file:        LICENSE-author:              Duc Lee <ledu@onid.oregonstate.edu>+author:              Duc Lee <ledu@onid.oregonstate.edu>,                      Rahul Gopinath <rahul@gopinath.org> maintainer:          rahul@gopinath.org category:            Testing@@ -26,18 +26,51 @@ source-repository    this   type:              git   location:          https://bitbucket.org/osu-testing/mucheck.git-  tag:               0.1.2.2+  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, hspec >= 2.0, hspec-core >= 2.0, random+  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  library-  exposed-modules:  MuCheck.MuOp, MuCheck.Config, MuCheck.Interpreter, MuCheck.Mutation, MuCheck.Operators, MuCheck.Utils.Syb, MuCheck.Utils.Common, MuCheck.Utils.Print, MuCheck.Run.Common, MuCheck.Run.QuickCheck, MuCheck.Run.HUnit, MuCheck.Run.Hspec+  exposed-modules:  Test.MuCheck.MuOp,+                    Test.MuCheck.Config,+                    Test.MuCheck.Interpreter,+                    Test.MuCheck.Mutation,+                    Test.MuCheck.Operators,+                    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   -- 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, hspec>= 2.0, hspec-core >= 2.0, random+  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 @@ -46,5 +79,17 @@   hs-source-dirs:   test   main-is:          Spec.hs   default-language: Haskell2010-  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, hspec>= 2.0, hspec-core >= 2.0, MuCheck, random+  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,+                    MuCheck,+                    random >= 1.0.0 

@@ -1,7 +1,16 @@ # Changelog +## [0.1.3.0] (Rahul Gopinath)+  * Migrate mucheck to Test namespace+  * Add more tests+  * Fix eamples in docs++## [0.1.2.2] (Rahul Gopinath)+  * Handle single pattern function definitions correctly.+ ## [0.1.2.1] (Rahul Gopinath)   * Fix minor tagging issue+ ## [0.1.2.0] (Rahul Gopinath)   * Update usage docs   * Add hspec test framework support

@@ -2,16 +2,16 @@ import System.Environment (getArgs, withArgs) import Control.Monad (void) -import MuCheck.MuOp-import MuCheck.Config-import MuCheck.Mutation-import MuCheck.Operators-import MuCheck.Utils.Common-import MuCheck.Utils.Print-import MuCheck.Interpreter-import MuCheck.Run.QuickCheck-import MuCheck.Run.HUnit-import MuCheck.Run.Hspec+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

@@ -1,28 +0,0 @@-module MuCheck.Config where--import MuCheck.MuOp-import MuCheck.Operators--data GenerationMode-  = FirstOrderOnly-  | FirstAndHigherOrder-  deriving (Eq, Show)--data Config = Config { muOps :: [MuOp]-  , doMutatePatternMatches :: Rational-  , doMutateValues :: Rational-  , doNegateIfElse :: Rational-  , doNegateGuards :: Rational-  , maxNumMutants :: Int-  , genMode :: GenerationMode }-  deriving Show--defaultConfig :: Config-defaultConfig = Config {muOps = allOps-  , doMutatePatternMatches = 1.0-  , doMutateValues = 1.0-  , doNegateIfElse = 1.0-  , doNegateGuards = 1.0-  , maxNumMutants = 300-  , genMode = FirstOrderOnly }-

@@ -1,117 +0,0 @@-{-# 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 qualified Test.Hspec.Core.Runner as Hspec-import Data.Typeable-import MuCheck.Utils.Print (showA, showAS, (./.))-import Data.Either (partitionEithers, rights)-import Data.List(groupBy, sortBy)-import Data.Function (on)--import MuCheck.Run.Common-import MuCheck.Run.QuickCheck-import MuCheck.Run.HUnit-import 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---- | 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-  results <- mapM (runCodeOnMutants mutantFiles topModule) evalSrcLst-  let singleTestSummaries = zip evalSrcLst $ map (testSummary mutantFiles) results-      tssum  = multipleCheckSummary (isSuccess . snd) results-  -- print results to terminal-  putStrLn $ delim ++ "Overall Results:"-  putStrLn $ terminalSummary tssum-  putStrLn $ showAS $ map showBrief singleTestSummaries-  putStr delim-  -- print results to logfile-  appendFile logFile $ "OVERALL RESULTS:\n" ++ 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-        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),-           ""]-           where cpx fn = show (fn msum) ++ " " ++ (fn msum) ./. (tsum_numMutants 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),-          ""]-           where cpx fn = show (fn tssum) ++ " " ++ (fn tssum) ./. (tssum_numMutants tssum)-        delim = "\n" ++ replicate 25 '=' ++ "\n"----- | Run one test suite on all mutants--- @--- >>> t = runInterpreter (evalMethod "Examples/QuickCheckTest.hs" "Examples.QuickCheckTest" "quickCheckResult idEmp")--- @-runCodeOnMutants mutantFiles topModule evalStr = mapM (evalMyStr evalStr) mutantFiles-  where evalMyStr evalStr file = do putStrLn $ ">" ++ ":" ++ file ++ ":" ++ topModule ++ ":" ++ evalStr-                                    I.runInterpreter (evalMethod file topModule evalStr)---- | Given the filename, modulename, test 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]-  result <- I.interpret evalStr (I.as :: (Typeable a => IO a)) >>= liftIO-  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}---- | Summarize the entire run-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}-  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-        countExecutedCases = length . head $ executedCases-        countMutants = length . head $ results-

@@ -1,77 +0,0 @@-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 .) . (,)

@@ -1,163 +0,0 @@-{-# 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 System.Random-import Data.Time.Clock.POSIX--import MuCheck.MuOp-import MuCheck.Utils.Syb-import MuCheck.Utils.Common-import MuCheck.Operators-import MuCheck.Config---- | The `genMutants` function is a wrapper to genMutantsWith with standard--- configuraton-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 = func funcname ast--        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--        patternMatchMutants, ifElseNegMutants, guardedNegMutants, operatorMutants, allMutants :: [Decl]-        allMutants = nub $ patternMatchMutants ++ operatorMutants--        patternMatchMutants = mutatesN swapOps f fstOrder-        ifElseNegMutants = mutatesN ifElseNegOps f fstOrder-        guardedNegMutants = mutatesN guardedBoolNegOps f fstOrder-        operatorMutants = case genMode args of-            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)--    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---- | Mutating 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..]---- 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]--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---- | 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--{--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' :: (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]-

@@ -1,28 +0,0 @@-module MuCheck.Operators (comparators,-                          predNums,-                          binAriths,-                          arithLists,-                          allOps) where--import MuCheck.MuOp-import MuCheck.Utils.Common-import Language.Haskell.Exts (Name(Symbol), Exp(Var), QName(UnQual), Name(Ident))---- | all available operators-allOps = concat [comparators, predNums, binAriths, arithLists]---- | comparison operators-comparators = coupling (==>) $ map Symbol ["<", ">", "<=", ">=", "/=", "=="]---- | predicates-predNums = coupling (==>) $ map varfn ["pred", "id", "succ"]---- | binary arithmetic-binAriths = coupling (==>) $ map Symbol ["+", "-", "*", "/"]---- | arithmetic on lists-arithLists = coupling (==>) $ map varfn ["sum", "product", "maximum", "minimum", "head", "last"]---- utilities-varfn = Var . UnQual . Ident-

@@ -1,19 +0,0 @@-module 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 MuCheck.Run.HUnit where-import qualified Test.HUnit as HUnit-import MuCheck.Run.Common-import 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 MuCheck.Run.Hspec where-import qualified Test.Hspec.Core.Runner as Hspec-import MuCheck.Run.Common-import 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 MuCheck.Run.QuickCheck where-import qualified Test.QuickCheck.Test as Qc-import MuCheck.Run.Common-import 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

@@ -1,53 +0,0 @@-module 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]]-choose xs n = filter (\x -> length x == n) $ subsequences xs---- | 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]----- | The `genFileNames` function lazily generates filenames of mutants-genFileNames :: String -> [String]-genFileNames s =  map newname [1..]-    where (name, ext) = splitExtension s-          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 `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 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 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-

@@ -1,15 +0,0 @@-module MuCheck.Utils.Print where--import Data.List(intercalate)---- | simple wrapper for adding a % at the end.-n ./. t =  "(" ++ show (n * 100 `div` t) ++ "%)"---- | join lines together-showAS :: [String] -> String-showAS = intercalate "\n"---- | make lists into lines in text.-showA :: Show a => [a] -> String-showA =  showAS . map show-

@@ -1,37 +0,0 @@-{-# LANGUAGE RankNTypes #-}--- | SYB functions-module MuCheck.Utils.Syb ( selectMany-                     , selectOne-                     , relevantOps-                     , once-                     , once') where--import Data.Generics (Data, Typeable, GenericM, gmapMo, everything, mkQ, mkMp)-import MuCheck.MuOp (mkMp', MuOp)-import MuCheck.Utils.Common (safeHead)-import Control.Monad (MonadPlus, mplus)-import Data.Maybe(fromMaybe, isJust)---- | apply a mutating function on a piece of code one 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 :: (Typeable a, Data a1) => (a -> Bool) -> a1 -> Maybe a-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-

@@ -0,0 +1,28 @@+module Test.MuCheck.Config where++import Test.MuCheck.MuOp+import Test.MuCheck.Operators++data GenerationMode+  = FirstOrderOnly+  | FirstAndHigherOrder+  deriving (Eq, Show)++data Config = Config { muOps :: [MuOp]+  , doMutatePatternMatches :: Rational+  , doMutateValues :: Rational+  , doNegateIfElse :: Rational+  , doNegateGuards :: Rational+  , maxNumMutants :: Int+  , genMode :: GenerationMode }+  deriving Show++defaultConfig :: Config+defaultConfig = Config {muOps = allOps+  , doMutatePatternMatches = 1.0+  , doMutateValues = 1.0+  , doNegateIfElse = 1.0+  , doNegateGuards = 1.0+  , maxNumMutants = 300+  , genMode = FirstOrderOnly }+

@@ -0,0 +1,109 @@+{-# LANGUAGE StandaloneDeriving, DeriveDataTypeable #-}+module Test.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 qualified Test.Hspec.Core.Runner as Hspec+import Data.Typeable+import Test.MuCheck.Utils.Print (showA, showAS, (./.))+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++-- | 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+  results <- mapM (runCodeOnMutants mutantFiles topModule) evalSrcLst+  let singleTestSummaries = zip evalSrcLst $ map (testSummary mutantFiles) results+      tssum  = multipleCheckSummary (isSuccess . snd) results+  -- print results to terminal+  putStrLn $ delim ++ "Overall Results:"+  putStrLn $ terminalSummary tssum+  putStrLn $ showAS $ map showBrief singleTestSummaries+  putStr delim+  -- print results to logfile+  appendFile logFile $ "OVERALL RESULTS:\n" ++ 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+        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),+           ""]+           where cpx fn = show (fn msum) ++ " " ++ (fn msum) ./. (tsum_numMutants 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),+          ""]+           where cpx fn = show (fn tssum) ++ " " ++ (fn tssum) ./. (tssum_numMutants tssum)+        delim = "\n" ++ replicate 25 '=' ++ "\n"+++-- | Run one test suite on all mutants+-- > t = runInterpreter (evalMethod "Examples/QuickCheckTest.hs" "Examples.QuickCheckTest" "quickCheckResult idEmp")+runCodeOnMutants mutantFiles topModule evalStr = mapM (evalMyStr evalStr) mutantFiles+  where evalMyStr evalStr file = do putStrLn $ ">" ++ ":" ++ file ++ ":" ++ topModule ++ ":" ++ evalStr+                                    I.runInterpreter (evalMethod file topModule evalStr)++-- | Given the filename, modulename, test 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]+  result <- I.interpret evalStr (I.as :: (Typeable a => IO a)) >>= liftIO+  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}++-- | Summarize the entire run+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}+  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+        countExecutedCases = length . head $ executedCases+        countMutants = length . head $ results+

@@ -0,0 +1,78 @@+module Test.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)+  deriving Eq++-- 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 .) . (,)

@@ -0,0 +1,166 @@+{-# LANGUAGE ImpredicativeTypes #-}+-- | Mutation happens here.+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,+        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 System.Random+import Data.Time.Clock.POSIX++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 = 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 = func funcname ast++        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++        patternMatchMutants, ifElseNegMutants, guardedNegMutants, operatorMutants, allMutants :: [Decl]+        allMutants = nub $ patternMatchMutants ++ operatorMutants++        patternMatchMutants = mutatesN swapOps f fstOrder+        ifElseNegMutants = mutatesN ifElseNegOps f fstOrder+        guardedNegMutants = mutatesN guardedBoolNegOps f fstOrder+        operatorMutants = case genMode args of+            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)++    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++-- | Mutating 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..]++-- 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]++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 _  = []++-- | generates transformations that removes one pattern match from a function+-- definition.+removeOnePMatch :: Decl -> [MuOp]+removeOnePMatch d@(FunBind [x]) = []+removeOnePMatch d@(FunBind ms) = d ==>* map FunBind (removeOneElem ms \\ [ms])+removeOnePMatch _  = []++-- | 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++{-+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' :: (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]+

@@ -0,0 +1,28 @@+module Test.MuCheck.Operators (comparators,+                          predNums,+                          binAriths,+                          arithLists,+                          allOps) where++import Test.MuCheck.MuOp+import Test.MuCheck.Utils.Common+import Language.Haskell.Exts (Name(Symbol), Exp(Var), QName(UnQual), Name(Ident))++-- | all available operators+allOps = concat [comparators, predNums, binAriths, arithLists]++-- | comparison operators ["<", ">", "<=", ">=", "/=", "=="]+comparators = coupling (==>) $ map Symbol ["<", ">", "<=", ">=", "/=", "=="]++-- | predicates ["pred", "id", "succ"]+predNums = coupling (==>) $ map varfn ["pred", "id", "succ"]++-- | binary arithmetic ["+", "-", "*", "/"]+binAriths = coupling (==>) $ map Symbol ["+", "-", "*", "/"]++-- | functions on lists ["sum", "product", "maximum", "minimum", "head", "last"]+arithLists = coupling (==>) $ map varfn ["sum", "product", "maximum", "minimum", "head", "last"]++-- utilities+varfn = Var . UnQual . Ident+

@@ -0,0 +1,19 @@+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+

@@ -0,0 +1,38 @@+{-# 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+

@@ -0,0 +1,34 @@+{-# 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+

@@ -0,0 +1,39 @@+{-# 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,53 @@+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]]+choose xs n = filter (\x -> length x == n) $ subsequences xs++-- | 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]+++-- | The `genFileNames` function lazily generates filenames of mutants+genFileNames :: String -> [String]+genFileNames s =  map newname [1..]+    where (name, ext) = splitExtension s+          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 `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 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 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+

@@ -0,0 +1,16 @@+module Test.MuCheck.Utils.Print where+import Debug.Trace+import Data.List(intercalate)++-- | simple wrapper for adding a % at the end.+n ./. t =  "(" ++ show (n * 100 `div` t) ++ "%)"++-- | join lines together+showAS :: [String] -> String+showAS = intercalate "\n"++-- | make lists into lines in text.+showA :: Show a => [a] -> String+showA =  showAS . map show++tt v = trace (">" ++ (show v)) v

@@ -0,0 +1,37 @@+{-# LANGUAGE RankNTypes #-}+-- | SYB functions+module Test.MuCheck.Utils.Syb ( selectMany+                     , selectOne+                     , relevantOps+                     , once+                     , 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 Control.Monad (MonadPlus, mplus)+import Data.Maybe(fromMaybe, isJust)++-- | apply a mutating function on a piece of code one 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 :: (Typeable a, Data a1) => (a -> Bool) -> a1 -> Maybe a+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+

@@ -1,7 +1,9 @@ {-# OPTIONS_GHC -F -pgmF hspec-discover #-} import Test.Hspec -import qualified MuCheck.Util.Common+import qualified Test.MuCheck.Utils.Common+import qualified Test.MuCheck.Utils.Print+import qualified Test.MuCheck.Mutation   main :: IO ()@@ -9,4 +11,6 @@  spec :: Spec spec = do-  describe "Common" MuCheck.Util.Common.spec+  describe "Common" Test.MuCheck.Utils.CommonSpec.spec+  describe "Print" Test.MuCheck.Utils.PrintSpec.spec+  describe "Mutation" Test.MuCheck.MutationSpec.spec