diff --git a/ghc/tests/concurrent/should_run/conc004.hs b/ghc/tests/concurrent/should_run/conc004.hs
index 2580636585e1b4fb70d2e4024a1308c376c719d1..246f898d065c62a50d60db12933c0c947e4eeb1d 100644
--- a/ghc/tests/concurrent/should_run/conc004.hs
+++ b/ghc/tests/concurrent/should_run/conc004.hs
@@ -10,7 +10,7 @@ main = do
    mvar <- newEmptyMVar
 
    let 
-   	spawner :: (IO () -> IO ()) -> Int -> IO ()
+   	spawner :: (IO () -> IO ThreadId) -> Int -> IO ()
    	spawner c 0 = putMVar mvar ()
    	spawner c n = do { c (spawner c (n-1)); return ()}
 
diff --git a/ghc/tests/concurrent/should_run/conc007.hs b/ghc/tests/concurrent/should_run/conc007.hs
new file mode 100644
index 0000000000000000000000000000000000000000..ccd11bed8d0a97c7928194265a136c6efd424158
--- /dev/null
+++ b/ghc/tests/concurrent/should_run/conc007.hs
@@ -0,0 +1,24 @@
+{-# OPTIONS -fglasgow-exts #-}
+
+module Main where
+
+import Concurrent
+import IOExts
+
+choose :: a -> a -> IO a
+choose a b = do
+   ready <- newMVar ()
+   answer <- newEmptyMVar
+   a_id <- forkIO (a `seq` takeMVar ready >> putMVar answer a)
+   b_id <- forkIO (b `seq` takeMVar ready >> putMVar answer b)
+   it <- takeMVar answer
+   killThread a_id
+   killThread b_id
+   return it
+
+main = do
+   let big = sum [1..]
+       small = sum [1..42]
+   test1 <- choose big small
+   test2 <- choose small big
+   print (test1,test2)
diff --git a/ghc/tests/concurrent/should_run/conc007.stdout b/ghc/tests/concurrent/should_run/conc007.stdout
new file mode 100644
index 0000000000000000000000000000000000000000..ee81b5ecd3801951cd06c8c5eae5001c9b3f5665
--- /dev/null
+++ b/ghc/tests/concurrent/should_run/conc007.stdout
@@ -0,0 +1 @@
+(903,903)