[commit: dph] master: Migrate to QuickCheck v2. (7c7c5e4)

[Ben Lippmeier]

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 <groldugin at cse.unsw.edu.au>
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