module Test.Chell.QuickCheck
( property
) where
import Data.Text (Text, pack)
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 => Text -> prop -> Chell.Suite
property name prop = Chell.test (Chell.Test name chell_io) where
chell_io 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 = pack (Test.output result)
return $ case result of
Test.Success{} -> Chell.TestPassed
[("seed", pack (show seed))]
Test.Failure{} -> Chell.TestFailed
[("seed", pack (show seed))]
[Chell.Failure Nothing output]
Test.GaveUp{} -> Chell.TestAborted
[("seed", pack (show seed))]
output
Test.NoExpectedFailure{} -> Chell.TestFailed
[("seed", pack (show seed))]
[Chell.Failure Nothing output]
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