--- show-0.3.4-orig/show.cabal 2010-01-20 11:24:11.000000000 +1100 +++ show-0.3.4/show.cabal 2010-12-11 14:45:16.596614944 +1100 @@ -30,7 +30,7 @@ library exposed-modules: ShowQ, ShowFun, ShowIO, SimpleReflect - build-depends: random, QuickCheck<2, smallcheck>=0.4 + build-depends: random, QuickCheck>=2 && <3, smallcheck>=0.4 if flag(Base4orNewer) build-depends: base >= 4 && < 5, syb --- show-0.3.4-orig/ShowQ.hs 2010-01-20 11:24:11.000000000 +1100 +++ show-0.3.4/ShowQ.hs 2010-12-11 14:26:05.181930087 +1100 @@ -6,12 +6,13 @@ module ShowQ where --- import Language.Haskell.TH import System.IO.Unsafe import Data.Ratio import qualified Test.SmallCheck (smallCheck, Testable) -import Test.QuickCheck +import Test.QuickCheck hiding (Result, reason) +import Test.QuickCheck.Gen +import Test.QuickCheck.Property hiding (result) import Data.Char import Data.List import Data.Word @@ -21,48 +22,57 @@ type T = [Int] type I = Int -instance Arbitrary Char where - arbitrary = choose (minBound, maxBound) - coarbitrary c = variant (ord c `rem` 4) - -instance Arbitrary Word8 where - arbitrary = choose (minBound, maxBound) - coarbitrary c = variant (fromIntegral ((fromIntegral c) `rem` 4)) - -instance Arbitrary Ordering where - arbitrary = elements [LT,EQ,GT] - coarbitrary LT = variant 1 - coarbitrary EQ = variant 2 - coarbitrary GT = variant 0 - -instance Arbitrary Int64 where - arbitrary = sized $ \n -> choose (-fromIntegral n,fromIntegral n) - coarbitrary n = variant (fromIntegral (if n >= 0 then 2*n else 2*(-n) + 1)) - -instance (Integral a, Arbitrary a) => Arbitrary (Ratio a) where - arbitrary = do a <- arbitrary - b <- arbitrary - return $ if b == 0 - then if a == 0 - then (1 % 1) - else (b % a) - else (a % b) - - coarbitrary m = variant (fromIntegral $ if n >= 0 then 2*n else 2*(-n) + 1) - where n = numerator m - -instance Random Word8 where - randomR = integralRandomR - random = randomR (minBound,maxBound) - -instance Random Int64 where - randomR = integralRandomR - random = randomR (minBound,maxBound) +-- instance Arbitrary Char where +-- arbitrary = choose (minBound, maxBound) + +-- instance CoArbitrary Char where +-- coarbitrary c = variant (ord c `rem` 4) + +-- instance Arbitrary Word8 where +-- arbitrary = choose (minBound, maxBound) + +-- instance CoArbitrary Word8 where +-- coarbitrary c = variant (fromIntegral ((fromIntegral c) `rem` 4)) + +-- instance Arbitrary Ordering where +-- arbitrary = elements [LT,EQ,GT] + +-- instance CoArbitrary Ordering where +-- coarbitrary LT = variant 1 +-- coarbitrary EQ = variant 2 +-- coarbitrary GT = variant 0 + +-- instance Arbitrary Int64 where +-- arbitrary = sized $ \n -> choose (-fromIntegral n,fromIntegral n) + +-- instance CoArbitrary Int64 where +-- coarbitrary n = variant (fromIntegral (if n >= 0 then 2*n else 2*(-n) + 1)) + +-- instance (Integral a, Arbitrary a) => Arbitrary (Ratio a) where +-- arbitrary = do a <- arbitrary +-- b <- arbitrary +-- return $ if b == 0 +-- then if a == 0 +-- then (1 % 1) +-- else (b % a) +-- else (a % b) + +-- instance (Integral a, CoArbitrary a) => CoArbitrary (Ratio a) where +-- coarbitrary m = variant (fromIntegral $ if n >= 0 then 2*n else 2*(-n) + 1) +-- where n = numerator m + +-- instance Random Word8 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 - (x,g) -> (fromIntegral x, g) + (x,g') -> (fromIntegral x, g') mysmallcheck :: (Test.SmallCheck.Testable a) => a -> () mysmallcheck = unsafePerformIO . mysmallcheck' @@ -70,25 +80,33 @@ mysmallcheck' a = Test.SmallCheck.smallCheck 6 a myquickcheck :: Testable a => a -> String -myquickcheck = unsafePerformIO . myquickcheck' - -myquickcheck' :: Testable a => a -> IO String -myquickcheck' a = do - rnd <- newStdGen - tests (evaluate a) rnd 0 0 [] - +myquickcheck = concat . (map fst) . labels . unsafePerformIO . quickCheckResult +-- note: Quickcheck 2.4 has "output" that can replace "concat . (map fst) . labels" +-- however avoiding output to maintain compatibility with quickcheck 2.1.1.1 +-- myquickcheck = output . unsafePerformIO . quickCheckResult + +-- myquickcheck' :: Testable a => a -> IO String +-- myquickcheck' a = do +-- rnd <- newStdGen +-- tests (evaluate a) rnd 0 0 [] + +generate :: Int -> StdGen -> Gen a -> a +generate n rnd (MkGen m) = m rnd' size + where + (size, rnd') = randomR (0, n) rnd + tests :: Gen Result -> StdGen -> Int -> Int -> [[String]] -> IO String tests gen rnd0 ntest nfail stamps | ntest == 500 = done "OK, passed" ntest stamps | nfail == 1000 = done "Arguments exhausted after" ntest stamps | otherwise = case ok result of Nothing -> tests gen rnd1 ntest (nfail+1) stamps - Just True -> tests gen rnd1 (ntest+1) nfail (stamp result:stamps) + Just True -> tests gen rnd1 (ntest+1) nfail (map fst (stamp result):stamps) Just False -> return $ "Falsifiable, after " ++ show ntest ++ " tests:\n" - ++ unlines (arguments result) - where + ++ reason result + where result = generate (((+ 3) . (`div` 2)) ntest) rnd2 gen (rnd1,rnd2) = split rnd0