Interação de forkIO/killThread com forkProcess

Question

Eu escrevi o código abaixo e notei que killThread blocos e o thread ainda continua.Isso só acontece se eu fizer no forkProcess, se eu remover o forkProcess, tudo funciona conforme o esperado.

Código

{-# 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

Saída

$ 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

Este não é o problema usual de não haver alocação de memória e, portanto, o agendador de threads do GHC não funcionar.Eu verifiquei isso executando o programa com +RTS -sstderr, o que mostra que o coletor de lixo está sendo executado com muita frequência.Estou executando isso no Linux de 64 bits.

Answer 1

Esse relatório de erro observa que forkProcess mascara exceções assíncronas no processo filho, apesar de não haver indicação disso na documentação.O comportamento deve ser corrigido na versão 7.8.1 quando for lançada.

É claro que, se as exceções assíncronas forem mascaradas, o throw dentro de killThread bloqueará indefinidamente.Se você simplesmente excluir as linhas em main contendo forkProcess e getProcessStatus, o programa funciona conforme planejado:

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"

Eu construo com ghc --make -threaded async.hs e correr com ./async +RTS -N4.

Se por algum motivo você precisar de um processo separado, terá que desmascarar manualmente as exceções assíncronas no processo filho no GHC 7.6.3.