{-# LANGUAGE CPP #-} module Test.Chell.QuickCheck ( property ) where import Data.Monoid (mempty) import System.Random (mkStdGen) import qualified Test.Chell as Chell import qualified Test.QuickCheck as QuickCheck import qualified Test.QuickCheck.Gen as Gen #if MIN_VERSION_QuickCheck(2,7,0) import Test.QuickCheck.Property (unProperty) import qualified Test.QuickCheck.Random as QCRandom #endif import qualified Test.QuickCheck.State as State import qualified Test.QuickCheck.Test as Test import qualified Test.QuickCheck.Text as Text -- | Convert a QuickCheck property to a Chell 'Chell.Test'. -- -- @ --import Test.Chell --import Test.Chell.QuickCheck --import Test.QuickCheck hiding (property) -- --test_NullLength :: Test --test_NullLength = property \"null-length\" -- (\xs -> not (null xs) ==> length xs > 0) -- @ property :: QuickCheck.Testable prop => String -> prop -> Chell.Test #if MIN_VERSION_QuickCheck(2,6,0) property name prop = Chell.test name $ \opts -> Text.withNullTerminal $ \term -> do #else property name prop = Chell.test name $ \opts -> do term <- Text.newNullTerminal #endif let seed = Chell.testOptionSeed opts args = QuickCheck.stdArgs state = State.MkState { State.terminal = term , State.maxSuccessTests = QuickCheck.maxSuccess args #if MIN_VERSION_QuickCheck(2,10,1) , State.maxDiscardedRatio = QuickCheck.maxDiscardRatio args #else , State.maxDiscardedTests = maxDiscardedTests args prop #endif , State.computeSize = computeSize (QuickCheck.maxSize args) (QuickCheck.maxSuccess args) , State.numSuccessTests = 0 , State.numDiscardedTests = 0 #if MIN_VERSION_QuickCheck(2,12,0) , State.classes = mempty , State.tables = mempty , State.requiredCoverage = mempty , State.expected = True , State.coverageConfidence = Nothing #else , State.collected = [] , State.expectedFailure = False #endif #if MIN_VERSION_QuickCheck(2,7,0) , State.randomSeed = QCRandom.mkQCGen seed #else , State.randomSeed = mkStdGen seed #endif , State.numSuccessShrinks = 0 , State.numTryShrinks = 0 #if MIN_VERSION_QuickCheck(2,5,0) , State.numTotTryShrinks = 0 #endif #if MIN_VERSION_QuickCheck(2,5,1) , State.numRecentlyDiscardedTests = 0 #endif #if MIN_VERSION_QuickCheck(2,8,0) , State.labels = mempty #endif #if MIN_VERSION_QuickCheck(2,10,0) , State.numTotMaxShrinks = QuickCheck.maxShrinks args #endif } #if MIN_VERSION_QuickCheck(2,12,0) result <- Test.test state (QuickCheck.property prop) #else #if MIN_VERSION_QuickCheck(2,7,0) let genProp = unProperty (QuickCheck.property prop) #else let genProp = QuickCheck.property prop #endif result <- Test.test state (Gen.unGen genProp) #endif let output = Test.output result notes = [("seed", show seed)] failure = Chell.failure { Chell.failureMessage = output } return $ case result of Test.Success{} -> Chell.TestPassed notes Test.Failure{} -> Chell.TestFailed notes [failure] Test.GaveUp{} -> Chell.TestAborted notes output Test.NoExpectedFailure{} -> Chell.TestFailed notes [failure] -- copied from quickcheck-2.4.1.1/src/Test/QuickCheck/Test.hs computeSize :: Int -> Int -> Int -> Int -> Int computeSize maxSize maxSuccess n d -- e.g. with maxSuccess = 250, maxSize = 100, goes like this: -- 0, 1, 2, ..., 99, 0, 1, 2, ..., 99, 0, 2, 4, ..., 98. | n `roundTo` maxSize + maxSize <= maxSuccess || n >= maxSuccess || maxSuccess `mod` maxSize == 0 = n `mod` maxSize + d `div` 10 | otherwise = (n `mod` maxSize) * maxSize `div` (maxSuccess `mod` maxSize) + d `div` 10 roundTo :: Int -> Int -> Int roundTo n m = (n `div` m) * m maxDiscardedTests :: QuickCheck.Testable prop => QuickCheck.Args -> prop -> Int #if MIN_VERSION_QuickCheck(2,9,0) maxDiscardedTests args _ = QuickCheck.maxDiscardRatio args #elif MIN_VERSION_QuickCheck(2,5,0) maxDiscardedTests args p = if QuickCheck.exhaustive p then QuickCheck.maxDiscardRatio args else QuickCheck.maxDiscardRatio args * QuickCheck.maxSuccess args #else maxDiscardedTests args _ = QuickCheck.maxDiscard args #endif