Compatibility with QuickCheck 2 as well as QuickCheck 1

Used the C preprocessor to make it compile against either QuickCheck version. Added some implementations for the new "shrink" method of class Arbitrary.

The tests (runTests 10) succeed when compiled with QC 1. 

With QC 2 (runTests 10 too) the fourth "vector operations" test (complex trigonometry) now fails. I don't know whether this is a bug in my changes, or whether QC 2 just generates Doubles differently and thus uncovered a real bug.

5 files changed, 128 insertions, 15 deletions

diff --git a/hmatrix.cabal b/hmatrix.cabal
index 516e6b5..c1b4e01 100644
--- a/hmatrix.cabal
+++ b/hmatrix.cabal
@@ -15,6 +15,8 @@ tested-with:        GHC ==6.10.1
 
 cabal-version:      >=1.2
 build-type:         Simple
+extra-source-files: lib/Numeric/LinearAlgebra/Tests/quickCheckCompat.h
+
 
 flag splitBase
     description:    Choose the new smaller, split-up base package.
@@ -34,9 +36,9 @@ flag unsafe
 
 library
     if flag(splitBase)
-      build-depends:    base >= 3, array, QuickCheck < 2, HUnit, storable-complex
+      build-depends:    base >= 3, array, QuickCheck, HUnit, storable-complex
     else
-      build-depends:    base < 3, QuickCheck < 2, HUnit, storable-complex
+      build-depends:    base < 3, QuickCheck, HUnit, storable-complex
 
     Build-Depends:      haskell98
     Extensions:         ForeignFunctionInterface,
