diff --git a/TestUtil.hs b/TestUtil.hs
index 85a3642..504f112 100644
--- a/TestUtil.hs
+++ b/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 .
-}
+{-|
+
+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:
+. 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
import qualified AST as A
@@ -32,32 +52,45 @@ import CompState
import Utils
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 = 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 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 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 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 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 s = tag3 A.Name DontCare A.ProcName s
+-- | Creates a 'A.Variable' with the given 'String' as the name.
variable :: String -> A.Variable
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 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 e = A.ExprVariable emptyMeta $ variable e
@@ -65,62 +98,115 @@ exprVariable e = A.ExprVariable emptyMeta $ variable e
exprDirVariable :: A.Direction -> String -> A.Expression
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 e = tag2 A.ExprVariable DontCare $ variablePattern e
+-- | Creates an integer literal 'A.Expression' with the given integer.
intLiteral :: Integer -> A.Expression
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 = (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 (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 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 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 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 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 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 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 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 str = A.Literal emptyMeta (A.Array [A.Dimension (length str)] A.Byte) (A.ArrayLiteral emptyMeta (map makeLiteralChar str))
where
makeLiteralChar :: Char -> A.ArrayElem
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 = (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 =
unless (cmp actual expected) (assertFailure msg)
where msg = (if null preface then "" else preface ++ "\n") ++
"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 (/=)
--- | Helper function that checks two items in the Items set (by two given keys) are not the same
-assertItemNotSame :: String -> Items -> String -> String -> Assertion
+-- | 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.
+-- 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)
-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 =
--passResult :: Either String b
do passResult <- runPass actualPass startState
@@ -131,14 +217,33 @@ testPassGetItems testName expected actualPass startStateTrans =
startState :: CompState
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)
-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:
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 $
((liftM snd) (testPassGetItems testName expected actualPass startStateTrans))
>>= (\res ->
@@ -147,7 +252,15 @@ testPassWithCheck testName expected actualPass startStateTrans checkFunc = TestC
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 $
(testPassGetItems testName expected actualPass startStateTrans)
>>= (\x ->
@@ -156,7 +269,15 @@ testPassWithStateCheck testName expected actualPass startStateTrans checkFunc =
(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 $
(testPassGetItems testName expected actualPass startStateTrans)
>>= (\x ->
@@ -165,15 +286,26 @@ testPassWithItemsStateCheck testName expected actualPass startStateTrans checkFu
(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 $
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
+-- | Asserts that a particular variable is defined in the given 'CompState'.
+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
= case (Map.lookup varName (csNames state)) of
Nothing -> assertFailure $ prefix ++ " variable was not recorded: " ++ varName