System.Posix.Signals weirdness

Matthias Kilian kili at outback.escape.de
Mon Feb 7 00:10:44 CET 2011


Hi,

I'd expect the following program (compiled with ghc and without any
specieal flags) to produce

	Just (Exited ExitSuccess)
	True

but it produces

	Just (Exited ExitSuccess)
	False

on Debian Lenny (ghc-6.8), OpenBSD-current (ghc-6.12.3), OpenBSD-current
(ghc=7.0 from the 7.0 branch).

	module Main where

	import Data.IORef
	import System.Posix.Process
	import System.Posix.Signals
	import System.Posix.Unistd

	main = do
		caughtCHLD <- newIORef False
		installHandler sigCHLD (Catch $ writeIORef caughtCHLD True) Nothing
		pid <- forkProcess $ sleep 2 >> return ()
		s <- sleep 8
		getProcessStatus False False pid >>= print
		readIORef caughtCHLD >>= print

The sigCHLD handler is never called in this program. Is this expected
behaviour? If so, why?

Ciao,
	Kili



More information about the Glasgow-haskell-users mailing list