Re: [PATCH 1/2] DWARF: process all TYPE_DECL nodes when iterating on scopes

[Pierre-Marie de Rodat <derodat at adacore dot com>]

Here is another attempt to solve the original issue. This time, with a 
proper testcase. ;-)

Rebased against trunk, boostrapped and regtested on x86_64-linux.

gcc/

    * dwarf2out.c (process_scope_var): Relocate DIEs for TYPE_DECL
    nodes that are not stubs.
    (gen_decl_die): For TYPE_DECLs that have the same scope as their
    type, relocate the type DIE if it was generated without a scope.

gcc/testsuite/

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

--
Pierre-Marie de Rodat

>From 7b6288889a631b532d561ed66c0dc973dfbf1f5d Mon Sep 17 00:00:00 2001
From: Pierre-Marie de Rodat <derodat@adacore.com>
Date: Tue, 5 Jan 2016 15:32:34 +0100
Subject: [PATCH] DWARF: process all TYPE_DECL nodes when iterating on scopes

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;

If we generate debugging information for Child first before Parent, the
debug info for T will be generated at global scope since the DIE for
Parent does not exist yet.  It is when generating debug info for Parent
that we are supposed to relocate it.  This change enhances the
relocation machinery to handle the above case.

gcc/

	* dwarf2out.c (process_scope_var): Relocate DIEs for TYPE_DECL
	nodes that are not stubs.
	(gen_decl_die): For TYPE_DECLs that have the same scope as their
	type, relocate the type DIE if it was generated without a scope.

gcc/testsuite/

	* gnat.dg/debug9.adb: New testcase.
---
 gcc/dwarf2out.c                  | 18 ++++++++++++--
 gcc/testsuite/gnat.dg/debug9.adb | 53 ++++++++++++++++++++++++++++++++++++++++
 2 files changed, 69 insertions(+), 2 deletions(-)
 create mode 100644 gcc/testsuite/gnat.dg/debug9.adb

diff --git a/gcc/dwarf2out.c b/gcc/dwarf2out.c
index 45eb684..2e3ca71 100644
--- a/gcc/dwarf2out.c
+++ b/gcc/dwarf2out.c
@@ -23248,6 +23248,8 @@ process_scope_var (tree stmt, tree decl, tree origin, dw_die_ref context_die)
   else if (TREE_CODE (decl_or_origin) == TYPE_DECL
            && TYPE_DECL_IS_STUB (decl_or_origin))
     die = lookup_type_die (TREE_TYPE (decl_or_origin));
+  else if (TREE_CODE (decl_or_origin) == TYPE_DECL)
+    die = lookup_decl_die (decl_or_origin);
   else
     die = NULL;
 
@@ -23732,8 +23734,20 @@ gen_decl_die (tree decl, tree origin, struct vlr_context *ctx,
       if (is_redundant_typedef (decl))
 	gen_type_die (TREE_TYPE (decl), context_die);
       else
-	/* Output a DIE to represent the typedef itself.  */
-	gen_typedef_die (decl, context_die);
+	{
+	  /* Output a DIE to represent the typedef itself.  */
+	  gen_typedef_die (decl, context_die);
+
+	  /* The above may create a typedef in the proper scope, but the
+	     underlying type itself could have been created earlier, at a point
+	     when the scope was not available yet.  If it's the case, relocate
+	     it.  This is analogous to what is done in process_scope_var,
+	     except we deal with a TYPE and not a DECL, here.  */
+	  dw_die_ref type_die = lookup_type_die (TREE_TYPE (decl));
+	  if (type_die != NULL && type_die->die_parent == NULL
+	      && DECL_CONTEXT (decl) == TYPE_CONTEXT (TREE_TYPE (decl)))
+	    add_child_die (context_die, type_die);
+	}
       break;
 
     case LABEL_DECL:
diff --git a/gcc/testsuite/gnat.dg/debug9.adb b/gcc/testsuite/gnat.dg/debug9.adb
new file mode 100644
index 0000000..dd14210
--- /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;
-- 
2.3.3.199.g52cae64