From 6a22e3758958d4db10a0e073e82f8a453554f913 Mon Sep 17 00:00:00 2001 From: Neil Brown Date: Tue, 28 Aug 2007 12:25:59 +0000 Subject: [PATCH] Added Haddock documentation to all the functions in TestUtil, and tweaked the type of assertVarDef --- TestUtil.hs | 164 +++++++++++++++++++++++++++++++++++++++++++++++----- 1 file changed, 148 insertions(+), 16 deletions(-) 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