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 :: (Data a, Data b) => String -> a -> PassM b -> (State CompState ()) -> IO (CompState, Either Assertion Items)
|
||||||
testPassGetItems testName expected actualPass startStateTrans =
|
testPassGetItems testName expected actualPass startStateTrans =
|
||||||
--passResult :: Either String b
|
--passResult :: Either String b
|
||||||
do passResult <- runPass actualPass
|
do passResult <- runPass actualPass startState
|
||||||
case passResult of
|
case passResult of
|
||||||
(st,Left err) -> return (st, Left $ assertFailure (testName ++ "; pass actually failed: " ++ err) )
|
(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 )
|
(st,Right resultItem) -> return (st, transformEither (sequence_ . map (assertFailure . ((++) testName))) (id) $ getMatchedItems expected resultItem )
|
||||||
where
|
where
|
||||||
startState :: CompState
|
startState :: CompState
|
||||||
startState = execState startStateTrans emptyState
|
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
|
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:
|
--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
|
(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 :: String -> A.SpecType -> A.NameDef
|
||||||
simpleDef n sp = A.NameDef {A.ndMeta = m, A.ndName = n, A.ndOrigName = n, A.ndNameType = A.VariableName,
|
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}
|
A.ndType = sp, A.ndAbbrevMode = A.Original, A.ndPlacement = A.Unplaced}
|
||||||
|
|
Loading…
Reference in New Issue
Block a user