QuickCheck (empty) → 1.0

raw patch · 11 files changed

+885/−0 lines, 11 filesdep +basebuild-type:Customsetup-changed

Dependencies added: base

Files

• Debug/QuickCheck.hs +21/−0
• Debug/QuickCheck/Batch.hs +21/−0
• Debug/QuickCheck/Poly.hs +19/−0
• Debug/QuickCheck/Utils.hs +21/−0
• LICENSE +31/−0
• QuickCheck.cabal +30/−0
• Setup.hs +2/−0
• Test/QuickCheck.hs +355/−0
• Test/QuickCheck/Batch.hs +246/−0
• Test/QuickCheck/Poly.hs +86/−0
• Test/QuickCheck/Utils.hs +53/−0

@@ -0,0 +1,21 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Debug.QuickCheck+-- Copyright   :  (c) Koen Claessen, John Hughes 2001+-- License     :  BSD-style (see the file libraries/base/LICENSE)+-- +-- Maintainer  :  libraries@haskell.org+-- Stability   :  deprecated+-- Portability :  portable+--+-- implementation moved to Test.QuickCheck+-----------------------------------------------------------------------------++module Debug.QuickCheck+{-# DEPRECATED "Use module Test.QuickCheck instead" #-}+  ( module Test.QuickCheck+  )+ where++import Test.QuickCheck+

@@ -0,0 +1,21 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Debug.QuickCheck.Batch+-- Copyright   :  (c) Andy Gill 2001+-- License     :  BSD-style (see the file libraries/base/LICENSE)+-- +-- Maintainer  :  libraries@haskell.org+-- Stability   :  deprecated+-- Portability :  non-portable (uses Control.Exception, Control.Concurrent)+--+-- This is a batch driver for running QuickCheck (GHC only).+--+-----------------------------------------------------------------------------++module Debug.QuickCheck.Batch+{-# DEPRECATED "Use module Test.QuickCheck.Batch instead" #-}+   ( module Test.QuickCheck.Batch+   ) where++import Test.QuickCheck.Batch+

@@ -0,0 +1,19 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Debug.QuickCheck.Poly+-- Copyright   :  (c) Andy Gill 2001+-- License     :  BSD-style (see the file libraries/base/LICENSE)+-- +-- Maintainer  :  libraries@haskell.org+-- Stability   :  deprecated+-- Portability :  portable+--+-----------------------------------------------------------------------------++module Debug.QuickCheck.Poly+{-# DEPRECATED "Use module Test.QuickCheck.Poly instead" #-}+  ( module Test.QuickCheck.Poly+  ) where++import Test.QuickCheck.Poly+

@@ -0,0 +1,21 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Debug.QuickCheck.Utils+-- Copyright   :  (c) Andy Gill 2001+-- License     :  BSD-style (see the file libraries/base/LICENSE)+-- +-- Maintainer  :  libraries@haskell.org+-- Stability   :  deprecated+-- Portability :  portable+--+-- These are some general purpose utilities for use with QuickCheck.+--+-----------------------------------------------------------------------------++module Debug.QuickCheck.Utils+{-# DEPRECATED "Use module Test.QuickCheck.Utils instead" #-}+  ( module Test.QuickCheck.Utils+  ) where++import Test.QuickCheck.Utils+

@@ -0,0 +1,31 @@+The Glasgow Haskell Compiler License++Copyright 2004, The University Court of the University of Glasgow. +All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++- Redistributions of source code must retain the above copyright notice,+this list of conditions and the following disclaimer.+ +- Redistributions in binary form must reproduce the above copyright notice,+this list of conditions and the following disclaimer in the documentation+and/or other materials provided with the distribution.+ +- Neither name of the University nor the names of its contributors may be+used to endorse or promote products derived from this software without+specific prior written permission. ++THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF+GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,+INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND+FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE+UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT+LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY+OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH+DAMAGE.

@@ -0,0 +1,30 @@+name:		QuickCheck+version:	1.0+license:	BSD3+license-file:	LICENSE+author:		Koen Classen and John Hughes+maintainer:	libraries@haskell.org+category:	Testing+homepage:	http://www.math.chalmers.se/~rjmh/QuickCheck/+synopsis:	Automatic testing of Haskell programs+description:+	A library for testing Haskell programs automatically.+	The programmer provides a specification of the program, in+	the form of properties which functions should satisfy, and+	QuickCheck then tests that the properties hold in a large number+	of randomly generated cases.  Specifications are expressed in+	Haskell, using combinators defined in the QuickCheck library.+	QuickCheck provides combinators to define properties, observe+	the distribution of test data, and define test+	data generators.+exposed-modules:+	Debug.QuickCheck.Batch,+	Debug.QuickCheck.Poly,+	Debug.QuickCheck.Utils,+	Debug.QuickCheck,+	Test.QuickCheck.Batch,+	Test.QuickCheck.Poly,+	Test.QuickCheck.Utils,+	Test.QuickCheck+build-depends:	base+extensions:	CPP

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,355 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Test.QuickCheck+-- Copyright   :  (c) Koen Claessen, John Hughes 2001+-- License     :  BSD-style (see the file libraries/base/LICENSE)+-- +-- Maintainer  :  libraries@haskell.org+-- Stability   :  experimental+-- Portability :  portable+--+-- QuickCheck v.0.2+-- DRAFT implementation; last update 000104.+-- Koen Claessen, John Hughes.+-- This file represents work in progress, and might change at a later date.+--+-----------------------------------------------------------------------------++module Test.QuickCheck+  -- testing functions+  ( quickCheck    -- :: prop -> IO ()+  , verboseCheck  -- :: prop -> IO ()+  , test          -- :: prop -> IO ()  -- = quickCheck+  +  , Config(..)    -- :: *+  , defaultConfig -- :: Config+  , check         -- :: Config -> prop -> IO ()+ +  -- property combinators+  , forAll        -- :: Gen a -> (a -> prop) -> prop+  , (==>)         -- :: Bool -> prop -> prop+  +  -- gathering test-case information+  , label         -- :: String         -> prop -> prop+  , collect       -- :: Show a => a    -> prop -> prop+  , classify      -- :: Bool -> String -> prop -> prop+  , trivial       -- :: Bool           -> prop -> prop+  +  -- generator combinators+  , Gen           -- :: * -> * ; Functor, Monad+  +  , elements      -- :: [a] -> Gen a+  , two           -- :: Gen a -> Gen (a,a)+  , three         -- :: Gen a -> Gen (a,a,a)+  , four          -- :: Gen a -> Gen (a,a,a,a)+  +  , sized         -- :: (Int -> Gen a) -> Gen a+  , resize        -- :: Int -> Gen a -> Gen a+  , choose        -- :: Random a => (a, a) -> Gen a+  , oneof         -- :: [Gen a] -> Gen a+  , frequency     -- :: [(Int, Gen a)] -> Gen a+  +  , vector        -- :: Arbitrary a => Int -> Gen [a]++  -- default generators+  , Arbitrary(..) -- :: class+  , rand          -- :: Gen StdGen+  , promote       -- :: (a -> Gen b) -> Gen (a -> b)+  , variant       -- :: Int -> Gen a -> Gen a++  -- testable+  , Testable(..)  -- :: class+  , Property      -- :: *++  -- For writing your own driver+  , Result(..)	 -- :: data+  , generate	 -- :: Int -> StdGen -> Gen a -> a+  , evaluate     -- :: Testable a => a -> Gen Result+  )+ where++import Prelude++import System.Random+import Data.List( group, sort, intersperse )+import Control.Monad( liftM2, liftM3, liftM4 )++infixr 0 ==>+infix  1 `classify`++--------------------------------------------------------------------+-- Generator++newtype Gen a+  = Gen (Int -> StdGen -> a)++sized :: (Int -> Gen a) -> Gen a+sized fgen = Gen (\n r -> let Gen m = fgen n in m n r)++resize :: Int -> Gen a -> Gen a+resize n (Gen m) = Gen (\_ r -> m n r)++rand :: Gen StdGen+rand = Gen (\n r -> r)++promote :: (a -> Gen b) -> Gen (a -> b)+promote f = Gen (\n r -> \a -> let Gen m = f a in m n r)++variant :: Int -> Gen a -> Gen a+variant v (Gen m) = Gen (\n r -> m n (rands r !! (v+1)))+ where+  rands r0 = r1 : rands r2 where (r1, r2) = split r0++generate :: Int -> StdGen -> Gen a -> a+generate n rnd (Gen m) = m size rnd'+ where+  (size, rnd') = randomR (0, n) rnd++instance Functor Gen where+  fmap f m = m >>= return . f++instance Monad Gen where+  return a    = Gen (\n r -> a)+  Gen m >>= k =+    Gen (\n r0 -> let (r1,r2) = split r0+                      Gen m'  = k (m n r1)+                   in m' n r2)++-- derived++choose :: Random a => (a, a) -> Gen a+choose bounds = (fst . randomR bounds) `fmap` rand++elements :: [a] -> Gen a+elements xs = (xs !!) `fmap` choose (0, length xs - 1)++vector :: Arbitrary a => Int -> Gen [a]+vector n = sequence [ arbitrary | i <- [1..n] ]++oneof :: [Gen a] -> Gen a+oneof gens = elements gens >>= id++frequency :: [(Int, Gen a)] -> Gen a+frequency xs = choose (1, tot) >>= (`pick` xs)+ where+  tot = sum (map fst xs)++  pick n ((k,x):xs)+    | n <= k    = x+    | otherwise = pick (n-k) xs++-- general monadic++two :: Monad m => m a -> m (a, a)+two m = liftM2 (,) m m++three :: Monad m => m a -> m (a, a, a)+three m = liftM3 (,,) m m m++four :: Monad m => m a -> m (a, a, a, a)+four m = liftM4 (,,,) m m m m++--------------------------------------------------------------------+-- Arbitrary++class Arbitrary a where+  arbitrary   :: Gen a+  coarbitrary :: a -> Gen b -> Gen b++instance Arbitrary () where+  arbitrary     = return ()+  coarbitrary _ = variant 0++instance Arbitrary Bool where+  arbitrary     = elements [True, False]+  coarbitrary b = if b then variant 0 else variant 1++instance Arbitrary Int where+  arbitrary     = sized $ \n -> choose (-n,n)+  coarbitrary n = variant (if n >= 0 then 2*n else 2*(-n) + 1)++instance Arbitrary Integer where+  arbitrary     = sized $ \n -> choose (-fromIntegral n,fromIntegral n)+  coarbitrary n = variant (fromInteger (if n >= 0 then 2*n else 2*(-n) + 1))++instance Arbitrary Float where+  arbitrary     = liftM3 fraction arbitrary arbitrary arbitrary +  coarbitrary x = coarbitrary (decodeFloat x)++instance Arbitrary Double where+  arbitrary     = liftM3 fraction arbitrary arbitrary arbitrary +  coarbitrary x = coarbitrary (decodeFloat x)++fraction a b c = fromInteger a + (fromInteger b / (abs (fromInteger c) + 1))++instance (Arbitrary a, Arbitrary b) => Arbitrary (a, b) where+  arbitrary          = liftM2 (,) arbitrary arbitrary+  coarbitrary (a, b) = coarbitrary a . coarbitrary b++instance (Arbitrary a, Arbitrary b, Arbitrary c) => Arbitrary (a, b, c) where+  arbitrary             = liftM3 (,,) arbitrary arbitrary arbitrary+  coarbitrary (a, b, c) = coarbitrary a . coarbitrary b . coarbitrary c++instance (Arbitrary a, Arbitrary b, Arbitrary c, Arbitrary d)+      => Arbitrary (a, b, c, d)+ where+  arbitrary = liftM4 (,,,) arbitrary arbitrary arbitrary arbitrary+  coarbitrary (a, b, c, d) =+    coarbitrary a . coarbitrary b . coarbitrary c . coarbitrary d++instance Arbitrary a => Arbitrary [a] where+  arbitrary          = sized (\n -> choose (0,n) >>= vector)+  coarbitrary []     = variant 0+  coarbitrary (a:as) = coarbitrary a . variant 1 . coarbitrary as++instance (Arbitrary a, Arbitrary b) => Arbitrary (a -> b) where+  arbitrary         = promote (`coarbitrary` arbitrary)+  coarbitrary f gen = arbitrary >>= ((`coarbitrary` gen) . f)++--------------------------------------------------------------------+-- Testable++data Result+  = Result { ok :: Maybe Bool, stamp :: [String], arguments :: [String] }++nothing :: Result+nothing = Result{ ok = Nothing, stamp = [], arguments = [] }++newtype Property+  = Prop (Gen Result)++result :: Result -> Property+result res = Prop (return res)++evaluate :: Testable a => a -> Gen Result+evaluate a = gen where Prop gen = property a++class Testable a where+  property :: a -> Property++instance Testable () where+  property _ = result nothing++instance Testable Bool where+  property b = result (nothing{ ok = Just b })++instance Testable Result where+  property res = result res++instance Testable Property where+  property prop = prop++instance (Arbitrary a, Show a, Testable b) => Testable (a -> b) where+  property f = forAll arbitrary f++forAll :: (Show a, Testable b) => Gen a -> (a -> b) -> Property+forAll gen body = Prop $+  do a   <- gen+     res <- evaluate (body a)+     return (argument a res)+ where+  argument a res = res{ arguments = show a : arguments res }++(==>) :: Testable a => Bool -> a -> Property+True  ==> a = property a+False ==> a = property ()++label :: Testable a => String -> a -> Property+label s a = Prop (add `fmap` evaluate a)+ where+  add res = res{ stamp = s : stamp res }++classify :: Testable a => Bool -> String -> a -> Property+classify True  name = label name+classify False _    = property++trivial :: Testable a => Bool -> a -> Property+trivial = (`classify` "trivial")++collect :: (Show a, Testable b) => a -> b -> Property+collect v = label (show v)++--------------------------------------------------------------------+-- Testing++data Config = Config+  { configMaxTest :: Int+  , configMaxFail :: Int+  , configSize    :: Int -> Int+  , configEvery   :: Int -> [String] -> String+  }++quick :: Config+quick = Config+  { configMaxTest = 100+  , configMaxFail = 1000+  , configSize    = (+ 3) . (`div` 2)+  , configEvery   = \n args -> let s = show n in s ++ [ '\b' | _ <- s ]+  }+         +verbose :: Config+verbose = quick+  { configEvery = \n args -> show n ++ ":\n" ++ unlines args+  }++defaultConfig :: Config+defaultConfig = quick++test, quickCheck, verboseCheck :: Testable a => a -> IO ()+test         = check quick+quickCheck   = check quick+verboseCheck = check verbose+         +check :: Testable a => Config -> a -> IO ()+check config a =+  do rnd <- newStdGen+     tests config (evaluate a) rnd 0 0 []++tests :: Config -> Gen Result -> StdGen -> Int -> Int -> [[String]] -> IO () +tests config gen rnd0 ntest nfail stamps+  | ntest == configMaxTest config = do done "OK, passed" ntest stamps+  | nfail == configMaxFail config = do done "Arguments exhausted after" ntest stamps+  | otherwise               =+      do putStr (configEvery config ntest (arguments result))+         case ok result of+           Nothing    ->+             tests config gen rnd1 ntest (nfail+1) stamps+           Just True  ->+             tests config gen rnd1 (ntest+1) nfail (stamp result:stamps)+           Just False ->+             putStr ( "Falsifiable, after "+                   ++ show ntest+                   ++ " tests:\n"+                   ++ unlines (arguments result)+                    )+     where+      result      = generate (configSize config ntest) rnd2 gen+      (rnd1,rnd2) = split rnd0++done :: String -> Int -> [[String]] -> IO ()+done mesg ntest stamps =+  do putStr ( mesg ++ " " ++ show ntest ++ " tests" ++ table )+ where+  table = display+        . map entry+        . reverse+        . sort+        . map pairLength+        . group+        . sort+        . filter (not . null)+        $ stamps++  display []  = ".\n"+  display [x] = " (" ++ x ++ ").\n"+  display xs  = ".\n" ++ unlines (map (++ ".") xs)++  pairLength xss@(xs:_) = (length xss, xs)+  entry (n, xs)         = percentage n ntest+                       ++ " "+                       ++ concat (intersperse ", " xs)++  percentage n m        = show ((100 * n) `div` m) ++ "%"++--------------------------------------------------------------------+-- the end.

@@ -0,0 +1,246 @@+{-# OPTIONS_GHC -cpp #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Test.QuickCheck.Batch+-- Copyright   :  (c) Andy Gill 2001+-- License     :  BSD-style (see the file libraries/base/LICENSE)+-- +-- Maintainer  :  libraries@haskell.org+-- Stability   :  experimental+-- Portability :  non-portable (uses Control.Exception, Control.Concurrent)+--+-- A batch driver for running QuickCheck.+--+-- /Note:/ in GHC only, it is possible to place a time limit on each test,+-- to ensure that testing terminates.+--+-----------------------------------------------------------------------------++{-+ - Here is the key for reading the output.+ -  . = test successful+ -  ? = every example passed, but quickcheck did not find enough good examples+ -  * = test aborted for some reason (out-of-time, bottom, etc)+ -  # = test failed outright+ - + - We also provide the dangerous "isBottom".+ -+ - Here is is an example of use for sorting:+ - + - testOptions :: TestOptions+ - testOptions = TestOptions + -                 { no_of_tests = 100		-- number of tests to run+ -                 , length_of_tests = 1	-- 1 second max per check+ -						-- where a check == n tests+ -                 , debug_tests = False	-- True => debugging info+ -                 }+ - + - prop_sort1 xs = sort xs == sortBy compare xs+ -   where types = (xs :: [OrdALPHA])+ - prop_sort2 xs = + -         (not (null xs)) ==>+ -         (head (sort xs) == minimum xs)+ -   where types = (xs :: [OrdALPHA])+ - prop_sort3 xs = (not (null xs)) ==>+ -         last (sort xs) == maximum xs+ -   where types = (xs :: [OrdALPHA])+ - prop_sort4 xs ys =+ -         (not (null xs)) ==>+ -         (not (null ys)) ==>+ -         (head (sort (xs ++ ys)) == min (minimum xs) (minimum ys))+ -   where types = (xs :: [OrdALPHA], ys :: [OrdALPHA])+ - prop_sort6 xs ys =+ -         (not (null xs)) ==>+ -         (not (null ys)) ==>+ -         (last (sort (xs ++ ys)) == max (maximum xs) (maximum ys))+ -   where types = (xs :: [OrdALPHA], ys :: [OrdALPHA])+ - prop_sort5 xs ys =+ -         (not (null xs)) ==>+ -         (not (null ys)) ==>+ -         (head (sort (xs ++ ys)) == max (maximum xs) (maximum ys))+ -   where types = (xs :: [OrdALPHA], ys :: [OrdALPHA])+ - + - test_sort = runTests "sort" testOptions+ -         [ run prop_sort1+ -         , run prop_sort2+ -         , run prop_sort3+ -         , run prop_sort4+ -         , run prop_sort5+ -         ]+ - + - When run, this gives+ - Main> test_sort+ -                     sort : .....+ - + - You would tie together all the test_* functions+ - into one test_everything, on a per module basis.+ -+ -}++module Test.QuickCheck.Batch+   ( run		-- :: Testable a => a -> TestOptions -> IO TestResult+   , runTests		-- :: String -> TestOptions -> +			--	[TestOptions -> IO TestResult] -> IO ()+   , defOpt		-- :: TestOptions+   , TestOptions (..)+   , TestResult (..)+   , isBottom		-- :: a -> Bool+   , bottom		-- :: a 		{- _|_ -}+   ) where++import Prelude++import System.Random+#ifdef __GLASGOW_HASKELL__+import Control.Concurrent+#endif+import Control.Exception hiding (catch, evaluate)+import qualified Control.Exception as Exception (catch, evaluate)+import Test.QuickCheck+import System.IO.Unsafe++data TestOptions = TestOptions {+	no_of_tests     :: Int,	-- ^ number of tests to run.+	length_of_tests :: Int,	-- ^ time limit for test, in seconds.+				-- If zero, no time limit.+				-- /Note:/ only GHC supports time limits.+	debug_tests     :: Bool }++defOpt :: TestOptions+defOpt = TestOptions +	{ no_of_tests = 100+	, length_of_tests = 1+	, debug_tests = False+	}++data TestResult = TestOk 	String  Int [[String]]+		| TestExausted 	String  Int [[String]]+		| TestFailed   [String] Int+		| TestAborted   Exception++tests :: Config -> Gen Result -> StdGen -> Int -> Int -> [[String]] +      -> IO TestResult+tests config gen rnd0 ntest nfail stamps+  | ntest == configMaxTest config = return (TestOk  "OK, passed" ntest stamps)+  | nfail == configMaxFail config = return (TestExausted "Arguments exhausted after"+					 ntest stamps)+  | otherwise               =+      do (if not (null txt) then putStr txt else return ())+	 case ok result of+           Nothing    ->+             tests config gen rnd1 ntest (nfail+1) stamps+           Just True  ->+             tests config gen rnd1 (ntest+1) nfail (stamp result:stamps)+           Just False ->+             do return (TestFailed (arguments result) ntest)+     where+      txt         = configEvery config ntest (arguments result)+      result      = generate (configSize config ntest) rnd2 gen+      (rnd1,rnd2) = split rnd0++batch n v = Config+  { configMaxTest = n+  , configMaxFail = n * 10+  , configSize    = (+ 3) . (`div` 2)+  , configEvery   = \n args -> if v then show n ++ ":\n" ++ unlines args else ""+  }++-- | Run the test.+-- Here we use the same random number each time,+-- so we get reproducable results!+run :: Testable a => a -> TestOptions -> IO TestResult+run a TestOptions { no_of_tests = n, length_of_tests = len, debug_tests = debug } =+#ifdef __GLASGOW_HASKELL__+  do me <- myThreadId+     ready <- newEmptyMVar+     r <- if len == 0+	   then try theTest+	   else try (do+     	     -- This waits a bit, then raises an exception in its parent,+             -- saying, right, you've had long enough!+	     watcher <- forkIO (Exception.catch+			      (do threadDelay (len * 1000 * 1000)+				  takeMVar ready+				  throwTo me NonTermination+				  return ())+			      (\ _ -> return ()))+	     -- Tell the watcher we are starting...+	     putMVar ready ()+             -- This is cheating, because possibly some of the internal message+             -- inside "r" might be _|_, but anyway....+	     r <- theTest+	     -- Now, we turn off the watcher.+	     -- Ignored if the watcher is already dead,	+	     -- (unless some unlucky thread picks up the same name)+	     killThread watcher+	     return r)+     case r of+        Right r -> return r+        Left  e -> return (TestAborted e)+#else+     Exception.catch theTest $ \ e -> return (TestAborted e)+#endif+  where+	theTest = tests (batch n debug) (evaluate a) (mkStdGen 0) 0 0 []     ++-- | Prints a one line summary of various tests with common theme+runTests :: String -> TestOptions -> [TestOptions -> IO TestResult] -> IO ()+runTests name scale actions =+  do putStr (rjustify 25 name ++ " : ")+     f <- tr 1 actions [] 0+     mapM fa f+     return ()+  where+	rjustify n s = replicate (max 0 (n - length s)) ' ' ++ s++	tr n [] xs c = do+			putStr (rjustify (max 0 (35-n)) " (" ++ show c ++ ")\n")+			return xs+	tr n (action:actions) others c = +	   do r <- action scale+	      case r of+		(TestOk _ m _) +			-> do { putStr "." ;+			       tr (n+1) actions others (c+m) }+		(TestExausted s m ss) ++			-> do { putStr "?" ;+			       tr (n+1) actions others (c+m) }+		(TestAborted e) +			-> do { putStr "*" ;+			       tr (n+1) actions others c }+	  	(TestFailed f num)+			-> do { putStr "#" ;+			        tr (n+1) actions ((f,n,num):others) (c+num) }++	fa :: ([String],Int,Int) -> IO ()+	fa (f,n,no) = +	  do putStr "\n"+	     putStr ("    ** test " +			++ show (n  :: Int)+			++ " of "+			++ name+			++ " failed with the binding(s)\n")+	     sequence_ [putStr ("    **   " ++ v ++ "\n")+			| v <- f ]+  	     putStr "\n"++bottom :: a+bottom = error "_|_"++-- | Look out behind you! These can be misused badly.+-- However, in the context of a batch tester, can also be very useful.+--+-- Examples of use of bottom and isBottom:+--+-- >	{- test for abort -}+-- >	prop_head2 = isBottom (head [])+-- >	{- test for strictness -}+-- >	prop_head3 = isBottom (head bottom)++isBottom :: a -> Bool+isBottom a = unsafePerformIO (do+	a' <- try (Exception.evaluate a)+	case a' of+	   Left _ -> return True+	   Right _ -> return False)

@@ -0,0 +1,86 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Test.QuickCheck.Poly+-- Copyright   :  (c) Andy Gill 2001+-- License     :  BSD-style (see the file libraries/base/LICENSE)+-- +-- Maintainer  :  libraries@haskell.org+-- Stability   :  experimental+-- Portability :  portable+--+-- This is an attempt to emulate polymorphic types for the +-- purposes of testing by using abstract monomorphic types.+-- +-- It is likely that future versions of QuickCheck will+-- include some polymorphic emulation testing facility,+-- but this module can be used for now.+--+-----------------------------------------------------------------------------++module Test.QuickCheck.Poly+  ( ALPHA+  , BETA+  , GAMMA+  , OrdALPHA+  , OrdBETA+  , OrdGAMMA+  ) where++import Prelude++import Test.QuickCheck+import Test.QuickCheck.Utils++{- This is the basic pseudo-polymorphic object.+ - The idea is you can't cheat, and use the integer+ - directly, but need to use the abstraction.+ - + - We use phantom types (ref: Domain Specific Embedded Compilers,+ - Daan Leijen & Erik Meijer, 2nd Conference of Domain Specific+ - Languages, Austin, TX, 1999)+ -}++newtype Poly a = Poly Int++instance Show (Poly a) where+        show (Poly a) = "_" ++ show a++instance Arbitrary (Poly a) where+    arbitrary            = sized $ \n -> (choose (1,n) >>= return . Poly)+    coarbitrary (Poly n) = variant (if n >= 0 then 2*n else 2*(-n) + 1)++instance Eq a => Eq (Poly a) where+        (Poly a) == (Poly b) = a == b++instance Ord a => Ord (Poly a) where+        (Poly a) `compare` (Poly b) = a `compare` b++{-+ - These are what we export, our pseudo-polymorphic instances.+ -}++type ALPHA = Poly ALPHA_+data ALPHA_ = ALPHA_ deriving (Eq)++type BETA = Poly BETA_+data BETA_ = BETA_ deriving (Eq)++type GAMMA = Poly GAMMA_+data GAMMA_ = GAMMA_ deriving (Eq)++type OrdALPHA = Poly OrdALPHA_+data OrdALPHA_ = OrdALPHA_ deriving (Eq,Ord)++type OrdBETA = Poly OrdBETA_+data OrdBETA_ = OrdBETA_ deriving (Eq,Ord)++type OrdGAMMA = Poly OrdGAMMA_+data OrdGAMMA_ = OrdGAMMA_ deriving (Eq,Ord)++{-+ - This is a condition on OrdALPHA, OrdBETA, etc, itself.+ - It states that all OrdALPHA objects obey total ordering.+ -}++prop_OrdPOLY x y = isTotalOrder x y+    where types = (x :: OrdALPHA, y :: OrdALPHA)

@@ -0,0 +1,53 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Test.QuickCheck.Utils+-- Copyright   :  (c) Andy Gill 2001+-- License     :  BSD-style (see the file libraries/base/LICENSE)+-- +-- Maintainer  :  libraries@haskell.org+-- Stability   :  experimental+-- Portability :  portable+--+-- These are some general purpose utilities for use with QuickCheck.+--+-----------------------------------------------------------------------------++module Test.QuickCheck.Utils+  ( isAssociativeBy+  , isAssociative+  , isCommutableBy+  , isCommutable+  , isTotalOrder+  ) where++import Prelude++import Test.QuickCheck++isAssociativeBy :: (Show a,Testable prop) +		=> (a -> a -> prop) -> Gen a -> (a -> a -> a) -> Property+isAssociativeBy (===) src (**) = +     	forAll src $ \ a ->+     	forAll src $ \ b ->+     	forAll src $ \ c ->+	((a ** b) ** c) === (a ** (b ** c))++isAssociative :: (Arbitrary a,Show a,Eq a) => (a -> a -> a) -> Property+isAssociative = isAssociativeBy (==) arbitrary++isCommutableBy :: (Show a,Testable prop) +	       => (b -> b -> prop) -> Gen a -> (a -> a -> b) -> Property+isCommutableBy (===) src (**) =+	forAll src $ \ a ->+	forAll src $ \ b ->+	(a ** b) === (b ** a)++isCommutable :: (Arbitrary a,Show a,Eq b) => (a -> a -> b) -> Property+isCommutable = isCommutableBy (==) arbitrary++isTotalOrder :: (Arbitrary a,Show a,Ord a) => a -> a -> Property+isTotalOrder x y = +    classify (x > y)  "less than" $+    classify (x == y) "equals" $+    classify (x < y)  "greater than" $+    x < y || x == y || x > y