Add a regression test for #17912

3 files changed, 36 insertions, 0 deletions

diff --git a/libraries/base/tests/IO/T17912.hs b/libraries/base/tests/IO/T17912.hs
new file mode 100644
index 0000000000..102e891968
--- /dev/null
+++ b/libraries/base/tests/IO/T17912.hs
@@ -0,0 +1,34 @@
+{-# Language ScopedTypeVariables #-}
+module Main where
+
+import Control.Concurrent
+import Control.Exception
+import System.IO
+import System.Exit
+import System.Process
+import GHC.IO.Handle.FD
+
+main = do
+  ecode <- waitForProcess =<< spawnProcess "mkfifo" ["fifo"]
+  case ecode of
+    ExitFailure code -> putStrLn "mkfifo failed"
+    ExitSuccess -> do
+      passed <- newEmptyMVar
+      opener <- forkIO $
+        (openFileBlocking "fifo" WriteMode >> return ())
+          `catch` \(e:: AsyncException) -> do
+             if e == ThreadKilled then do
+                putStrLn "openFileBlocking successfully interrupted"
+                putMVar passed True
+             else print e
+             throwIO e
+      threadDelay 1000
+      forkIO $ killThread opener
+      forkIO $ do
+        threadDelay (10^6)
+        putStrLn "timeout!"
+        putMVar passed False
+      res <- readMVar passed
+      case res of
+        True -> exitSuccess
+        False -> exitFailure
diff --git a/libraries/base/tests/IO/T17912.stdout b/libraries/base/tests/IO/T17912.stdout
new file mode 100644
index 0000000000..bdfca81701
--- /dev/null
+++ b/libraries/base/tests/IO/T17912.stdout
@@ -0,0 +1 @@
+openFileBlocking successfully interrupted
diff --git a/libraries/base/tests/IO/all.T b/libraries/base/tests/IO/all.T
index a2aac9f37f..40e9dbf35f 100644
--- a/libraries/base/tests/IO/all.T
+++ b/libraries/base/tests/IO/all.T
@@ -149,3 +149,4 @@ test('T17414',
      compile_and_run, [''])
 test('T17510', expect_broken(17510), compile_and_run, [''])
 test('bytestringread001', extra_run_opts('test.data'), compile_and_run, [''])
+test('T17912', [only_ways(['threaded1']), when(opsys('mingw32'),expect_broken(1))], compile_and_run, [''])