linuxhaskellconcurrencyghcgreen-threads

Interaction of forkIO/killThread with forkProcess


I've written the code below, and noticed that killThread blocks and the thread still continues. That only happens if I do it in the forkProcess, if I remove the forkProcess, everything works as expected.

Code

{-# LANGUAGE TupleSections #-}
module Main where

import Control.Concurrent
import Control.Monad
import System.Posix.Process

{-# NOINLINE primes #-}
primes :: [Integer]
primes = 2:[x | x <- [3..], all (not . flip isDivisorOf x) (takeWhile (< truncate (sqrt $ fromInteger x :: Double)) primes)]
  where x `isDivisorOf` y = y `rem` x == 0

evaluator :: Show a => [a] -> IO ()
evaluator xs = do
  putStrLn "[Evaluator] Started evaluator."
  forM_ xs $ \x -> putStrLn $ "[Evaluator] Got result: " ++ show x
  putStrLn "[Evaluator] Evaluator exited."

test :: IO ThreadId
test = forkIO (evaluator $ filter ((== 13) . flip rem (79 * 5 * 7 * 3 * 3 * 2 * 3)) primes) -- Just some computation that doesn't finsish too fast

main :: IO ()
main = do
  pid <- forkProcess $ do
    a <- test
    threadDelay $ 4000 * 1000
    putStrLn "Canceling ..."
    killThread a
    putStrLn "Canceled"
  void $ getProcessStatus True False pid

Output

$ ghc test.hs -O -fforce-recomp -threaded -eventlog -rtsopts # I also tried with -threaded
$ ./test +RTS -N2  # I also tried without -N
[Evaluator] Started evaluator.
[Evaluator] Got result: 13
[Evaluator] Got result: 149323
[Evaluator] Got result: 447943
[Evaluator] Got result: 597253
[Evaluator] Got result: 746563
[Evaluator] Got result: 1045183
Canceling ...
[Evaluator] Got result: 1194493
[Evaluator] Got result: 1642423
[Evaluator] Got result: 1791733
[Evaluator] Got result: 2090353
[Evaluator] Got result: 2687593
[Evaluator] Got result: 3135523
[Evaluator] Got result: 3284833
[Evaluator] Got result: 4777933
[Evaluator] Got result: 5375173
^C[Evaluator] Got result: 5524483
^C

This is not the usual problem that there is no memory allocation and thus GHC's thread scheduler doesn't run. I verified that by running the program with +RTS -sstderr, which shows that the garbage collector is running very often. I'm running this on linux 64bit.


Solution

  • This bug report notes that forkProcess masks asynchronous exceptions in the child process despite no indication of such in the documentation. The behavior should be fixed in 7.8.1 when it is released.

    Of course, if asynchronous exceptions are masked, the throw inside the killThread will block indefinitely. If you simply delete the lines in main containing forkProcess and getProcessStatus, the program works as intended:

    module Main where
    
    import           Control.Concurrent
    import           Control.Monad
    import           System.Posix.Process
    
    {-# NOINLINE primes #-}
    primes :: [Integer]
    primes = 2:[ x | x <- [3..], all (not . flip isDivisorOf x) (takeWhile (< truncate (sqrt $ fromInteger x :: Double)) primes)]
      where x `isDivisorOf` y = y `rem` x == 0
    
    evaluator :: Show a => [a] -> IO ()
    evaluator = mapM_ $ \x ->
      putStrLn $ "[Evaluator] Got result: " ++ show x
    
    test :: IO ThreadId
    test = forkIO (evaluator $ filter ((== 13) . flip rem (79 * 5 * 7 * 3 * 3 * 2 * 3)) primes) -- Just some computation that doesn't finsish too fast
    
    main :: IO ()
    main = do
      a <- test
      threadDelay $ 4000 * 1000
      putStrLn "Canceling ..."
      killThread a
      putStrLn "Canceled"
    

    I build it with ghc --make -threaded async.hs and run with ./async +RTS -N4.

    If for some reason you need a separate process, you will have to manually unmask asynchronous exceptions in the child process in GHC 7.6.3.