diff --git a/lib/Numeric/LinearAlgebra/Tests.hs b/lib/Numeric/LinearAlgebra/Tests.hs
index 9617a7a..8b92287 100644
--- a/lib/Numeric/LinearAlgebra/Tests.hs
+++ b/lib/Numeric/LinearAlgebra/Tests.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE CPP #-}
+{-# OPTIONS_GHC -fno-warn-unused-imports #-}
 -----------------------------------------------------------------------------
 {- |
 Module      :  Numeric.LinearAlgebra.Tests
@@ -22,18 +24,16 @@ module Numeric.LinearAlgebra.Tests(
 import Numeric.LinearAlgebra
 import Numeric.LinearAlgebra.Tests.Instances
 import Numeric.LinearAlgebra.Tests.Properties
-import Test.QuickCheck hiding (test)
-import Test.HUnit hiding ((~:),test)
+import Test.HUnit hiding ((~:),test,Testable)
 import System.Info
 import Data.List(foldl1')
 import Numeric.GSL hiding (sin,cos,exp,choose)
 import Prelude hiding ((^))
 import qualified Prelude
+#include "Tests/quickCheckCompat.h"
 
 a ^ b = a Prelude.^ (b :: Int)
 
-qCheck n = check defaultConfig {configSize = const n}
-
 utest str b = TestCase $ assertBool str b
 
 feye n = flipud (ident n) :: Matrix Double
diff --git a/lib/Numeric/LinearAlgebra/Tests/Instances.hs b/lib/Numeric/LinearAlgebra/Tests/Instances.hs
index 4e829d2..9b18513 100644
--- a/lib/Numeric/LinearAlgebra/Tests/Instances.hs
+++ b/lib/Numeric/LinearAlgebra/Tests/Instances.hs
@@ -1,4 +1,5 @@
-{-# LANGUAGE FlexibleContexts, UndecidableInstances #-}
+{-# LANGUAGE FlexibleContexts, UndecidableInstances, CPP #-}
+{-# OPTIONS_GHC -fno-warn-unused-imports #-}
 -----------------------------------------------------------------------------
 {- |
 Module      :  Numeric.LinearAlgebra.Tests.Instances
@@ -24,24 +25,53 @@ module Numeric.LinearAlgebra.Tests.Instances(
     RM,CM, rM,cM
 ) where
 
+
+
+
 import Numeric.LinearAlgebra
-import Test.QuickCheck
 import Control.Monad(replicateM)
+#include "quickCheckCompat.h"
+
+
+#if MIN_VERSION_QuickCheck(2,0,0)
+shrinkListElementwise :: (Arbitrary a) => [a] -> [[a]]
+shrinkListElementwise []     = []
+shrinkListElementwise (x:xs) = [ y:xs | y  <- shrink x                 ]
+                            ++ [ x:ys | ys <- shrinkListElementwise xs ]
+
+shrinkPair :: (Arbitrary a, Arbitrary b) => (a,b) -> [(a,b)]
+shrinkPair (a,b) = [ (a,x) | x <- shrink b ] ++ [ (x,b) | x <- shrink a ]
+#endif
+
 
 instance (Arbitrary a, RealFloat a) => Arbitrary (Complex a) where
     arbitrary = do
         re <- arbitrary
         im <- arbitrary
         return (re :+ im)
-    coarbitrary = undefined
+
+#if MIN_VERSION_QuickCheck(2,0,0)
+    shrink (re :+ im) = 
+        [ u :+ v | (u,v) <- shrinkPair (re,im) ]
+#else
+    -- this has been moved to the 'Coarbitrary' class in QuickCheck 2
+    coarbitrary = undefined 
+#endif
 
 chooseDim = sized $ \m -> choose (1,max 1 m)
 
 instance (Field a, Arbitrary a) => Arbitrary (Vector a) where 
-   arbitrary = do m <- chooseDim
-                  l <- vector m
-                  return $ fromList l
-   coarbitrary = undefined
+    arbitrary = do m <- chooseDim
+                   l <- vector m
+                   return $ fromList l
+
+#if MIN_VERSION_QuickCheck(2,0,0)
+    -- shrink any one of the components
+    shrink = map fromList . shrinkListElementwise . toList
+                              
+#else
+    coarbitrary = undefined
+#endif
 
 instance (Element a, Arbitrary a) => Arbitrary (Matrix a) where 
     arbitrary = do
@@ -49,7 +79,17 @@ instance (Element a, Arbitrary a) => Arbitrary (Matrix a) where
         n <- chooseDim
         l <- vector (m*n)
         return $ (m><n) l
+
+#if MIN_VERSION_QuickCheck(2,0,0)
+    -- shrink any one of the components
+    shrink a = map ((rows a) >< (cols a))
+               . shrinkListElementwise
+               . concat . toLists 
+                     $ a
+#else
     coarbitrary = undefined
+#endif
+
 
 -- a square matrix
 newtype (Sq a) = Sq (Matrix a) deriving Show
@@ -58,7 +98,13 @@ instance (Element a, Arbitrary a) => Arbitrary (Sq a) where
         n <- chooseDim
         l <- vector (n*n)
         return $ Sq $ (n><n) l
+
+#if MIN_VERSION_QuickCheck(2,0,0)
+    shrink (Sq a) = [ Sq b | b <- shrink a ]
+#else
     coarbitrary = undefined
+#endif
+
 
 -- a unitary matrix
 newtype (Rot a) = Rot (Matrix a) deriving Show
@@ -67,7 +113,12 @@ instance (Field a, Arbitrary a) => Arbitrary (Rot a) where
         Sq m <- arbitrary
         let (q,_) = qr m
         return (Rot q)
+
+#if MIN_VERSION_QuickCheck(2,0,0)
+#else
     coarbitrary = undefined
+#endif
+
 
 -- a complex hermitian or real symmetric matrix
 newtype (Her a) = Her (Matrix a) deriving Show
@@ -76,7 +127,12 @@ instance (Field a, Arbitrary a, Num (Vector a)) => Arbitrary (Her a) where
         Sq m <- arbitrary
         let m' = m/2
         return $ Her (m' + ctrans m')
+
+#if MIN_VERSION_QuickCheck(2,0,0)
+#else
     coarbitrary = undefined
+#endif
+
 
 -- a well-conditioned general matrix (the singular values are between 1 and 100)
 newtype (WC a) = WC (Matrix a) deriving Show
@@ -90,7 +146,12 @@ instance (Field a, Arbitrary a) => Arbitrary (WC a) where
         sv <- replicateM n (choose (1,100))
         let s = diagRect (fromList sv) r c
         return $ WC (u <> real s <> trans v)
+
+#if MIN_VERSION_QuickCheck(2,0,0)
+#else
     coarbitrary = undefined
+#endif
+
 
 -- a well-conditioned square matrix (the singular values are between 1 and 100)
 newtype (SqWC a) = SqWC (Matrix a) deriving Show
@@ -102,7 +163,12 @@ instance (Field a, Arbitrary a) => Arbitrary (SqWC a) where
         sv <- replicateM n (choose (1,100))
         let s = diag (fromList sv)
         return $ SqWC (u <> real s <> trans v)
+
+#if MIN_VERSION_QuickCheck(2,0,0)
+#else
     coarbitrary = undefined
+#endif
+
 
 -- a positive definite square matrix (the eigenvalues are between 0 and 100)
 newtype (PosDef a) = PosDef (Matrix a) deriving Show
@@ -115,7 +181,12 @@ instance (Field a, Arbitrary a, Num (Vector a)) => Arbitrary (PosDef a) where
         let s = diag (fromList l)
             p = v <> real s <> ctrans v
         return $ PosDef (0.5 .* p + 0.5 .* ctrans p)
+
+#if MIN_VERSION_QuickCheck(2,0,0)
+#else
     coarbitrary = undefined
+#endif
+
 
 -- a pair of matrices that can be multiplied
 newtype (Consistent a) = Consistent (Matrix a, Matrix a) deriving Show
@@ -127,7 +198,13 @@ instance (Field a, Arbitrary a) => Arbitrary (Consistent a) where
         la <- vector (n*k)
         lb <- vector (k*m)
         return $ Consistent ((n><k) la, (k><m) lb)
+
+#if MIN_VERSION_QuickCheck(2,0,0)
+    shrink (Consistent (x,y)) = [ Consistent (u,v) | (u,v) <- shrinkPair (x,y) ]
+#else
     coarbitrary = undefined
+#endif
+
 
 
 type RM = Matrix Double
diff --git a/lib/Numeric/LinearAlgebra/Tests/Properties.hs b/lib/Numeric/LinearAlgebra/Tests/Properties.hs
index ec87ad0..d4c2770 100644
--- a/lib/Numeric/LinearAlgebra/Tests/Properties.hs
+++ b/lib/Numeric/LinearAlgebra/Tests/Properties.hs
@@ -1,4 +1,5 @@
-{-# OPTIONS #-}
+{-# LANGUAGE CPP #-}
+{-# OPTIONS_GHC -fno-warn-unused-imports #-}
 -----------------------------------------------------------------------------
 {- |
 Module      :  Numeric.LinearAlgebra.Tests.Properties
@@ -40,7 +41,7 @@ module Numeric.LinearAlgebra.Tests.Properties (
 ) where
 
 import Numeric.LinearAlgebra
-import Test.QuickCheck
+#include "quickCheckCompat.h"
 -- import Debug.Trace
 
 -- debug x = trace (show x) x
diff --git a/lib/Numeric/LinearAlgebra/Tests/quickCheckCompat.h b/lib/Numeric/LinearAlgebra/Tests/quickCheckCompat.h
new file mode 100644
index 0000000..714587b
--- /dev/null
+++ b/lib/Numeric/LinearAlgebra/Tests/quickCheckCompat.h
@@ -0,0 +1,33 @@
+#ifndef MIN_VERSION_QuickCheck
+#define MIN_VERSION_QuickCheck(A,B,C) 1
+#endif
+
+#if MIN_VERSION_QuickCheck(2,0,0)
+import Test.QuickCheck(Arbitrary,arbitrary,coarbitrary,choose,vector
+                      ,sized,classify,Testable,Property
+
+                      ,quickCheckWith,maxSize,stdArgs,shrink)
+
+#else
+import Test.QuickCheck(Arbitrary,arbitrary,coarbitrary,choose,vector
+                      ,sized,classify,Testable,Property
+
+                      ,check,configSize,defaultConfig,trivial)
+#endif
+
+
+
+#if MIN_VERSION_QuickCheck(2,0,0)
+trivial :: Testable a => Bool -> a -> Property
+trivial = (`classify` "trivial")
+#else
+#endif
+
+
+-- define qCheck, which used to be in Tests.hs
+#if MIN_VERSION_QuickCheck(2,0,0)
+qCheck n = quickCheckWith stdArgs {maxSize = n}
+#else
+qCheck n = check defaultConfig {configSize = const n}
+#endif
+