Test case: Looking through unfoldings when matching lambdas

3 files changed, 44 insertions, 0 deletions

diff --git a/testsuite/tests/simplCore/should_run/all.T b/testsuite/tests/simplCore/should_run/all.T
index fa11dc542f..530e4e58f2 100644
--- a/testsuite/tests/simplCore/should_run/all.T
+++ b/testsuite/tests/simplCore/should_run/all.T
@@ -21,6 +21,7 @@ test('simplrun009', normal, compile_and_run, [''])
 test('simplrun010', [extra_run_opts('24 16 8 +RTS -M10m -RTS'),
                      exit_code(251)]
                   , compile_and_run, [''])
+test('simplrun011', normal, compile_and_run, [''])
 
 # Really we'd like to run T2486 too, to check that its
 # runtime has not gone up, but here I just compile it so that
diff --git a/testsuite/tests/simplCore/should_run/simplrun011.hs b/testsuite/tests/simplCore/should_run/simplrun011.hs
new file mode 100644
index 0000000000..e7f664602b
--- /dev/null
+++ b/testsuite/tests/simplCore/should_run/simplrun011.hs
@@ -0,0 +1,37 @@
+module Main where
+
+import GHC.Exts
+
+-- This checks that rules look through unfoldings when matching
+-- lambdas, but only in the right phase
+
+foo :: (Int -> IO ()) -> IO ()
+foo f = putStr "not fired: " >> f 0
+{-# NOINLINE foo #-}
+
+f1 :: Int -> IO ()
+f1 _ = putStrLn "f1"
+{-# NOINLINE[0] f1 #-}
+
+f2 :: Int -> IO ()
+f2 _ = putStrLn "f2"
+{-# NOINLINE f2 #-}
+
+newtype Age = MkAge Int
+
+-- It also checks that this can look through casted lambdas
+
+f3 :: Age -> IO ()
+f3 _ = putStrLn "f3"
+{-# NOINLINE[0] f3 #-}
+
+
+{-# RULES "foo" [0] forall g . foo (\x -> g) = putStr "fired: " >> g #-}
+
+main = do
+    foo f1
+    foo f1
+    foo f2
+    foo f2
+    foo (coerce f3)
+    foo (coerce f3)
diff --git a/testsuite/tests/simplCore/should_run/simplrun011.stdout b/testsuite/tests/simplCore/should_run/simplrun011.stdout
new file mode 100644
index 0000000000..3751791728
--- /dev/null
+++ b/testsuite/tests/simplCore/should_run/simplrun011.stdout
@@ -0,0 +1,6 @@
+fired: f1
+fired: f1
+not fired: f2
+not fired: f2
+fired: f3
+fired: f3