Merge pull request #60 from purescript/bump3

Prepare for 2.0 release (sans shrinking)

Author: garyb

src/Test/QuickCheck.purs

@@ -19,6 +19,7 @@ module Test.QuickCheck
   ( QC
   , quickCheck
   , quickCheck'
+  , quickCheckWithSeed
   , quickCheckPure
   , class Testable
   , test
@@ -29,6 +30,8 @@ module Test.QuickCheck
   , (===)
   , assertNotEquals
   , (/==)
+  , module Test.QuickCheck.LCG
+  , module Test.QuickCheck.Arbitrary
   ) where
 
 import Prelude
@@ -47,9 +50,9 @@ import Data.Monoid (mempty)
 import Data.Tuple (Tuple(..))
 import Data.Unfoldable (replicateA)
 
-import Test.QuickCheck.Arbitrary (class Arbitrary, arbitrary)
+import Test.QuickCheck.Arbitrary (class Arbitrary, arbitrary, class Coarbitrary, coarbitrary)
 import Test.QuickCheck.Gen (Gen, evalGen, runGen)
-import Test.QuickCheck.LCG (Seed, randomSeed)
+import Test.QuickCheck.LCG (Seed, runSeed, randomSeed)
 
 -- | A type synonym which represents the effects used by the `quickCheck` function.
 type QC eff a = Eff (console :: CONSOLE, random :: RANDOM, err :: EXCEPTION | eff) a
@@ -66,14 +69,24 @@ quickCheck prop = quickCheck' 100 prop
 quickCheck' :: forall eff prop. Testable prop => Int -> prop -> QC eff Unit
 quickCheck' n prop = do
   seed <- randomSeed
+  quickCheckWithSeed seed n prop
+
+-- | A variant of the `quickCheck'` function that accepts a specific seed as
+-- | well as the number tests that should be run.
+quickCheckWithSeed
+  :: forall eff prop. Testable prop => Seed -> Int -> prop -> QC eff Unit
+quickCheckWithSeed seed n prop = do
   let result = tailRec loop { seed, index: 0, successes: 0, firstFailure: mempty }
   log $ show result.successes <> "/" <> show n <> " test(s) passed."
-  for_ result.firstFailure \{ index, message } ->
-    throwException $ error $ "Test " <> show (index + 1) <> " failed: \n" <> message
+  for_ result.firstFailure \{ index, message, seed: failureSeed } ->
+    throwException $ error
+      $ "Test " <> show (index + 1)
+      <> " (seed " <> show (runSeed failureSeed) <> ") failed: \n"
+      <> message
   where
-  loop :: LoopState -> Step LoopState (LoopResult ())
-  loop { seed, index, successes, firstFailure }
-    | index == n = Done { successes, firstFailure }
+  loop :: LoopState -> Step LoopState LoopState
+  loop state@{ seed, index, successes, firstFailure }
+    | index == n = Done state
     | otherwise =
         case runGen (test prop) { newSeed: seed, size: 10 } of
           Tuple Success s ->
@@ -88,17 +101,17 @@ quickCheck' n prop = do
               { seed: s.newSeed
               , index: index + 1
               , successes
-              , firstFailure: firstFailure <> First (Just { index, message })
+              , firstFailure:
+                  firstFailure <> First (Just { index, message, seed })
               }
 
-type LoopResult r =
+type LoopState =
   { successes :: Int
-  , firstFailure :: First { index :: Int, message :: String }
-  | r
+  , firstFailure :: First { index :: Int, message :: String, seed :: Seed }
+  , seed :: Seed
+  , index :: Int
   }
 
-type LoopState = LoopResult (seed :: Seed, index :: Int)
-
 -- | Test a property, returning all test results as an array.
 -- |
 -- | The first argument is the _random seed_ to be passed to the random generator.
@@ -125,6 +138,9 @@ instance testableBoolean :: Testable Boolean where
 instance testableFunction :: (Arbitrary t, Testable prop) => Testable (t -> prop) where
   test f = arbitrary >>= test <<< f
 
+instance testableGen :: Testable prop => Testable (Gen prop) where
+  test = flip bind test
+
 -- | The result of a test: success or failure (with an error message).
 data Result = Success | Failed String
 

src/Test/QuickCheck/Data/AlphaNumString.purs

@@ -8,13 +8,15 @@ import Data.Newtype (class Newtype)
 import Data.String (fromCharArray, toCharArray)
 
 import Test.QuickCheck.Gen (Gen, arrayOf, oneOf)
-import Test.QuickCheck.Arbitrary (class Coarbitrary, class Arbitrary, coarbitrary)
+import Test.QuickCheck.Arbitrary (class Coarbitrary, class Arbitrary)
 
 -- | A newtype for `String` whose `Arbitrary` instance generated random
 -- | alphanumeric strings.
 newtype AlphaNumString = AlphaNumString String
 
 derive instance newtypeAlphaNumString :: Newtype AlphaNumString _
+derive newtype instance eqAlphaNumString :: Eq AlphaNumString
+derive newtype instance ordAlphaNumString :: Ord AlphaNumString
 
 instance arbAlphaNumString :: Arbitrary AlphaNumString where
   arbitrary = AlphaNumString <<< fromCharArray <$> arrayOf anyChar
@@ -25,5 +27,4 @@ instance arbAlphaNumString :: Arbitrary AlphaNumString where
     anyChar :: Gen Char
     anyChar = oneOf (pure 'a') (map pure rest)
 
-instance coarbAlphaNumString :: Coarbitrary AlphaNumString where
-  coarbitrary (AlphaNumString s) = coarbitrary s
+derive newtype instance coarbAlphaNumString :: Coarbitrary AlphaNumString

src/Test/QuickCheck/LCG.purs

@@ -58,7 +58,7 @@ seedMin = 1
 
 -- | The maximum permissible Seed value.
 seedMax :: Int
-seedMax = lcgM - 1
+seedMax = lcgN - 1
 
 -- | A seed for the linear congruential generator. We omit a `Semiring`
 -- | instance because there is no `zero` value, as 0 is not an acceptable
@@ -73,8 +73,11 @@ runSeed (Seed x) = x
 
 ensureBetween :: Int -> Int -> Int -> Int
 ensureBetween min max n =
-  let rangeSize = max - min
-  in (((n `mod` rangeSize) + rangeSize) `mod` rangeSize) + min
+  let
+    rangeSize = max - min
+    n' = n `mod` rangeSize
+  in
+    if n' < min then n' + max else n'
 
 instance showSeed :: Show Seed where
   show (Seed x) = "Seed " <> show x