diff options
Diffstat (limited to 'testsuite/tests/concurrent/should_run/conc039.hs')
| -rw-r--r-- | testsuite/tests/concurrent/should_run/conc039.hs | 31 |
1 files changed, 31 insertions, 0 deletions
diff --git a/testsuite/tests/concurrent/should_run/conc039.hs b/testsuite/tests/concurrent/should_run/conc039.hs new file mode 100644 index 0000000000..dc5d181a31 --- /dev/null +++ b/testsuite/tests/concurrent/should_run/conc039.hs @@ -0,0 +1,31 @@ +{-# LANGUAGE ForeignFunctionInterface #-} + +import Foreign +import System.Mem +import Control.Concurrent + +foreign export ccall "performGC_" performGC' :: IO () +performGC' = do putMVar m (); yield; performGC + +foreign import ccall "performGC_" f :: IO () + +{-# NOINLINE m #-} +m = unsafePerformIO newEmptyMVar + +main = do + forkIO f + takeMVar m + +-- This tests for a bug in the garbage collector, whereby a main +-- thread that has completed may be GC'd before its return value is +-- propagated back to the caller of rts_evalIO(). +-- +-- The sequence we hope to create is: +-- - main thread (1) forks off thread (2) +-- - thread (2) invokes new main thread (3) via a 'safe' ccall +-- - thread (3) yields to thread (1) +-- - thread (1) completes, but cannot return yet because (3) +-- is the current main thread (unless we +-- are in SMP or RTS_SUPPORTS_THREADS mode) +-- - thread (3) invokes a GC +-- - thread (1) is GC'd, unless we're careful! |