[commit: ghc] master: Call Arity test case: Check what happens with unboxed lets (aab6b9b)

[git at git.haskell.org]

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

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

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

commit aab6b9bdc00dee375feb0b52907ba01bade607fa
Author: Joachim Breitner <mail at joachim-breitner.de>
Date:   Fri Mar 14 19:16:58 2014 +0100

    Call Arity test case: Check what happens with unboxed lets


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

aab6b9bdc00dee375feb0b52907ba01bade607fa
 .../should_run}/Makefile                           |    0
 testsuite/tests/callarity/should_run/StrictLet.hs  |   32 ++++++++++++++++++++
 .../tests/callarity/should_run/StrictLet.stderr    |    1 +
 testsuite/tests/callarity/should_run/all.T         |    1 +
 4 files changed, 34 insertions(+)

diff --git a/testsuite/tests/annotations/should_compile/Makefile b/testsuite/tests/callarity/should_run/Makefile
similarity index 100%
copy from testsuite/tests/annotations/should_compile/Makefile
copy to testsuite/tests/callarity/should_run/Makefile
diff --git a/testsuite/tests/callarity/should_run/StrictLet.hs b/testsuite/tests/callarity/should_run/StrictLet.hs
new file mode 100644
index 0000000..bae0183
--- /dev/null
+++ b/testsuite/tests/callarity/should_run/StrictLet.hs
@@ -0,0 +1,32 @@
+{-# LANGUAGE MagicHash #-}
+
+{-
+If the (unboxed, hence strict) "let thunk =" would survive to the CallArity
+stage, it might yield wrong results (eta-expanding thunk and hence "cond" would
+be called multiple times).
+
+It does not actually happen (CallArity sees a "case"), so this test just
+safe-guards against future changes here.
+-}
+
+import Debug.Trace
+import GHC.Exts
+import System.Environment
+
+cond :: Int# -> Bool
+cond x = trace ("cond called with " ++ show (I# x)) True
+{-# NOINLINE cond #-}
+
+
+bar (I# x) =
+    let go n = let x = thunk n
+               in case n of
+                    100# -> I# x
+                    _    -> go (n +# 1#)
+    in go x
+  where thunk = if cond x then \x -> (x +# 1#) else \x -> (x -# 1#)
+
+
+main = do
+    args <- getArgs
+    bar (length args) `seq` return ()
diff --git a/testsuite/tests/callarity/should_run/StrictLet.stderr b/testsuite/tests/callarity/should_run/StrictLet.stderr
new file mode 100644
index 0000000..4387bc0
--- /dev/null
+++ b/testsuite/tests/callarity/should_run/StrictLet.stderr
@@ -0,0 +1 @@
+cond called with 0
diff --git a/testsuite/tests/callarity/should_run/all.T b/testsuite/tests/callarity/should_run/all.T
new file mode 100644
index 0000000..571448c
--- /dev/null
+++ b/testsuite/tests/callarity/should_run/all.T
@@ -0,0 +1 @@
+test('StrictLet', [], compile_and_run, [''])