Commit 2ec9734d authored by Duncan Coutts's avatar Duncan Coutts
Browse files

Add tests for the top level exception handler

The top level exception handler is wrapped around main, and FFI exports.
It handles exceptions that are not otherwise caught in user code. For
most exception is just prints them, but handles a few specially,
including ExitCode and UserInterrupt.

On Unix it installs a signal handler for SIGINT to translate it into a
UserInterrupt async exception.

So we test that:

1. receiving SIGINT does trigger a UserInterrupt async exception
2. an unhandled UserInterrupt makes us kill ourselves with SIGINT
3. an unhandled ExitFailure (-sig) makes us kill ourselves with sig
parent 643f07c6
......@@ -134,3 +134,8 @@ test('CatEntail', normal, compile, [''])
test('T7653', normal, compile_and_run, [''])
test('T7787', normal, compile_and_run, [''])
test('topHandler01', when(opsys('mingw32'), skip), compile_and_run, [''])
test('topHandler02', [ when(opsys('mingw32'), skip), exit_code(130), omit_ways(['ghci']) ], compile_and_run, [''])
test('topHandler03', [ when(opsys('mingw32'), skip), exit_code(143) ], compile_and_run, [''])
import System.Posix.Process
import System.Posix.Signals
import Control.Exception
import Control.Concurrent
-- Test that a simulated ^C sends an async UserInterrupt
-- exception to the main thread.
main = handle userInterrupt $ do
us <- getProcessID
signalProcess sigINT us
threadDelay 1000000
putStrLn "Fail: never received exception"
userInterrupt UserInterrupt = putStrLn "Success: caught UserInterrupt"
userInterrupt e = putStrLn "Fail: caught unexpected exception"
Success: caught UserInterrupt
import Control.Exception
import Control.Concurrent
-- Test that a UserInterrupt exception that propagates to the top level
-- causes the process to terminate by killing itself with SIGINT
main = throwIO UserInterrupt
import System.Posix.Signals
import System.Exit
import Data.Bits
-- Test that a ExitFailure representing SIGTERM causes
-- the process to terminate by killing itself with SIGTERM
main = exitWith (ExitFailure (fromIntegral (-sigTERM)))
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment