[commit: ghc] master: Test Trac #9390 (2990e97)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/2990e97f008c9703eb4b47e24a29d052d5735f00/ghc

>---------------------------------------------------------------

commit 2990e97f008c9703eb4b47e24a29d052d5735f00
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date:   Thu Aug 7 10:08:00 2014 +0100

    Test Trac #9390


>---------------------------------------------------------------

2990e97f008c9703eb4b47e24a29d052d5735f00
 testsuite/tests/simplCore/should_run/T9390.hs     | 27 +++++++++++++++++++++++
 testsuite/tests/simplCore/should_run/T9390.stdout |  1 +
 testsuite/tests/simplCore/should_run/all.T        |  1 +
 3 files changed, 29 insertions(+)

diff --git a/testsuite/tests/simplCore/should_run/T9390.hs b/testsuite/tests/simplCore/should_run/T9390.hs
new file mode 100644
index 0000000..04b4da0
--- /dev/null
+++ b/testsuite/tests/simplCore/should_run/T9390.hs
@@ -0,0 +1,27 @@
+{-# LANGUAGE MagicHash, UnboxedTuples #-}
+module Main(main ) where
+
+import GHC.IO (IO (..))
+import GHC.Prim
+
+writeB :: MutableArray# RealWorld Char -> IO ()
+writeB arr# = IO $ \s0# -> (# writeArray# arr# 0# 'B' s0#, () #)
+
+inlineWriteB :: MutableArray# RealWorld Char -> ()
+inlineWriteB arr# =
+    case f realWorld# of
+        (# _, x #) -> x
+  where
+    IO f = writeB arr#
+
+test :: IO Char
+test = IO $ \s0# ->
+  case newArray# 1# 'A' s0# of
+    (# s1#, arr# #) ->
+      case seq# (inlineWriteB arr#) s1# of
+        (# s2#, () #) ->
+          readArray# arr# 0# s2#
+
+main :: IO ()
+main = test >>= print
+
diff --git a/testsuite/tests/simplCore/should_run/T9390.stdout b/testsuite/tests/simplCore/should_run/T9390.stdout
new file mode 100644
index 0000000..69349b4
--- /dev/null
+++ b/testsuite/tests/simplCore/should_run/T9390.stdout
@@ -0,0 +1 @@
+'B'
diff --git a/testsuite/tests/simplCore/should_run/all.T b/testsuite/tests/simplCore/should_run/all.T
index e36fb00..93dc4c6 100644
--- a/testsuite/tests/simplCore/should_run/all.T
+++ b/testsuite/tests/simplCore/should_run/all.T
@@ -67,3 +67,4 @@ test('T7924', exit_code(1), compile_and_run, [''])
 test('T457', [ only_ways(['normal','optasm']), exit_code(1) ], compile_and_run, [''])
 
 test('T9128', normal, compile_and_run, [''])
+test('T9390', normal, compile_and_run, [''])