Interaction de forkIO/killThread avec forkProcess
-
21-12-2019 - |
Question
J'ai écrit le code ci-dessous et j'ai remarqué que killThread
bloque et le fil continue.Cela n'arrive que si je le fais dans forkProcess, si je supprime forkProcess, tout fonctionne comme prévu.
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
Sortir
$ 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
Ce n'est pas un problème habituel : il n'y a pas d'allocation de mémoire et donc le planificateur de threads de GHC ne s'exécute pas.J'ai vérifié cela en exécutant le programme avec +RTS -sstderr
, ce qui montre que le ramasse-miettes s'exécute très souvent.Je l'utilise sous Linux 64 bits.
La solution
Ce rapport d'erreur Note que forkProcess
masque les exceptions asynchrones dans le processus enfant malgré aucune indication à ce sujet dans la documentation.Le comportement devrait être corrigé dans la version 7.8.1 lors de sa sortie.
Bien entendu, si les exceptions asynchrones sont masquées, le throw
à l'intérieur de killThread
bloquera indéfiniment.Si vous supprimez simplement les lignes dans main
contenant forkProcess
et getProcessStatus
, le programme fonctionne comme prévu :
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"
Je le construis avec ghc --make -threaded async.hs
et courir avec ./async +RTS -N4
.
Si, pour une raison quelconque, vous avez besoin d'un processus distinct, vous devrez démasquer manuellement les exceptions asynchrones dans le processus enfant dans GHC 7.6.3.