From e38d29f43d7e3717121b361ff0397135db1dae69 Mon Sep 17 00:00:00 2001 From: Neil Brown Date: Sat, 18 Aug 2007 23:00:41 +0000 Subject: [PATCH] Moved a bunch of functions from RainPassTest to TestUtil, so that they can be re-used --- RainPassTest.hs | 61 -------------------------------------- TestUtil.hs | 79 ++++++++++++++++++++++++++++++++++++++++++++++++- 2 files changed, 78 insertions(+), 62 deletions(-) diff --git a/RainPassTest.hs b/RainPassTest.hs index 1617d79..9292acf 100644 --- a/RainPassTest.hs +++ b/RainPassTest.hs @@ -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 diff --git a/TestUtil.hs b/TestUtil.hs index df97fb8..f39356c 100644 --- a/TestUtil.hs +++ b/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