diff options
Diffstat (limited to 'testsuite/tests/runghc')
| -rw-r--r-- | testsuite/tests/runghc/T-signals-child.hs | 9 | ||||
| -rw-r--r-- | testsuite/tests/runghc/all.T | 4 |
2 files changed, 10 insertions, 3 deletions
diff --git a/testsuite/tests/runghc/T-signals-child.hs b/testsuite/tests/runghc/T-signals-child.hs index 21c1b646ae..ee36f62121 100644 --- a/testsuite/tests/runghc/T-signals-child.hs +++ b/testsuite/tests/runghc/T-signals-child.hs @@ -1,7 +1,7 @@ import Control.Concurrent.MVar (readMVar) import System.Environment (getArgs) import System.Exit (ExitCode (ExitFailure), exitFailure) -import System.IO (hGetLine, hPutStrLn) +import System.IO (hClose, hGetLine, hPutStrLn) import System.Posix.Process (exitImmediately, getProcessID) import System.Posix.Signals (Handler (Catch), installHandler, sigHUP, signalProcess) @@ -9,6 +9,7 @@ import System.Process (StdStream (CreatePipe), createProcess, proc, std_in, std_out, waitForProcess) import System.Process.Internals (ProcessHandle (..), ProcessHandle__ (OpenHandle)) +import System.Timeout (timeout) main :: IO () main = do @@ -46,6 +47,7 @@ runParent runghc = do -- Send the child some input so that it will exit if it didn't -- have a sigHUP handler installed. hPutStrLn inH "" + hClose inH -- Read out the rest of stdout from the child, which will be -- either "NOSIGNAL\n" or "HUP\n" @@ -95,7 +97,10 @@ runChild = do -- Block until we receive input, giving a chance for the signal -- handler to be triggered, and if the signal handler isn't -- triggered, gives us an escape route from this function. - _ <- getLine + -- + -- Include a reasonable timeout to prevent this from running for + -- too long + _ <- timeout 10000000 getLine -- Reaching this point indicates a failure of the test. Print some -- non HUP message and exit with a non HUP exit diff --git a/testsuite/tests/runghc/all.T b/testsuite/tests/runghc/all.T index 107f35b74b..01337bca42 100644 --- a/testsuite/tests/runghc/all.T +++ b/testsuite/tests/runghc/all.T @@ -10,6 +10,8 @@ test('T11247', [req_interp, expect_broken(11247)], run_command, test('T6132', [when(opsys('darwin'), expect_broken(6132))], compile, ['']) test('T-signals-child', - [when(opsys('mingw32'), skip), req_interp], + [ when(opsys('mingw32'), skip), req_interp + , only_ways(['threaded1', 'threaded2']) + ], run_command, ['$MAKE --no-print-directory -s T-signals-child']) |