Opened 4 years ago

Closed 4 years ago

#5471 closed bug (fixed)

Incorrect InterruptibleFFI test

Reported by: shelarcy Owned by: simonmar
Priority: normal Milestone: 7.4.1
Component: Test Suite Version: 7.2.1
Keywords: Cc:
Operating System: Unknown/Multiple Architecture: Unknown/Multiple
Type of failure: Other Test Case:
Blocked By: Blocking:
Related Tickets: Differential Rev(s):
Wiki Page:


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 ()
sleep n = sleepBlock n
foreign import ccall safe "sleep" sleepBlock :: Int -> IO ()

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"
  threadDelay 500000
  killThread tid
  x <- takeMVar th
  putStrLn x
  putStrLn "\nshutting down"

newThread started

shutting down

Windows and Mac OS X return this result.

Change History (2)

comment:1 Changed 4 years ago by simonmar

  • Milestone set to 7.4.1
  • Owner set to simonmar

comment:2 Changed 4 years ago by simonmar

  • Resolution set to fixed
  • Status changed from new to closed

commit 5d4ee3759a6b2e3e0c9b06fd712042f0d6b5980e

Author: Simon Marlow <[email protected]>
Date:   Fri Oct 7 14:56:46 2011 +0100

    make the test fail if the sleep doesn't get interrupted (#5471)
Note: See TracTickets for help on using tickets.