diff options
author | Douglas Wilson <douglas.wilson@gmail.com> | 2017-11-09 17:54:28 -0500 |
---|---|---|
committer | Ben Gamari <ben@smart-cactus.org> | 2017-11-09 18:31:22 -0500 |
commit | e6b13c963d0b54099a41bb1b51fe680644582051 (patch) | |
tree | 9dbb7e1d68a00843e001d97d85c06e3217002664 | |
parent | 6b52b4c832f888f7741a4ba0fec1fdac10244f6d (diff) | |
download | haskell-e6b13c963d0b54099a41bb1b51fe680644582051.tar.gz |
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
-rw-r--r-- | testsuite/tests/profiling/should_compile/T5889/A.hs | 7 | ||||
-rw-r--r-- | testsuite/tests/profiling/should_compile/T5889/B.hs | 65 | ||||
-rw-r--r-- | 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 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=<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 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']) |