Interazione di forko / killthread con carrelli elevatori

Question

Ho scritto il codice qui sotto, e ho notato che i blocchi killThread e il filo continua ancora.Quello accade solo se lo faccio nel carrelloepocess, se rimuovo il carrelloepocess, tutto funziona come previsto.

Codice

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

.

Uscita

$ 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

.

Questo non è il solito problema che non vi è alcuna allocazione della memoria e quindi viene eseguito lo scheduler del thread di GHC.Ho verificato che eseguendo il programma con +RTS -sstderr, che mostra che il raccoglitore della spazzatura funziona molto spesso.Sto correndo su Linux 64 bit.

Answer 1

Questo Bug Report Nota che forkProcess maschera eccezioni asincroni nel processo infantile nonostanteNessuna indicazione di tale nella documentazione.Il comportamento dovrebbe essere fissato in 7.8.1 quando viene rilasciato.

Naturalmente, se le eccezioni asincroni sono mascherate, il throw all'interno del killThread bloccherà indefinitamente.Se si è sufficiente eliminare le righe in main contenente forkProcess e getProcessStatus, il programma funziona come 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 costruisco con ghc --make -threaded async.hs ed esegui con ./async +RTS -N4.

Se per qualche motivo hai bisogno di un processo separato, dovrai manualmente smascherare le eccezioni asincrone nel processo infantile in GHC 7.6.3.