Pregunta

Escribí el código a continuación y noté que killThread se bloquea y el hilo aún continúa.Eso solo pasa si lo hago en el forkProcess, si elimino el forkProcess, todo funciona como se esperaba.

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

Producción

$ 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 no es el problema habitual de que no hay asignación de memoria y, por lo tanto, el programador de subprocesos de GHC no se ejecuta.Verifiqué que ejecutando el programa con +RTS -sstderr, lo que muestra que el recolector de basura se ejecuta con mucha frecuencia.Estoy ejecutando esto en Linux de 64 bits.

¿Fue útil?

Solución

Este informe de error señala que forkProcess enmascara excepciones asincrónicas en el proceso secundario a pesar de que no se indique nada al respecto en la documentación.El comportamiento debería corregirse en 7.8.1 cuando se publique.

Por supuesto, si se enmascaran las excepciones asincrónicas, el throw dentro de killThread se bloqueará indefinidamente.Si simplemente elimina las líneas en main que contiene forkProcess y getProcessStatus, el programa funciona según lo previsto:

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"

lo construyo con ghc --make -threaded async.hs y correr con ./async +RTS -N4.

Si por alguna razón necesita un proceso separado, tendrá que desenmascarar manualmente las excepciones asincrónicas en el proceso secundario en GHC 7.6.3.

Licenciado bajo: CC-BY-SA con atribución
No afiliado a StackOverflow
scroll top