Skip to content

Commit e181aaf

Browse files
authored
Make quickCheckPure and quickCheckPure' stack safe (#127)
1 parent 7bdc476 commit e181aaf

File tree

3 files changed

+32
-8
lines changed

3 files changed

+32
-8
lines changed

CHANGELOG.md

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -9,6 +9,7 @@ Breaking changes:
99
New features:
1010

1111
Bugfixes:
12+
- `quickCheckPure` and `quickCheckPure'` stack safety (#127)
1213

1314
Other improvements:
1415

src/Test/QuickCheck.purs

Lines changed: 22 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -57,18 +57,17 @@ import Prelude
5757
import Control.Monad.Rec.Class (Step(..), tailRec)
5858
import Data.Foldable (for_)
5959
import Data.FoldableWithIndex (foldlWithIndex)
60-
import Data.List (List)
60+
import Data.List (List, (:))
6161
import Data.List as List
6262
import Data.Maybe (Maybe(..))
6363
import Data.Maybe.First (First(..))
64-
import Data.Tuple (Tuple(..))
65-
import Data.Unfoldable (replicateA)
64+
import Data.Tuple (Tuple(..), snd)
6665
import Effect (Effect)
6766
import Effect.Console (log)
6867
import Effect.Exception (throwException, error)
6968
import Random.LCG (Seed, mkSeed, unSeed, randomSeed)
7069
import Test.QuickCheck.Arbitrary (class Arbitrary, arbitrary, class Coarbitrary, coarbitrary)
71-
import Test.QuickCheck.Gen (Gen, evalGen, runGen, stateful)
70+
import Test.QuickCheck.Gen (Gen, runGen)
7271

7372
-- | Test a property.
7473
-- |
@@ -149,17 +148,33 @@ type LoopState =
149148
-- | The first argument is the _random seed_ to be passed to the random generator.
150149
-- | The second argument is the number of tests to run.
151150
quickCheckPure :: forall prop. Testable prop => Seed -> Int -> prop -> List Result
152-
quickCheckPure s n prop = evalGen (replicateA n (test prop)) { newSeed: s, size: 10 }
151+
quickCheckPure s n prop = map snd (quickCheckPure' s n prop)
153152

154153
-- | Test a property, returning all test results as a List, with the Seed that
155154
-- | was used for each result.
156155
-- |
157156
-- | The first argument is the _random seed_ to be passed to the random generator.
158157
-- | The second argument is the number of tests to run.
159158
quickCheckPure' :: forall prop. Testable prop => Seed -> Int -> prop -> List (Tuple Seed Result)
160-
quickCheckPure' s n prop = evalGen (replicateA n (go prop)) { newSeed: s, size: 10 }
159+
quickCheckPure' s n prop = tailRec loop { seed: s, index: 0, results: mempty }
161160
where
162-
go p = stateful \gs -> Tuple gs.newSeed <$> test p
161+
loop :: PureLoopState -> Step PureLoopState (List (Tuple Seed Result))
162+
loop { seed, index, results }
163+
| index == n = Done (List.reverse (results))
164+
| otherwise =
165+
case runGen (test prop) { newSeed: seed, size: 10 } of
166+
Tuple r {newSeed} ->
167+
Loop
168+
{ seed: newSeed
169+
, index: index + 1
170+
, results: (Tuple seed r) : results
171+
}
172+
173+
type PureLoopState =
174+
{ seed :: Seed
175+
, index :: Int
176+
, results :: List (Tuple Seed Result)
177+
}
163178

164179
-- | A version of `quickCheckPure` with the property specialized to `Gen`.
165180
quickCheckGenPure :: forall prop. Testable prop => Seed -> Int -> Gen prop -> List Result

test/Main.purs

Lines changed: 9 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -17,9 +17,11 @@ import Data.Number (isFinite)
1717
import Partial.Unsafe (unsafePartial)
1818
import Random.LCG (mkSeed)
1919
import Test.Assert (assert)
20-
import Test.QuickCheck (class Testable, quickCheck, (/=?), (<=?), (<?), (==?), (>=?), (>?))
20+
import Test.QuickCheck (class Testable, quickCheck, quickCheckPure', (/=?), (<=?), (<?), (==?), (>=?), (>?))
2121
import Test.QuickCheck.Arbitrary (arbitrary, genericArbitrary, class Arbitrary)
2222
import Test.QuickCheck.Gen (Gen, Size, randomSample, randomSample', resize, runGen, sized, vectorOf)
23+
import Data.Maybe (Maybe(..))
24+
import Data.List as List
2325

2426
data Foo a = F0 a | F1 a a | F2 { foo :: a, bar :: Array a }
2527
derive instance genericFoo :: Generic (Foo a) _
@@ -86,6 +88,12 @@ main = do
8688
quickCheck $ 4 >? 3
8789
quickCheckFail $ 4 <=? 3
8890

91+
log "Testing stack safety of quickCheckPure'"
92+
let n = 100_000
93+
let pairs = quickCheckPure' (mkSeed 1234) n \(x :: Int) -> x <? x + 1
94+
assert (Just (mkSeed 1234) /= map fst (List.last pairs))
95+
log ("Completed " <> show n <> " runs.")
96+
8997
log "Checking that chooseFloat over the whole Number range always yields a finite value"
9098
randomSample (MGen.chooseFloat ((-1.7976931348623157e+308)) (1.7976931348623157e+308)) >>= assert <<< all isFinite
9199

0 commit comments

Comments
 (0)