MuCheck 0.1.1.0 → 0.1.2.0
raw patch · 8 files changed
+176/−189 lines, 8 filesdep +randomdep ~haskell-src-exts
Dependencies added: random
Dependency ranges changed: haskell-src-exts
Files
- MuCheck.cabal +11/−6
- src/Main.hs +14/−8
- src/MuCheck/Interpreter.hs +62/−125
- src/MuCheck/Mutation.hs +23/−19
- src/MuCheck/Operators.hs +20/−10
- src/MuCheck/StdArgs.hs +8/−8
- src/MuCheck/Utils/Common.hs +29/−4
- src/MuCheck/Utils/Syb.hs +9/−9
MuCheck.cabal view
@@ -1,12 +1,13 @@ name: MuCheck-version: 0.1.1.0+version: 0.1.2.0 synopsis: Automated Mutation Testing description: This package defines a mutation analysis library for haskell programs. It does this by parsing the haskell source, and replacing a few of the common haskell functions and operators with other, but similar operators and functions, and running the testsuite to check whether the difference has been- detected. Currently, it supports QuickCheck and HUnit tests.+ detected. Currently, it supports QuickCheck, HUnit and Hspec+ tests. homepage: https://bitbucket.com/osu-testing/mucheck license: GPL-2 license-file: LICENSE@@ -18,21 +19,25 @@ build-type: Simple cabal-version: >= 1.10 +source-repository head+ type: git+ location: https://bitbucket.org/osu-testing/mucheck.git+ source-repository this type: git location: https://bitbucket.org/osu-testing/mucheck.git- tag: 0.1.0.1+ tag: 0.1.2.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+ 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 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, hspec>= 2.0, hspec-core >= 2.0+ 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 default-language: Haskell2010 hs-source-dirs: src @@ -41,5 +46,5 @@ 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+ 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
src/Main.hs view
@@ -1,22 +1,28 @@ module Main where-import System.Environment+import System.Environment (getArgs, withArgs)+import Control.Monad (void) import MuCheck.MuOp-import Language.Haskell.Exts import MuCheck.StdArgs-import MuCheck.Interpreter 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 process :: String -> String -> String -> String -> [String] -> IO () process t fn file modulename args = do numMutants <- genMutants fn file+ let muts = take numMutants $ genFileNames file+ l = "./" ++ t ++ ".log"+ fn f = void $ f muts modulename args l case t of- "qcheck" -> checkQuickCheckOnMutants (take numMutants $ genFileNames file) modulename args "./qcheck.log" >> return ()- "hspec" -> checkHspecOnMutants (take numMutants $ genFileNames file) modulename args "./hspec.log" >> return ()- "hunit" -> checkHUnitOnMutants (take numMutants $ genFileNames file) modulename args "./hunit.log" >> return ()+ "qcheck" -> fn checkQuickCheckOnMutants+ "hspec" -> fn checkHspecOnMutants+ "hunit" -> fn checkHUnitOnMutants _ -> error "Unexpected test type" @@ -29,8 +35,8 @@ _ -> error "Need [qcheck|hunit|hspec] function file modulename [args]\n\tUse -h to get help" help :: IO ()-help = putStrLn ("mucheck type function file modulename [args]\n" ++ (showAS ["E.g:",+help = putStrLn $ "mucheck type function file modulename [args]\n" ++ showAS ["E.g:", " ./mucheck qcheck qsort Examples/QuickCheckTest.hs Examples.QuickCheckTest 'quickCheckResult idEmpProp' 'quickCheckResult revProp' 'quickCheckResult modelProp'", " ./mucheck hunit qsort Examples/HUnitTest.hs Examples.HUnitTest 'runTestTT tests'",- " ./mucheck hspec qsort Examples/HspecTest.hs Examples.HspecTest 'spec (with \\\"qsort1\\\")'"]))+ " ./mucheck hspec qsort Examples/HspecTest.hs Examples.HspecTest 'spec (with \\\"qsort1\\\")'"]
src/MuCheck/Interpreter.hs view
@@ -9,65 +9,82 @@ import Data.Typeable import MuCheck.Utils.Print (showA, showAS, (./.)) import Data.Either (partitionEithers, rights)-import Data.List((\\), groupBy, sortBy, intercalate, isInfixOf)-import Data.Time.Clock--deriving instance Typeable Qc.Result-deriving instance Typeable HUnit.Counts-deriving instance Typeable Hspec.Summary+import Data.List(groupBy, sortBy)+import Data.Function (on) -type InterpreterOutput a = Either I.InterpreterError (String, a)+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 --- main entry point-mutantCheckSummary :: Summarizable a => [String] -> String -> [String] -> FilePath -> IO [a]+-- | 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 = suiteSummary 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)+ 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" ++ detail msum+ 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" ++ show (tsum_loadError msum),- "\tNot Killed:\t" ++ show (tsum_notKilled msum),- "\tKilled:\t" ++ show (tsum_killed msum),- "\tOthers:\t" ++ show (tsum_others msum),- ""]- detail msum = tsum_log msum- terminalSummary tssum = showAS ["Total number of mutants:\t" ++ show (tssum_numMutants tssum),- "Total number of alive mutants:\t" ++ show (tssum_alive tssum),- "Total number of load errors:\t" ++ show (tssum_errors tssum),- ""]- delim = "\n" ++ (take 25 (repeat '=')) ++ "\n"+ "\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" --- Interpreter Functionalities--- Examples--- t = runInterpreter (evalMethod "Examples/Quicksort.hs" "Quicksort" "quickCheckResult idEmp")++-- | 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 ++ ">"- x <- I.runInterpreter (evalMethod file topModule evalStr)- return x+ where evalMyStr evalStr file = do putStrLn $ ">" ++ ":" ++ file ++ ":" ++ topModule ++ ":" ++ evalStr+ I.runInterpreter (evalMethod file topModule evalStr) --- Given the filename, modulename, method to evaluate, evaluate, and return--- result as a pair.+-- | 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]@@ -75,101 +92,21 @@ result <- I.interpret evalStr (I.as :: (Typeable a => IO a)) >>= liftIO return (fileName, result) -data TSum = TSum {tsum_numMutants::Int, tsum_loadError::Int, tsum_notKilled::Int, tsum_killed::Int, tsum_others::Int, tsum_log::String}-data TSSum = TSSum {tssum_numMutants::Int, tssum_alive::Int, tssum_errors::Int, tssum_log::String}---- Class/Instance declaration-type MutantFilename = String-class Typeable s => Summarizable s where- testSummary :: [MutantFilename] -> [InterpreterOutput s] -> TSum- suiteSummary :: [[InterpreterOutput s]] -> TSSum- isSuccess :: s -> Bool--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]- suiteSummary = multipleCheckSummary (isSuccess . snd)- isSuccess = (\c -> (HUnit.cases c == HUnit.tried c) && HUnit.failures c == 0 && HUnit.errors c == 0)--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-- suiteSummary = multipleCheckSummary (isSuccess . snd)- isSuccess = Qc.isSuccess--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- suiteSummary = multipleCheckSummary (isSuccess . snd)- isSuccess (Hspec.Summary { Hspec.summaryExamples = se, Hspec.summaryFailures = sf } ) = sf == 0+-- | Datatype to hold results of the entire run+data TSSum = TSSum {tssum_numMutants::Int,+ tssum_alive::Int,+ tssum_errors::Int,+ tssum_log::String} --- we assume that checking each prop results in the same number of errorCases and executedCases+-- | 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 (\x y -> fst x == fst y) . sortBy (\x y -> fst x `compare` fst y) . rights $ concat results+ | 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
src/MuCheck/Mutation.hs view
@@ -12,6 +12,8 @@ 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@@ -25,33 +27,35 @@ genMutantsWith :: StdArgs -> String -> FilePath -> IO Int genMutantsWith args funcname filename = liftM length $ do ast <- getASTFromFile filename+ now <- round `fmap` getPOSIXTime 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 []+ g = mkStdGen now+ ops = relevantOps f (muOps args ++ valOps ++ ifElseNegOps ++ guardedBoolNegOps)+ swapOps = sampleF g (doMutatePatternMatches args) $ permMatches f ++ removeOnePMatch f - fstOrder = 1 -- first order+ 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 -> [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 = nub $ patternMatchMutants ++ operatorMutants - allMutants f = nub $ patternMatchMutants f ++ operatorMutants f+ patternMatchMutants, ifElseNegMutants, guardedNegMutants, operatorMutants, allMutants :: [Decl]+ 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 (func funcname 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
src/MuCheck/Operators.hs view
@@ -1,18 +1,28 @@-module MuCheck.Operators where+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+-- | 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"] +-- | 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-infixr 0 <$> -- this might not be the right fixity-f <$> ops = [o1 ==> o2 | o1 <- ops', o2 <- ops', o1 /= o2]- where ops' = map f ops+varfn = Var . UnQual . Ident+
src/MuCheck/StdArgs.hs view
@@ -8,20 +8,20 @@ deriving (Eq, Show) data StdArgs = StdArgs {muOps :: [MuOp]- , doMutatePatternMatches :: Bool- , doMutateValues :: Bool- , doNegateIfElse :: Bool- , doNegateGuards :: Bool+ , doMutatePatternMatches :: Rational+ , doMutateValues :: Rational+ , doNegateIfElse :: Rational+ , doNegateGuards :: Rational , maxNumMutants :: Int , genMode :: GenerationMode } deriving Show stdArgs :: StdArgs stdArgs = StdArgs {muOps = allOps- , doMutatePatternMatches = True -- False- , doMutateValues = True- , doNegateIfElse = True- , doNegateGuards = True+ , doMutatePatternMatches = 1.0+ , doMutateValues = 1.0+ , doNegateIfElse = 1.0+ , doNegateGuards = 1.0 , maxNumMutants = 300 , genMode = FirstOrderOnly }
src/MuCheck/Utils/Common.hs view
@@ -1,13 +1,19 @@ 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 :: [b] -> Int -> [[b]]-_ `choose` 0 = [[]]-[] `choose` _ = []-(x:xs) `choose` k = (x:) `fmap` (xs `choose` (k-1)) ++ xs `choose` k+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..]@@ -25,4 +31,23 @@ 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
src/MuCheck/Utils/Syb.hs view
@@ -1,5 +1,5 @@ {-# LANGUAGE RankNTypes #-}-+-- | SYB functions module MuCheck.Utils.Syb ( selectMany , selectOne , relevantOps@@ -7,29 +7,29 @@ , once') where import Data.Generics (Data, Typeable, GenericM, gmapMo, everything, mkQ, mkMp)-import MuCheck.MuOp-import MuCheck.Utils.Common+import MuCheck.MuOp (mkMp', MuOp)+import MuCheck.Utils.Common (safeHead) 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+-- | 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+-- | 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+-- | 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+-- | 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