From 12752342228fc60d87c4235c253655a9092388a3 Mon Sep 17 00:00:00 2001
From: Ben Gamari <ben@smart-cactus.org>
Date: Wed, 19 Jun 2019 12:17:10 -0400
Subject: [PATCH] testsuite: Add T5611a
This is the same as T5611 but with an unsafe call to sleep.
---
.../tests/concurrent/should_run/T5611a.hs | 36 +++++++++++++++++++
.../tests/concurrent/should_run/T5611a.stderr | 1 +
.../should_run/T5611a.stderr.mingw32 | 1 +
.../tests/concurrent/should_run/T5611a.stdout | 2 ++
testsuite/tests/concurrent/should_run/all.T | 6 ++--
5 files changed, 42 insertions(+), 4 deletions(-)
create mode 100644 testsuite/tests/concurrent/should_run/T5611a.hs
create mode 100644 testsuite/tests/concurrent/should_run/T5611a.stderr
create mode 100644 testsuite/tests/concurrent/should_run/T5611a.stderr.mingw32
create mode 100644 testsuite/tests/concurrent/should_run/T5611a.stdout
diff --git a/testsuite/tests/concurrent/should_run/T5611a.hs b/testsuite/tests/concurrent/should_run/T5611a.hs
new file mode 100644
index 000000000000..81e6cc957e1c
--- /dev/null
+++ b/testsuite/tests/concurrent/should_run/T5611a.hs
@@ -0,0 +1,36 @@
+-- The same as T5611 but with unsafe calls.
+
+{-# LANGUAGE CPP,ForeignFunctionInterface #-}
+
+import Control.Concurrent
+import Foreign.C
+import System.IO
+
+#if defined(mingw32_HOST_OS)
+sleep n = sleepBlock (n*1000)
+foreign import stdcall unsafe "Sleep" sleepBlock :: Int -> IO ()
+#else
+sleep n = sleepBlock n
+foreign import ccall unsafe "sleep" sleepBlock :: Int -> IO ()
+#endif
+
+main :: IO ()
+main = do
+ hSetBuffering stdout LineBuffering
+
+ tid <- forkIO $ do
+ putStrLn "child: Sleeping"
+ _ <- sleep 1
+
+ -- The following lines should not happen after the killThread from the
+ -- parent thread completes. However, they do...
+ -- putStrLn "child: Done sleeping"
+ threadDelay 100000
+ putStrLn "child: Done waiting"
+
+ threadDelay 100000
+ -- putStrLn $ "parent: Throwing exception to thread " ++ show tid
+ throwTo tid $ userError "Exception delivered successfully"
+ putStrLn "parent: Done throwing exception"
+
+ threadDelay 200000
diff --git a/testsuite/tests/concurrent/should_run/T5611a.stderr b/testsuite/tests/concurrent/should_run/T5611a.stderr
new file mode 100644
index 000000000000..644a878735f3
--- /dev/null
+++ b/testsuite/tests/concurrent/should_run/T5611a.stderr
@@ -0,0 +1 @@
+T5611a: user error (Exception delivered successfully)
diff --git a/testsuite/tests/concurrent/should_run/T5611a.stderr.mingw32 b/testsuite/tests/concurrent/should_run/T5611a.stderr.mingw32
new file mode 100644
index 000000000000..42c9f24f7679
--- /dev/null
+++ b/testsuite/tests/concurrent/should_run/T5611a.stderr.mingw32
@@ -0,0 +1 @@
+T5611a: <stdout>: commitBuffer: user error (Exception delivered successfully)
diff --git a/testsuite/tests/concurrent/should_run/T5611a.stdout b/testsuite/tests/concurrent/should_run/T5611a.stdout
new file mode 100644
index 000000000000..cf4f0d28274a
--- /dev/null
+++ b/testsuite/tests/concurrent/should_run/T5611a.stdout
@@ -0,0 +1,2 @@
+child: Sleeping
+parent: Done throwing exception
diff --git a/testsuite/tests/concurrent/should_run/all.T b/testsuite/tests/concurrent/should_run/all.T
index 706cd68ed482..b8aeb32803a5 100644
--- a/testsuite/tests/concurrent/should_run/all.T
+++ b/testsuite/tests/concurrent/should_run/all.T
@@ -74,10 +74,8 @@ test('T5558',
compile_and_run, [''])
test('T5421', normal, compile_and_run, [''])
-test('T5611',
- [expect_broken_for(16845, ['ghci']),
- when(opsys('darwin'), fragile(12751))],
- compile_and_run, [''])
+test('T5611', when(opsys('darwin'), fragile(12751)) , compile_and_run, [''])
+test('T5611a', when(opsys('darwin'), fragile(12751)) , compile_and_run, [''])
test('T5238', normal, compile_and_run, [''])
test('T5866', exit_code(1), compile_and_run, [''])
--
GitLab