[commit: ghc] ghc-7.10: Test case for #10176 (7e1758a)

[git at git.haskell.org]

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

On branch  : ghc-7.10
Link       : http://ghc.haskell.org/trac/ghc/changeset/7e1758a9cf86c28440834d3e3d44737186e5ca5f/ghc

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

commit 7e1758a9cf86c28440834d3e3d44737186e5ca5f
Author: Joachim Breitner <mail at joachim-breitner.de>
Date:   Sat Mar 21 15:08:16 2015 +0100

    Test case for #10176
    
    originally provided by Neil Mitchell. Despite what he observed, I can
    observe the bug even with all in one module.
    
    (cherry picked from commit 5119e097b5cc08d1e6e94529d8c6d7c654a28829)


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

7e1758a9cf86c28440834d3e3d44737186e5ca5f
 testsuite/tests/simplCore/should_compile/T10176.hs | 34 ++++++++++++++++++++++
 testsuite/tests/simplCore/should_compile/all.T     |  1 +
 2 files changed, 35 insertions(+)

diff --git a/testsuite/tests/simplCore/should_compile/T10176.hs b/testsuite/tests/simplCore/should_compile/T10176.hs
new file mode 100644
index 0000000..e91ccda
--- /dev/null
+++ b/testsuite/tests/simplCore/should_compile/T10176.hs
@@ -0,0 +1,34 @@
+
+module T10176(buggy) where
+
+{-# NOINLINE error2Args #-}
+error2Args :: () -> () -> a
+error2Args _ _ = error "here"
+
+newtype ReaderT r a = ReaderT { runReaderT :: r -> IO a }
+
+instance Functor (ReaderT r) where
+    fmap = undefined
+
+instance Applicative (ReaderT r) where
+    pure    = liftReaderT . pure
+    f <*> v = undefined
+
+instance Monad (ReaderT r) where
+    return   = liftReaderT . return
+    m >>= k  = undefined
+    m >> k  = ReaderT $ \r -> do runReaderT m r; runReaderT k r
+
+liftReaderT :: IO a -> ReaderT r a
+liftReaderT m = ReaderT (const m)
+
+{-# NOINLINE buggy #-}
+buggy fun unit bool =
+    runReaderT (do
+        if bool then liftReaderT $ print () else pure ()
+        case fun unit of
+            True -> do
+                error2Args unit unit
+                pure ()
+            _ -> pure ()
+        ) () :: IO ()
diff --git a/testsuite/tests/simplCore/should_compile/all.T b/testsuite/tests/simplCore/should_compile/all.T
index bbdadbf..998894a 100644
--- a/testsuite/tests/simplCore/should_compile/all.T
+++ b/testsuite/tests/simplCore/should_compile/all.T
@@ -209,3 +209,4 @@ test('T6056', only_ways(['optasm']), multimod_compile, ['T6056', '-v0 -ddump-rul
 test('T9400', only_ways(['optasm']), compile, ['-O0 -ddump-simpl -dsuppress-uniques'])
 test('T9583', only_ways(['optasm']), compile, [''])
 test('T9565', only_ways(['optasm']), compile, [''])
+test('T10176', [only_ways(['optasm']), expect_broken(10176)], compile, [''])