tasty-quickcheck 0.10.3 → 0.11

raw patch · 4 files changed

+132/−49 lines, 4 filesdep ~QuickCheckPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: QuickCheck

API changes (from Hackage documentation)

Files

• CHANGELOG.md +20/−1
• Test/Tasty/QuickCheck.hs +58/−45
• tasty-quickcheck.cabal +4/−3
• tests/test.hs +50/−0

@@ -1,10 +1,29 @@ Changes ======= +Version 0.11+--------------++* Fix issues with QuickCheck progress reporting in the presence of `withMaxSuccess`+  ([#419](https://github.com/UnkindPartition/tasty/pull/419)).+* Produce seeds that run a single failing tests instead of reproducing+  all the earlier successes ([#410](https://github.com/UnkindPartition/tasty/pull/410)).++  Seeds are now pairs instead of single integers, e.g.+  `--quickcheck-replay="(SMGen 2909028190965759779 12330386376379709109,0)"`++  Single integer seeds are still accepted as input, but they do run through+  earlier successes.++  The `QuickCheckReplay` type used as a tasty option has three data constructors+  now. `QuickCheckReplayNone` is the default value and provides no seed.+  `QuickCheckReplayLegacy` takes an integer as before. The `QuickCheckReplay`+  data constructor takes the new seed form.+ Version 0.10.3 -------------- -* Print Quickcheck progress using Tasty progress reporting.+* Print QuickCheck progress using Tasty progress reporting.   ([#311](https://github.com/UnkindPartition/tasty/pull/311)).  Version 0.10.2

@@ -24,9 +24,8 @@ import Test.Tasty.Providers import Test.Tasty.Options import qualified Test.QuickCheck as QC-import qualified Test.QuickCheck.Test as QC+import qualified Test.QuickCheck.Property as QCP import qualified Test.QuickCheck.State as QC-import qualified Test.QuickCheck.Text as QC import Test.Tasty.Runners (formatMessage, emptyProgress) import Test.QuickCheck hiding -- for re-export   ( quickCheck@@ -50,16 +49,14 @@   , verboseCheckAll   ) -import qualified Data.Char as Char+import Control.Applicative import Data.Typeable import Data.List import Text.Printf-import Text.Read (readMaybe)-import Test.QuickCheck.Random (mkQCGen)+import Test.QuickCheck.Random (QCGen, mkQCGen) import Options.Applicative (metavar) import System.Random (getStdRandom, randomR) #if !MIN_VERSION_base(4,9,0)-import Control.Applicative import Data.Monoid #endif @@ -82,7 +79,21 @@ newtype QuickCheckTests = QuickCheckTests Int   deriving (Num, Ord, Eq, Real, Enum, Integral, Typeable) -newtype QuickCheckReplay = QuickCheckReplay (Maybe Int)+-- | Replay seed+data QuickCheckReplay+    = -- | No seed+      --+      -- @since 0.11+      QuickCheckReplayNone+    | -- | Legacy integer seed+      --+      -- @since 0.11+      QuickCheckReplayLegacy Int+    | -- | @(qcgen, intSize)@ holds both the seed and the size+      -- to run QuickCheck tests+      --+      -- @since 0.11+      QuickCheckReplay (QCGen, Int)   deriving (Typeable)  -- | If a test case fails unexpectedly, show the replay token@@ -118,11 +129,12 @@   optionCLParser = mkOptionCLParser $ metavar "NUMBER"  instance IsOption QuickCheckReplay where-  defaultValue = QuickCheckReplay Nothing-  -- Reads a replay int seed-  parseValue v = QuickCheckReplay . Just <$> safeRead v+  defaultValue = QuickCheckReplayNone+  -- Reads either a replay Int seed or a (QCGen, Int) seed+  parseValue v =+    (QuickCheckReplayLegacy <$> safeRead v) <|> (QuickCheckReplay <$> safeRead v)   optionName = return "quickcheck-replay"-  optionHelp = return "Random seed to use for replaying a previous test run (use same --quickcheck-max-size)"+  optionHelp = return "Random seed to use for replaying a previous test run"   optionCLParser = mkOptionCLParser $ metavar "SEED"  instance IsOption QuickCheckShowReplay where@@ -168,30 +180,37 @@ -- This is a low-level function that was originally added for tasty-hspec -- but may be used by others. --+-- The returned Int is kept only for backward compatibility purposes. It+-- has no use in @tasty-quickcheck@.+-- -- @since 0.9.1 optionSetToArgs :: OptionSet -> IO (Int, QC.Args) optionSetToArgs opts = do-  replaySeed <- case mReplay of-    Nothing -> getStdRandom (randomR (1,999999))-    Just seed -> return seed+  (intSeed, replaySeed) <- case quickCheckReplay of+    QuickCheckReplayNone -> do+      intSeed <- getStdRandom (randomR (1,999999))+      return (intSeed, (mkQCGen intSeed, 0))+    QuickCheckReplayLegacy intSeed -> return (intSeed, (mkQCGen intSeed, 0))+    -- The intSeed is not used when the new form of replay seed is used.+    QuickCheckReplay replaySeed -> return (0, replaySeed)    let args = QC.stdArgs         { QC.chatty          = False         , QC.maxSuccess      = nTests         , QC.maxSize         = maxSize-        , QC.replay          = Just (mkQCGen replaySeed, 0)+        , QC.replay          = Just replaySeed         , QC.maxDiscardRatio = maxRatio         , QC.maxShrinks      = maxShrinks         } -  return (replaySeed, args)+  return (intSeed, args)    where-    QuickCheckTests      nTests     = lookupOption opts-    QuickCheckReplay     mReplay    = lookupOption opts-    QuickCheckMaxSize    maxSize    = lookupOption opts-    QuickCheckMaxRatio   maxRatio   = lookupOption opts-    QuickCheckMaxShrinks maxShrinks = lookupOption opts+    QuickCheckTests        nTests        = lookupOption opts+    quickCheckReplay                     = lookupOption opts+    QuickCheckMaxSize      maxSize       = lookupOption opts+    QuickCheckMaxRatio     maxRatio      = lookupOption opts+    QuickCheckMaxShrinks   maxShrinks    = lookupOption opts  instance IsTest QC where   testOptions = return@@ -205,12 +224,10 @@     ]    run opts (QC prop) yieldProgress = do-    (replaySeed, args) <- optionSetToArgs opts+    (_, args) <- optionSetToArgs opts     let       QuickCheckShowReplay showReplay = lookupOption opts       QuickCheckVerbose    verbose    = lookupOption opts-      maxSize = QC.maxSize args-      replayMsg = makeReplayMsg replaySeed maxSize      -- Quickcheck already catches exceptions, no need to do it here.     r <- quickCheck yieldProgress@@ -224,6 +241,8 @@             else qcOutput ++ "\n"         testSuccessful = successful r         putReplayInDesc = (not testSuccessful) || showReplay+    Just seedSz <- return $ replayFromResult r <|> QC.replay args+    let replayMsg = makeReplayMsg seedSz     return $       (if testSuccessful then testPassed else testFailed)       (qcOutputNl ++@@ -237,21 +256,12 @@            -> QC.Args            -> QC.Property            -> IO QC.Result-quickCheck yieldProgress args prop = do-  -- Here we rely on the fact that QuickCheck currently prints its progress to-  -- stderr and the overall status (which we don't need) to stdout-  tm <- QC.newTerminal-          (const $ pure ())-          (\progressText -> yieldProgress emptyProgress { progressPercent = parseProgress progressText })-  QC.withState args $ \ s ->-    QC.test s { QC.terminal = tm } prop-  where-    -- QuickCheck outputs something like "(15461 tests)\b\b\b\b\b\b\b\b\b\b\b\b\b"-    parseProgress :: String -> Float-    parseProgress = maybe 0 (\n -> fromIntegral (n :: Int) / fromIntegral (QC.maxSuccess args))-                  . readMaybe-                  . takeWhile Char.isDigit-                  . drop 1+quickCheck yieldProgress args+  = (.) (QC.quickCheckWithResult args)+  $ QCP.callback+  $ QCP.PostTest QCP.NotCounterexample+  $ \QC.MkState {QC.maxSuccessTests, QC.numSuccessTests} _ ->+    yieldProgress $ emptyProgress {progressPercent = fromIntegral numSuccessTests / fromIntegral maxSuccessTests}  successful :: QC.Result -> Bool successful r =@@ -259,9 +269,12 @@     QC.Success {} -> True     _ -> False -makeReplayMsg :: Int -> Int -> String-makeReplayMsg seed size = let-    sizeStr = if (size /= defaultMaxSize)-                 then printf " --quickcheck-max-size=%d" size-                 else ""-  in printf "Use --quickcheck-replay=%d%s to reproduce." seed sizeStr+makeReplayMsg :: (QCGen, Int) -> String+makeReplayMsg seedSz =+  printf "Use --quickcheck-replay=\"%s\" to reproduce." (show seedSz)++replayFromResult :: QC.Result -> Maybe (QCGen, Int)+replayFromResult r =+  case r of+    Failure{} -> Just (QC.usedSeed r, QC.usedSize r)+    _ -> Nothing

@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/  name:                tasty-quickcheck-version:             0.10.3+version:             0.11 synopsis:            QuickCheck support for the Tasty test framework. description:         QuickCheck support for the Tasty test framework.                      .@@ -29,9 +29,9 @@   other-extensions:    GeneralizedNewtypeDeriving, DeriveDataTypeable   build-depends:       base >= 4.8 && < 5,                        tagged < 0.9,-                       tasty >= 1.0.1 && < 1.6,+                       tasty >= 1.5 && < 1.6,                        random < 1.3,-                       QuickCheck >= 2.10 && < 2.15,+                       QuickCheck >= 2.10 && < 2.16,                        optparse-applicative < 0.19    -- hs-source-dirs:@@ -55,6 +55,7 @@     , tasty-quickcheck     , tasty-hunit     , pcre-light+    , QuickCheck   ghc-options: -Wall   if (!impl(ghc >= 8.0) || os(windows))     buildable: False

@@ -1,4 +1,6 @@ {-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}+import Control.Concurrent (threadDelay) import Test.Tasty import Test.Tasty.Options import Test.Tasty.Providers as Tasty@@ -6,6 +8,7 @@ import Test.Tasty.QuickCheck import Test.Tasty.HUnit import Data.Maybe+import Test.QuickCheck.Random (QCGen) import Text.Regex.PCRE.Light.Char8 import Text.Printf @@ -67,6 +70,29 @@           resultDescription =~ "Failed"           resultDescription =~ "Use .* to reproduce" +      , testCase "Replay unexpected failure" $ do+          Result{..} <- runMaxSized 3 $ \x -> x /= (2 :: Int)+          case resultOutcome of+            Tasty.Failure {} -> return ()+            _ -> assertFailure $ show resultOutcome+          resultDescription =~ "Failed"+          resultDescription =~ "Use --quickcheck-replay=.* to reproduce."+          let firstResultDescription = resultDescription+          Just seedSz <- return (parseSeed resultDescription)++          Result{..} <- runReplayWithSeed seedSz $ \x -> x /= (2 :: Int)+          case resultOutcome of+            Tasty.Failure {} -> return ()+            _ -> assertFailure $ show resultOutcome++          resultDescription =~ "Failed"+          -- Compare the last lines reporting the replay seed.+          let lastLine = concat . take 1 . reverse . lines+          lastLine resultDescription =~ "Use --quickcheck-replay=.* to reproduce."+          lastLine resultDescription @?= lastLine firstResultDescription+          -- Exactly one test is executed+          resultDescription =~ "Falsified \\(after 1 test\\)"+       , testCase "Gave up" $ do           Result{..} <- run' $ \x -> x > x ==> x > (x :: Int)           case resultOutcome of@@ -83,6 +109,9 @@           resultDescription =~ "Failed.*expected failure"           resultDescription =~ "Use .* to reproduce" +      -- Run the test suite manually and check that progress does not go beyond 100%+      , testProperty "Percent Complete" $ withMaxSuccess 1000 $ \(_ :: Int) -> ioProperty $ threadDelay 10000+       ]  run' :: Testable p => p -> IO Result@@ -98,3 +127,24 @@     (singleOption $ QuickCheckShowReplay True)     (QC $ property p)     (const $ return ())++runMaxSized :: Testable p => Int -> p -> IO Result+runMaxSized sz p =+  run+    (singleOption $ QuickCheckMaxSize sz)+    (QC $ property p)+    (const $ return ())++runReplayWithSeed :: Testable p => (QCGen, Int) -> p -> IO Result+runReplayWithSeed seedSz p =+  run+    (singleOption $ QuickCheckReplay seedSz)+    (QC $ property p)+    (const $ return ())++-- | Reads a seed from a message like+--+-- > "Use --quickcheck-single-replay=\"(SMGen 2909028190965759779 12330386376379709109,0)\" to reproduce."+--+parseSeed :: String -> Maybe (QCGen, Int)+parseSeed = safeRead . takeWhile (/= '\"') . drop 1 . dropWhile (/='\"')