From 7e1758a9cf86c28440834d3e3d44737186e5ca5f Mon Sep 17 00:00:00 2001
From: Joachim Breitner <mail@joachim-breitner.de>
Date: Sat, 21 Mar 2015 15:08:16 +0100
Subject: [PATCH] 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)
---
.../tests/simplCore/should_compile/T10176.hs | 34 +++++++++++++++++++
.../tests/simplCore/should_compile/all.T | 1 +
2 files changed, 35 insertions(+)
create mode 100644 testsuite/tests/simplCore/should_compile/T10176.hs
diff --git a/testsuite/tests/simplCore/should_compile/T10176.hs b/testsuite/tests/simplCore/should_compile/T10176.hs
new file mode 100644
index 000000000000..e91ccda4e965
--- /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 bbdadbf1fa9c..998894abbfd7 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, [''])
--
GitLab