[commit: ghc] master: Test case for #10176 (5119e09)

git at git.haskell.org git at git.haskell.org
Sun Mar 22 16:22:36 UTC 2015


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

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/5119e097b5cc08d1e6e94529d8c6d7c654a28829/ghc

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

commit 5119e097b5cc08d1e6e94529d8c6d7c654a28829
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.


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

5119e097b5cc08d1e6e94529d8c6d7c654a28829
 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 bc1ed26..5520b40 100644
--- a/testsuite/tests/simplCore/should_compile/all.T
+++ b/testsuite/tests/simplCore/should_compile/all.T
@@ -211,3 +211,4 @@ test('T9400', only_ways(['optasm']), compile, ['-O0 -ddump-simpl -dsuppress-uniq
 test('T9583', only_ways(['optasm']), compile, [''])
 test('T9565', only_ways(['optasm']), compile, [''])
 test('T5821', only_ways(['optasm']), compile, [''])
+test('T10176', [only_ways(['optasm']), expect_broken(10176)], compile, [''])



More information about the ghc-commits mailing list