From 7d65db43c0a0c596baa72a871b0ca3be7cea6cff Mon Sep 17 00:00:00 2001 From: Neil Brown Date: Sat, 17 May 2008 13:13:52 +0000 Subject: [PATCH] Changed TestHarness to support Rain test files as well as occam --- Main.hs | 2 +- checks/ArrayUsageCheckTest.hs | 25 ++++++++++++++----------- common/TestHarness.hs | 30 +++++++++++++++++++++--------- frontends/ParseRain.hs | 9 ++++----- 4 files changed, 40 insertions(+), 26 deletions(-) diff --git a/Main.hs b/Main.hs index b31d1e5..c2fbf82 100644 --- a/Main.hs +++ b/Main.hs @@ -285,7 +285,7 @@ compile mode fn outHandle progress "Parse" ast1 <- case csFrontend optsPS of FrontendOccam -> preprocessOccamProgram fn >>= parseOccamProgram - FrontendRain -> parseRainProgram fn + FrontendRain -> liftIO (readFile fn) >>= parseRainProgram fn debugAST ast1 debug "}}}" diff --git a/checks/ArrayUsageCheckTest.hs b/checks/ArrayUsageCheckTest.hs index 9884637..1155745 100644 --- a/checks/ArrayUsageCheckTest.hs +++ b/checks/ArrayUsageCheckTest.hs @@ -34,6 +34,7 @@ import Test.QuickCheck hiding (check) import ArrayUsageCheck import qualified AST as A +import CompState import Metadata import Omega import ShowCode @@ -1163,17 +1164,19 @@ qcOmegaPrune = [("Omega Test Pruning", scaleQC (100,1000,10000,50000) prop)] ioqcTests :: IO (Test, [LabelledQuickCheckTest]) ioqcTests = seqPair - (liftM (TestLabel "ArrayUsageCheckTest" . TestList) $ sequence - [ - return testArrayCheck - ,return testIndexes - ,return testMakeEquations - ,automaticTest "testcases/automatic/usage-check-1.occ.test" - ,automaticTest "testcases/automatic/usage-check-2.occ.test" - ,automaticTest "testcases/automatic/usage-check-3.occ.test" - ,automaticTest "testcases/automatic/usage-check-4.occ.test" - ,automaticTest "testcases/automatic/usage-check-5.occ.test" - ] + (liftM (TestLabel "ArrayUsageCheckTest" . TestList) $ sequence $ + map return [ + testArrayCheck + ,testIndexes + ,testMakeEquations + ] + ++ map (automaticTest FrontendOccam) + ["testcases/automatic/usage-check-1.occ.test" + ,"testcases/automatic/usage-check-2.occ.test" + ,"testcases/automatic/usage-check-3.occ.test" + ,"testcases/automatic/usage-check-4.occ.test" + ,"testcases/automatic/usage-check-5.occ.test" + ] ,return $ qcOmegaEquality ++ qcOmegaPrune ++ qcTestMakeEquations) diff --git a/common/TestHarness.hs b/common/TestHarness.hs index a45a4ff..53b8a41 100644 --- a/common/TestHarness.hs +++ b/common/TestHarness.hs @@ -44,27 +44,39 @@ import Text.Regex import CompState import ParseOccam +import ParseRain import Pass import PassList import PreprocessOccam import Utils -automaticTest :: FilePath -> IO Test -automaticTest fileName = readFile fileName >>* performTest fileName +automaticTest :: CompFrontend -> FilePath -> IO Test +automaticTest fr fileName = readFile fileName >>* performTest fr fileName -- Bit of a hard-hack, until usage-checking is on by default: -defaultState :: CompState -defaultState = emptyState {csUsageChecking = True} +defaultState :: CompFrontend -> CompState +defaultState fr = emptyState {csUsageChecking = True, csFrontend = fr} -- | Tests if compiling the given source gives any errors. -- If there are errors, they are returned. Upon success, Nothing is returned testOccam :: String -> IO (Maybe String) -testOccam source = do (result,_,_) <- runPassM defaultState compilation +testOccam source = do (result,_,_) <- runPassM (defaultState FrontendOccam) compilation return $ case result of Left (_,err) -> Just err Right _ -> Nothing where - compilation = preprocessOccamSource source >>= parseOccamProgram >>= runPasses (getPassList defaultState) + compilation = preprocessOccamSource source + >>= parseOccamProgram + >>= runPasses (getPassList $ defaultState FrontendOccam) + +testRain :: String -> IO (Maybe String) +testRain source = do (result,_,_) <- runPassM (defaultState FrontendRain) compilation + return $ case result of + Left (_,err) -> Just err + Right _ -> Nothing + where + compilation = parseRainProgram "" source + >>= runPasses (getPassList $ defaultState FrontendRain) -- | Substitutes each substitution into the prologue substitute :: String -> [(Bool, Bool, String, String)] -> [(Bool, Bool, String, String)] @@ -72,8 +84,8 @@ substitute prologue = map (\(a,b,c,subst) -> (a,b,c,subRegex (mkRegex "%%") prol -- | Given a file's contents, tests it -performTest :: String -> String -> Test -performTest fileName fileContents +performTest :: CompFrontend -> String -> String -> Test +performTest fr fileName fileContents = case parseTestFile fileContents of Left err -> TestCase $ assertFailure $ "Error processing file \"" ++ fileName ++ "\": " ++ err Right (prologue,tests) -> TestLabel fileName $ TestList $ map performTest' (substitute prologue tests) @@ -82,7 +94,7 @@ performTest fileName fileContents performTest' :: (Bool, Bool, String, String) -> Test performTest' (expPass, _, testName, testText) = TestCase $ - do result <- testOccam testText + do result <- (if fr == FrontendOccam then testOccam else testRain) 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/frontends/ParseRain.hs b/frontends/ParseRain.hs index cffd5bb..655517f 100644 --- a/frontends/ParseRain.hs +++ b/frontends/ParseRain.hs @@ -498,11 +498,10 @@ rainTimerName :: A.Name rainTimerName = A.Name {A.nameName = ghostVarPrefix ++ "raintimer" ++ ghostVarSuffix, A.nameMeta = emptyMeta, A.nameType = A.TimerName} --- | Load and parse a Rain source file. -parseRainProgram :: String -> PassM A.AST -parseRainProgram filename - = do source <- liftIO $ readFile filename - lexOut <- liftIO $ L.runLexer filename source +-- | Parse Rain source text (with filename for error messages) +parseRainProgram :: FilePath -> String -> PassM A.AST +parseRainProgram filename source + = do lexOut <- liftIO $ L.runLexer filename source case lexOut of Left merr -> dieP merr $ "Parse (lexing) error" Right toks ->