Rain: Added a helper function to the pass tests for tests that are expected to fail

This commit is contained in:
Neil Brown 2007-08-18 18:10:09 +00:00
parent 3f84532695
commit 3473c512a3

View File

@ -28,15 +28,16 @@ assertItemNotEqual msg exp (Just act) = assertNotEqual msg (ADI exp) act
testPassGetItems :: (Data a, Data b) => String -> a -> PassM b -> (State CompState ()) -> IO (CompState, Either Assertion Items)
testPassGetItems testName expected actualPass startStateTrans =
--passResult :: Either String b
do passResult <- runPass actualPass
do passResult <- runPass actualPass startState
case passResult of
(st,Left err) -> return (st, Left $ assertFailure (testName ++ "; pass actually failed: " ++ err) )
(st,Right resultItem) -> return (st, transformEither (sequence_ . map (assertFailure . ((++) testName))) (id) $ getMatchedItems expected resultItem )
where
startState :: CompState
startState = execState startStateTrans emptyState
runPass :: PassM b -> IO (CompState, Either String b)
runPass actualPass = (liftM (\(x,y) -> (y,x))) (runStateT (runErrorT actualPass) startState)
runPass :: PassM b -> CompState -> IO (CompState, Either String b)
runPass actualPass startState = (liftM (\(x,y) -> (y,x))) (runStateT (runErrorT actualPass) startState)
testPass :: (Data a, Data b) => String -> a -> PassM b -> (State CompState ()) -> Test
--If Items are returned by testPassGetItems we return () [i.e. give an empty assertion], otherwise give back the assertion:
@ -60,6 +61,14 @@ testPassWithStateCheck testName expected actualPass startStateTrans checkFunc =
(st,Right _) -> checkFunc st
)
testPassShouldFail :: (Show b, Data b) => String -> PassM b -> (State CompState ()) -> Test
testPassShouldFail testName actualPass startStateTrans = TestCase $
do ret <- runPass actualPass (execState startStateTrans emptyState)
case ret of
(_,Left err) -> return ()
_ -> assertFailure $ testName ++ " pass succeeded when expected to fail, data: " ++ (show ret)
simpleDef :: String -> A.SpecType -> A.NameDef
simpleDef n sp = A.NameDef {A.ndMeta = m, A.ndName = n, A.ndOrigName = n, A.ndNameType = A.VariableName,
A.ndType = sp, A.ndAbbrevMode = A.Original, A.ndPlacement = A.Unplaced}