From: Pierre-Marie de Rodat <derodat@adacore.com>
Date: Wed, 12 Oct 2016 08:29:01 +0000 (+0000)
Subject: DWARF: fix scoping for descriptions of local types
X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=c0dbd22d2eebf14210473be5c37da77083dbbf5f;p=gcc.git

DWARF: fix scoping for descriptions of local types

In Ada, it is possible to have nested subprograms in the following
configuration:

    procedure Parent is
       type T;
       [...]
       procedure Child (Value : T) is
       begin
          [...]
       end Child;
    begin
       [...]
    end Parent;

As we currently generate debugging information for Child first before
Parent, the debug info for T appears in global scope since the DIE for
Parent does not exist yet.

This patch makes sure that when we generate early debug info for a
nested function, we trigger generation for the parent function first.

gcc/

	* dwarf2out.c (dwarf2out_early_global_decl): For nested
	functions, call dwarf2out_decl on the parent function first.

gcc/testsuite/

	* gnat.dg/debug9.adb: New testcase.

From-SVN: r241023
---

diff --git a/gcc/ChangeLog b/gcc/ChangeLog
index a50d32d6ef8..b39089633f1 100644
--- a/gcc/ChangeLog
+++ b/gcc/ChangeLog
@@ -1,3 +1,8 @@
+2016-10-12  Pierre-Marie de Rodat  <derodat@adacore.com>
+
+	* dwarf2out.c (dwarf2out_early_global_decl): For nested
+	functions, call dwarf2out_decl on the parent function first.
+
 2016-10-12  Richard Biener  <rguenther@suse.de>
 
 	* match.pd ((X /[ex] A) * A -> X): Remove unnecessary constraint
diff --git a/gcc/dwarf2out.c b/gcc/dwarf2out.c
index 3f7833ff9cd..f03e9aa4f2f 100644
--- a/gcc/dwarf2out.c
+++ b/gcc/dwarf2out.c
@@ -23902,6 +23902,16 @@ dwarf2out_early_global_decl (tree decl)
 	  if (!DECL_STRUCT_FUNCTION (decl))
 	    goto early_decl_exit;
 
+	  /* For nested functions, emit DIEs for the parents first so that all
+	     nested DIEs are generated at the proper scope in the first
+	     shot.  */
+	  tree context = decl_function_context (decl);
+	  if (context != NULL)
+	    {
+	      current_function_decl = context;
+	      dwarf2out_decl (context);
+	    }
+
 	  current_function_decl = decl;
 	}
       dwarf2out_decl (decl);
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 1c4d4cf8de2..27d84131b0f 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,7 @@
+2016-10-12  Pierre-Marie de Rodat  <derodat@adacore.com>
+
+	* gnat.dg/debug9.adb: New testcase.
+
 2016-10-12  Richard Biener  <rguenther@suse.de>
 
 	* gcc.dg/tree-ssa/vrp35.c: Adjust.
diff --git a/gcc/testsuite/gnat.dg/debug9.adb b/gcc/testsuite/gnat.dg/debug9.adb
new file mode 100644
index 00000000000..a15069faf21
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/debug9.adb
@@ -0,0 +1,53 @@
+--  The aim of this test is to check that Ada types appear in the proper
+--  context in the debug info.
+--
+--  Checking this directly would be really tedious just scanning for assembly
+--  lines, so instead we rely on DWARFv4's .debug_types sections, which must be
+--  created only for global-scope types. Checking the number of .debug_types is
+--  some hackish way to check that types are output in the proper context (i.e.
+--  at global or local scope).
+--
+--  { dg-options "-g -gdwarf-4 -cargs -fdebug-types-section -dA" }
+--  { dg-final { scan-assembler-times "\\(DIE \\(0x\[a-f0-9\]*\\) DW_TAG_type_unit\\)" 0 } }
+
+procedure Debug9 is
+   type Array_Type is array (Natural range <>) of Integer;
+   type Record_Type (L1, L2 : Natural) is record
+      I1 : Integer;
+      A1 : Array_Type (1 .. L1);
+      I2 : Integer;
+      A2 : Array_Type (1 .. L2);
+      I3 : Integer;
+   end record;
+
+   function Get (L1, L2 : Natural) return Record_Type is
+      Result : Record_Type (L1, L2);
+   begin
+      Result.I1 := 1;
+      for I in Result.A1'Range loop
+         Result.A1 (I) := I;
+      end loop;
+      Result.I2 := 2;
+      for I in Result.A2'Range loop
+         Result.A2 (I) := I;
+      end loop;
+      Result.I3 := 3;
+      return Result;
+   end Get;
+
+   R1 : Record_Type := Get (0, 0);
+   R2 : Record_Type := Get (1, 0);
+   R3 : Record_Type := Get (0, 1);
+   R4 : Record_Type := Get (2, 2);
+
+   procedure Process (R : Record_Type) is
+   begin
+      null;
+   end Process;
+
+begin
+   Process (R1);
+   Process (R2);
+   Process (R3);
+   Process (R4);
+end Debug9;