diff --git a/Test/Framework.hs b/Test/Framework.hs
--- a/Test/Framework.hs
+++ b/Test/Framework.hs
@@ -10,7 +10,7 @@
         module Test.Framework.Seed
     ) where
 
-import Test.Framework.Core (Test, TestName, testGroup, plusTestOptions, buildTest, mutuallyExclusive)
+import Test.Framework.Core (Test, TestName, testGroup, plusTestOptions, buildTest, buildTestBracketed, mutuallyExclusive)
 import Test.Framework.Options
 import Test.Framework.Runners.Console
 import Test.Framework.Runners.Options
diff --git a/Test/Framework/Core.hs b/Test/Framework/Core.hs
--- a/Test/Framework/Core.hs
+++ b/Test/Framework/Core.hs
@@ -4,6 +4,7 @@
 import Test.Framework.Improving
 import Test.Framework.Options
 
+import Control.Arrow (first, second)
 import Control.Concurrent.MVar
 import Data.Typeable
 
@@ -40,7 +41,7 @@
             (Testlike i r t, Typeable t) => Test TestName t -- ^ A single test of some particular type
           | TestGroup TestName [Test]                       -- ^ Assemble a number of tests into a cohesive group
           | PlusTestOptions TestOptions Test                -- ^ Add some options to child tests
-          | BuildTest (IO Test)                             -- ^ Convenience for creating tests from an 'IO' action
+          | BuildTestBracketed (IO (Test, IO ()))           -- ^ Convenience for creating tests from an 'IO' action, with cleanup
 
 -- | Assemble a number of tests into a cohesive group
 testGroup :: TestName -> [Test] -> Test
@@ -52,24 +53,28 @@
 
 -- | Convenience for creating tests from an 'IO' action
 buildTest :: IO Test -> Test
-buildTest = BuildTest
+buildTest mx = BuildTestBracketed (fmap (flip (,) (return ())) mx)
 
+-- | Convenience for creating tests from an 'IO' action, with a cleanup handler for when tests are finished
+buildTestBracketed :: IO (Test, IO ()) -> Test
+buildTestBracketed = BuildTestBracketed
 
+
 data MutuallyExcluded t = ME (MVar ()) t
     deriving Typeable
 
 -- This requires UndecidableInstances, but I think it can't be made inconsistent?
 instance Testlike i r t => Testlike i r (MutuallyExcluded t) where
