Moved a bunch of functions from RainPassTest to TestUtil, so that they can be re-used
This commit is contained in:
Neil Brown
parent
c4a04675ad
commit
e38d29f43d
|
|
@ -33,60 +33,6 @@ import Pass
|
|||
import Data.Generics
|
||||
import Utils
|
||||
|
||||
-- | Helper function that checks two items in the Items set (by two given keys) are not the same
|
||||
assertItemNotSame :: String -> Items -> String -> String -> Assertion
|
||||
assertItemNotSame msg items key0 key1 = assertNotEqual msg ((Map.lookup key0 items) :: Maybe AnyDataItem) ((Map.lookup key1 items) :: Maybe AnyDataItem)
|
||||
|
||||
-- | Helper function that checks if a looked-up value is what was expected
|
||||
assertItemNotEqual :: Data a => String -> a -> Maybe AnyDataItem -> Assertion
|
||||
assertItemNotEqual msg _ Nothing = assertFailure $ msg ++ " item not matched!"
|
||||
--Putting x into ADI wrapper and using the Eq instance for AnyDataItem is easier than taking y out and checking the data types match:
|
||||
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 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 -> 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:
|
||||
testPass w x y z = TestCase $ join $ liftM (either (id) (\x -> return ())) $ (liftM snd) $ (testPassGetItems w x y z)
|
||||
|
||||
testPassWithCheck :: (Data a, Data b) => String -> a -> PassM b -> (State CompState ()) -> (Items -> Assertion) -> Test
|
||||
testPassWithCheck testName expected actualPass startStateTrans checkFunc = TestCase $
|
||||
((liftM snd) (testPassGetItems testName expected actualPass startStateTrans))
|
||||
>>= (\res ->
|
||||
case res of
|
||||
Left assert -> assert
|
||||
Right items -> checkFunc items
|
||||
)
|
||||
|
||||
testPassWithStateCheck :: (Data a, Data b) => String -> a -> PassM b -> (State CompState ()) -> (CompState -> Assertion) -> Test
|
||||
testPassWithStateCheck testName expected actualPass startStateTrans checkFunc = TestCase $
|
||||
(testPassGetItems testName expected actualPass startStateTrans)
|
||||
>>= (\x ->
|
||||
case x of
|
||||
(_,Left assert) -> assert
|
||||
(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}
|
||||
|
|
@ -189,13 +135,6 @@ testUnique2 = testPassWithCheck "testUnique2" exp (uniquifyAndResolveVars orig)
|
|||
(tag2 A.OnlyP m $ tag3 A.Assign DontCare [tag2 A.Variable DontCare (Named "newc" DontCare)] (tag2 A.ExpressionList DontCare [(exprVariable "d")]))
|
||||
check items = assertItemNotEqual "testUnique2: Variable was not made unique" (simpleName "c") (Map.lookup "newc" items)
|
||||
|
||||
assertVarDef :: Data a => String -> CompState -> String -> a -> Assertion
|
||||
assertVarDef prefix state varName varDef
|
||||
= case (Map.lookup varName (csNames state)) of
|
||||
Nothing -> assertFailure $ prefix ++ " variable was not recorded: " ++ varName
|
||||
Just actVarDef -> assertPatternMatch (prefix ++ " variable definition not as expected for " ++ varName) varDef actVarDef
|
||||
|
||||
|
||||
testRecordDeclNames0 :: Test
|
||||
testRecordDeclNames0 = testPassWithStateCheck "testRecordDeclNames0" exp (recordDeclNameTypes orig) (return ()) check
|
||||
where
|
||||
|
|
|
|||
79
TestUtil.hs
79
TestUtil.hs
|
|
@ -21,7 +21,15 @@ module TestUtil where
|
|||
import qualified AST as A
|
||||
import Metadata (Meta,emptyMeta)
|
||||
import Monad
|
||||
import Test.HUnit
|
||||
import Test.HUnit hiding (State)
|
||||
import Data.Generics
|
||||
import TreeUtil
|
||||
import Control.Monad.State
|
||||
import Control.Monad.Error
|
||||
import Pass
|
||||
import CompState
|
||||
import Utils
|
||||
import qualified Data.Map as Map
|
||||
|
||||
m :: Meta
|
||||
m = emptyMeta
|
||||
|
|
@ -74,3 +82,72 @@ assertCompareCustom preface cmp expected actual =
|
|||
|
||||
assertNotEqual :: (Show a,Eq a) => String -> a -> a -> Assertion
|
||||
assertNotEqual msg = assertCompareCustom msg (/=)
|
||||
|
||||
-- | Helper function that checks two items in the Items set (by two given keys) are not the same
|
||||
assertItemNotSame :: String -> Items -> String -> String -> Assertion
|
||||
assertItemNotSame msg items key0 key1 = assertNotEqual msg ((Map.lookup key0 items) :: Maybe AnyDataItem) ((Map.lookup key1 items) :: Maybe AnyDataItem)
|
||||
|
||||
-- | Helper function that checks if a looked-up value is what was expected
|
||||
assertItemNotEqual :: Data a => String -> a -> Maybe AnyDataItem -> Assertion
|
||||
assertItemNotEqual msg _ Nothing = assertFailure $ msg ++ " item not matched!"
|
||||
--Putting x into ADI wrapper and using the Eq instance for AnyDataItem is easier than taking y out and checking the data types match:
|
||||
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 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 -> 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:
|
||||
testPass w x y z = TestCase $ join $ liftM (either (id) (\x -> return ())) $ (liftM snd) $ (testPassGetItems w x y z)
|
||||
|
||||
testPassWithCheck :: (Data a, Data b) => String -> a -> PassM b -> (State CompState ()) -> (Items -> Assertion) -> Test
|
||||
testPassWithCheck testName expected actualPass startStateTrans checkFunc = TestCase $
|
||||
((liftM snd) (testPassGetItems testName expected actualPass startStateTrans))
|
||||
>>= (\res ->
|
||||
case res of
|
||||
Left assert -> assert
|
||||
Right items -> checkFunc items
|
||||
)
|
||||
|
||||
testPassWithStateCheck :: (Data a, Data b) => String -> a -> PassM b -> (State CompState ()) -> (CompState -> Assertion) -> Test
|
||||
testPassWithStateCheck testName expected actualPass startStateTrans checkFunc = TestCase $
|
||||
(testPassGetItems testName expected actualPass startStateTrans)
|
||||
>>= (\x ->
|
||||
case x of
|
||||
(_,Left assert) -> assert
|
||||
(st,Right _) -> checkFunc st
|
||||
)
|
||||
|
||||
testPassWithItemsStateCheck :: (Data a, Data b) => String -> a -> PassM b -> (State CompState ()) -> ((Items,CompState) -> Assertion) -> Test
|
||||
testPassWithItemsStateCheck testName expected actualPass startStateTrans checkFunc = TestCase $
|
||||
(testPassGetItems testName expected actualPass startStateTrans)
|
||||
>>= (\x ->
|
||||
case x of
|
||||
(_,Left assert) -> assert
|
||||
(st,Right items) -> checkFunc (items,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)
|
||||
|
||||
|
||||
assertVarDef :: Data a => String -> CompState -> String -> a -> Assertion
|
||||
assertVarDef prefix state varName varDef
|
||||
= case (Map.lookup varName (csNames state)) of
|
||||
Nothing -> assertFailure $ prefix ++ " variable was not recorded: " ++ varName
|
||||
Just actVarDef -> assertPatternMatch (prefix ++ " variable definition not as expected for " ++ varName) varDef actVarDef
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user