Changed TestHarness to support Rain test files as well as occam

This commit is contained in:
Neil Brown 2008-05-17 13:13:52 +00:00
parent 63a28d0044
commit 7d65db43c0
4 changed files with 40 additions and 26 deletions

View File

@ -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 "}}}"

View File

@ -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)

View File

@ -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 "<test>" 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")

View File

@ -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 ->