-    runTest cto (ME mvar x) = withMVar mvar $ \() -> runTest cto x
+    runTest cto (ME mvar x) = fmap (second (\act -> withMVar mvar $ \() -> act)) $ runTest cto x
     testTypeName ~(ME _ x) = testTypeName x
 
 -- | Mark all tests in this portion of the tree as mutually exclusive, so only one runs at a time
 {-# NOINLINE mutuallyExclusive #-}
 mutuallyExclusive :: Test -> Test
-mutuallyExclusive init_t = BuildTest $ do
+mutuallyExclusive init_t = buildTest $ do
     mvar <- newMVar ()
-    let go (Test tn t)            = Test tn (ME mvar t)
-        go (TestGroup tn ts)      = TestGroup tn (map go ts)
-        go (PlusTestOptions to t) = PlusTestOptions to (go t)
-        go (BuildTest build)      = BuildTest (fmap go build)
+    let go (Test tn t)                = Test tn (ME mvar t)
+        go (TestGroup tn ts)          = TestGroup tn (map go ts)
+        go (PlusTestOptions to t)     = PlusTestOptions to (go t)
+        go (BuildTestBracketed build) = BuildTestBracketed (fmap (first go) build)
     return (go init_t)
diff --git a/Test/Framework/Improving.hs b/Test/Framework/Improving.hs
--- a/Test/Framework/Improving.hs
+++ b/Test/Framework/Improving.hs
@@ -1,6 +1,6 @@
 module Test.Framework.Improving (
         (:~>)(..), bimapImproving, improvingLast, consumeImproving,
-        ImprovingIO, yieldImprovement, runImprovingIO, liftIO,
+        ImprovingIO, yieldImprovement, runImprovingIO, tunnelImprovingIO, liftIO,
         timeoutImprovingIO, maybeTimeoutImprovingIO
     ) where
 
@@ -48,6 +48,10 @@
     -- by the timeout code then they know about it reasonably promptly.
     yield
     writeChan chan (Left improvement)
+
+-- NB: could have a more general type but it would be impredicative
+tunnelImprovingIO :: ImprovingIO i f (ImprovingIO i f a -> IO a)
+tunnelImprovingIO = IIO $ \chan -> return $ \iio -> unIIO iio chan
 
 runImprovingIO :: ImprovingIO i f f -> IO (i :~> f, IO ())
 runImprovingIO iio = do
diff --git a/Test/Framework/Runners/Console.hs b/Test/Framework/Runners/Console.hs
--- a/Test/Framework/Runners/Console.hs
+++ b/Test/Framework/Runners/Console.hs
@@ -167,7 +167,7 @@
     showTest path (Test name _testlike)    = ["  "++path ++ name]
     showTest path (TestGroup name tests)   = concatMap (showTest (path++":"++name)) tests
     showTest path (PlusTestOptions _ test) = showTest path test
-    showTest _    (BuildTest _)            = []
+    showTest path (BuildTestBracketed _)   = ["  "++path ++ "<created at runtime>"]
 
 
 completeRunnerOptions :: RunnerOptions -> CompleteRunnerOptions
diff --git a/Test/Framework/Runners/Core.hs b/Test/Framework/Runners/Core.hs
--- a/Test/Framework/Runners/Core.hs
+++ b/Test/Framework/Runners/Core.hs
@@ -11,6 +11,9 @@
 import Test.Framework.Seed
 import Test.Framework.Utilities
 
+import Control.Concurrent.MVar
+import Control.Exception (mask, finally, onException)
+import Control.Monad
 import Data.Maybe
 import Data.Monoid
 
@@ -47,7 +50,23 @@
     (results, actions) <- runTests' use_test (path ++ [name]) topts tests
     return $ if null results then Nothing else Just ((RunTestGroup name results), actions)
 runTest' use_test path topts (PlusTestOptions extra_topts test) = runTest' use_test path (topts `mappend` extra_topts) test
-runTest' use_test path topts (BuildTest build) = build >>= runTest' use_test path topts
+runTest' use_test path topts (BuildTestBracketed build) = mask $ \restore -> build >>= \(test, cleanup) -> do
+    mb_res <- restore (runTest' use_test path topts test) `onException` cleanup
+    case mb_res of
+      -- No sub-tests: perform the cleanup NOW
+      Nothing                  -> cleanup >> return Nothing
+      Just (run_test, actions) -> do
+        -- Sub-tests: perform the cleanup as soon as each of them have completed
+        (mvars, actions') <- liftM unzip $ forM actions $ \action -> do
+          mvar <- newEmptyMVar
+          return (mvar, action `finally` putMVar mvar ())
+        -- NB: the takeMVar action MUST be last in the list because the returned actions are
+        -- scheduled left-to-right, and we want all the actions we depend on to be scheduled
+        -- before we wait for them to complete, or we might deadlock.
+        --
+        -- FIXME: this is a bit of a hack because it uses one pool thread just waiting
+        -- for some other pool threads to complete! Switch to parallel-io?
+        return $ Just (run_test, actions' ++ [(cleanup >> mapM_ takeMVar mvars)])
 
 runTests' :: ([String] -> String -> Bool) -> [String]
           -> TestOptions -> [Test] -> IO ([RunningTest], [IO ()])
diff --git a/test-framework.cabal b/test-framework.cabal
--- a/test-framework.cabal
+++ b/test-framework.cabal
@@ -1,5 +1,5 @@
 Name:                test-framework
-Version:             0.7.0
+Version:             0.8
 Cabal-Version:       >= 1.2.3
 Category:            Testing
 Synopsis:            Framework for running and organising tests, with HUnit and QuickCheck support