Rain: Added a helper function to the pass tests for tests that are expected to fail
This commit is contained in:
parent
3f84532695
commit
3473c512a3
|
@ -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}
|
||||
|
|
Loading…
Reference in New Issue
Block a user