packages feed

tasty-quickcheck 0.8.2 → 0.8.3

raw patch · 4 files changed

+132/−17 lines, 4 filesdep +pcre-lightdep +tasty-hunitdep +tasty-quickcheckdep ~tasty

Dependencies added: pcre-light, tasty-hunit, tasty-quickcheck

Dependency ranges changed: tasty

Files

CHANGELOG.md view
@@ -1,6 +1,12 @@ Changes ======= +Version 0.8.3+-------------++* Export 'show replay' option+* Fixed a run-time error when using QuickCheck's `expectFailure`+ Version 0.8.2 ------------- 
Test/Tasty/QuickCheck.hs view
@@ -4,9 +4,15 @@   ( testProperty   , QuickCheckTests(..)   , QuickCheckReplay(..)+  , QuickCheckShowReplay(..)   , QuickCheckMaxSize(..)   , QuickCheckMaxRatio(..)   , module Test.QuickCheck+    -- * Internal+    -- | This is exposed for testing purposes and not considered as a part+    -- of the public API.+    -- You probably shouldn't need it.+  , QC(..)   ) where  import Test.Tasty.Providers@@ -110,15 +116,12 @@       QuickCheckMaxSize    maxSize    = lookupOption opts       QuickCheckMaxRatio   maxRatio   = lookupOption opts       args = QC.stdArgs { QC.chatty = False, QC.maxSuccess = nTests, QC.maxSize = maxSize, QC.replay = replay, QC.maxDiscardRatio = maxRatio}-    -- TODO yield progress     r <- QC.quickCheckWithResult args prop      return $       (if successful r then testPassed else testFailed)-      (if unexpected r && showReplay-         then QC.output r ++ reproduceMsg r-         else QC.output r-      )+      (QC.output r +++        (if showReplay then reproduceMsg r else ""))  successful :: QC.Result -> Bool successful r =@@ -126,15 +129,9 @@     QC.Success {} -> True     _ -> False -unexpected :: QC.Result -> Bool-unexpected r =-  case r of-    QC.Failure {} -> True-    QC.NoExpectedFailure {} -> True-    _ -> False-+-- | If the result is a failure, produce a message that explains how to+-- reproduce it. If the result is not a failure, return an empty string. reproduceMsg :: QC.Result -> String-reproduceMsg r =-  printf "Use --quickcheck-replay '%d %s' to reproduce."-    (QC.usedSize r)-    (show $ QC.usedSeed r)+reproduceMsg QC.Failure { QC.usedSize = size, QC.usedSeed = seed } =+  printf "Use --quickcheck-replay '%d %s' to reproduce." size (show seed)+reproduceMsg _ = ""
tasty-quickcheck.cabal view
@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/  name:                tasty-quickcheck-version:             0.8.2+version:             0.8.3 synopsis:            QuickCheck support for the Tasty test framework. description:         QuickCheck support for the Tasty test framework. license:             MIT@@ -29,3 +29,19 @@   build-depends:       base == 4.*, tasty >= 0.8, QuickCheck >= 2.7 && < 3, tagged   -- hs-source-dirs:         default-language:    Haskell2010++test-suite test+  default-language:+    Haskell2010+  type:+    exitcode-stdio-1.0+  hs-source-dirs:+    tests+  main-is:+    test.hs+  build-depends:+      base >= 4 && < 5+    , tasty >= 0.10+    , tasty-quickcheck+    , tasty-hunit+    , pcre-light
+ tests/test.hs view
@@ -0,0 +1,96 @@+{-# LANGUAGE RecordWildCards #-}+import Test.Tasty+import Test.Tasty.Options+import Test.Tasty.Providers as Tasty+import Test.Tasty.Runners as Tasty+import Test.Tasty.QuickCheck+import Test.Tasty.HUnit+import Data.Monoid+import Data.Maybe+import Text.Regex.PCRE.Light.Char8+import Text.Printf++(=~), (!~)+  :: String -- ^ text+  -> String -- ^ regex+  -> Assertion+text =~ regexStr =+  let+    msg = printf "Expected /%s/, got %s" regexStr (show text)+    -- NB show above the intentional -- to add quotes around the string and+    -- escape newlines etc.+  in assertBool msg $ match' text regexStr+text !~ regexStr =+  let+    msg = printf "Did not expect /%s/, got %s" regexStr (show text)+  in assertBool msg $ not $ match' text regexStr++-- note: the order of arguments is reversed relative to match from+-- pcre-light, but consistent with =~ and !~+match' :: String -> String -> Bool+match' text regexStr =+  let+    regex = compile regexStr []+  in+    isJust $ match regex text []++main =+  defaultMain $+    testGroup "Unit tests for Test.Tasty.QuickCheck"+      [ testCase "Success" $ do+          Result{..} <- run' $ \x -> x >= (x :: Int)+          -- there is no instance Show Outcome(+          -- (because there is no instance Show SomeException),+          -- so we can't use @?= for this+          case resultOutcome of+            Tasty.Success -> return ()+            _ -> assertFailure $ show resultOutcome+          resultDescription =~ "OK, passed 100 tests"++      , testCase "Unexpected failure" $ do+          Result{..} <- run' $ \x -> x > (x :: Int)+          case resultOutcome of+            Tasty.Failure {} -> return ()+            _ -> assertFailure $ show resultOutcome+          resultDescription =~ "Failed"+          resultDescription =~ "Use .* to reproduce"++      , testCase "Unexpected failure, no replay message" $ do+          Result{..} <- runNoReplay $ \x -> x > (x :: Int)+          case resultOutcome of+            Tasty.Failure {} -> return ()+            _ -> assertFailure $ show resultOutcome+          resultDescription =~ "Failed"+          resultDescription !~ "Use .* to reproduce"++      , testCase "Gave up" $ do+          Result{..} <- run' $ \x -> x > x ==> x > (x :: Int)+          case resultOutcome of+            Tasty.Failure {} -> return ()+            _ -> assertFailure $ show resultOutcome+          resultDescription =~ "Gave up"+          resultDescription !~ "Use .* to reproduce"++      , testCase "No expected failure" $ do+          Result{..} <- run' $ expectFailure $ \x -> x >= (x :: Int)+          case resultOutcome of+            Tasty.Failure {} -> return ()+            _ -> assertFailure $ show resultOutcome+          resultDescription =~ "Failed.*expected failure"+          resultDescription !~ "Use .* to reproduce"++      ]++run' :: Testable p => p -> IO Result+run' p =+  run+    mempty -- options+    (QC $ property p)+    (const $ return ()) -- callback++runNoReplay :: Testable p => p -> IO Result+runNoReplay p =+  run+    (singleOption $ QuickCheckShowReplay False)+    (QC $ property p)+    (const $ return ())