suzanne.soy/tock-mirror
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Corrected all the tests to use the new PassM monad

Browse Source
This commit is contained in:
Neil Brown 2008-03-10 17:07:48 +00:00
parent d66fb79796
commit 20843f70a4
4 changed files with 21 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
backends/GenerateCTest.hs
View File

@ -48,7 +48,6 @@ import GenerateC
import GenerateCBased import GenerateCBased
import GenerateCPPCSP import GenerateCPPCSP
import Metadata import Metadata
import Pass
import TestUtils import TestUtils
import Utils import Utils
@ -110,7 +109,7 @@ evalCGen :: CGen () -> GenOps -> CompState -> IO (Either Errors.ErrorReport [Str
evalCGen act ops state = evalCGen' (runReaderT act ops) state evalCGen act ops state = evalCGen' (runReaderT act ops) state
evalCGen' :: CGen' () -> CompState -> IO (Either Errors.ErrorReport [String]) evalCGen' :: CGen' () -> CompState -> IO (Either Errors.ErrorReport [String])
evalCGen' act state = runPassM (execStateT act (Left []) >>* (\(Left x) -> x)) state >>* transformEither id (\(x,_,_) -> x) evalCGen' act state = runWriterT (evalStateT (runErrorT $ execStateT act (Left []) >>* (\(Left x) -> x)) state) >>* fst
-- | Checks that running the test for the C and C++ backends produces the right output for each. -- | Checks that running the test for the C and C++ backends produces the right output for each.
testBothS :: testBothS ::

2
common/TestHarness.hs
View File

@ -59,7 +59,7 @@ defaultState = emptyState {csUsageChecking = True}
-- | Tests if compiling the given source gives any errors. -- | Tests if compiling the given source gives any errors.
-- If there are errors, they are returned. Upon success, Nothing is returned -- If there are errors, they are returned. Upon success, Nothing is returned
testOccam :: String -> IO (Maybe String) testOccam :: String -> IO (Maybe String)
testOccam source = do result <- runPassM compilation defaultState testOccam source = do (result,_) <- runWriterT $ evalStateT (runErrorT compilation) defaultState
return $ case result of return $ case result of
Left (_,err) -> Just err Left (_,err) -> Just err
Right _ -> Nothing Right _ -> Nothing

36
common/TestUtils.hs
View File

@ -475,13 +475,13 @@ testPassGetItems ::
-> a -- ^ The expected outcome of the pass. Will be used as a 'Pattern', to find the named items in the result of the pass. -> a -- ^ The expected outcome of the pass. Will be used as a 'Pattern', to find the named items in the result of the pass.
-> PassM b -- ^ The actual pass. -> PassM b -- ^ The actual pass.
-> (State CompState ()) -- ^ A function to transform a 'CompState'. Will be used on the 'emptyState' to get the initial state for the pass. -> (State CompState ()) -- ^ A function to transform a 'CompState'. Will be used on the 'emptyState' to get the initial state for the pass.
-> m (Either (m ()) (CompState, Items)) -- ^ Returns the state, along with either an 'Assertion' (if the pass fails) or the 'Items' (if the pass succeeds). -> m (CompState, Either (m ()) Items) -- ^ Returns the state, along with either an 'Assertion' (if the pass fails) or the 'Items' (if the pass succeeds).
testPassGetItems testName expected actualPass startStateTrans = testPassGetItems testName expected actualPass startStateTrans =
--passResult :: Either String b --passResult :: Either String b
do passResult <- runPass actualPass startState do passResult <- runPass actualPass startState
case passResult of case passResult of
Left err -> return (Left $ testFailure (prefixErr $ "pass actually failed: " ++ show err)) (st, Left (_, err)) -> return (st, Left $ testFailure (prefixErr $ "pass actually failed: " ++ err))
Right (st, resultItem) -> return (transformEither (mapM_ (testFailure . prefixErr)) (\y -> (st,y)) $ getMatchedItems expected resultItem) (st, Right resultItem) -> return (st, transformEither (mapM_ (testFailure . prefixErr)) (id) $ getMatchedItems expected resultItem)
where where
startState :: CompState startState :: CompState
startState = execState startStateTrans emptyState startState = execState startStateTrans emptyState
@ -494,8 +494,8 @@ testPassGetItems testName expected actualPass startStateTrans =
runPass :: TestMonad m r => runPass :: TestMonad m r =>
PassM b -- ^ The actual pass. PassM b -- ^ The actual pass.
-> CompState -- ^ The state to use to run the pass. -> CompState -- ^ The state to use to run the pass.
-> m (Either ErrorReport (CompState, b)) -- ^ The resultant state, and either an error or the successful outcome of the pass. -> m (CompState, Either ErrorReport b) -- ^ The resultant state, and either an error or the successful outcome of the pass.
runPass actualPass startState = liftM (liftM (\(x,y,_) -> (y,x))) $ runIO (runPassM actualPass startState) runPass actualPass startState = liftM (\((x,y),_) -> (y,x)) $ runIO (runWriterT $ runStateT (runErrorT actualPass) startState)
-- | A test that runs a given AST pass and checks that it succeeds. -- | A test that runs a given AST pass and checks that it succeeds.
testPass :: testPass ::
@ -506,7 +506,7 @@ testPass ::
-> (State CompState ()) -- ^ A function to transform a 'CompState'. Will be used on the 'emptyState' to get the initial state for the pass. -> (State CompState ()) -- ^ A function to transform a 'CompState'. Will be used on the 'emptyState' to get the initial state for the pass.
-> m () -> m ()
--If Items are returned by testPassGetItems we return () [i.e. give an empty assertion], otherwise give back the assertion: --If Items are returned by testPassGetItems we return () [i.e. give an empty assertion], otherwise give back the assertion:
testPass w x y z = join $ liftM (either (id) (\x -> return ())) $ testPassGetItems w x y z testPass w x y z = join $ liftM (either (id) (\x -> return ())) $ (liftM snd) $ (testPassGetItems w x y z)
-- | A test that runs a given AST pass and checks that it succeeds, and performs an additional check on the result -- | A test that runs a given AST pass and checks that it succeeds, and performs an additional check on the result
testPassWithCheck :: testPassWithCheck ::
@ -519,9 +519,9 @@ testPassWithCheck ::
-> m () -> m ()
testPassWithCheck testName expected actualPass startStateTrans checkFunc = testPassWithCheck testName expected actualPass startStateTrans checkFunc =
do passResult <- runPass actualPass (execState startStateTrans emptyState) do passResult <- runPass actualPass (execState startStateTrans emptyState)
case passResult of case snd passResult of
Left err -> testFailure (testName ++ "; pass actually failed: " ++ show err) Left (_,err) -> testFailure (testName ++ "; pass actually failed: " ++ err)
Right (_, result) -> (testPatternMatch testName expected result) >> (checkFunc result) Right result -> (testPatternMatch testName expected result) >> (checkFunc result)
-- | A test that runs a given AST pass, checks that it succeeds, and checks the resulting 'Items' with a given function. -- | A test that runs a given AST pass, checks that it succeeds, and checks the resulting 'Items' with a given function.
testPassWithItemsCheck :: testPassWithItemsCheck ::
@ -533,11 +533,11 @@ testPassWithItemsCheck ::
-> (Items -> m ()) -- ^ A function to check the 'Items' once the pass succeeds. -> (Items -> m ()) -- ^ A function to check the 'Items' once the pass succeeds.
-> m () -> m ()
testPassWithItemsCheck testName expected actualPass startStateTrans checkFunc = testPassWithItemsCheck testName expected actualPass startStateTrans checkFunc =
testPassGetItems testName expected actualPass startStateTrans ((liftM snd) (testPassGetItems testName expected actualPass startStateTrans))
>>= (\res -> >>= (\res ->
case res of case res of
Left assert -> assert Left assert -> assert
Right (_, items) -> checkFunc items Right items -> checkFunc items
) )
-- | A test that runs a given AST pass, checks that it succeeds, and checks the resulting 'CompState' with a given function. -- | A test that runs a given AST pass, checks that it succeeds, and checks the resulting 'CompState' with a given function.
@ -550,11 +550,11 @@ testPassWithStateCheck ::
-> (CompState -> m ()) -- ^ A function to check the 'CompState' once the pass succeeds. -> (CompState -> m ()) -- ^ A function to check the 'CompState' once the pass succeeds.
-> m () -> m ()
testPassWithStateCheck testName expected actualPass startStateTrans checkFunc = testPassWithStateCheck testName expected actualPass startStateTrans checkFunc =
testPassGetItems testName expected actualPass startStateTrans (testPassGetItems testName expected actualPass startStateTrans)
>>= (\x -> >>= (\x ->
case x of case x of
Left assert -> assert (_,Left assert) -> assert
Right (st, _) -> checkFunc st (st,Right _) -> checkFunc st
) )
-- | A test that runs a given AST pass, checks that it succeeds, and checks the resulting 'CompState' and 'Items' with a given function. -- | A test that runs a given AST pass, checks that it succeeds, and checks the resulting 'CompState' and 'Items' with a given function.
@ -567,11 +567,11 @@ testPassWithItemsStateCheck ::
-> ((Items,CompState) -> m ()) -- ^ A function to check the 'Items' and 'CompState' once the pass succeeds. -> ((Items,CompState) -> m ()) -- ^ A function to check the 'Items' and 'CompState' once the pass succeeds.
-> m () -> m ()
testPassWithItemsStateCheck testName expected actualPass startStateTrans checkFunc = testPassWithItemsStateCheck testName expected actualPass startStateTrans checkFunc =
testPassGetItems testName expected actualPass startStateTrans (testPassGetItems testName expected actualPass startStateTrans)
>>= (\x -> >>= (\x ->
case x of case x of
Left assert -> assert (_,Left assert) -> assert
Right (st, items) -> checkFunc (items,st) (st,Right items) -> checkFunc (items,st)
) )
-- | A test that checks that a given AST pass fails. If the pass fails, the test succeeds. If the pass succeeds, the test fails. -- | A test that checks that a given AST pass fails. If the pass fails, the test succeeds. If the pass succeeds, the test fails.
@ -584,7 +584,7 @@ testPassShouldFail ::
testPassShouldFail testName actualPass startStateTrans = testPassShouldFail testName actualPass startStateTrans =
do ret <- runPass actualPass (execState startStateTrans emptyState) do ret <- runPass actualPass (execState startStateTrans emptyState)
case ret of case ret of
Left err -> return () (_,Left err) -> return ()
Right (state, output) -> testFailure $ testName ++ " pass succeeded when expected to fail; output: " ++ pshow output Right (state, output) -> testFailure $ testName ++ " pass succeeded when expected to fail; output: " ++ pshow output
--}}} --}}}

2
frontends/RainTypesTest.hs
View File

@ -448,7 +448,7 @@ checkExpressionTest = TestList
if (e /= act) then pass' (10000 + n) t (mkPattern e) e else return () if (e /= act) then pass' (10000 + n) t (mkPattern e) e else return ()
where where
errorOrType :: IO (Either ErrorReport A.Type) errorOrType :: IO (Either ErrorReport A.Type)
errorOrType = runPassM (typeOfExpression e) (execState state emptyState) >>* transformEither id (\(x,_,_) -> x) errorOrType = ((runWriterT (evalStateT (runErrorT $ typeOfExpression e) (execState state emptyState))) :: IO (Either ErrorReport A.Type, [WarningReport])) >>* fst
fail :: Int -> ExprHelper -> Test fail :: Int -> ExprHelper -> Test