[commit: ghc] master: testsuite: Add test for #5889 (e6b13c9)

[git at git.haskell.org]

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

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

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

commit e6b13c963d0b54099a41bb1b51fe680644582051
Author: Douglas Wilson <douglas.wilson at gmail.com>
Date:   Thu Nov 9 17:54:28 2017 -0500

    testsuite: Add test for #5889
    
    Test Plan: make test TEST=5889
    
    Reviewers: austin, bgamari
    
    Reviewed By: bgamari
    
    Subscribers: rwbarton, thomie
    
    GHC Trac Issues: #5889
    
    Differential Revision: https://phabricator.haskell.org/D4158


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

e6b13c963d0b54099a41bb1b51fe680644582051
 .../tests/profiling/should_compile/T5889/A.hs      |  7 +++
 .../tests/profiling/should_compile/T5889/B.hs      | 65 ++++++++++++++++++++++
 testsuite/tests/profiling/should_compile/all.T     |  3 +-
 3 files changed, 73 insertions(+), 2 deletions(-)

diff --git a/testsuite/tests/profiling/should_compile/T5889/A.hs b/testsuite/tests/profiling/should_compile/T5889/A.hs
new file mode 100644
index 0000000..98a2d70
--- /dev/null
+++ b/testsuite/tests/profiling/should_compile/T5889/A.hs
@@ -0,0 +1,7 @@
+import B
+
+-- See B.hs for an explanation on how this bug is triggered.
+
+-- This is a linker error, so we have to define a main and link
+main :: IO ()
+main = putStrLn $ show $ bar 100 Nothing
diff --git a/testsuite/tests/profiling/should_compile/T5889/B.hs b/testsuite/tests/profiling/should_compile/T5889/B.hs
new file mode 100644
index 0000000..fb998cc
--- /dev/null
+++ b/testsuite/tests/profiling/should_compile/T5889/B.hs
@@ -0,0 +1,65 @@
+{-# OPTIONS_GHC -fprof-auto #-}
+module B where
+
+plus_noinline :: Integer -> Integer -> Integer
+plus_noinline x y = x + y
+{-# NOINLINE plus_noinline #-}
+
+-- | This is the key function. We do not want this to be inlined into bar, but
+-- we DO want it to be inlined into main (in A.hs). Moreover, when it is inlined
+-- into main, we don't want the values inside the tuple to be inlined. To
+-- achieve this, in main we call bar with Nothing allowing split to be inlined
+-- with the first case, where the values in tuple are calls to NOINLINE
+-- functions.
+split :: Integer -> Maybe Integer -> (Integer, Integer)
+split n Nothing = (n `plus_noinline` 1, n `plus_noinline` 2)
+split n (Just m) =
+  if n == 0 then (m, m) else split (n - 1) (Just m)
+
+
+{- | The simplified core for bar is:
+
+[GblId,
+ Arity=2,
+ Str=<L,U><S,1*U>,
+ Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True,
+         WorkFree=True, Expandable=True,
+         Guidance=ALWAYS_IF(arity=2,unsat_ok=True,boring_ok=False)
+         Tmpl= \ (n_a1Gq [Occ=OnceL] :: Integer)
+                 (m_a1Gr [Occ=OnceL] :: Maybe Integer) ->
+                 scc<bar>
+                 let {
+                   ds_s2rg :: (Integer, Integer)
+                   [LclId]
+                   ds_s2rg = scc<bar.(...)> split n_a1Gq m_a1Gr } in
+                 plus_noinline
+                   (scc<bar.y>
+                    case ds_s2rg of { (y_a2ps [Occ=Once], _ [Occ=Dead])
+                      -> y_a2ps })
+                   (scc<bar.z>
+                    case ds_s2rg of { (_ [Occ=Dead], z_a2pu [Occ=Once])
+                      -> z_a2pu })}]
+bar
+  = \ (n_a1Gq :: Integer) (m_a1Gr :: Maybe Integer) ->
+      scc<bar>
+      case scc<bar.(...)> split n_a1Gq m_a1Gr of
+      { (ww1_s2s7, ww2_s2s8) ->
+      plus_noinline ww1_s2s7 ww2_s2s8
+      }
+
+Note that there are sccs around the (x,y) pattern match in the unfolding, but
+not in the simplified function. See #5889 for a discussion on why the sccs are
+present in one but not the other, and whether this is correct.
+
+split is not inlined here, because it is a recursive function.
+
+In A.hs, bar is called with m = Nothing, allowing split to be inlined (as it is
+not recursive in that case) and the sccs ARE present in the simplified core of
+main (as they are around function calls, not ids). This triggers the linker
+error.
+
+-}
+bar :: Integer -> Maybe Integer -> Integer
+bar n m = y `plus_noinline` z
+  where
+    (y, z) = split n m
diff --git a/testsuite/tests/profiling/should_compile/all.T b/testsuite/tests/profiling/should_compile/all.T
index 45d0b3a..068b43b 100644
--- a/testsuite/tests/profiling/should_compile/all.T
+++ b/testsuite/tests/profiling/should_compile/all.T
@@ -1,8 +1,7 @@
-
 # We need to run prof001 and prof002 the normal way, as the extra flags
 # added for the profiling ways makes it pass
 test('prof001', [only_ways(['normal']), req_profiling], compile_and_run, ['-prof -fprof-cafs'])
 test('prof002', [only_ways(['normal']), req_profiling], compile_and_run, ['-prof -fprof-cafs'])
 
 test('T2410', [only_ways(['normal']), req_profiling], compile, ['-O2 -prof -fprof-cafs'])
-
+test('T5889', [expect_broken(5889), only_ways(['normal']), req_profiling, extra_files(['T5889/A.hs', 'T5889/B.hs'])], multimod_compile, ['A B', '-O -prof -fno-prof-count-entries -v0'])