diff --git a/TestMain.hs b/TestMain.hs index 538b6a3..5eeeaae 100644 --- a/TestMain.hs +++ b/TestMain.hs @@ -39,6 +39,7 @@ with this program. If not, see . -- * "RainUsageCheckTest" module TestMain () where +import Control.Monad import System.Console.GetOpt import System.Environment import Test.HUnit @@ -68,9 +69,10 @@ main = do opts <- getArgs >>* getOpt RequireOrder options ([Left unknownLevel], [], []) -> err ("Unknown level: " ++ unknownLevel) (_,_,errs) -> err (concat errs) - runTestTT hunitTests + hunitTests >>= runTestTT case qcLevel of - Just level -> sequence_ $ applyAll level qcTests + -- Monadic mess! + Just level -> join $ liftM sequence_ $ (liftM $ applyAll level) qcTests Nothing -> return () where err msg = ioError (userError (msg ++ usageInfo header options)) @@ -87,14 +89,16 @@ main = do opts <- getArgs >>* getOpt RequireOrder options "extensive" -> Right $ Just QC_Extensive unknown -> Left unknown - hunitTests = TestList $ map fst tests - qcTests = concatMap snd tests + hunitTests :: IO Test + hunitTests = sequence tests >>* (TestList . fst . unzip) + qcTests :: IO [QuickCheckTest] + qcTests = concatMapM (liftM snd) tests tests = [ ArrayUsageCheckTest.qcTests ,noqc BackendPassesTest.tests ,noqc CommonTest.tests - ,FlowGraphTest.qcTests + ,return FlowGraphTest.qcTests ,noqc GenerateCTest.tests ,noqc ParseRainTest.tests ,noqc PassTest.tests @@ -103,5 +107,6 @@ main = do opts <- getArgs >>* getOpt RequireOrder options ,noqc RainUsageCheckTest.tests ] - noqc :: Test -> (Test, [QuickCheckTest]) - noqc t = (t,[]) + noqc :: Test -> IO (Test, [QuickCheckTest]) + noqc t = return (t,[]) + diff --git a/common/TestHarness.hs b/common/TestHarness.hs index 01cf0ca..da99080 100644 --- a/common/TestHarness.hs +++ b/common/TestHarness.hs @@ -46,8 +46,8 @@ import PassList import PreprocessOccam import Utils -automaticTest :: FilePath -> Test -automaticTest fileName = TestCase $ readFile fileName >>= performTest +automaticTest :: FilePath -> IO Test +automaticTest fileName = readFile fileName >>* performTest -- Bit of a hard-hack, until usage-checking is on by default: defaultState :: CompState @@ -63,20 +63,21 @@ testOccam source = do result <- evalStateT (runErrorT compilation) defaultState where compilation = preprocessOccamSource source >>= parseOccamProgram >>= runPasses (getPassList defaultState) -- | Given a file's contents, tests it -performTest :: String -> Assertion +performTest :: String -> Test performTest fileName = case parseTestFile fileName of - Left err -> assertFailure $ "Error processing file \"" ++ fileName ++ "\": " ++ err - Right (prologue,tests) -> mapM_ performTest' (substitute prologue tests) + Left err -> TestCase $ assertFailure $ "Error processing file \"" ++ fileName ++ "\": " ++ err + Right (prologue,tests) -> TestList $ map performTest' (substitute prologue tests) where -- Substitutes each substitution into the prologue substitute :: String -> [(Bool, String, String)] -> [(Bool, String, String)] substitute prologue = map (\(a,b,subst) -> (a,b,subRegex (mkRegex "%%") prologue subst)) - performTest' :: (Bool, String, String) -> Assertion + performTest' :: (Bool, String, String) -> Test performTest' (expPass, testName, testText) - = do result <- testOccam testText + = TestCase $ + do result <- testOccam testText case result of Just err -> if expPass then assertFailure (testName ++ " failed with error: " ++ err) else return () Nothing -> if expPass then return () else assertFailure (testName ++ " expected to fail but passed") diff --git a/transformations/ArrayUsageCheckTest.hs b/transformations/ArrayUsageCheckTest.hs index 6f099b9..77b28e7 100644 --- a/transformations/ArrayUsageCheckTest.hs +++ b/transformations/ArrayUsageCheckTest.hs @@ -31,7 +31,6 @@ import Test.QuickCheck hiding (check) import ArrayUsageCheck import qualified AST as A -import PrettyShow import TestHarness import TestUtils hiding (m) import Utils @@ -713,15 +712,18 @@ qcOmegaPrune = [scaleQC (100,1000,10000,50000) prop] result = undefined -- TODO replace solveAndPrune: solveProblem [] inp -} -qcTests :: (Test, [QuickCheckTest]) -qcTests = (TestList - [ - testArrayCheck - ,testIndexes - ,testMakeEquations - ,automaticTest "testcases/automatic/usage-check-1.occ.test" - ] - ,qcOmegaEquality ++ qcOmegaPrune) +qcTests :: IO (Test, [QuickCheckTest]) +qcTests + = do usageCheckTest <- automaticTest "testcases/automatic/usage-check-1.occ.test" + return + (TestList + [ + testArrayCheck + ,testIndexes + ,testMakeEquations + ,usageCheckTest + ] + ,qcOmegaEquality ++ qcOmegaPrune)