From 59d7347119c9f17e83b02d428f4efec823c065e1 Mon Sep 17 00:00:00 2001
From: Bartosz Nitka <niteria@gmail.com>
Date: Sun, 25 Mar 2018 15:34:27 -0400
Subject: [PATCH] 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)
---
compiler/nativeGen/Dwarf.hs | 11 +++++++++--
testsuite/tests/simplCore/should_run/T14894.hs | 9 +++++++++
testsuite/tests/simplCore/should_run/T14894.stdout | 1 +
testsuite/tests/simplCore/should_run/all.T | 1 +
4 files changed, 20 insertions(+), 2 deletions(-)
create mode 100644 testsuite/tests/simplCore/should_run/T14894.hs
create mode 100644 testsuite/tests/simplCore/should_run/T14894.stdout
diff --git a/compiler/nativeGen/Dwarf.hs b/compiler/nativeGen/Dwarf.hs
index b858b7734dbe..8ccf408e7ed4 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 000000000000..420b85e466a7
--- /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/testsuite/tests/simplCore/should_run/T14894.stdout b/testsuite/tests/simplCore/should_run/T14894.stdout
new file mode 100644
index 000000000000..f599e28b8ab0
--- /dev/null
+++ b/testsuite/tests/simplCore/should_run/T14894.stdout
@@ -0,0 +1 @@
+10
diff --git a/testsuite/tests/simplCore/should_run/all.T b/testsuite/tests/simplCore/should_run/all.T
index d1ea496af372..d697605754ce 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, [''])
--
GitLab