Add tests for the top level exception handler
authorDuncan Coutts <duncan@well-typed.com>
Thu, 14 Nov 2013 15:16:30 +0000 (15:16 +0000)
committerDuncan Coutts <duncan@well-typed.com>
Thu, 14 Nov 2013 15:36:49 +0000 (15:36 +0000)
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

libraries/base/tests/all.T
libraries/base/tests/topHandler01.hs [new file with mode: 0644]
libraries/base/tests/topHandler01.stdout [new file with mode: 0644]
libraries/base/tests/topHandler02.hs [new file with mode: 0644]
libraries/base/tests/topHandler03.hs [new file with mode: 0644]

index 55b9e9d..efc5ca9 100644 (file)
@@ -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, [''])
+
diff --git a/libraries/base/tests/topHandler01.hs b/libraries/base/tests/topHandler01.hs
new file mode 100644 (file)
index 0000000..0ee4bcb
--- /dev/null
@@ -0,0 +1,16 @@
+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"
diff --git a/libraries/base/tests/topHandler01.stdout b/libraries/base/tests/topHandler01.stdout
new file mode 100644 (file)
index 0000000..1679411
--- /dev/null
@@ -0,0 +1 @@
+Success: caught UserInterrupt
diff --git a/libraries/base/tests/topHandler02.hs b/libraries/base/tests/topHandler02.hs
new file mode 100644 (file)
index 0000000..270239c
--- /dev/null
@@ -0,0 +1,7 @@
+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
diff --git a/libraries/base/tests/topHandler03.hs b/libraries/base/tests/topHandler03.hs
new file mode 100644 (file)
index 0000000..01f69af
--- /dev/null
@@ -0,0 +1,8 @@
+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)))