tasty-expected-failure 0.11.1.2 → 0.12
raw patch · 4 files changed
+144/−10 lines, 4 filesdep +hedgehogdep +tasty-expected-failuredep +tasty-goldendep ~basedep ~tastyPVP ok
version bump matches the API change (PVP)
Dependencies added: hedgehog, tasty-expected-failure, tasty-golden, tasty-hedgehog, tasty-hunit, unbounded-delays
Dependency ranges changed: base, tasty
API changes (from Hackage documentation)
Files
- Test/Tasty/ExpectedFailure.hs +45/−6
- tasty-expected-failure.cabal +29/−4
- tests/TestExpectedFails.hs +30/−0
- tests/TestExpectedFailsHH.hs +40/−0
Test/Tasty/ExpectedFailure.hs view
@@ -1,19 +1,58 @@-{-# LANGUAGE DeriveDataTypeable, ScopedTypeVariables #-}+{-# LANGUAGE DeriveDataTypeable, ScopedTypeVariables, LambdaCase #-} module Test.Tasty.ExpectedFailure (expectFail, expectFailBecause, ignoreTest, ignoreTestBecause, wrapTest) where import Test.Tasty.Options import Test.Tasty.Runners import Test.Tasty.Providers+import Test.Tasty ( Timeout(..) ) import Data.Typeable import Data.Tagged import Data.Maybe import Data.Monoid+import Control.Exception ( displayException, try, SomeException )+import Control.Concurrent.Timeout ( timeout ) + data WrappedTest t = WrappedTest (IO Result -> IO Result) t deriving Typeable instance forall t. IsTest t => IsTest (WrappedTest t) where- run opts (WrappedTest wrap t) prog = wrap (run opts t prog)+ run opts (WrappedTest wrap t) prog =+ -- Re-implement timeouts and exception handling *inside* the+ -- wrapper. The primary location for timeout and exception+ -- handling is in `executeTest` in the Tasty module's+ -- Test.Tasty.Run implementation, but that handling is above the+ -- level of this wrapper which therefore cannot absorb timeouts+ -- and exceptions as *expected* failures.+ let (pre,post) = case lookupOption opts of+ NoTimeout -> (fmap Just, fromJust)+ Timeout t s -> (timeout (faster t), fromMaybe (timeoutResult t s))+ -- 'faster' has to shorten the user-specified timeout by a+ -- small amount because the main Timeout option is+ -- separately passed to `executeTest` and that one will+ -- usually fire first if both have the same timeout. This+ -- is a really kludgy hack, but the assumption is that most+ -- test timeouts have low resolution, so making the timeout+ -- slightly faster isn't significant in the overall sense.+ -- If it is, the test writer will hopefully find this+ -- comment, increase their timeout specification+ -- accordingly, and not curse us too heavily.+ faster t = t - 2000 -- must specify a timeout period that will *fire* faster than the original+ timeoutResult t s =+ Result { resultOutcome = Failure $ TestTimedOut t+ , resultDescription = "Timed out after " <> s+ , resultShortDescription = "TIMEOUT"+ , resultTime = fromIntegral t+ }+ exceptionResult e =+ Result { resultOutcome = Failure $ TestThrewException e+ , resultDescription = "Exception: " ++ displayException e+ , resultShortDescription = "FAIL"+ , resultTime = 0+ }+ in wrap $ try (pre $ run opts t prog) >>= \case+ Right r -> return (post r)+ Left (e :: SomeException) -> return $ exceptionResult e testOptions = retag (testOptions :: Tagged t [OptionDescription]) -- | 'wrapTest' allows you to modify the behaviour of the tests, e.g. by@@ -56,13 +95,13 @@ change r | resultSuccessful r = r { resultOutcome = Failure TestFailed- , resultDescription = resultDescription r <> "(unexpected success" <> comment <> ")"- , resultShortDescription = "PASS (unexpected" <> comment <> ")"+ , resultDescription = resultDescription r <> " (unexpected success" <> comment <> ")"+ , resultShortDescription = resultShortDescription r <> " (unexpected" <> comment <> ")" } | otherwise = r { resultOutcome = Success- , resultDescription = resultDescription r <> "(expected failure)"- , resultShortDescription = "FAIL (expected" <> comment <> ")"+ , resultDescription = resultDescription r <> " (expected failure)"+ , resultShortDescription = resultShortDescription r <> " (expected" <> comment <> ")" } "" `append` s = s t `append` s | last t == '\n' = t ++ s ++ "\n"
tasty-expected-failure.cabal view
@@ -1,5 +1,5 @@ name: tasty-expected-failure-version: 0.11.1.2+version: 0.12 synopsis: Mark tasty tests as failure expected description: With the function 'Test.Tasty.ExpectedFailure.expectFail' in the provided module@@ -27,17 +27,42 @@ build-type: Simple extra-source-files: README.md cabal-version: >=1.10-tested-with: GHC == 7.4.2, GHC == 7.6.3, GHC == 7.8.4, GHC == 7.10.3, GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.4, GHC == 8.6.5, GHC == 8.8.1+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 library exposed-modules: Test.Tasty.ExpectedFailure build-depends:- base >= 4.5 && <4.14,+ base >= 4.9 && <5, tagged >= 0.7 && < 0.9,- tasty >= 0.11+ tasty >= 0.11,+ unbounded-delays < 0.2 default-language: Haskell2010 source-repository head type: git location: git://github.com/nomeata/tasty-expected-failure+++test-suite expected-fail-tests+ type: exitcode-stdio-1.0+ default-language: Haskell2010+ hs-source-dirs: tests+ main-is: TestExpectedFails.hs+ build-depends: base,+ tasty,+ tasty-hunit,+ tasty-golden,+ tasty-expected-failure+++test-suite expected-fail-hh-tests+ type: exitcode-stdio-1.0+ default-language: Haskell2010+ hs-source-dirs: tests+ main-is: TestExpectedFailsHH.hs+ build-depends: base,+ hedgehog,+ tasty,+ tasty-hedgehog,+ tasty-expected-failure
+ tests/TestExpectedFails.hs view
@@ -0,0 +1,30 @@+import Control.Concurrent (threadDelay)+import Test.Tasty+import Test.Tasty.ExpectedFailure+import Test.Tasty.Golden+import Test.Tasty.HUnit++-- n.b. running via `cabal v2-test` outputs plaintext, but running via+-- `cabal v2-run test:expected-fail-tests` will generate colorized+-- output. It's adviseable to visually inspect this output to ensure+-- that "PASS (unexpected)" is rendered in Red and "FAIL (expected)"+-- is rendered in Green.++main = defaultMain $+ localOption (mkTimeout 1000000) $ -- 1s+ testGroup "Expected Failures" $+ [ testCase "clearly good" $ 1 + 1 @=? 2+ , expectFail $ testCase "clearly bad" $ 1 + 1 @=? 3++ -- n.b. uncomment this to observe the results of a test that was+ -- , expectFail $ testCase "also good" $ 1 + 2 @=? 3++ , expectFail $ expectFail $ testCase "two wrongs make a right" $ 1 + 1 @=? 2++ , expectFail $ testCase "throws failure" $ fail "bad"+ , expectFail $ testCase "throws error" $ error "also bad"++ , expectFail $ testCase "takes too long" $ threadDelay 2000000++ , expectFail $ goldenVsString "hello" "hello.out" $ return $ error "not golden"+ ]
+ tests/TestExpectedFailsHH.hs view
@@ -0,0 +1,40 @@+import Control.Concurrent ( threadDelay )+import Control.Monad.IO.Class ( liftIO )+import Hedgehog+import qualified Hedgehog.Gen as Gen+import qualified Hedgehog.Range as Range+import Test.Tasty+import Test.Tasty.ExpectedFailure+import Test.Tasty.Hedgehog++-- n.b. running via `cabal v2-test` outputs plaintext, but running via+-- `cabal v2-run test:expected-fail-tests` will generate colorized+-- output. It's adviseable to visually inspect this output to ensure+-- that "PASS (unexpected)" is rendered in Red and "FAIL (expected)"+-- is rendered in Green.++main = defaultMain $+ localOption (mkTimeout 1000000) $ -- 1s+ testGroup "Expected Hedgehog Failures" $+ [ testProperty "good" $ property $ success+ , expectFail $ testProperty "rarely good" $ property $ do+ xs <- forAll $ Gen.list (Range.linear 0 10) Gen.alpha+ reverse xs === xs++ -- n.b. uncomment this to observe the results of a test that was+ -- expected to fail but actually passes.+ -- , expectFail $ testProperty "surprisingly good" $ property $ success++ , expectFail $ testProperty "giving up" $ property $ discard++ , expectFail $ expectFail $ testProperty "the failure of a failure is my good" $+ property $ success++ , expectFail $ testProperty "throws failure" $+ property $ fail "bad"++ , expectFail $ testProperty "too slow" $+ property $ do+ liftIO $ threadDelay 2000000+ success+ ]