diff --git a/backends/GenerateCTest.hs b/backends/GenerateCTest.hs index 64eb137..f469c40 100644 --- a/backends/GenerateCTest.hs +++ b/backends/GenerateCTest.hs @@ -48,7 +48,6 @@ import GenerateC import GenerateCBased import GenerateCPPCSP import Metadata -import Pass import TestUtils 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' :: 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. testBothS :: diff --git a/common/TestHarness.hs b/common/TestHarness.hs index 7b598ce..f4ea8c0 100644 --- a/common/TestHarness.hs +++ b/common/TestHarness.hs @@ -59,7 +59,7 @@ defaultState = emptyState {csUsageChecking = True} -- | 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 compilation defaultState +testOccam source = do (result,_) <- runWriterT $ evalStateT (runErrorT compilation) defaultState return $ case result of Left (_,err) -> Just err Right _ -> Nothing diff --git a/common/TestUtils.hs b/common/TestUtils.hs index 4874356..16856bc 100644 --- a/common/TestUtils.hs +++ b/common/TestUtils.hs @@ -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. -> 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. - -> 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 = --passResult :: Either String b do passResult <- runPass actualPass startState case passResult of - Left err -> return (Left $ testFailure (prefixErr $ "pass actually failed: " ++ show err)) - Right (st, resultItem) -> return (transformEither (mapM_ (testFailure . prefixErr)) (\y -> (st,y)) $ getMatchedItems expected resultItem) + (st, Left (_, err)) -> return (st, Left $ testFailure (prefixErr $ "pass actually failed: " ++ err)) + (st, Right resultItem) -> return (st, transformEither (mapM_ (testFailure . prefixErr)) (id) $ getMatchedItems expected resultItem) where startState :: CompState startState = execState startStateTrans emptyState @@ -494,8 +494,8 @@ testPassGetItems testName expected actualPass startStateTrans = runPass :: TestMonad m r => PassM b -- ^ The actual 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. -runPass actualPass startState = liftM (liftM (\(x,y,_) -> (y,x))) $ runIO (runPassM actualPass startState) + -> m (CompState, Either ErrorReport b) -- ^ The resultant state, and either an error or the successful outcome of the pass. +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. 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. -> m () --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 testPassWithCheck :: @@ -519,9 +519,9 @@ testPassWithCheck :: -> m () testPassWithCheck testName expected actualPass startStateTrans checkFunc = do passResult <- runPass actualPass (execState startStateTrans emptyState) - case passResult of - Left err -> testFailure (testName ++ "; pass actually failed: " ++ show err) - Right (_, result) -> (testPatternMatch testName expected result) >> (checkFunc result) + case snd passResult of + Left (_,err) -> testFailure (testName ++ "; pass actually failed: " ++ err) + 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. testPassWithItemsCheck :: @@ -533,11 +533,11 @@ testPassWithItemsCheck :: -> (Items -> m ()) -- ^ A function to check the 'Items' once the pass succeeds. -> m () testPassWithItemsCheck testName expected actualPass startStateTrans checkFunc = - testPassGetItems testName expected actualPass startStateTrans + ((liftM snd) (testPassGetItems testName expected actualPass startStateTrans)) >>= (\res -> case res of 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. @@ -550,11 +550,11 @@ testPassWithStateCheck :: -> (CompState -> m ()) -- ^ A function to check the 'CompState' once the pass succeeds. -> m () testPassWithStateCheck testName expected actualPass startStateTrans checkFunc = - testPassGetItems testName expected actualPass startStateTrans + (testPassGetItems testName expected actualPass startStateTrans) >>= (\x -> case x of - Left assert -> assert - Right (st, _) -> checkFunc st + (_,Left assert) -> assert + (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. @@ -567,11 +567,11 @@ testPassWithItemsStateCheck :: -> ((Items,CompState) -> m ()) -- ^ A function to check the 'Items' and 'CompState' once the pass succeeds. -> m () testPassWithItemsStateCheck testName expected actualPass startStateTrans checkFunc = - testPassGetItems testName expected actualPass startStateTrans + (testPassGetItems testName expected actualPass startStateTrans) >>= (\x -> case x of - Left assert -> assert - Right (st, items) -> checkFunc (items,st) + (_,Left assert) -> assert + (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. @@ -584,7 +584,7 @@ testPassShouldFail :: testPassShouldFail testName actualPass startStateTrans = do ret <- runPass actualPass (execState startStateTrans emptyState) case ret of - Left err -> return () + (_,Left err) -> return () Right (state, output) -> testFailure $ testName ++ " pass succeeded when expected to fail; output: " ++ pshow output --}}} diff --git a/frontends/RainTypesTest.hs b/frontends/RainTypesTest.hs index 9254abc..71f385f 100644 --- a/frontends/RainTypesTest.hs +++ b/frontends/RainTypesTest.hs @@ -448,7 +448,7 @@ checkExpressionTest = TestList if (e /= act) then pass' (10000 + n) t (mkPattern e) e else return () where 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