diff --git a/TestMain.hs b/TestMain.hs index bed316b..4146e9f 100644 --- a/TestMain.hs +++ b/TestMain.hs @@ -83,7 +83,7 @@ main = do (opts, nonOpts, errs) <- getArgs >>* getOpt RequireOrder options else runTestTT case qcLevel of -- Monadic mess! - Just level -> join $ liftM sequence_ $ (liftM $ applyAll level) qcTests + Just level -> mapM_ (runQCTest level) =<< qcTests Nothing -> return () where err msg = ioError (userError (msg ++ usageInfo header options)) @@ -111,9 +111,12 @@ main = do (opts, nonOpts, errs) <- getArgs >>* getOpt RequireOrder options "extensive" -> Right $ Just QC_Extensive unknown -> Left unknown + runQCTest :: QuickCheckLevel -> LabelledQuickCheckTest -> IO () + runQCTest level (label, test) = putStr (label ++ ": ") >> test level + hunitTests :: IO Test hunitTests = sequence tests >>* (TestList . fst . unzip) - qcTests :: IO [QuickCheckTest] + qcTests :: IO [LabelledQuickCheckTest] qcTests = concatMapM (liftM snd) tests tests = [ @@ -129,6 +132,6 @@ main = do (opts, nonOpts, errs) <- getArgs >>* getOpt RequireOrder options ,noqc RainUsageCheckTest.tests ] - noqc :: Test -> IO (Test, [QuickCheckTest]) + noqc :: Test -> IO (Test, [LabelledQuickCheckTest]) noqc t = return (t,[]) diff --git a/checks/ArrayUsageCheckTest.hs b/checks/ArrayUsageCheckTest.hs index 4ae85a1..39a13f5 100644 --- a/checks/ArrayUsageCheckTest.hs +++ b/checks/ArrayUsageCheckTest.hs @@ -728,8 +728,8 @@ generateProblem = choose (1,10) >>= (\n -> replicateM n $ choose (-20,20)) >>= instance Arbitrary OmegaTestInput where arbitrary = generateProblem >>* OMI -qcOmegaEquality :: [QuickCheckTest] -qcOmegaEquality = [scaleQC (40,200,2000,10000) prop] +qcOmegaEquality :: [LabelledQuickCheckTest] +qcOmegaEquality = [("Omega Test Equality Solving", scaleQC (40,200,2000,10000) prop)] where prop (OMI (ans,(eq,ineq))) = omegaCheck actAnswer where @@ -812,8 +812,8 @@ newtype OmegaPruneInput = OPI MutatedProblem deriving (Show) instance Arbitrary OmegaPruneInput where arbitrary = ((generateProblem >>* snd) >>= (return . snd) >>= mutateEquations) >>* OPI -qcOmegaPrune :: [QuickCheckTest] -qcOmegaPrune = [scaleQC (100,1000,10000,50000) prop] +qcOmegaPrune :: [LabelledQuickCheckTest] +qcOmegaPrune = [("Omega Test Pruning", scaleQC (100,1000,10000,50000) prop)] where --We perform the map assocs because we can't compare arrays using *==* -- (toConstr fails in the pretty-printing!). @@ -831,7 +831,7 @@ qcOmegaPrune = [scaleQC (100,1000,10000,50000) prop] result = undefined -- TODO replace solveAndPrune: solveProblem [] inp -} -ioqcTests :: IO (Test, [QuickCheckTest]) +ioqcTests :: IO (Test, [LabelledQuickCheckTest]) ioqcTests = seqPair (liftM (TestLabel "ArrayUsageCheckTest" . TestList) $ sequence diff --git a/common/FlowGraphTest.hs b/common/FlowGraphTest.hs index 95a09b4..9b48a3a 100644 --- a/common/FlowGraphTest.hs +++ b/common/FlowGraphTest.hs @@ -680,12 +680,12 @@ deepCheck test level = (flip check) test $ configForSize $ QC_High -> 5000 QC_Extensive -> 10000 -testModify :: [QuickCheckTest] +testModify :: [LabelledQuickCheckTest] testModify = [ - deepCheck prop_Id - ,deepCheck prop_Rep - ,deepCheck prop_gennums + ("Control-Flow Graph Identity Transformations", deepCheck prop_Id) + ,("Control-Flow Graph Replacement Transformations", deepCheck prop_Rep) + ,("Random List Generation", deepCheck prop_gennums) ] where -- | Checks that applying any set (from the powerset of identity functions) of identity functions @@ -726,7 +726,7 @@ testModify = collectAll' r0 r1 | ok r0 == Just False = r0 | otherwise = r1 -- | Returns the list of tests: -qcTests :: (Test, [QuickCheckTest]) +qcTests :: (Test, [LabelledQuickCheckTest]) qcTests = (TestLabel "FlowGraphTest" $ TestList [ testCase diff --git a/common/TestUtils.hs b/common/TestUtils.hs index c89dc8e..8051626 100644 --- a/common/TestUtils.hs +++ b/common/TestUtils.hs @@ -61,6 +61,8 @@ data QuickCheckLevel = QC_Low | QC_Medium | QC_High | QC_Extensive deriving (Sho type QuickCheckTest = QuickCheckLevel -> IO () +type LabelledQuickCheckTest = (String, QuickCheckTest) + scaleQC :: Testable a => (Int,Int,Int,Int) -> a -> QuickCheckTest scaleQC (low,med,high,ext) test level = case level of