[commit: ghc] master: Test case: Looking through unfoldings when matching lambdas (cde88e2)

[git at git.haskell.org]

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

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

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

commit cde88e20a880a5240831c330191610d536e48ccf
Author: Joachim Breitner <mail at joachim-breitner.de>
Date:   Tue Feb 11 11:24:28 2014 +0000

    Test case: Looking through unfoldings when matching lambdas


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

cde88e20a880a5240831c330191610d536e48ccf
 testsuite/tests/simplCore/should_run/all.T         |    1 +
 .../tests/simplCore/should_run/simplrun011.hs      |   37 ++++++++++++++++++++
 .../tests/simplCore/should_run/simplrun011.stdout  |    6 ++++
 3 files changed, 44 insertions(+)

diff --git a/testsuite/tests/simplCore/should_run/all.T b/testsuite/tests/simplCore/should_run/all.T
index fa11dc5..530e4e5 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 0000000..e7f6646
--- /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 0000000..3751791
--- /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