我写了下面的代码,注意到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 位上运行它。
此错误报告指出,尽管文档中没有说明异步异常,但forkProcess
屏蔽了子进程中的异步异常。该行为应在 7.8.1 发布时修复。
当然,如果异步异常被屏蔽,killThread
内部的throw
将无限期地阻止。如果您只是删除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 中的子进程中手动取消屏蔽异步异常。