linux-forkIO / killThread与forkProcess的交互

我已经在下面编写了代码,并注意到killThread块并且该线程仍然继续.仅当我在forkProcess中执行此操作时,如果我删除forkProcess,一切都会按预期进行.

码

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

输出量

$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

这不是通常的问题,因为没有内存分配,因此GHC的线程调度程序无法运行.我通过使用RTS -sstderr运行该程序进行了验证,这表明垃圾收集器运行得非常频繁.我在Linux 64位上运行它.

解决方法:

该bug report指出,尽管在文档中没有指出,forkProcess会在子进程中屏蔽异步异常.该行为在发布时应在7.8.1中修复.

当然,如果屏蔽了异步异常,则killThread内部的抛出将无限期阻塞.如果仅删除main中包含forkProcess和getProcessStatus的行,则程序将按预期工作：

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"

我用ghc –make -threaded async.hs构建它,并使用./async RTS -N4运行.

如果由于某些原因需要单独的进程,则必须在GHC 7.6.3的子进程中手动取消屏蔽异步异常.

标签：concurrency,ghc,green-threads,linux,haskell
来源： https://codeday.me/bug/20191122/2056661.html