4 files changed, 124 insertions, 13 deletions

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
+