diff --git a/core/Control/Concurrent/Async.hs b/core/Control/Concurrent/Async.hs
index c2254af0..711bf14d 100644
--- a/core/Control/Concurrent/Async.hs
+++ b/core/Control/Concurrent/Async.hs
@@ -36,7 +36,7 @@ THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
 OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 -}
 
-{-# LANGUAGE MagicHash, UnboxedTuples #-}
+{-# LANGUAGE CPP, MagicHash, UnboxedTuples #-}
 
 module Control.Concurrent.Async (
   async, withAsync, wait, asyncThreadId, cancel, concurrently
@@ -44,6 +44,18 @@ module Control.Concurrent.Async (
 
 import Control.Concurrent.STM
 import Control.Exception
+  ( BlockedIndefinitelyOnMVar(..)
+  , BlockedIndefinitelyOnSTM(..)
+  , Exception
+  , SomeException
+  , asyncExceptionFromException
+  , asyncExceptionToException
+  , catch
+  , fromException
+  , onException
+  , toException
+  , try
+  )
 import Control.Concurrent
 import Control.Monad
 import Data.IORef
@@ -51,6 +63,21 @@ import GHC.Conc (ThreadId(..))
 import GHC.Exts
 import GHC.IO hiding (onException)
 
+#if MIN_VERSION_base(4,21,0)
+import Control.Exception (ExceptionWithContext, tryWithContext, catchNoPropagate, rethrowIO)
+#else
+type ExceptionWithContext x = x
+
+catchNoPropagate :: IO a -> (ExceptionWithContext SomeException -> IO a) -> IO a
+catchNoPropagate = catchAll
+
+tryWithContext :: IO a -> IO (Either (ExceptionWithContext SomeException) a)
+tryWithContext = try
+
+rethrowIO :: ExceptionWithContext SomeException -> IO a
+rethrowIO = throwIO
+#endif
+
 -- | An asynchronous action spawned by 'async' or 'withAsync'.
 -- Asynchronous actions are executed in a separate thread, and
 -- operations are provided for waiting for asynchronous actions to
@@ -60,7 +87,7 @@ data Async a = Async
   { asyncThreadId :: {-# UNPACK #-} !ThreadId
                   -- ^ Returns the t'ThreadId' of the thread running
                   -- the given t'Async'.
-  , _asyncWait    :: STM (Either SomeException a)
+  , _asyncWait    :: STM (Either (ExceptionWithContext SomeException) a)
   }
 
 -- | Spawn an asynchronous action in a separate thread.
@@ -102,11 +129,11 @@ withAsyncUsing :: (IO () -> IO ThreadId)
 withAsyncUsing doFork = \action inner -> do
   var <- newEmptyTMVarIO
   mask $ \restore -> do
-    t <- doFork $ try (restore action) >>= atomically . putTMVar var
+    t <- doFork $ tryWithContext (restore action) >>= atomically . putTMVar var
     let a = Async t (readTMVar var)
-    r <- restore (inner a) `catchAll` \e -> do
+    r <- restore (inner a) `catchNoPropagate` \e -> do
       uninterruptibleCancel a
-      throwIO e
+      rethrowIO (e :: ExceptionWithContext SomeException)
     uninterruptibleCancel a
     return r
 
@@ -130,7 +157,7 @@ wait = tryAgain . atomically . waitSTM
 -- > waitCatch = atomically . waitCatchSTM
 --
 {-# INLINE waitCatch #-}
-waitCatch :: Async a -> IO (Either SomeException a)
+waitCatch :: Async a -> IO (Either (ExceptionWithContext SomeException) a)
 waitCatch = tryAgain . atomically . waitCatchSTM
   where
     -- See: https://github.com/simonmar/async/issues/14
@@ -146,7 +173,7 @@ waitSTM a = do
 -- | A version of 'waitCatch' that can be used inside an STM transaction.
 --
 {-# INLINE waitCatchSTM #-}
-waitCatchSTM :: Async a -> STM (Either SomeException a)
+waitCatchSTM :: Async a -> STM (Either (ExceptionWithContext SomeException) a)
 waitCatchSTM (Async _ w) = w
 
 -- | Cancel an asynchronous action by throwing the @AsyncCancelled@
diff --git a/core/Test/Tasty/Core.hs b/core/Test/Tasty/Core.hs
index 8791e472..e4c789da 100644
--- a/core/Test/Tasty/Core.hs
+++ b/core/Test/Tasty/Core.hs
@@ -2,6 +2,7 @@
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE ExistentialQuantification #-}
 {-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE ImplicitParams #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE TypeApplications #-}
@@ -57,6 +58,10 @@ import Test.Tasty.Providers.ConsoleFormat
 import Text.Printf
 import Text.Read (readMaybe)
 
+#if MIN_VERSION_base(4,21,0) && !MIN_VERSION_base(4,22,0)
+import Control.Exception.Context
+#endif
+
 -- | If a test failed, 'FailureReason' describes why.
 --
 -- @since 0.8
@@ -169,12 +174,24 @@ resultSuccessful r =
 exceptionResult :: SomeException -> Result
 exceptionResult e = Result
   { resultOutcome = Failure $ TestThrewException e
-  , resultDescription = "Exception: " ++ displayException e
+  , resultDescription = "Exception: " ++ displayException' e
   , resultShortDescription = "FAIL"
   , resultTime = 0
   , resultDetailsPrinter = noResultDetails
   }
 
+displayException' :: SomeException -> String
+#if MIN_VERSION_base(4,22,0)
+displayException' = displayExceptionWithInfo
+#elif MIN_VERSION_base(4,21,0)
+displayException' (SomeException e) =
+  displayException e ++ case displayExceptionContext ?exceptionContext of
+    "" -> ""
+    dc -> "\n\n" ++ dc
+#else
+displayException' = displayException
+#endif
+
 -- | Test progress information.
 --
 -- This may be used by a runner to provide some feedback to the user while