Generate debug info for local dynamic record types

In Ada you can embed VLAs in local record types and thus end up with
dynamic offsets in record types, which are not well described in DWARF
because 1) the temporaries generated for them by the gimplifier are
naturally marked DECL_IGNORED_P and 2) when the types are referenced
in nested subprograms, the DWARF back-end does not correctly handle
the rewritten references.

gcc/
	* dwarf2out.c (loc_list_from_tree_1) <DECL>: During early DWARF, do
	not expand the VALUE_EXPR of variables put in the non-local frame.
	* gimplify.c (gimplify_type_sizes) <RECORD_TYPE>: If the type is not
	to be ignored for debug info, ensure its variable offsets are not.
gcc/testsuite/
	* gnat.dg/debug8.adb: Minor tweak.
	* gnat.dg/debug11.adb: Likewise.
	* gnat.dg/debug16.adb: Likewise.
	* gnat.dg/debug17.adb: New test.
	* gnat.dg/specs/debug1.ads: Minor tweak.

diff --git a/gcc/dwarf2out.c b/gcc/dwarf2out.c
index c36fd5a7f6a4f9bd767d24a737df7647aee1a8ea..5b819ab1a923b0045f23de28376e52bd962749c1 100644 (file)
--- a/gcc/dwarf2out.c
+++ b/gcc/dwarf2out.c
@@ -18658,8 +18658,20 @@ loc_list_from_tree_1 (tree loc, int want_address,
 
     case RESULT_DECL:
       if (DECL_HAS_VALUE_EXPR_P (loc))
-       return loc_list_from_tree_1 (DECL_VALUE_EXPR (loc),
-                                    want_address, context);
+       {
+         tree value_expr = DECL_VALUE_EXPR (loc);
+
+         /* Non-local frame structures are DECL_IGNORED_P variables so we need
+            to wait until they get an RTX in order to reference them.  */
+         if (early_dwarf
+             && TREE_CODE (value_expr) == COMPONENT_REF
+             && VAR_P (TREE_OPERAND (value_expr, 0))
+             && DECL_NONLOCAL_FRAME (TREE_OPERAND (value_expr, 0)))
+           ;
+         else
+           return loc_list_from_tree_1 (value_expr, want_address, context);
+       }
+
       /* FALLTHRU */
 
     case FUNCTION_DECL:

diff --git a/gcc/gimplify.c b/gcc/gimplify.c
index b65106b14596fe173c8e8ea71fe916d3cdf75f9f..e790f08b23fe5cb4cb3b27bc84d88cd3c5d87466 100644 (file)
--- a/gcc/gimplify.c
+++ b/gcc/gimplify.c
@@ -15141,11 +15141,15 @@ gimplify_expr (tree *expr_p, gimple_seq *pre_p, gimple_seq *post_p,
 void
 gimplify_type_sizes (tree type, gimple_seq *list_p)
 {
-  tree field, t;
-
   if (type == NULL || type == error_mark_node)
     return;
 
+  const bool ignored_p
+    = TYPE_NAME (type)
+      && TREE_CODE (TYPE_NAME (type)) == TYPE_DECL
+      && DECL_IGNORED_P (TYPE_NAME (type));
+  tree t;
+
   /* We first do the main variant, then copy into any other variants.  */
   type = TYPE_MAIN_VARIANT (type);
 
@@ -15179,9 +15183,7 @@ gimplify_type_sizes (tree type, gimple_seq *list_p)
       /* Ensure VLA bounds aren't removed, for -O0 they should be variables
         with assigned stack slots, for -O1+ -g they should be tracked
         by VTA.  */
-      if (!(TYPE_NAME (type)
-           && TREE_CODE (TYPE_NAME (type)) == TYPE_DECL
-           && DECL_IGNORED_P (TYPE_NAME (type)))
+      if (!ignored_p
          && TYPE_DOMAIN (type)
          && INTEGRAL_TYPE_P (TYPE_DOMAIN (type)))
        {
@@ -15197,10 +15199,16 @@ gimplify_type_sizes (tree type, gimple_seq *list_p)
     case RECORD_TYPE:
     case UNION_TYPE:
     case QUAL_UNION_TYPE:
-      for (field = TYPE_FIELDS (type); field; field = DECL_CHAIN (field))
+      for (tree field = TYPE_FIELDS (type); field; field = DECL_CHAIN (field))
        if (TREE_CODE (field) == FIELD_DECL)
          {
            gimplify_one_sizepos (&DECL_FIELD_OFFSET (field), list_p);
+           /* Likewise, ensure variable offsets aren't removed.  */
+           if (!ignored_p
+               && (t = DECL_FIELD_OFFSET (field))
+               && VAR_P (t)
+               && DECL_ARTIFICIAL (t))
+             DECL_IGNORED_P (t) = 0;
            gimplify_one_sizepos (&DECL_SIZE (field), list_p);
            gimplify_one_sizepos (&DECL_SIZE_UNIT (field), list_p);
            gimplify_type_sizes (TREE_TYPE (field), list_p);

diff --git a/gcc/testsuite/gnat.dg/debug11.adb b/gcc/testsuite/gnat.dg/debug11.adb
index 26db5db33fcd5e8c8b0b5a0d8d17f05b6f2a3bca..0fd9e369f2a2a7a4017d14cbfe5cd3117f46dfc8 100644 (file)
--- a/gcc/testsuite/gnat.dg/debug11.adb
+++ b/gcc/testsuite/gnat.dg/debug11.adb
@@ -1,14 +1,11 @@
---  { dg-do compile }
---  { dg-skip-if "No Dwarf" { { hppa*-*-hpux* } && { ! lp64 } } }
---  { dg-options "-cargs -O0 -g -dA -fgnat-encodings=minimal -margs" }
+-- { dg-do compile }
+-- { dg-skip-if "No Dwarf" { { hppa*-*-hpux* } && { ! lp64 } } }
+-- { dg-options "-cargs -O0 -g -dA -fgnat-encodings=minimal -margs" }
 --
---  This testcase checks that in the DWARF description of the variant type
---  below, the C discriminant is properly described as unsigned, hence the 0x5a
---  ('Z') and 0x80 (128) values in the DW_AT_discr_list attribute. If it was
---  described as signed, we would have instead 90 and -128.
---
---  { dg-final { scan-assembler-times "0x5a.*DW_AT_discr_list" 1 } }
---  { dg-final { scan-assembler-times "0x80.*DW_AT_discr_list" 1 } }
+-- This testcase checks that in the DWARF description of the variant type
+-- below, the C discriminant is properly described as unsigned, hence the 0x5a
+-- ('Z') and 0x80 (128) values in the DW_AT_discr_list attribute. If it was
+-- described as signed, we would have instead 90 and -128.
 
 with Ada.Text_IO;
 
@@ -25,3 +22,6 @@ begin
    R.I := 0;
    Ada.Text_IO.Put_Line ("" & R.C);
 end Debug11;
+
+-- { dg-final { scan-assembler-times "0x5a.*DW_AT_discr_list" 1 } }
+-- { dg-final { scan-assembler-times "0x80.*DW_AT_discr_list" 1 } }

diff --git a/gcc/testsuite/gnat.dg/debug16.adb b/gcc/testsuite/gnat.dg/debug16.adb
index 8752002ec9b82df7c832173265ed7be11e4dd2ab..5695edb616e1bb34f3139bfe7867bdc3f24fd693 100644 (file)
--- a/gcc/testsuite/gnat.dg/debug16.adb
+++ b/gcc/testsuite/gnat.dg/debug16.adb
@@ -1,6 +1,6 @@
---  { dg-do compile }
---  { dg-skip-if "No Dwarf" { { hppa*-*-hpux* } && { ! lp64 } } }
---  { dg-options "-cargs -O0 -g -dA -fgnat-encodings=minimal -margs" }
+-- { dg-do compile }
+-- { dg-skip-if "No Dwarf" { { hppa*-*-hpux* } && { ! lp64 } } }
+-- { dg-options "-cargs -O0 -g -dA -fgnat-encodings=minimal -margs" }
 
 procedure Debug16 is
 
@@ -24,4 +24,4 @@ begin
    end if;
 end;
 
---  { dg-final { scan-assembler-times "DW_AT_discr" 4 } }
+-- { dg-final { scan-assembler-times "DW_AT_discr" 4 } }

diff --git a/gcc/testsuite/gnat.dg/debug17.adb b/gcc/testsuite/gnat.dg/debug17.adb
new file mode 100644 (file)
index 0000000..4f33ecd
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/debug17.adb
@@ -0,0 +1,27 @@
+-- { dg-do compile }
+-- { dg-skip-if "No Dwarf" { { hppa*-*-hpux* } && { ! lp64 } } }
+-- { dg-options "-cargs -O0 -g -dA -fgnat-encodings=minimal -margs" }
+
+pragma No_Component_Reordering;
+
+procedure Debug17 (Number_Of_Bits : Natural) is
+
+   type Bitinfos_T is array (Natural range 1 .. Number_Of_Bits) of Float;
+
+   type Inner_Record_T is
+      record
+         Bitinfos : Bitinfos_T := (others => 1.5);
+         Check1 : Integer := 1983;
+         Check2 : Integer := 1995;
+         Flag : Boolean := False;
+         Check3 : Integer := 2005;
+
+      end record;
+
+   Rfield : Inner_Record_T;
+
+begin
+   null;
+end;
+
+-- { dg-final { scan-assembler-not "DW_AT_data_member_location (0)" } }

diff --git a/gcc/testsuite/gnat.dg/debug8.adb b/gcc/testsuite/gnat.dg/debug8.adb
index 882be5558deaeb18e4d4bd0994571e3c64f3f260..6302be39de932fe4934eaf285a2297d4ff272400 100644 (file)
--- a/gcc/testsuite/gnat.dg/debug8.adb
+++ b/gcc/testsuite/gnat.dg/debug8.adb
@@ -1,7 +1,6 @@
 -- { dg-do compile }
--- { dg-options "-cargs -g -fgnat-encodings=minimal -dA -margs" }
--- { dg-final { scan-assembler-not "DW_OP_const4u" } }
--- { dg-final { scan-assembler-not "DW_OP_const8u" } }
+-- { dg-skip-if "No Dwarf" { { hppa*-*-hpux* } && { ! lp64 } } }
+-- { dg-options "-cargs -O0 -g -dA -fgnat-encodings=minimal -margs" }
 
 --  The DW_AT_byte_size attribute DWARF expression for the
 --  DW_TAG_structure_type DIE that describes Rec_Type contains the -4u literal.
@@ -27,3 +26,6 @@ procedure Debug8 is
 begin
    null;
 end Debug8;
+
+-- { dg-final { scan-assembler-not "DW_OP_const4u" } }
+-- { dg-final { scan-assembler-not "DW_OP_const8u" } }

diff --git a/gcc/testsuite/gnat.dg/specs/debug1.ads b/gcc/testsuite/gnat.dg/specs/debug1.ads
index f94b42aa76c1820b768fafbc857afb58458e6a9f..9b67427027c72816341dbb6a6ca6518d56228af6 100644 (file)
--- a/gcc/testsuite/gnat.dg/specs/debug1.ads
+++ b/gcc/testsuite/gnat.dg/specs/debug1.ads
@@ -1,5 +1,6 @@
 -- { dg-do compile }
--- { dg-options "-cargs -g -dA -fgnat-encodings=minimal -margs" }
+-- { dg-skip-if "No Dwarf" { { hppa*-*-hpux* } && { ! lp64 } } }
+-- { dg-options "-cargs -O0 -g -dA -fgnat-encodings=minimal -margs" }
 
 package Debug1 is