From 337f189b8a82e3f454165c82b8f23f513de52848 Mon Sep 17 00:00:00 2001 From: Neil Brown Date: Thu, 13 Dec 2007 18:21:53 +0000 Subject: [PATCH] Separated the QuickCheck tests from the HUnit tests and made the number of test-cases configurable for the QuickCheck tests --- TestMain.hs | 43 ++++++++++++++++++--------- common/FlowGraphTest.hs | 34 ++++++++++++++------- transformations/RainUsageCheckTest.hs | 12 ++++---- 3 files changed, 58 insertions(+), 31 deletions(-) diff --git a/TestMain.hs b/TestMain.hs index 2ff033b..deae160 100644 --- a/TestMain.hs +++ b/TestMain.hs @@ -41,25 +41,40 @@ import Test.HUnit import qualified BackendPassesTest (tests) import qualified CommonTest (tests) -import qualified FlowGraphTest (tests) +import qualified FlowGraphTest (qcTests) import qualified GenerateCTest (tests) import qualified ParseRainTest (tests) import qualified PassTest (tests) import qualified RainPassesTest (tests) import qualified RainTypesTest (tests) -import qualified RainUsageCheckTest (tests) +import qualified RainUsageCheckTest (qcTests) +import TestUtil +import Utils +-- We run all the HUnit tests before all the QuickCheck tests. +-- We run them apart so that the output from QuickCheck doesn't get +-- confusing by being amongst the HUnit output, +-- and we run HUnit first because these are typically the more +-- interesting (and most worked on tests) so we see failures earlier. main :: IO () -main = do runTestTT $ TestList - [ - BackendPassesTest.tests - ,CommonTest.tests - ,FlowGraphTest.tests - ,GenerateCTest.tests - ,ParseRainTest.tests - ,PassTest.tests - ,RainPassesTest.tests - ,RainTypesTest.tests - ,RainUsageCheckTest.tests - ] +main = do runTestTT hunitTests + sequence $ applyAll QC_Medium qcTests return () + where + hunitTests = TestList $ map fst tests + qcTests = concatMap snd tests + + tests = [ + noqc BackendPassesTest.tests + ,noqc CommonTest.tests + ,FlowGraphTest.qcTests + ,noqc GenerateCTest.tests + ,noqc ParseRainTest.tests + ,noqc PassTest.tests + ,noqc RainPassesTest.tests + ,noqc RainTypesTest.tests + ,RainUsageCheckTest.qcTests + ] + + noqc :: Test -> (Test, [QuickCheckTest]) + noqc t = (t,[]) diff --git a/common/FlowGraphTest.hs b/common/FlowGraphTest.hs index ae9857d..517cdf4 100644 --- a/common/FlowGraphTest.hs +++ b/common/FlowGraphTest.hs @@ -19,7 +19,7 @@ with this program. If not, see . -- #ignore-exports -- | A module for testing building a control flow-graph from an AST. -module FlowGraphTest (tests) where +module FlowGraphTest (qcTests) where import Control.Monad.Identity import Control.Monad.State @@ -30,7 +30,7 @@ import Data.List import qualified Data.Map as Map import Data.Maybe import System.Random -import Test.HUnit hiding (Node, State) +import Test.HUnit hiding (Node, State, Testable) import Test.QuickCheck import qualified AST as A @@ -554,14 +554,25 @@ pickFuncRep gr = Map.fromList $ map (helpApplyFunc . getMetaFunc) (labNodes gr) -- | It is important to have these functions in the right ratio. The number of possible trees is -- 2^N, where N is the test size. Therefore I suggest keeping N <= 10 as a sensible limit. -- Hence, if there are 1000 tests, we divide the test number by 100 to get the test size. -deepCheck p = check (defaultConfig { configMaxTest = 1000, configSize = \x -> div x 100}) p +configForSize :: Int -> Config +configForSize n = defaultConfig { configMaxTest = n, configSize = \x -> x `div` scale } + where + scale = n `div` 10 -testModify :: Test -testModify = TestList +deepCheck :: Testable a => a -> QuickCheckTest +deepCheck test level = (flip check) test $ configForSize $ + case level of + QC_Low -> 100 + QC_Medium -> 1000 + QC_High -> 5000 + QC_Extensive -> 10000 + +testModify :: [QuickCheckTest] +testModify = [ - TestCase $ deepCheck prop_Id - ,TestCase $ deepCheck prop_Rep - ,TestCase $ deepCheck prop_gennums + deepCheck prop_Id + ,deepCheck prop_Rep + ,deepCheck prop_gennums ] where -- | Checks that applying any set (from the powerset of identity functions) of identity functions @@ -598,13 +609,14 @@ testModify = TestList collectAll' r0 r1 | ok r0 == Just False = r0 | otherwise = r1 -- | Returns the list of tests: -tests :: Test -tests = TestList +qcTests :: (Test, [QuickCheckTest]) +qcTests = (TestList [ testCase ,testIf - ,testModify ,testPar ,testSeq ,testWhile ] + ,testModify) + diff --git a/transformations/RainUsageCheckTest.hs b/transformations/RainUsageCheckTest.hs index 7ab2f3c..4d3495f 100644 --- a/transformations/RainUsageCheckTest.hs +++ b/transformations/RainUsageCheckTest.hs @@ -16,7 +16,7 @@ You should have received a copy of the GNU General Public License along with this program. If not, see . -} -module RainUsageCheckTest (tests) where +module RainUsageCheckTest (qcTests) where import Control.Monad.Identity import Data.Graph.Inductive @@ -397,8 +397,8 @@ generateProblem = (choose (1,10) >>= (\n -> replicateM n $ choose (-20,20)) >>= instance Arbitrary OmegaTestInput where arbitrary = generateProblem -qcOmegaEquality :: Test -qcOmegaEquality = TestCase $ check (defaultConfig { configMaxTest = 1000}) prop +qcOmegaEquality :: [QuickCheckTest] +qcOmegaEquality = [scaleQC (40,200,2000,10000) prop] where prop (OMI (eq,ineq)) = omegaCheck actAnswer where @@ -406,16 +406,16 @@ qcOmegaEquality = TestCase $ check (defaultConfig { configMaxTest = 1000}) prop omegaCheck (Just ineqs) = all (all (== 0) . elems) ineqs omegaCheck Nothing = False -tests :: Test -tests = TestList +qcTests :: (Test, [QuickCheckTest]) +qcTests = (TestList [ testGetVarProc ,testInitVar -- ,testParUsageCheck ,testReachDef ,testArrayCheck - ,qcOmegaEquality ] + ,qcOmegaEquality)