Incorrect InterruptibleFFI test

It seems that testsuite/tests/concurrent/should_run/foreignInterruptible.hs's test is wrong. Because safe foreign call with -threaded also returns same result.

{-# LANGUAGE ForeignFunctionInterface, CPP #-}
module Main where

import Control.Concurrent
import Control.Exception
import Prelude hiding (catch)
import Foreign
import System.IO

#ifdef mingw32_HOST_OS
sleep n = sleepBlock (n*1000)
foreign import stdcall safe "Sleep" sleepBlock :: Int -> IO ()
#else
sleep n = sleepBlock n
foreign import ccall safe "sleep" sleepBlock :: Int -> IO ()
#endif

main :: IO ()
main = do
  newStablePtr stdout -- prevent stdout being finalized
  th <- newEmptyMVar
  tid <- forkIO $ do
     putStrLn "newThread started"
     (sleep 2 >> putStrLn "fail") `catch` (\ThreadKilled -> putStrLn "pass")
     putMVar th "child"
  yield
  threadDelay 500000
  killThread tid
  x <- takeMVar th
  putStrLn x
  putStrLn "\nshutting down"

newThread started
pass
child

shutting down

Windows and Mac OS X return this result.

Trac metadata

Trac field	Value
Version	7.2.1
Type	Bug
TypeOfFailure	OtherFailure
Priority	normal
Resolution	Unresolved
Component	Test Suite
Test case
Differential revisions
BlockedBy
Related
Blocking
CC
Operating system
Architecture