tasty-hedgehog 0.2.0.0 → 1.4.0.2
raw patch · 4 files changed
Files
- changelog.md +48/−1
- src/Test/Tasty/Hedgehog.hs +83/−29
- tasty-hedgehog.cabal +11/−10
- test/Main.hs +14/−2
changelog.md view
@@ -1,9 +1,56 @@ # Revision history for tasty-hedgehog +## 1.4.0.2 -- 2023-08-07++* Support hedgehog 1.4++## 1.4.0.1 -- 2023-03-15++* Support base 4.18 (GHC 9.6)+* Improve suggested test replay command++## 1.4.0.0 -- 2022-10-12++* Support `hedgehog-1.2`. This is a breaking change due to `hedgehog`'s [new mechanism for skipping to a particular test and shrink result](https://github.com/hedgehogqa/haskell-hedgehog/pull/454). The `--hedgehog-replay` option now expects a `Skip` value and a `Seed`, for example: `stack test --test-arguments='--pattern "$NF ~ /badReverse involutive fails/" --hedgehog-replay "3:b2 Seed 10332913068362713902 1302058653756691475"'` ([#63](https://github.com/qfpl/tasty-hedgehog/pull/63))++## 1.3.1.0 -- 2022-10-03++* The instructions for reproducing test failures are now more clearly distinguished from `hedgehog`'s own instructions and include a pattern in the example to limit which tests are re-run. ([#62](https://github.com/qfpl/tasty-hedgehog/pull/62))++## 1.3.0.0 -- 2022-08-22++* The `testProperty` function has been undeprecated. Its behaviour differs from that in version `1.1.0.0` and below in that it now passes no `PropertyName` to Hedgehog. Therefore, Hedgehog will render the text `<property>` in its instructions for reproducing test failures, as opposed to whatever description is provided for `testProperty`.++## 1.2.0.0 -- 2022-03-07++* Add `testPropertyNamed` function and deprecate `testProperty`.++## 1.1.0.0 -- 2021-04-03++* Add fromGroup function++## 1.0.1.0 -- 2021-01-25++* Automatically enable or disable colour, based on the same criteria+ that hedgehog itself checks.++## 1.0.0.2 -- 2020-01-16++* Upgrade to `hedgehog-1.0.2`++## 1.0.0.1 -- 2019-05-22++* Fixed test result reporting to made plain hedgehog's messages (fixes #30)++## 1.0.0.0 -- 2019-05-17++* Removed support for GHC < 8+* Upgrade to `hedgehog-1`+ ## 0.2.0.0 -- 2018-03-13 * Removes the verbosity option, which was unsupported-* Fixes a bug in configuration option handling, which +* Fixes a bug in configuration option handling, which was overwriting use configuration with the defaults. ## 0.1.0.2 -- 2018-01-22
src/Test/Tasty/Hedgehog.hs view
@@ -4,14 +4,16 @@ -- -- @ -- testGroup "tasty-hedgehog tests" [--- testProperty "reverse involutive" prop_reverse_involutive--- , testProperty "sort idempotent" prop_sort_idempotent+-- testPropertyNamed "reverse involutive" "prop_reverse_involutive" prop_reverse_involutive+-- , testPropertyNamed "sort idempotent" "prop_sort_idempotent" prop_sort_idempotent -- ] -- @ -- {-# LANGUAGE GeneralizedNewtypeDeriving #-} module Test.Tasty.Hedgehog ( testProperty+ , testPropertyNamed+ , fromGroup -- * Options you can pass in via tasty , HedgehogReplay(..) , HedgehogShowReplay(..)@@ -24,32 +26,62 @@ import Data.Maybe (fromMaybe) import Data.Typeable +import qualified Test.Tasty as T import qualified Test.Tasty.Providers as T import Test.Tasty.Options import Hedgehog+import Hedgehog.Internal.Config (UseColor, detectColor) import Hedgehog.Internal.Property import Hedgehog.Internal.Runner as H import Hedgehog.Internal.Report import Hedgehog.Internal.Seed as Seed -data HP = HP T.TestName Property+data HP = HP T.TestName (Maybe PropertyName) Property deriving (Typeable) --- | Create a 'Test' from a Hedgehog property+-- | Create a 'T.TestTree' from a Hedgehog 'Property'. testProperty :: T.TestName -> Property -> T.TestTree-testProperty name prop = T.singleTest name (HP name prop)+testProperty name prop = T.singleTest name (HP name Nothing prop) +-- | `testPropertyNamed` @testName propertyName property@ creates a+-- 'T.TestTree' from @property@ using @testName@ as the displayed+-- description for the property. The @propertyName@ is used by Hedgehog+-- when a failure occurs to provide instructions for how to re-run+-- the property and should normally be set to a string representation+-- of the @property@ argument.+--+-- @+-- testPropertyNamed+-- "reverse is involutive"+-- "prop_reverse_involutive"+-- prop_reverse_involutive+-- @+--+-- @since 1.2.0.0+testPropertyNamed :: T.TestName -> PropertyName -> Property -> T.TestTree+testPropertyNamed name propName prop =+ T.singleTest name (HP name (Just propName) prop)++-- | Create a 'T.TestTree' from a Hedgehog 'Group'.+fromGroup :: Group -> T.TestTree+fromGroup group =+ T.testGroup (unGroupName $ groupName group) $+ map mkTestTree (groupProperties group)+ where+ mkTestTree :: (PropertyName, Property) -> T.TestTree+ mkTestTree (propName, prop) = testProperty (unPropertyName propName) prop+ -- | The replay token to use for replaying a previous test run-newtype HedgehogReplay = HedgehogReplay (Maybe (Size, Seed))+newtype HedgehogReplay = HedgehogReplay (Maybe (Skip, Seed)) deriving (Typeable) instance IsOption HedgehogReplay where defaultValue = HedgehogReplay Nothing parseValue v = HedgehogReplay . Just <$> replay- -- Reads a replay token in the form "{size} {seed}"- where replay = (,) <$> safeRead (unwords size) <*> safeRead (unwords seed)- (size, seed) = splitAt 2 $ words v+ -- Reads a replay token in the form "{skip} {seed}"+ where replay = (,) <$> skipDecompress (unwords skip) <*> safeRead (unwords seed)+ (skip, seed) = splitAt 1 $ words v optionName = return "hedgehog-replay" optionHelp = return "Replay token to use for replaying a previous test run" @@ -103,10 +135,22 @@ optionName = return "hedgehog-retries" optionHelp = return "Number of times to re-run a test during shrinking" +propertyTestLimit :: PropertyConfig -> TestLimit+propertyTestLimit =+ let+ getTestLimit (EarlyTermination _ tests) = tests+ getTestLimit (NoEarlyTermination _ tests) = tests+ getTestLimit (NoConfidenceTermination tests) = tests+ in+ getTestLimit . propertyTerminationCriteria+ reportToProgress :: PropertyConfig -> Report Progress -> T.Progress-reportToProgress config (Report testsDone _ status) =+reportToProgress config Report{+ reportTests = testsDone,+ reportStatus = status+ } = let TestLimit testLimit = propertyTestLimit config ShrinkLimit shrinkLimit = propertyShrinkLimit config@@ -120,24 +164,34 @@ T.Progress "Shrinking" (ratio (failureShrinks fr) shrinkLimit) reportOutput :: Bool- -> String+ -> UseColor+ -> T.TestName+ -> Maybe PropertyName -> Report Result -> IO String-reportOutput showReplay name report@(Report _ _ status) = do- -- TODO add details for tests run / discarded / shrunk- s <- renderResult Nothing (Just (PropertyName name)) report- pure $ case status of- Failed fr -> do+reportOutput showReplay useColor testName name report = do+ s <- renderResult useColor name report+ pure $ case reportStatus report of+ Failed fr -> let- size = failureSize fr- seed = failureSeed fr+ count = reportTests report+ seed = reportSeed report+ discards = reportDiscards report+ shrinkPath = failureShrinkPath fr replayStr = if showReplay- then "\nUse '--hedgehog-replay \"" ++ show size ++ " " ++ show seed ++ "\"' to reproduce."+ then+ "\nUse \"--pattern \'$NF ~ /" +++ testName +++ "/\' --hedgehog-replay \'" +++ skipCompress (SkipToShrink count discards shrinkPath) +++ " " +++ show seed +++ "\'\" to reproduce from the command-line." else ""- s ++ replayStr- GaveUp -> "Gave up"- OK -> "OK"+ in+ s ++ replayStr ++ "\n"+ _ -> s instance T.IsTest HP where testOptions =@@ -149,7 +203,8 @@ , Option (Proxy :: Proxy HedgehogShrinkRetries) ] - run opts (HP name (Property pConfig pTest)) yieldProgress = do+ run opts (HP testName name (Property pConfig pTest)) yieldProgress = do+ useColor <- detectColor let HedgehogReplay replay = lookupOption opts HedgehogShowReplay showReplay = lookupOption opts@@ -159,22 +214,21 @@ HedgehogShrinkRetries mRetries = lookupOption opts config = PropertyConfig- (fromMaybe (propertyTestLimit pConfig) mTests) (fromMaybe (propertyDiscardLimit pConfig) mDiscards) (fromMaybe (propertyShrinkLimit pConfig) mShrinks) (fromMaybe (propertyShrinkRetries pConfig) mRetries)+ (NoConfidenceTermination $ fromMaybe (propertyTestLimit pConfig) mTests)+ (maybe Nothing (Just . fst) replay) randSeed <- Seed.random- let- size = maybe 0 fst replay- seed = maybe randSeed snd replay+ let seed = maybe randSeed snd replay - report <- checkReport config size seed pTest (yieldProgress . reportToProgress config)+ report <- checkReport config 0 seed pTest (yieldProgress . reportToProgress config) let resultFn = if reportStatus report == OK then T.testPassed else T.testFailed - out <- reportOutput showReplay name report+ out <- reportOutput showReplay useColor testName name report return $ resultFn out
tasty-hedgehog.cabal view
@@ -1,18 +1,19 @@ name: tasty-hedgehog-version: 0.2.0.0+version: 1.4.0.2 license: BSD3 license-file: LICENCE author: Dave Laing maintainer: dave.laing.80@gmail.com copyright: Copyright (c) 2017, Commonwealth Scientific and Industrial Research Organisation (CSIRO) ABN 41 687 119 230.-description: Integrates the hedgehog testing library with the tasty testing framework. +description: Integrates the <https://hackage.haskell.org/package/hedgehog hedgehog testing library> with the <https://hackage.haskell.org/package/tasty tasty testing framework>. category: Testing synopsis: Integration for tasty and hedgehog.-homepage: https://github.com/qfpl/tasty-hedghog+homepage: https://github.com/qfpl/tasty-hedgehog bug-reports: https://github.com/qfpl/tasty-hedgehog/issues build-type: Simple extra-source-files: changelog.md cabal-version: >=1.10+tested-with: GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.4, GHC == 8.6.5, GHC == 8.8.3, GHC == 8.10.1 source-repository head type: git@@ -20,10 +21,10 @@ library exposed-modules: Test.Tasty.Hedgehog- build-depends: base >= 4.8 && <4.11+ build-depends: base >= 4.8 && <4.19 , tagged >= 0.8 && < 0.9- , tasty >= 0.11 && < 1.1- , hedgehog >= 0.5 && < 0.6+ , tasty >= 0.11 && < 1.5+ , hedgehog >= 1.4 && < 1.5 hs-source-dirs: src ghc-options: -Wall default-language: Haskell2010@@ -32,10 +33,10 @@ type: exitcode-stdio-1.0 main-is: Main.hs hs-source-dirs: test- build-depends: base >= 4.8 && <4.11- , tasty >= 0.11 && < 1.1- , tasty-expected-failure >= 0.11 && < 0.12- , hedgehog >= 0.5 && < 0.6+ build-depends: base >= 4.8 && <4.19+ , tasty >= 0.11 && < 1.5+ , tasty-expected-failure >= 0.11 && < 0.13+ , hedgehog >= 1.4 && < 1.5 , tasty-hedgehog ghc-options: -Wall default-language: Haskell2010
test/Main.hs view
@@ -1,3 +1,4 @@+{-# language OverloadedStrings #-} module Main where import Hedgehog@@ -19,12 +20,15 @@ prop_reverse_involutive = property $ do xs <- forAll genAlphaList+ classify "empty" $ length xs == 0+ classify "small" $ length xs < 10+ classify "large" $ length xs >= 10 test_involutive reverse xs badReverse :: [a] -> [a] badReverse [] = [] badReverse [_] = []-badReverse as = reverse as+badReverse (x : xs) = badReverse xs ++ [x] prop_badReverse_involutive :: Property prop_badReverse_involutive =@@ -41,5 +45,13 @@ prop_reverse_involutive , expectFail $ testProperty "badReverse involutive fails"- prop_badReverse_involutive+ prop_badReverse_involutive+ , testPropertyNamed+ "reverse involutive"+ "prop_reverse_involutive"+ prop_reverse_involutive+ , expectFail $ testPropertyNamed+ "badReverse involutive fails"+ "prop_badReverse_involutive"+ prop_badReverse_involutive ]