From e6b13c963d0b54099a41bb1b51fe680644582051 Mon Sep 17 00:00:00 2001 From: Douglas Wilson Date: Thu, 9 Nov 2017 17:54:28 -0500 Subject: 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 --- .../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(-) create mode 100644 testsuite/tests/profiling/should_compile/T5889/A.hs create mode 100644 testsuite/tests/profiling/should_compile/T5889/B.hs 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 0000000000..98a2d703a6 --- /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 0000000000..fb998cc5e6 --- /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=, + 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 + let { + ds_s2rg :: (Integer, Integer) + [LclId] + ds_s2rg = scc split n_a1Gq m_a1Gr } in + plus_noinline + (scc + case ds_s2rg of { (y_a2ps [Occ=Once], _ [Occ=Dead]) + -> y_a2ps }) + (scc + case ds_s2rg of { (_ [Occ=Dead], z_a2pu [Occ=Once]) + -> z_a2pu })}] +bar + = \ (n_a1Gq :: Integer) (m_a1Gr :: Maybe Integer) -> + scc + case scc 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 45d0b3aefd..068b43b77e 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']) -- cgit v1.2.1