Added Haddock documentation to all the functions in TestUtil, and tweaked the type of assertVarDef
This commit is contained in:
parent
ffb75e0fc7
commit
6a22e37589
162
TestUtil.hs
162
TestUtil.hs
|
@ -16,6 +16,26 @@ You should have received a copy of the GNU General Public License along
|
||||||
with this program. If not, see <http://www.gnu.org/licenses/>.
|
with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||||
-}
|
-}
|
||||||
|
|
||||||
|
{-|
|
||||||
|
|
||||||
|
This TestUtil module contains useful helper functions for testing. Examples of their use can be found in 'RainPassTest' and 'RainParseTest'.
|
||||||
|
Unless otherwise stated, all functions use empty meta tags (see 'emptyMeta').
|
||||||
|
|
||||||
|
See also the 'TreeUtil.assertPatternMatch' function.
|
||||||
|
|
||||||
|
|
||||||
|
The Tock test framework is built on top of HUnit. HUnit is a very simple test framework that is supplied by default with GHC:
|
||||||
|
<http://www.haskell.org/ghc/docs/latest/html/libraries/HUnit/Test-HUnit-Base.html>. The only useful things to know are that:
|
||||||
|
|
||||||
|
> Assertion :: IO ()
|
||||||
|
> assertFailure :: String -> Assertion
|
||||||
|
> assertEqual :: (Eq a, Show a) => String -> a -> a -> Assertion
|
||||||
|
|
||||||
|
'assertFailure' is an assertion that fails with the given text message. 'assertEqual' checks if two things of the same type are equal.
|
||||||
|
If they are not equal, it shows them (using 'show') with the given message prefixed.
|
||||||
|
|
||||||
|
-}
|
||||||
|
|
||||||
module TestUtil where
|
module TestUtil where
|
||||||
|
|
||||||
import qualified AST as A
|
import qualified AST as A
|
||||||
|
@ -32,32 +52,45 @@ import CompState
|
||||||
import Utils
|
import Utils
|
||||||
import qualified Data.Map as Map
|
import qualified Data.Map as Map
|
||||||
|
|
||||||
|
-- | An abbreviation for using 'emptyMeta'. TODO: This should really be removed (and all uses of it replaced with 'emptyMeta') for clarity.
|
||||||
m :: Meta
|
m :: Meta
|
||||||
m = emptyMeta
|
m = emptyMeta
|
||||||
|
|
||||||
--Helper function for creating an A.Name object:
|
-- | Creates a 'A.Name' object with the given 'String' as 'A.nameName', and 'A.nameType' as 'A.VariableName'.
|
||||||
simpleName :: String -> A.Name
|
simpleName :: String -> A.Name
|
||||||
simpleName s = A.Name { A.nameName = s , A.nameMeta = emptyMeta , A.nameType = A.VariableName }
|
simpleName s = A.Name { A.nameName = s , A.nameMeta = emptyMeta , A.nameType = A.VariableName }
|
||||||
|
|
||||||
|
-- | Creates a 'A.Name' object with the given 'String' as 'A.nameName', and 'A.nameType' as 'A.ProcName'.
|
||||||
procName :: String -> A.Name
|
procName :: String -> A.Name
|
||||||
procName s = A.Name { A.nameName = s , A.nameMeta = emptyMeta , A.nameType = A.ProcName }
|
procName s = A.Name { A.nameName = s , A.nameMeta = emptyMeta , A.nameType = A.ProcName }
|
||||||
|
|
||||||
|
-- | Creates a 'A.Name' object with the given 'String' as 'A.nameName', and 'A.nameType' as 'A.DataTypeName'.
|
||||||
typeName :: String -> A.Name
|
typeName :: String -> A.Name
|
||||||
typeName s = A.Name { A.nameName = s , A.nameMeta = emptyMeta , A.nameType = A.DataTypeName }
|
typeName s = A.Name { A.nameName = s , A.nameMeta = emptyMeta , A.nameType = A.DataTypeName }
|
||||||
|
|
||||||
|
-- | Creates a 'Pattern' to match a 'A.Name' instance.
|
||||||
|
-- @'assertPatternMatch' ('simpleNamePattern' x) ('simpleName' x)@ will always succeed.
|
||||||
|
-- All meta tags are ignored.
|
||||||
simpleNamePattern :: String -> Pattern
|
simpleNamePattern :: String -> Pattern
|
||||||
simpleNamePattern s = tag3 A.Name DontCare A.VariableName s
|
simpleNamePattern s = tag3 A.Name DontCare A.VariableName s
|
||||||
|
|
||||||
|
-- | Creates a 'Pattern' to match a 'A.Name' instance.
|
||||||
|
-- @'assertPatternMatch' ('procNamePattern' x) ('procName' x)@ will always succeed.
|
||||||
|
-- All meta tags are ignored.
|
||||||
procNamePattern :: String -> Pattern
|
procNamePattern :: String -> Pattern
|
||||||
procNamePattern s = tag3 A.Name DontCare A.ProcName s
|
procNamePattern s = tag3 A.Name DontCare A.ProcName s
|
||||||
|
|
||||||
|
-- | Creates a 'A.Variable' with the given 'String' as the name.
|
||||||
variable :: String -> A.Variable
|
variable :: String -> A.Variable
|
||||||
variable e = A.Variable emptyMeta $ simpleName e
|
variable e = A.Variable emptyMeta $ simpleName e
|
||||||
|
|
||||||
|
-- | Creates a 'Pattern' to match a 'A.Variable' instance.
|
||||||
|
-- @'assertPatternMatch' ('variablePattern' x) ('variable' x)@ will always succeed.
|
||||||
|
-- All meta tags are ignored.
|
||||||
variablePattern :: String -> Pattern
|
variablePattern :: String -> Pattern
|
||||||
variablePattern e = tag2 A.Variable DontCare (simpleNamePattern e)
|
variablePattern e = tag2 A.Variable DontCare (simpleNamePattern e)
|
||||||
|
|
||||||
--Helper function for creating a simple variable name as an expression:
|
-- | Creates an 'A.Expression' that has the 'A.ExprVariable' constructor with the given 'String' as the variable name.
|
||||||
exprVariable :: String -> A.Expression
|
exprVariable :: String -> A.Expression
|
||||||
exprVariable e = A.ExprVariable emptyMeta $ variable e
|
exprVariable e = A.ExprVariable emptyMeta $ variable e
|
||||||
|
|
||||||
|
@ -65,62 +98,115 @@ exprVariable e = A.ExprVariable emptyMeta $ variable e
|
||||||
exprDirVariable :: A.Direction -> String -> A.Expression
|
exprDirVariable :: A.Direction -> String -> A.Expression
|
||||||
exprDirVariable dir e = A.ExprVariable emptyMeta $ A.DirectedVariable emptyMeta dir $ variable e
|
exprDirVariable dir e = A.ExprVariable emptyMeta $ A.DirectedVariable emptyMeta dir $ variable e
|
||||||
|
|
||||||
|
-- | Creates a 'Pattern' to match an 'A.Expression' instance.
|
||||||
|
-- @'assertPatternMatch' ('exprVariablePattern' x) ('exprVariable' x)@ will always succeed.
|
||||||
|
-- All meta tags are ignored.
|
||||||
exprVariablePattern :: String -> Pattern
|
exprVariablePattern :: String -> Pattern
|
||||||
exprVariablePattern e = tag2 A.ExprVariable DontCare $ variablePattern e
|
exprVariablePattern e = tag2 A.ExprVariable DontCare $ variablePattern e
|
||||||
|
|
||||||
|
-- | Creates an integer literal 'A.Expression' with the given integer.
|
||||||
intLiteral :: Integer -> A.Expression
|
intLiteral :: Integer -> A.Expression
|
||||||
intLiteral n = A.Literal emptyMeta A.Int $ A.IntLiteral emptyMeta (show n)
|
intLiteral n = A.Literal emptyMeta A.Int $ A.IntLiteral emptyMeta (show n)
|
||||||
|
|
||||||
|
-- | Creates a 'Pattern' to match an 'A.Expression' instance.
|
||||||
|
-- @'assertPatternMatch' ('intLiteralPattern' x) ('intLiteral' x)@ will always succeed.
|
||||||
|
-- All meta tags are ignored.
|
||||||
intLiteralPattern :: Integer -> Pattern
|
intLiteralPattern :: Integer -> Pattern
|
||||||
intLiteralPattern = (stopCaringPattern emptyMeta) . mkPattern . intLiteral
|
intLiteralPattern = (stopCaringPattern emptyMeta) . mkPattern . intLiteral
|
||||||
|
|
||||||
|
-- | Creates a pair of variable lists, given a pair of variable-name lists as input.
|
||||||
makeNamesWR :: ([String],[String]) -> ([A.Variable],[A.Variable])
|
makeNamesWR :: ([String],[String]) -> ([A.Variable],[A.Variable])
|
||||||
makeNamesWR (x,y) = (map variable x,map variable y)
|
makeNamesWR (x,y) = (map variable x,map variable y)
|
||||||
|
|
||||||
|
-- | Creates a simple assignment ('A.Assign') 'A.Process', given two variable names.
|
||||||
makeSimpleAssign :: String -> String -> A.Process
|
makeSimpleAssign :: String -> String -> A.Process
|
||||||
makeSimpleAssign dest src = A.Assign emptyMeta [A.Variable emptyMeta $ simpleName dest] (A.ExpressionList emptyMeta [exprVariable src])
|
makeSimpleAssign dest src = A.Assign emptyMeta [A.Variable emptyMeta $ simpleName dest] (A.ExpressionList emptyMeta [exprVariable src])
|
||||||
|
|
||||||
|
-- | Creates a 'Pattern' to match a 'A.Process' instance.
|
||||||
|
-- @'assertPatternMatch' ('makeSimpleAssignPattern' x y) ('makeSimpleAssign' x y)@ will always succeed.
|
||||||
|
-- All meta tags are ignored.
|
||||||
makeSimpleAssignPattern :: String -> String -> Pattern
|
makeSimpleAssignPattern :: String -> String -> Pattern
|
||||||
makeSimpleAssignPattern lhs rhs = stopCaringPattern emptyMeta $ mkPattern $ makeSimpleAssign lhs rhs
|
makeSimpleAssignPattern lhs rhs = stopCaringPattern emptyMeta $ mkPattern $ makeSimpleAssign lhs rhs
|
||||||
|
|
||||||
|
-- | Turns a list of 'A.Process' into a 'A.Seq' with those processes in order, with empty meta tags.
|
||||||
makeSeq :: [A.Process] -> A.Process
|
makeSeq :: [A.Process] -> A.Process
|
||||||
makeSeq procList = A.Seq emptyMeta $ A.Several emptyMeta (map (\x -> A.OnlyP emptyMeta x) procList)
|
makeSeq procList = A.Seq emptyMeta $ A.Several emptyMeta (map (\x -> A.OnlyP emptyMeta x) procList)
|
||||||
|
|
||||||
|
-- | Turns a list of 'A.Process' into a 'A.Par' with those processes in order (with type 'A.PlainPar'), with empty meta tags.
|
||||||
makePar :: [A.Process] -> A.Process
|
makePar :: [A.Process] -> A.Process
|
||||||
makePar procList = A.Par emptyMeta A.PlainPar $ A.Several emptyMeta (map (\x -> A.OnlyP emptyMeta x) procList)
|
makePar procList = A.Par emptyMeta A.PlainPar $ A.Several emptyMeta (map (\x -> A.OnlyP emptyMeta x) procList)
|
||||||
|
|
||||||
|
-- | Wraps the given process in a replicated 'A.Par' of the form PAR i = 0 FOR 3.
|
||||||
makeRepPar :: A.Process -> A.Process
|
makeRepPar :: A.Process -> A.Process
|
||||||
makeRepPar proc = A.Par emptyMeta A.PlainPar $ A.Rep emptyMeta (A.For emptyMeta (simpleName "i") (intLiteral 0) (intLiteral 3)) (A.OnlyP emptyMeta proc)
|
makeRepPar proc = A.Par emptyMeta A.PlainPar $ A.Rep emptyMeta (A.For emptyMeta (simpleName "i") (intLiteral 0) (intLiteral 3)) (A.OnlyP emptyMeta proc)
|
||||||
|
|
||||||
|
-- | Creates an assignment to the given 'A.Variable' from the given 'A.Expression.'
|
||||||
makeAssign :: A.Variable -> A.Expression -> A.Process
|
makeAssign :: A.Variable -> A.Expression -> A.Process
|
||||||
makeAssign v e = A.Assign emptyMeta [v] $ A.ExpressionList emptyMeta [e]
|
makeAssign v e = A.Assign emptyMeta [v] $ A.ExpressionList emptyMeta [e]
|
||||||
|
|
||||||
|
-- | Creates a 'Pattern' to match a 'A.Process' instance.
|
||||||
|
-- @'assertPatternMatch' ('makeAssignPattern' (mkPattern x) (mkPattern y)) ('makeAssign' x y)@ will always succeed.
|
||||||
|
-- All meta tags are ignored
|
||||||
makeAssignPattern :: Pattern -> Pattern -> Pattern
|
makeAssignPattern :: Pattern -> Pattern -> Pattern
|
||||||
makeAssignPattern v e = tag3 A.Assign DontCare [v] $ tag2 A.ExpressionList DontCare [e]
|
makeAssignPattern v e = tag3 A.Assign DontCare [v] $ tag2 A.ExpressionList DontCare [e]
|
||||||
|
|
||||||
|
-- | Creates a literal string expression from the given 'String'.
|
||||||
makeLiteralString :: String -> A.Expression
|
makeLiteralString :: String -> A.Expression
|
||||||
makeLiteralString str = A.Literal emptyMeta (A.Array [A.Dimension (length str)] A.Byte) (A.ArrayLiteral emptyMeta (map makeLiteralChar str))
|
makeLiteralString str = A.Literal emptyMeta (A.Array [A.Dimension (length str)] A.Byte) (A.ArrayLiteral emptyMeta (map makeLiteralChar str))
|
||||||
where
|
where
|
||||||
makeLiteralChar :: Char -> A.ArrayElem
|
makeLiteralChar :: Char -> A.ArrayElem
|
||||||
makeLiteralChar c = A.ArrayElemExpr $ A.Literal emptyMeta A.Byte (A.ByteLiteral emptyMeta [c] {-(show (fromEnum c))-})
|
makeLiteralChar c = A.ArrayElemExpr $ A.Literal emptyMeta A.Byte (A.ByteLiteral emptyMeta [c] {-(show (fromEnum c))-})
|
||||||
|
|
||||||
|
-- | Creates a 'Pattern' to match an 'A.Expression' instance.
|
||||||
|
-- @'assertPatternMatch' ('makeLiteralStringPattern' x) ('makeLiteralString' x)@ will always succeed.
|
||||||
|
-- All meta tags are ignored
|
||||||
makeLiteralStringPattern :: String -> Pattern
|
makeLiteralStringPattern :: String -> Pattern
|
||||||
makeLiteralStringPattern = (stopCaringPattern emptyMeta) . mkPattern . makeLiteralString
|
makeLiteralStringPattern = (stopCaringPattern emptyMeta) . mkPattern . makeLiteralString
|
||||||
|
|
||||||
assertCompareCustom :: (Show a) => String -> (a -> a -> Bool) -> a -> a -> Assertion
|
-- | Asserts a comparison using a custom comparison function.
|
||||||
|
-- @'assertCompareCustom' msg (==) x y@ will function the same (except for slightly different messages on failure) as @'assertEqual' msg x y@.
|
||||||
|
assertCompareCustom ::
|
||||||
|
Show a =>
|
||||||
|
String -- ^ The message\/test name to prefix on failure.
|
||||||
|
-> (a -> a -> Bool) -- ^ The comparison function. A return of True means the Assertion will succeed, False means the Assertion will fail.
|
||||||
|
-> a -- ^ The expected\/yardstick value.
|
||||||
|
-> a -- ^ The actual value from running the test.
|
||||||
|
-> Assertion
|
||||||
assertCompareCustom preface cmp expected actual =
|
assertCompareCustom preface cmp expected actual =
|
||||||
unless (cmp actual expected) (assertFailure msg)
|
unless (cmp actual expected) (assertFailure msg)
|
||||||
where msg = (if null preface then "" else preface ++ "\n") ++
|
where msg = (if null preface then "" else preface ++ "\n") ++
|
||||||
"expected: " ++ show expected ++ "\n*** got: " ++ show actual
|
"expected: " ++ show expected ++ "\n*** got: " ++ show actual
|
||||||
|
|
||||||
assertNotEqual :: (Show a,Eq a) => String -> a -> a -> Assertion
|
-- | Asserts that the two given items are not equal.
|
||||||
|
-- Similar to assertEqual, but with the condition reversed.
|
||||||
|
assertNotEqual ::
|
||||||
|
(Show a,Eq a) =>
|
||||||
|
String -- ^ The message\/test name to prefix on failure.
|
||||||
|
-> a -- ^ The expected\/yardstick value that the actual value should not equal.
|
||||||
|
-> a -- ^ The actual value from running the test.
|
||||||
|
-> Assertion
|
||||||
assertNotEqual msg = assertCompareCustom msg (/=)
|
assertNotEqual msg = assertCompareCustom msg (/=)
|
||||||
|
|
||||||
-- | Helper function that checks two items in the Items set (by two given keys) are not the same
|
-- | Asserts that two items in the Items set (by two given keys) are not the same, typically checking that an item has been transformed somehow.
|
||||||
assertItemNotSame :: String -> Items -> String -> String -> Assertion
|
-- This function is often used with 'testPassGetItems' or 'testPassWithCheck' or 'testPassWithItemsStateCheck'.
|
||||||
|
assertItemNotSame ::
|
||||||
|
String -- ^ The message\/test name to prefix on failur
|
||||||
|
-> Items -- ^ The set of items after running the test.
|
||||||
|
-> String -- ^ The key of the untransformed original item
|
||||||
|
-> String -- ^ The key of the new transformed item
|
||||||
|
-> Assertion
|
||||||
assertItemNotSame msg items key0 key1 = assertNotEqual msg ((Map.lookup key0 items) :: Maybe AnyDataItem) ((Map.lookup key1 items) :: Maybe AnyDataItem)
|
assertItemNotSame msg items key0 key1 = assertNotEqual msg ((Map.lookup key0 items) :: Maybe AnyDataItem) ((Map.lookup key1 items) :: Maybe AnyDataItem)
|
||||||
|
|
||||||
testPassGetItems :: (Data a, Data b) => String -> a -> PassM b -> (State CompState ()) -> IO (CompState, Either Assertion Items)
|
-- | Tests a given AST pass. This function is primarily intended for internal use by this module.
|
||||||
|
-- It takes an expected value, a transformed value (wrapped in the 'PassM' monad), an initial state-changing function, and returns the subsequent
|
||||||
|
-- state, with either an assertion (if the pass failed) or the 'Items' (if the pass succeeded)
|
||||||
|
testPassGetItems ::
|
||||||
|
(Data a, Data b) =>
|
||||||
|
String -- ^ The message\/test name to prefix on failure.
|
||||||
|
-> 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.
|
||||||
|
-> IO (CompState, Either Assertion 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 =
|
testPassGetItems testName expected actualPass startStateTrans =
|
||||||
--passResult :: Either String b
|
--passResult :: Either String b
|
||||||
do passResult <- runPass actualPass startState
|
do passResult <- runPass actualPass startState
|
||||||
|
@ -131,14 +217,33 @@ testPassGetItems testName expected actualPass startStateTrans =
|
||||||
startState :: CompState
|
startState :: CompState
|
||||||
startState = execState startStateTrans emptyState
|
startState = execState startStateTrans emptyState
|
||||||
|
|
||||||
runPass :: PassM b -> CompState -> IO (CompState, Either String b)
|
-- | Runs a given AST pass and returns the subsequent state, along with either an error or the result. This function is primarily intended for internal use by this module.
|
||||||
|
runPass ::
|
||||||
|
PassM b -- ^ The actual pass.
|
||||||
|
-> CompState -- ^ The state to use to run the pass.
|
||||||
|
-> IO (CompState, Either String b) -- ^ The resultant state, and either an error or the successful outcome of the pass.
|
||||||
runPass actualPass startState = (liftM (\(x,y) -> (y,x))) (runStateT (runErrorT actualPass) startState)
|
runPass actualPass startState = (liftM (\(x,y) -> (y,x))) (runStateT (runErrorT actualPass) startState)
|
||||||
|
|
||||||
testPass :: (Data a, Data b) => String -> a -> PassM b -> (State CompState ()) -> Test
|
-- | A test that runs a given AST pass and checks that it succeeds.
|
||||||
|
testPass ::
|
||||||
|
(Data a, Data b) =>
|
||||||
|
String -- ^ The test name.
|
||||||
|
-> a -- ^ The expected value. Can either be an actual AST, or a 'Pattern' to match an AST.
|
||||||
|
-> 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.
|
||||||
|
-> 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:
|
||||||
testPass w x y z = TestCase $ join $ liftM (either (id) (\x -> return ())) $ (liftM snd) $ (testPassGetItems w x y z)
|
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
|
-- | A test that runs a given AST pass, checks that it succeeds, and checks the resulting 'Items' with a given function.
|
||||||
|
testPassWithCheck ::
|
||||||
|
(Data a, Data b) =>
|
||||||
|
String -- ^ The test name.
|
||||||
|
-> a -- ^ The expected value. Can either be an actual AST, or a 'Pattern' to match an AST.
|
||||||
|
-> 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.
|
||||||
|
-> (Items -> Assertion) -- ^ A function to check the 'Items' once the pass succeeds.
|
||||||
|
-> Test
|
||||||
testPassWithCheck testName expected actualPass startStateTrans checkFunc = TestCase $
|
testPassWithCheck testName expected actualPass startStateTrans checkFunc = TestCase $
|
||||||
((liftM snd) (testPassGetItems testName expected actualPass startStateTrans))
|
((liftM snd) (testPassGetItems testName expected actualPass startStateTrans))
|
||||||
>>= (\res ->
|
>>= (\res ->
|
||||||
|
@ -147,7 +252,15 @@ testPassWithCheck testName expected actualPass startStateTrans checkFunc = TestC
|
||||||
Right items -> checkFunc items
|
Right items -> checkFunc items
|
||||||
)
|
)
|
||||||
|
|
||||||
testPassWithStateCheck :: (Data a, Data b) => String -> a -> PassM b -> (State CompState ()) -> (CompState -> Assertion) -> Test
|
-- | A test that runs a given AST pass, checks that it succeeds, and checks the resulting 'CompState' with a given function.
|
||||||
|
testPassWithStateCheck ::
|
||||||
|
(Data a, Data b) =>
|
||||||
|
String -- ^ The test name.
|
||||||
|
-> a -- ^ The expected value. Can either be an actual AST, or a 'Pattern' to match an AST.
|
||||||
|
-> 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.
|
||||||
|
-> (CompState -> Assertion) -- ^ A function to check the 'CompState' once the pass succeeds.
|
||||||
|
-> Test
|
||||||
testPassWithStateCheck testName expected actualPass startStateTrans checkFunc = TestCase $
|
testPassWithStateCheck testName expected actualPass startStateTrans checkFunc = TestCase $
|
||||||
(testPassGetItems testName expected actualPass startStateTrans)
|
(testPassGetItems testName expected actualPass startStateTrans)
|
||||||
>>= (\x ->
|
>>= (\x ->
|
||||||
|
@ -156,7 +269,15 @@ testPassWithStateCheck testName expected actualPass startStateTrans checkFunc =
|
||||||
(st,Right _) -> checkFunc st
|
(st,Right _) -> checkFunc st
|
||||||
)
|
)
|
||||||
|
|
||||||
testPassWithItemsStateCheck :: (Data a, Data b) => String -> a -> PassM b -> (State CompState ()) -> ((Items,CompState) -> Assertion) -> Test
|
-- | A test that runs a given AST pass, checks that it succeeds, and checks the resulting 'CompState' and 'Items' with a given function.
|
||||||
|
testPassWithItemsStateCheck ::
|
||||||
|
(Data a, Data b) =>
|
||||||
|
String -- ^ The test name.
|
||||||
|
-> a -- ^ The expected value. Can either be an actual AST, or a 'Pattern' to match an AST.
|
||||||
|
-> 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.
|
||||||
|
-> ((Items,CompState) -> Assertion) -- ^ A function to check the 'Items' and 'CompState' once the pass succeeds.
|
||||||
|
-> Test
|
||||||
testPassWithItemsStateCheck testName expected actualPass startStateTrans checkFunc = TestCase $
|
testPassWithItemsStateCheck testName expected actualPass startStateTrans checkFunc = TestCase $
|
||||||
(testPassGetItems testName expected actualPass startStateTrans)
|
(testPassGetItems testName expected actualPass startStateTrans)
|
||||||
>>= (\x ->
|
>>= (\x ->
|
||||||
|
@ -165,15 +286,26 @@ testPassWithItemsStateCheck testName expected actualPass startStateTrans checkFu
|
||||||
(st,Right items) -> checkFunc (items,st)
|
(st,Right items) -> checkFunc (items,st)
|
||||||
)
|
)
|
||||||
|
|
||||||
testPassShouldFail :: (Show b, Data b) => String -> PassM b -> (State CompState ()) -> Test
|
-- | A test that checks that a given AST pass fails. If the pass fails, the test succeeds. If the pass succeeds, the test fails.
|
||||||
|
testPassShouldFail ::
|
||||||
|
(Show b, Data b) =>
|
||||||
|
String -- ^ The test name.
|
||||||
|
-> 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.
|
||||||
|
-> Test
|
||||||
testPassShouldFail testName actualPass startStateTrans = TestCase $
|
testPassShouldFail testName actualPass startStateTrans = TestCase $
|
||||||
do ret <- runPass actualPass (execState startStateTrans emptyState)
|
do ret <- runPass actualPass (execState startStateTrans emptyState)
|
||||||
case ret of
|
case ret of
|
||||||
(_,Left err) -> return ()
|
(_,Left err) -> return ()
|
||||||
_ -> assertFailure $ testName ++ " pass succeeded when expected to fail, data: " ++ (show ret)
|
_ -> assertFailure $ testName ++ " pass succeeded when expected to fail, data: " ++ (show ret)
|
||||||
|
|
||||||
|
-- | Asserts that a particular variable is defined in the given 'CompState'.
|
||||||
assertVarDef :: Data a => String -> CompState -> String -> a -> Assertion
|
assertVarDef ::
|
||||||
|
String -- ^ The message\/test name to prefix on failure.
|
||||||
|
-> CompState -- ^ The 'CompState' in which to check for the variable being defined
|
||||||
|
-> String -- ^ The name of the variable to check for.
|
||||||
|
-> Pattern -- ^ The expected value of the definition. Expected to be a 'Pattern' that will match a 'A.NameDef'.
|
||||||
|
-> Assertion
|
||||||
assertVarDef prefix state varName varDef
|
assertVarDef prefix state varName varDef
|
||||||
= case (Map.lookup varName (csNames state)) of
|
= case (Map.lookup varName (csNames state)) of
|
||||||
Nothing -> assertFailure $ prefix ++ " variable was not recorded: " ++ varName
|
Nothing -> assertFailure $ prefix ++ " variable was not recorded: " ++ varName
|
||||||
|
|
Loading…
Reference in New Issue
Block a user