Repository : ssh://darcs.haskell.org//srv/darcs/packages/dph On branch : master
http://hackage.haskell.org/trac/ghc/changeset/7c7c5e4c5b9af3959a3b3ef02c113da1fbb7dd6e >--------------------------------------------------------------- commit 7c7c5e4c5b9af3959a3b3ef02c113da1fbb7dd6e Author: George Roldugin <[email protected]> Date: Thu May 19 18:29:26 2011 +1000 Migrate to QuickCheck v2. >--------------------------------------------------------------- examples/quickcheck/Testsuite/Testcase.hs | 23 +++++++++++------------ examples/quickcheck/Testsuite/Utils.hs | 9 +++------ 2 files changed, 14 insertions(+), 18 deletions(-) diff --git a/examples/quickcheck/Testsuite/Testcase.hs b/examples/quickcheck/Testsuite/Testcase.hs index 7a66862..974e6c3 100644 --- a/examples/quickcheck/Testsuite/Testcase.hs +++ b/examples/quickcheck/Testsuite/Testcase.hs @@ -3,7 +3,7 @@ module Testsuite.Testcase ( ) where import Test.QuickCheck -import Test.QuickCheck.Batch (TestResult(..), run, defOpt) +--import Test.QuickCheck.Batch (TestResult(..), run, defOpt) import Text.Regex @@ -30,21 +30,20 @@ runTests tests = do putStr $ name ++ spaces (60 - length name) ++ "... " hFlush stdout - res <- run prop defOpt + res <- quickCheckWithResult customArgs prop case res of - TestOk _ n _ -> putStrLn $ "pass (" ++ show n ++ ")" - TestExausted _ n _ -> putStrLn $ "EXHAUSTED (" ++ show n ++ ")" - TestFailed s n -> - do - putStrLn $ "FAIL (" ++ show n ++ ")" - mapM_ putStrLn $ map (" " ++) s - TestAborted e -> - do - putStrLn $ "ABORTED" - putStrLn $ " " ++ show e + Success n _ _ -> putStrLn $ "pass (" ++ show n ++ ")" + GaveUp n _ _ -> putStrLn $ "EXHAUSTED (" ++ show n ++ ")" + Failure n _ _ _ _ _ s -> do + putStrLn $ "FAILED (" ++ show n ++ ")" + putStrLn $ indent s + NoExpectedFailure + n _ _ -> putStrLn $ "NO EXPECTED FAILURE (" ++ show n ++ ")" hFlush stdout spaces n | n <= 0 = "" | otherwise = replicate n ' ' + customArgs = stdArgs { chatty = False } -- do not print to stdout + indent = unlines . map (spaces 4 ++) . lines pick :: [String] -> [Test] -> [Test] pick [] = id diff --git a/examples/quickcheck/Testsuite/Utils.hs b/examples/quickcheck/Testsuite/Utils.hs index 50ef342..7a28aeb 100644 --- a/examples/quickcheck/Testsuite/Utils.hs +++ b/examples/quickcheck/Testsuite/Utils.hs @@ -5,7 +5,7 @@ module Testsuite.Utils ( ) where import Test.QuickCheck -import Test.QuickCheck.Batch +--import Test.QuickCheck.Batch import Text.Show.Functions @@ -29,9 +29,11 @@ newtype BPerm = BPerm (Array Int) deriving (Eq,Show) -- array of index-value pairs with indices taken from [0..n-1] newtype DftPerm a = DftPerm (Array (Int, a)) deriving (Eq, Show) +{- instance Arbitrary Char where arbitrary = fmap chr . sized $ \n -> choose (0,n) coarbitrary = coarbitrary . ord +-} {- instance (Arbitrary a, Arbitrary b) => Arbitrary (a :*: b) where @@ -41,22 +43,18 @@ instance (Arbitrary a, Arbitrary b) => Arbitrary (a :*: b) where instance Arbitrary Len where arbitrary = sized $ \n -> Len `fmap` choose (0,n) - coarbitrary (Len n) = coarbitrary n instance Arbitrary Perm where arbitrary = Perm `fmap` (sized $ \n -> elements $ P.map fromList (permutations [0..n-1])) - coarbitrary = \(Perm arr) -> coarbitrary (toList arr) instance Arbitrary BPerm where arbitrary = sized $ \n -> (BPerm . fromList . P.map (`mod` n)) `fmap` enlarge n arbitrary - coarbitrary = \(BPerm arr) -> coarbitrary (toList arr) instance (Elt a, Arbitrary a) => Arbitrary (DftPerm a) where arbitrary = do BPerm idxs <- arbitrary -- :: Gen BPerm vals <- sized $ \n -> enlarge n arbitrary -- :: Gen (Array a) return $ DftPerm (U.zip idxs vals) - coarbitrary = \(DftPerm arr) -> coarbitrary (toList arr) {- instance Arbitrary a => Arbitrary (MaybeS a) where @@ -67,7 +65,6 @@ instance Arbitrary a => Arbitrary (MaybeS a) where instance (Elt a, Arbitrary a) => Arbitrary (Array a) where arbitrary = fmap fromList arbitrary - coarbitrary = coarbitrary . toList {- instance (UA a, Arbitrary a) => Arbitrary (SUArr a) where _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
