packages feed

tasty-expected-failure 0.11.1.2 → 0.12.3

raw patch · 4 files changed

Files

Test/Tasty/ExpectedFailure.hs view
@@ -1,35 +1,111 @@-{-# LANGUAGE DeriveDataTypeable, ScopedTypeVariables #-}+{-# LANGUAGE CPP #-}+{-# 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+#if MIN_VERSION_tasty(1,3,1)+import Test.Tasty.Providers.ConsoleFormat ( ResultDetailsPrinter(..) )+#endif+import Test.Tasty ( Timeout(..), askOption, localOption ) import Data.Typeable import Data.Tagged import Data.Maybe import Data.Monoid+import Control.Exception ( displayException, evaluate, try, SomeException )+import Control.Concurrent.Timeout ( timeout ) -data WrappedTest t = WrappedTest (IO Result -> IO Result) t++data WrappedTest t = WrappedTest Timeout (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 tmout 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 tmout of+                         NoTimeout -> (fmap Just, fromJust)+                         Timeout t s -> (timeout t, fromMaybe (timeoutResult t s))+          timeoutResult t s =+            Result { resultOutcome = Failure $ TestTimedOut t+                   , resultDescription = "Timed out after " <> s+                   , resultShortDescription = "TIMEOUT"+                   , resultTime = fromIntegral t+#if MIN_VERSION_tasty(1,3,1)+                   , resultDetailsPrinter = ResultDetailsPrinter . const . const $ return ()+#endif+                   }+          exceptionResult e =+            Result { resultOutcome = Failure $ TestThrewException e+                   , resultDescription = "Exception: " ++ displayException e+                   , resultShortDescription = "FAIL"+                   , resultTime = 0+#if MIN_VERSION_tasty(1,3,1)+                   , resultDetailsPrinter = ResultDetailsPrinter . const . const $ return ()+#endif+                   }+          forceList = foldr seq ()+      in wrap $ try (pre (run opts t prog+                         -- Ensure exceptions trying to show the+                         -- failure result are caught as "expected"+                         -- (see Issue #24 and note below)+                         >>= \r -> evaluate (forceList (resultDescription r) `seq`+                                             forceList (resultShortDescription r) `seq`+                                             resultOutcome r `seq`+                                             r)))+         >>= \case+               Right r -> return (post r)+               Left (e :: SomeException) -> return $ exceptionResult e     testOptions = retag (testOptions :: Tagged t [OptionDescription]) +    -- Note regarding post-run evaluate above:+    --+    -- The normal behavior of tasty-expected-failure is to run the+    -- test, show the failure result, but then note that the failure+    -- is expected and not count that against a test failure.  If the+    -- test unexpectedly succeeds, a message to that effect is+    -- printed, but there is no resultDescription display of the test+    -- inputs.+    --+    -- As of Tasty 1.4, the core tasty code was enhanced to fix issue+    -- #280 in tasty: essentially the test result report is forced.+    -- However, when used with tests expected to fail that also throw+    -- exceptions when attempting to show the result, the forcing in+    -- Tasty 1.4 causes an exception to be thrown after the+    -- tasty-expected-failure protections but still within the realm+    -- where tasty would count it as a failure.  The fix here attempts+    -- to `show` the failing value here in tasty-expected-failure; if+    -- an exception occurs during that `show` then code here will+    -- report it (somewhat incorrectly) via the exceptionResult above,+    -- where tasty's subsequent forcing of the text of that+    -- exceptionResult no longer causes an exception *there*.  Since+    -- the value is only shown if there was already a failure, the+    -- reason is misleading but the outcome is consistent with the+    -- intent of tasty-expected-failure handling.++ -- | 'wrapTest' allows you to modify the behaviour of the tests, e.g. by -- modifying the result or not running the test at all. It is used to implement -- 'expectFail' and 'ignoreTest'. wrapTest :: (IO Result -> IO Result) -> TestTree -> TestTree wrapTest wrap = go   where-    go (SingleTest n t) = SingleTest n (WrappedTest wrap t)+    go (SingleTest n t) =+      askOption $ \(old_timeout :: Timeout) ->+      localOption NoTimeout $  -- disable Tasty's timeout; handled here instead+      SingleTest n (WrappedTest old_timeout wrap t)     go (TestGroup name tests) = TestGroup name (map go tests)     go (PlusTestOptions plus tree) = PlusTestOptions plus (go tree)     go (WithResource spec gentree) = WithResource spec (go . gentree)     go (AskOptions f) = AskOptions (go . f)  --- | Marks all tests in the give test as expected failures: The tests will+-- | Marks all tests in the given test suite as expected failures: The tests will -- still be run, but if they succeed, it is reported as a test suite failure, -- and conversely a the failure of the test is ignored. --@@ -56,13 +132,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"@@ -92,6 +168,6 @@  ignoreTest' :: Maybe String -> TestTree -> TestTree ignoreTest' reason = wrapTest $ const $ return $-    (testPassed "") {-      resultShortDescription = "IGNORED" <> maybe "" (mappend ": ") reason+    (testPassed $ fromMaybe "" reason) {+      resultShortDescription = "IGNORED"     }
tasty-expected-failure.cabal view
@@ -1,5 +1,5 @@ name:                tasty-expected-failure-version:             0.11.1.2+version:             0.12.3 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,50 @@+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"++  -- Issue 24+  , expectFail $ testCase "this is expected to fail"+    (mrtOne (someFunc "Hello, world!") @?= "")++   , expectFail $ testCase "this is also expected to fail"+     (someFunc "Hello, world!" @?= MyResultType { mrtOne = "", mrtTwo = "" })+  ]+++data MyResultType = MyResultType { mrtOne :: String+                                 , mrtTwo :: String+                                 }+                    deriving (Eq, Show)++someFunc :: String -> MyResultType+someFunc fp = MyResultType+              {+                mrtOne = fp+              , mrtTwo = undefined+              }
+ 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+  ]