[commit: ghc] ghc-8.4: Don't refer to blocks in debug info when -g1 (59d7347)

[git at git.haskell.org]

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

On branch  : ghc-8.4
Link       : http://ghc.haskell.org/trac/ghc/changeset/59d7347119c9f17e83b02d428f4efec823c065e1/ghc

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

commit 59d7347119c9f17e83b02d428f4efec823c065e1
Author: Bartosz Nitka <niteria at gmail.com>
Date:   Sun Mar 25 15:34:27 2018 -0400

    Don't refer to blocks in debug info when -g1
    
    -g1 removes block information, but it turns out that procs can
    refer to block information through parents.
    Note [Splitting DebugBlocks] explains the parentage relationship.
    
    Test Plan:
    * ./validate
    * added a new test
    
    Reviewers: bgamari, simonmar
    
    Reviewed By: bgamari
    
    Subscribers: rwbarton, thomie, carter
    
    GHC Trac Issues: #14894
    
    Differential Revision: https://phabricator.haskell.org/D4496
    
    (cherry picked from commit 0cbb13b3dfd70b4c9665109cd6c4a150cb7b99df)


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

59d7347119c9f17e83b02d428f4efec823c065e1
 compiler/nativeGen/Dwarf.hs                                   | 11 +++++++++--
 testsuite/tests/simplCore/should_run/T14894.hs                |  9 +++++++++
 .../tests/simplCore/should_run/T14894.stdout                  |  0
 testsuite/tests/simplCore/should_run/all.T                    |  1 +
 4 files changed, 19 insertions(+), 2 deletions(-)

diff --git a/compiler/nativeGen/Dwarf.hs b/compiler/nativeGen/Dwarf.hs
index b858b77..8ccf408 100644
--- a/compiler/nativeGen/Dwarf.hs
+++ b/compiler/nativeGen/Dwarf.hs
@@ -182,10 +182,17 @@ procToDwarf df prc
                          _otherwise -> showSDocDump df $ ppr $ dblLabel prc
                     , dwLabel    = dblCLabel prc
                     , dwParent   = fmap mkAsmTempDieLabel
-                                   $ mfilter (/= dblCLabel prc)
+                                   $ mfilter goodParent
                                    $ fmap dblCLabel (dblParent prc)
-                      -- Omit parent if it would be self-referential
                     }
+  where
+  goodParent a | a == dblCLabel prc = False
+               -- Omit parent if it would be self-referential
+  goodParent a | not (externallyVisibleCLabel a)
+               , debugLevel df < 2 = False
+               -- We strip block information when running -g0 or -g1, don't
+               -- refer to blocks in that case. Fixes #14894.
+  goodParent _ = True
 
 -- | Generate DWARF info for a block
 blockToDwarf :: DynFlags -> DebugBlock -> DwarfInfo
diff --git a/testsuite/tests/simplCore/should_run/T14894.hs b/testsuite/tests/simplCore/should_run/T14894.hs
new file mode 100644
index 0000000..420b85e
--- /dev/null
+++ b/testsuite/tests/simplCore/should_run/T14894.hs
@@ -0,0 +1,9 @@
+{-# OPTIONS_GHC -g1 -O #-}
+import System.Environment
+summap :: (Int -> Int) -> (Int -> Int)
+summap f n = f 10
+{-# NOINLINE summap #-}
+
+main = do
+  n <- length `fmap` getArgs
+  print $ summap (+ n) n
diff --git a/libraries/base/tests/IO/T4895.stdout b/testsuite/tests/simplCore/should_run/T14894.stdout
similarity index 100%
copy from libraries/base/tests/IO/T4895.stdout
copy to testsuite/tests/simplCore/should_run/T14894.stdout
diff --git a/testsuite/tests/simplCore/should_run/all.T b/testsuite/tests/simplCore/should_run/all.T
index d1ea496..d697605 100644
--- a/testsuite/tests/simplCore/should_run/all.T
+++ b/testsuite/tests/simplCore/should_run/all.T
@@ -82,3 +82,4 @@ test('T14768', reqlib('vector'), compile_and_run, [''])
 test('T14868',
      [when((arch('powerpc64') or arch('powerpc64le')), expect_broken(11261))],
      compile_and_run, [''])
+test('T14894', normal, compile_and_run, [''])