Force the result description within the timeout. Fixes #280

UnkindPartition · Oct 25, 2020 · fcfccc8 · fcfccc8
1 parent 9679520
commit fcfccc8
Show file tree

Hide file tree

Showing 2 changed files with 12 additions and 3 deletions.
diff --git a/core/Test/Tasty/Run.hs b/core/Test/Tasty/Run.hs
@@ -34,7 +34,7 @@ import Test.Tasty.Patterns.Types
 import Test.Tasty.Options
 import Test.Tasty.Options.Core
 import Test.Tasty.Runners.Reducers
-import Test.Tasty.Runners.Utils (timed)
+import Test.Tasty.Runners.Utils (timed, forceElements)
 import Test.Tasty.Providers.ConsoleFormat (noResultDetails)
 
 -- | Current status of a test
@@ -106,7 +106,15 @@ executeTest action statusVar timeoutOpt inits fins = mask $ \restore -> do
     -- handler doesn't interfere with our timeout.
     withAsync (action yieldProgress) $ \asy -> do
       labelThread (asyncThreadId asy) "tasty_test_execution_thread"
-      timed $ applyTimeout timeoutOpt $ wait asy
+      timed $ applyTimeout timeoutOpt $ do
+        r <- wait asy
+        -- Not only wait for the result to be returned, but make sure to
+        -- evalute it inside applyTimeout; see #280.
+        evaluate $
+          resultOutcome r `seq`
+          forceElements (resultDescription r) `seq`
+          forceElements (resultShortDescription r)
+        return r
 
   -- no matter what, try to run each finalizer
   mbExn <- destroyResources restore

diff --git a/core/Test/Tasty/Runners/Utils.hs b/core/Test/Tasty/Runners/Utils.hs
@@ -47,7 +47,8 @@ formatMessage = go 3
         Right () -> return msg
         Left e' -> printf "message threw an exception: %s" <$> go (recLimit-1) (show (e' :: SomeException))
 
--- https://ro-che.info/articles/2015-05-28-force-list
+-- | Force elements of a list
+-- (<https://ro-che.info/articles/2015-05-28-force-list>)
 forceElements :: [a] -> ()
 forceElements = foldr seq ()