From 140bd94ce3d9c15122e4af70660b9606f2d1e51b Mon Sep 17 00:00:00 2001 From: Neil Brown Date: Thu, 13 Dec 2007 23:51:49 +0000 Subject: [PATCH] Added various (QuickCheck) Result helper functions to the TestUtils module --- common/FlowGraphTest.hs | 4 ---- common/TestUtils.hs | 15 +++++++++++++++ 2 files changed, 15 insertions(+), 4 deletions(-) diff --git a/common/FlowGraphTest.hs b/common/FlowGraphTest.hs index 1aec225..fc74b24 100644 --- a/common/FlowGraphTest.hs +++ b/common/FlowGraphTest.hs @@ -547,10 +547,6 @@ pickFuncRep gr = Map.fromList $ map (helpApplyFunc . getMetaFunc) (labNodes gr) g m = everywhereM (mkM $ replaceM m (replaceMeta m)) --- | A form of equality that yields a (QuickCheck) Result rather than a Bool, with the arguments pretty-printed -(*==*) :: (Data a, Eq a) => a -> a -> Result -(*==*) x y = Result {ok = Just (x == y), arguments = [pshow x, pshow y], stamp = []} - -- | It is important to have these functions in the right ratio. The number of possible trees is -- 2^N, where N is the test size. Therefore I suggest keeping N <= 10 as a sensible limit. -- Hence, if there are 1000 tests, we divide the test number by 100 to get the test size. diff --git a/common/TestUtils.hs b/common/TestUtils.hs index 46a76bc..d324ab7 100644 --- a/common/TestUtils.hs +++ b/common/TestUtils.hs @@ -71,6 +71,21 @@ scaleQC (low,med,high,ext) test level run :: Testable a => Int -> a -> IO () run n = check (defaultConfig { configMaxTest = n }) +-- | A form of equality that yields a (QuickCheck) Result rather than a Bool, with the arguments pretty-printed +(*==*) :: (Data a, Eq a) => a -> a -> Result +(*==*) x y = Result {ok = Just (x == y), arguments = [pshow x, pshow y], stamp = []} + +-- | Joins together two results from (*==*). Not sure what to do with other Results (when will ok be Nothing?). +(*&&*) :: Result -> Result -> Result +(*&&*) x@(Result (Just False) _ _) _ = x +(*&&*) _ y = y + +mkPassResult :: Result +mkPassResult = Result (Just True) [] [] + +mkFailResult :: String -> Result +mkFailResult s = Result (Just False) [s] [] + -- | 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