diff --git a/CHANGELOG.md b/CHANGELOG.md
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -1,6 +1,14 @@
 Changes
 =======
 
+Version 1.4
+-----------
+
+* Change the `TreeFold` data type to give all functions access to `OptionSet`
+* Fix a bug where a looping failure message escaped the time out set for the
+    test
+* Fix a bug where pattern changes inside the `TestTree` weren't respected
+
 Version 1.3.1
 -------------
 
diff --git a/Test/Tasty/Core.hs b/Test/Tasty/Core.hs
--- a/Test/Tasty/Core.hs
+++ b/Test/Tasty/Core.hs
@@ -1,6 +1,6 @@
 -- | Core types and definitions
 {-# LANGUAGE GeneralizedNewtypeDeriving, FlexibleContexts,
-             ExistentialQuantification, RankNTypes, DeriveDataTypeable,
+             ExistentialQuantification, RankNTypes, DeriveDataTypeable, NoMonomorphismRestriction,
              DeriveGeneric #-}
 module Test.Tasty.Core where
 
@@ -310,9 +310,9 @@
 -- indroduced.
 data TreeFold b = TreeFold
   { foldSingle :: forall t . IsTest t => OptionSet -> TestName -> t -> b
-  , foldGroup :: TestName -> b -> b
-  , foldResource :: forall a . ResourceSpec a -> (IO a -> b) -> b
-  , foldAfter :: DependencyType -> Expr -> b -> b
+  , foldGroup :: OptionSet -> TestName -> b -> b
+  , foldResource :: forall a . OptionSet -> ResourceSpec a -> (IO a -> b) -> b
+  , foldAfter :: OptionSet -> DependencyType -> Expr -> b -> b
   }
 
 -- | 'trivialFold' can serve as the basis for custom folds. Just override
@@ -329,9 +329,9 @@
 trivialFold :: Monoid b => TreeFold b
 trivialFold = TreeFold
   { foldSingle = \_ _ _ -> mempty
-  , foldGroup = const id
-  , foldResource = \_ f -> f $ throwIO NotRunningTests
-  , foldAfter = \_ _ b -> b
+  , foldGroup = \_ _ b -> b
+  , foldResource = \_ _ f -> f $ throwIO NotRunningTests
+  , foldAfter = \_ _ _ b -> b
   }
 
 -- | Fold a test tree into a single value.
@@ -353,7 +353,7 @@
 -- affected by the subsequent option changes. This shouldn't be a problem
 -- in practice; OTOH, this behaviour may be changed later.
 foldTestTree
-  :: Monoid b
+  :: forall b . Monoid b
   => TreeFold b
      -- ^ the algebra (i.e. how to fold a tree)
   -> OptionSet
@@ -362,21 +362,23 @@
      -- ^ the tree to fold
   -> b
 foldTestTree (TreeFold fTest fGroup fResource fAfter) opts0 tree0 =
-  let pat = lookupOption opts0
-  in go pat mempty opts0 tree0
+  go mempty opts0 tree0
   where
-    go pat path opts tree1 =
+    go :: (Seq.Seq TestName -> OptionSet -> TestTree -> b)
+    go path opts tree1 =
       case tree1 of
         SingleTest name test
           | testPatternMatches pat (path Seq.|> name)
             -> fTest opts name test
           | otherwise -> mempty
         TestGroup name trees ->
-          fGroup name $ foldMap (go pat (path Seq.|> name) opts) trees
-        PlusTestOptions f tree -> go pat path (f opts) tree
-        WithResource res0 tree -> fResource res0 $ \res -> go pat path opts (tree res)
-        AskOptions f -> go pat path opts (f opts)
-        After deptype dep tree -> fAfter deptype dep $ go pat path opts tree
+          fGroup opts name $ foldMap (go (path Seq.|> name) opts) trees
+        PlusTestOptions f tree -> go path (f opts) tree
+        WithResource res0 tree -> fResource opts res0 $ \res -> go path opts (tree res)
+        AskOptions f -> go path opts (f opts)
+        After deptype dep tree -> fAfter opts deptype dep $ go path opts tree
+      where
+        pat = lookupOption opts :: TestPattern
 
 -- | Get the list of options that are relevant for a given test tree
 treeOptions :: TestTree -> [OptionDescription]
diff --git a/Test/Tasty/Ingredients/ConsoleReporter.hs b/Test/Tasty/Ingredients/ConsoleReporter.hs
--- a/Test/Tasty/Ingredients/ConsoleReporter.hs
+++ b/Test/Tasty/Ingredients/ConsoleReporter.hs
@@ -136,8 +136,8 @@
 
       return $ PrintTest name printTestName printTestResult
 
-    runGroup :: TestName -> Ap (Reader Level) TestOutput -> Ap (Reader Level) TestOutput
-    runGroup name grp = Ap $ do
+    runGroup :: OptionSet -> TestName -> Ap (Reader Level) TestOutput -> Ap (Reader Level) TestOutput
+    runGroup _opts name grp = Ap $ do
       level <- ask
       let
         printHeading = printf "%s%s\n" (indent level) name
@@ -595,7 +595,7 @@
   foldTestTree
     trivialFold
       { foldSingle = \_ name _ level -> Maximum (stringWidth name + level)
-      , foldGroup = \_ m -> m . (+ indentSize)
+      , foldGroup = \_opts _ m -> m . (+ indentSize)
       }
     opts
   where
diff --git a/Test/Tasty/Ingredients/ListTests.hs b/Test/Tasty/Ingredients/ListTests.hs
--- a/Test/Tasty/Ingredients/ListTests.hs
+++ b/Test/Tasty/Ingredients/ListTests.hs
@@ -31,7 +31,7 @@
   foldTestTree
     trivialFold
       { foldSingle = \_opts name _test -> [name]
-      , foldGroup = \groupName names -> map ((groupName ++ ".") ++) names
+      , foldGroup = \_opts groupName names -> map ((groupName ++ ".") ++) names
       }
 
 -- | The ingredient that provides the test listing functionality
diff --git a/Test/Tasty/Run.hs b/Test/Tasty/Run.hs
--- a/Test/Tasty/Run.hs
+++ b/Test/Tasty/Run.hs
@@ -34,7 +34,7 @@
 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 @@
     -- 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
@@ -233,9 +241,9 @@
         (trivialFold :: TreeFold Tr)
           { foldSingle = runSingleTest
           , foldResource = addInitAndRelease
-          , foldGroup = \name (Traversal a) ->
+          , foldGroup = \_opts name (Traversal a) ->
               Traversal $ local (first (Seq.|> name)) a
-          , foldAfter = \deptype pat (Traversal a) ->
+          , foldAfter = \_opts deptype pat (Traversal a) ->
               Traversal $ local (second ((deptype, pat) :)) a
           }
         opts0 tree
@@ -260,8 +268,8 @@
         act (inits, fins) =
           executeTest (run opts test) statusVar (lookupOption opts) inits fins
       tell ([(act, (statusVar, path, deps))], mempty)
-    addInitAndRelease :: ResourceSpec a -> (IO a -> Tr) -> Tr
-    addInitAndRelease (ResourceSpec doInit doRelease) a = wrap $ \path deps -> do
+    addInitAndRelease :: OptionSet -> ResourceSpec a -> (IO a -> Tr) -> Tr
+    addInitAndRelease _opts (ResourceSpec doInit doRelease) a = wrap $ \path deps -> do
       initVar <- atomically $ newTVar NotCreated
       (tests, fins) <- unwrap path deps $ a (getResource initVar)
       let ntests = length tests
diff --git a/Test/Tasty/Runners/Utils.hs b/Test/Tasty/Runners/Utils.hs
--- a/Test/Tasty/Runners/Utils.hs
+++ b/Test/Tasty/Runners/Utils.hs
@@ -47,7 +47,8 @@
         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 ()
 
diff --git a/tasty.cabal b/tasty.cabal
--- a/tasty.cabal
+++ b/tasty.cabal
@@ -2,7 +2,7 @@
 --  see http://haskell.org/cabal/users-guide/
 
 name:                tasty
-version:             1.3.1
+version:             1.4
 synopsis:            Modern and extensible testing framework
 description:         Tasty is a modern testing framework for Haskell.
                      It lets you combine your unit tests, golden