From 2b8aea01b22db9aedb5bd6bdc327a02bfa92e1c2 Mon Sep 17 00:00:00 2001 From: Daniel Schüssler Date: Mon, 19 Jan 2009 10:41:49 +0000 Subject: 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. --- lib/Numeric/LinearAlgebra/Tests.hs | 8 +- lib/Numeric/LinearAlgebra/Tests/Instances.hs | 91 ++++++++++++++++++++-- lib/Numeric/LinearAlgebra/Tests/Properties.hs | 5 +- lib/Numeric/LinearAlgebra/Tests/quickCheckCompat.h | 33 ++++++++ 4 files changed, 124 insertions(+), 13 deletions(-) create mode 100644 lib/Numeric/LinearAlgebra/Tests/quickCheckCompat.h (limited to 'lib/Numeric') 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>< (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> 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> 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 + -- cgit v1.2.3