module Test.Chell.QuickCheck
( property
) where
import System.Random (mkStdGen)
import qualified Test.Chell as Chell
import qualified Test.QuickCheck as QuickCheck
import qualified Test.QuickCheck.Gen as Gen
import qualified Test.QuickCheck.State as State
import qualified Test.QuickCheck.Test as Test
import qualified Test.QuickCheck.Text as Text
property :: QuickCheck.Testable prop => String -> prop -> Chell.Test
property name prop = Chell.test name $ \opts -> do
let seed = Chell.testOptionSeed opts
term <- Text.newNullTerminal
let args = QuickCheck.stdArgs
let state = State.MkState
{ State.terminal = term
, State.maxSuccessTests = QuickCheck.maxSuccess args
, State.maxDiscardedTests = QuickCheck.maxDiscard args
, State.computeSize = computeSize (QuickCheck.maxSize args) (QuickCheck.maxSuccess args)
, State.numSuccessTests = 0
, State.numDiscardedTests = 0
, State.collected = []
, State.expectedFailure = False
, State.randomSeed = mkStdGen seed
, State.numSuccessShrinks = 0
, State.numTryShrinks = 0
}
result <- Test.test state (Gen.unGen (QuickCheck.property prop))
let output = Test.output result
let notes = [("seed", show seed)]
let 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]
computeSize :: Int -> Int -> Int -> Int -> Int
computeSize maxSize maxSuccess n d
| 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