Repository : ssh://darcs.haskell.org//srv/darcs/packages/bytestring On branch : master
http://hackage.haskell.org/trac/ghc/changeset/f20a5dcb1918409a4bb8de396cc41138ab4f327f >--------------------------------------------------------------- commit f20a5dcb1918409a4bb8de396cc41138ab4f327f Author: Duncan Coutts <[email protected]> Date: Sat Nov 5 23:35:37 2011 +0000 Fix test-suite and get rid of some warnings Based on a patch by Bas van Dijk <[email protected]> >--------------------------------------------------------------- bytestring.cabal | 2 +- tests/Properties.hs | 5 +++-- tests/QuickCheckUtils.hs | 15 ++------------- 3 files changed, 6 insertions(+), 16 deletions(-) diff --git a/bytestring.cabal b/bytestring.cabal index 6fb067c..fe625fb 100644 --- a/bytestring.cabal +++ b/bytestring.cabal @@ -78,7 +78,7 @@ test-suite prop-compiled type: exitcode-stdio-1.0 main-is: Properties.hs hs-source-dirs: . tests - build-depends: base, deepseq, random, directory, + build-depends: base, deepseq, random >= 1.0.1, directory, QuickCheck >= 2.3 && < 3 if impl(ghc >= 6.10) build-depends: ghc-prim diff --git a/tests/Properties.hs b/tests/Properties.hs index 55bf350..6f6b95f 100644 --- a/tests/Properties.hs +++ b/tests/Properties.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE PatternSignatures #-} +{-# LANGUAGE ScopedTypeVariables, BangPatterns #-} -- -- Must have rules off, otherwise the fusion rules will replace the rhs -- with the lhs, and we only end up testing lhs == lhs @@ -8,8 +8,9 @@ -- -fhpc interferes with rewrite rules firing. -- -import Foreign +import Foreign.Storable import Foreign.ForeignPtr +import Foreign.Marshal.Alloc import Foreign.Marshal.Array import GHC.Ptr import Test.QuickCheck diff --git a/tests/QuickCheckUtils.hs b/tests/QuickCheckUtils.hs index d07fc91..e156366 100644 --- a/tests/QuickCheckUtils.hs +++ b/tests/QuickCheckUtils.hs @@ -1,4 +1,5 @@ -{-# OPTIONS_GHC -fglasgow-exts #-} +{-# LANGUAGE CPP, MultiParamTypeClasses, + FlexibleInstances, TypeSynonymInstances #-} -- -- Uses multi-param type classes -- @@ -74,18 +75,6 @@ mytest p n = do ------------------------------------------------------------------------ -instance Random Word8 where - randomR = integralRandomR - random = randomR (minBound,maxBound) - -instance Random CChar where - randomR = integralRandomR - random = randomR (minBound,maxBound) - -instance Random Int64 where - randomR = integralRandomR - random = randomR (minBound,maxBound) - integralRandomR :: (Integral a, RandomGen g) => (a,a) -> g -> (a,g) integralRandomR (a,b) g = case randomR (fromIntegral a :: Integer, fromIntegral b :: Integer) g of _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
