From 5f01f12d431dbba2c2aa7066d6e8f77123476957 Mon Sep 17 00:00:00 2001 From: Neil Brown Date: Thu, 20 Nov 2008 14:20:36 +0000 Subject: [PATCH] Adjusted testOccamPassWarn to enable all warnings when testing a pass --- common/OccamEDSL.hs | 18 +++++++++++------- 1 file changed, 11 insertions(+), 7 deletions(-) diff --git a/common/OccamEDSL.hs b/common/OccamEDSL.hs index 0f5604b..e552653 100644 --- a/common/OccamEDSL.hs +++ b/common/OccamEDSL.hs @@ -31,6 +31,7 @@ module OccamEDSL (ExpInp, ExpInpT, import Control.Monad.State hiding (guard) import Data.Generics import qualified Data.Map as Map +import qualified Data.Set as Set import Test.HUnit hiding (State) import qualified AST as A @@ -373,15 +374,18 @@ testOccamPassWarn :: Data a => String -> ([WarningReport] -> Bool) -> O a -> Pas testOccamPassWarn str check code pass = let ExpInpT expm inpm = code (exp, expS) = runState expm emptyState - (inp, inpS) = runState inpm emptyState + (inp, inpS) = runState inpm emptyStateWithWarnings pass' = pass {passCode = \x -> do y <- passCode pass x - b <- lift get >>* (check . csWarnings) - when (not b) $ - dieP emptyMeta $ str ++ " warnings not as expected" + ws <- getCompState >>* csWarnings + when (not $ check ws) $ + dieP emptyMeta $ str ++ " warnings not as expected: " + ++ (show ws) return y} - in TestCase $ testPassWithStateCheck str exp pass' inp (put inpS) (assertEqual - str (csNames expS) . csNames) - + in TestCase $ testPassWithStateCheck str exp pass' inp + (put $ inpS {csWarnings = []}) -- Blank the warnings for the new pass + (assertEqual str (csNames expS) . csNames) + where + emptyStateWithWarnings = emptyState { csEnabledWarnings = Set.fromList [minBound..maxBound] } -- | Like testOccamPass, but applies a transformation to the patterns (such as -- using stopCaringPattern) before pattern-matching