Add PROP_VARIABLE_NAME

With -fgnat-encodings=minimal, an internal version (these patches will
be upstreamed in the near future) of the Ada compiler can emit DWARF
for an array where the bound comes from a variable, like:

 <1><12a7>: Abbrev Number: 7 (DW_TAG_array_type)
    <12a8>   DW_AT_name        : (indirect string, offset: 0x1ae9): pck__my_array
[...]
 <2><12b4>: Abbrev Number: 8 (DW_TAG_subrange_type)
    <12b5>   DW_AT_type        : <0x1294>
    <12b9>   DW_AT_upper_bound : <0x1277>

With the upper bound DIE being:

 <1><1277>: Abbrev Number: 2 (DW_TAG_variable)
    <1278>   DW_AT_name        : (indirect string, offset: 0x1a4d): pck__my_length___U
    <127c>   DW_AT_type        : <0x128f>
    <1280>   DW_AT_external    : 1
    <1280>   DW_AT_artificial  : 1
    <1280>   DW_AT_declaration : 1

Note that the variable is just a declaration -- in this situation, the
variable comes from another compilation unit, and must be found when
trying to compute the array bound.

This patch adds a new PROP_VARIABLE_NAME kind, to enable this search.

This same scenario can occur with DW_OP_GNU_variable_value, so this
patch adds support for that as well.

gdb/ChangeLog
2021-06-04  Tom Tromey  <tromey@adacore.com>

	* dwarf2/read.h (dwarf2_fetch_die_type_sect_off): Add 'var_name'
	parameter.
	* dwarf2/loc.c (dwarf2_evaluate_property) <case
	PROP_VARIABLE_NAME>: New case.
	(compute_var_value): New function.
	(sect_variable_value): Use compute_var_value.
	* dwarf2/read.c (attr_to_dynamic_prop): Handle DW_TAG_variable.
	(var_decl_name): New function.
	(dwarf2_fetch_die_type_sect_off): Add 'var_name' parameter.
	* gdbtypes.h (enum dynamic_prop_kind) <PROP_VARIABLE_NAME>: New
	constant.
	(union dynamic_prop_data) <variable_name>: New member.
	(struct dynamic_prop) <variable_name, set_variable_name>: New
	methods.

gdb/testsuite/ChangeLog
2021-06-04  Tom Tromey  <tromey@adacore.com>

	* gdb.ada/array_of_symbolic_length.exp: New file.
	* gdb.ada/array_of_symbolic_length/foo.adb: New file.
	* gdb.ada/array_of_symbolic_length/gl.adb: New file.
	* gdb.ada/array_of_symbolic_length/gl.ads: New file.
	* gdb.ada/array_of_symbolic_length/pck.adb: New file.
	* gdb.ada/array_of_symbolic_length/pck.ads: New file.

gdb/ChangeLog

@@ -1,3 +1,20 @@
+2021-06-04  Tom Tromey  <tromey@adacore.com>
+
+	* dwarf2/read.h (dwarf2_fetch_die_type_sect_off): Add 'var_name'
+	parameter.
+	* dwarf2/loc.c (dwarf2_evaluate_property) <case
+	PROP_VARIABLE_NAME>: New case.
+	(compute_var_value): New function.
+	(sect_variable_value): Use compute_var_value.
+	* dwarf2/read.c (attr_to_dynamic_prop): Handle DW_TAG_variable.
+	(var_decl_name): New function.
+	(dwarf2_fetch_die_type_sect_off): Add 'var_name' parameter.
+	* gdbtypes.h (enum dynamic_prop_kind) <PROP_VARIABLE_NAME>: New
+	constant.
+	(union dynamic_prop_data) <variable_name>: New member.
+	(struct dynamic_prop) <variable_name, set_variable_name>: New
+	methods.
+
 2021-06-04  Andrew Burgess  <andrew.burgess@embecosm.com>
 
 	* remote.c (remote_target)

gdb/dwarf2/loc.c

@@ -620,6 +620,19 @@ per_cu_dwarf_call (struct dwarf_expr_context *ctx, cu_offset die_offset,
   ctx->eval (block.data, block.size);
 }
 
+/* A helper function to find the definition of NAME and compute its
+   value.  Returns nullptr if the name is not found.  */
+
+static value *
+compute_var_value (const char *name)
+{
+  struct block_symbol sym = lookup_symbol (name, nullptr, VAR_DOMAIN,
+					   nullptr);
+  if (sym.symbol != nullptr)
+    return value_of_variable (sym.symbol, sym.block);
+  return nullptr;
+}
+
 /* Given context CTX, section offset SECT_OFF, and compilation unit
    data PER_CU, execute the "variable value" operation on the DIE
    found at SECT_OFF.  */
@@ -629,8 +642,10 @@ sect_variable_value (struct dwarf_expr_context *ctx, sect_offset sect_off,
 		     dwarf2_per_cu_data *per_cu,
 		     dwarf2_per_objfile *per_objfile)
 {
+  const char *var_name = nullptr;
   struct type *die_type
-    = dwarf2_fetch_die_type_sect_off (sect_off, per_cu, per_objfile);
+    = dwarf2_fetch_die_type_sect_off (sect_off, per_cu, per_objfile,
+				      &var_name);
 
   if (die_type == NULL)
     error (_("Bad DW_OP_GNU_variable_value DIE."));
@@ -638,9 +653,18 @@ sect_variable_value (struct dwarf_expr_context *ctx, sect_offset sect_off,
   /* Note: Things still work when the following test is removed.  This
      test and error is here to conform to the proposed specification.  */
   if (die_type->code () != TYPE_CODE_INT
+      && die_type->code () != TYPE_CODE_ENUM
+      && die_type->code () != TYPE_CODE_RANGE
       && die_type->code () != TYPE_CODE_PTR)
     error (_("Type of DW_OP_GNU_variable_value DIE must be an integer or pointer."));
 
+  if (var_name != nullptr)
+    {
+      value *result = compute_var_value (var_name);
+      if (result != nullptr)
+	return result;
+    }
+
   struct type *type = lookup_pointer_type (die_type);
   struct frame_info *frame = get_selected_frame (_("No frame selected."));
   return indirect_synthetic_pointer (sect_off, 0, per_cu, per_objfile, frame,
@@ -2691,6 +2715,17 @@ dwarf2_evaluate_property (const struct dynamic_prop *prop,
 	*value = value_as_address (val);
 	return true;
       }
+
+    case PROP_VARIABLE_NAME:
+      {
+	struct value *val = compute_var_value (prop->variable_name ());
+	if (val != nullptr)
+	  {
+	    *value = value_as_long (val);
+	    return true;
+	  }
+      }
+      break;
     }
 
   return false;

gdb/dwarf2/read.c

@@ -18172,6 +18172,25 @@ read_base_type (struct die_info *die, struct dwarf2_cu *cu)
   return set_die_type (die, type, cu);
 }
 
+/* A helper function that returns the name of DIE, if it refers to a
+   variable declaration.  */
+
+static const char *
+var_decl_name (struct die_info *die, struct dwarf2_cu *cu)
+{
+  if (die->tag != DW_TAG_variable)
+    return nullptr;
+
+  attribute *attr = dwarf2_attr (die, DW_AT_declaration, cu);
+  if (attr == nullptr || !attr->as_boolean ())
+    return nullptr;
+
+  attr = dwarf2_attr (die, DW_AT_name, cu);
+  if (attr == nullptr)
+    return nullptr;
+  return attr->as_string ();
+}
+
 /* Parse dwarf attribute if it's a block, reference or constant and put the
    resulting value of the attribute into struct bound_prop.
    Returns 1 if ATTR could be resolved into PROP, 0 otherwise.  */
@@ -18226,7 +18245,15 @@ attr_to_dynamic_prop (const struct attribute *attr, struct die_info *die,
 	target_attr = dwarf2_attr (target_die, DW_AT_data_member_location,
 				   target_cu);
       if (target_attr == NULL)
-	return 0;
+	{
+	  const char *name = var_decl_name (target_die, target_cu);
+	  if (name != nullptr)
+	    {
+	      prop->set_variable_name (name);
+	      return 1;
+	    }
+	  return 0;
+	}
 
       switch (target_attr->name)
 	{
@@ -23399,7 +23426,8 @@ dwarf2_fetch_constant_bytes (sect_offset sect_off,
 struct type *
 dwarf2_fetch_die_type_sect_off (sect_offset sect_off,
 				dwarf2_per_cu_data *per_cu,
-				dwarf2_per_objfile *per_objfile)
+				dwarf2_per_objfile *per_objfile,
+				const char **var_name)
 {
   struct die_info *die;
 
@@ -23414,6 +23442,8 @@ dwarf2_fetch_die_type_sect_off (sect_offset sect_off,
   if (!die)
     return NULL;
 
+  if (var_name != nullptr)
+    *var_name = var_decl_name (die, cu);
   return die_type (die, cu);
 }
 

gdb/dwarf2/read.h

@@ -671,11 +671,14 @@ extern const gdb_byte *dwarf2_fetch_constant_bytes
    LONGEST *len);
 
 /* Return the type of the die at SECT_OFF in PER_CU.  Return NULL if no
-   valid type for this die is found.  */
+   valid type for this die is found.  If VAR_NAME is non-null, and if
+   the DIE in question is a variable declaration (definitions are
+   excluded), then *VAR_NAME is set to the variable's name.  */
 
 struct type *dwarf2_fetch_die_type_sect_off
   (sect_offset sect_off, dwarf2_per_cu_data *per_cu,
-   dwarf2_per_objfile *per_objfile);
+   dwarf2_per_objfile *per_objfile,
+   const char **var_name = nullptr);
 
 /* When non-zero, dump line number entries as they are read in.  */
 extern unsigned int dwarf_line_debug;

gdb/gdbtypes.h

@@ -388,6 +388,7 @@ enum dynamic_prop_kind
   PROP_LOCLIST,    /* Location list.  */
   PROP_VARIANT_PARTS, /* Variant parts.  */
   PROP_TYPE,	   /* Type.  */
+  PROP_VARIABLE_NAME, /* Variable name.  */
 };
 
 union dynamic_prop_data
@@ -414,6 +415,11 @@ union dynamic_prop_data
      rewrite the property's kind and set this field.  */
 
   struct type *original_type;
+
+  /* Name of a variable to look up; the variable holds the value of
+     this property.  */
+
+  const char *variable_name;
 };
 
 /* * Used to store a dynamic property.  */
@@ -496,6 +502,22 @@ struct dynamic_prop
     m_data.original_type = original_type;
   }
 
+  /* Return the name of the variable that holds this property's value.
+     Only valid for PROP_VARIABLE_NAME.  */
+  const char *variable_name () const
+  {
+    gdb_assert (m_kind == PROP_VARIABLE_NAME);
+    return m_data.variable_name;
+  }
+
+  /* Set the name of the variable that holds this property's value,
+     and set this property to be of kind PROP_VARIABLE_NAME.  */
+  void set_variable_name (const char *name)
+  {
+    m_kind = PROP_VARIABLE_NAME;
+    m_data.variable_name = name;
+  }
+
   /* Determine which field of the union dynamic_prop.data is used.  */
   enum dynamic_prop_kind m_kind;
 

gdb/testsuite/ChangeLog

@@ -1,3 +1,12 @@
+2021-06-04  Tom Tromey  <tromey@adacore.com>
+
+	* gdb.ada/array_of_symbolic_length.exp: New file.
+	* gdb.ada/array_of_symbolic_length/foo.adb: New file.
+	* gdb.ada/array_of_symbolic_length/gl.adb: New file.
+	* gdb.ada/array_of_symbolic_length/gl.ads: New file.
+	* gdb.ada/array_of_symbolic_length/pck.adb: New file.
+	* gdb.ada/array_of_symbolic_length/pck.ads: New file.
+
 2021-06-03  Magne Hov  <mhov@undo.io>
 
 	PR python/27841

gdb/testsuite/gdb.ada/array_of_symbolic_length.exp

@@ -0,0 +1,59 @@
+# Copyright 2021 Free Software Foundation, Inc.
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+load_lib "ada.exp"
+
+if { [skip_ada_tests] } { return -1 }
+
+standard_ada_testfile foo
+
+foreach_with_prefix scenario {all minimal} {
+    set flags [list debug additional_flags=-fgnat-encodings=$scenario]
+
+    if {[gdb_compile_ada "${srcfile}" "${binfile}" executable $flags] != ""} {
+	return -1
+    }
+
+    clean_restart ${testfile}
+
+    set bp_location [gdb_get_line_number "BREAK" ${testdir}/foo.adb]
+    runto "foo.adb:$bp_location"
+
+    set test "print my_value"
+    gdb_test_multiple "$test" $test {
+	-re " = \\(23, 23, 23, 23, 23, 23, 23\\).*$gdb_prompt $" {
+	    pass $test
+	}
+	-re " = \\(\\).*$gdb_prompt $" {
+	    if {$scenario == "minimal"} {
+		setup_kfail "minimal encodings" *-*-*
+	    }
+	    fail $test
+	}
+    }
+
+    set test "print rt"
+    gdb_test_multiple "$test" $test {
+	-re " = \\(a => \\(\\(a1 => \\(4, 4\\), a2 => \\(8, 8\\)\\), \\(a1 => \\(4, 4\\), a2 => \\(8, 8\\)\\)\\)\\).*$gdb_prompt $" {
+	    pass $test
+	}
+	-re " = \\(a => \\(\\)\\).*$gdb_prompt $" {
+	    if {$scenario == "minimal"} {
+		setup_kfail "minimal encodings" *-*-*
+	    }
+	    fail $test
+	}
+    }
+}

gdb/testsuite/gdb.ada/array_of_symbolic_length/foo.adb

@@ -0,0 +1,25 @@
+--  Copyright 2021 Free Software Foundation, Inc.
+--
+--  This program is free software; you can redistribute it and/or modify
+--  it under the terms of the GNU General Public License as published by
+--  the Free Software Foundation; either version 3 of the License, or
+--  (at your option) any later version.
+--
+--  This program is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY; without even the implied warranty of
+--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+--  GNU General Public License for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+with Pck; use Pck;
+with System;
+
+procedure Foo is
+   My_Value : My_Array := (others => 23);
+   Rt : Outer := (A => (others => (A1 => (others => 4),
+                                   A2 => (others => 8))));
+begin
+   Do_Nothing (My_Value'Address); --  BREAK
+end Foo;

gdb/testsuite/gdb.ada/array_of_symbolic_length/gl.adb

@@ -0,0 +1,23 @@
+--  Copyright 2021 Free Software Foundation, Inc.
+--
+--  This program is free software; you can redistribute it and/or modify
+--  it under the terms of the GNU General Public License as published by
+--  the Free Software Foundation; either version 3 of the License, or
+--  (at your option) any later version.
+--
+--  This program is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY; without even the implied warranty of
+--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+--  GNU General Public License for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+package body Gl is
+
+   function Length return Natural is
+   begin
+      return 7;
+   end Length;
+
+end Gl;

gdb/testsuite/gdb.ada/array_of_symbolic_length/gl.ads

@@ -0,0 +1,18 @@
+--  Copyright 2021 Free Software Foundation, Inc.
+--
+--  This program is free software; you can redistribute it and/or modify
+--  it under the terms of the GNU General Public License as published by
+--  the Free Software Foundation; either version 3 of the License, or
+--  (at your option) any later version.
+--
+--  This program is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY; without even the implied warranty of
+--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+--  GNU General Public License for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+package Gl is
+   function Length return Natural;
+end Gl;

gdb/testsuite/gdb.ada/array_of_symbolic_length/pck.adb

@@ -0,0 +1,23 @@
+--  Copyright 2021 Free Software Foundation, Inc.
+--
+--  This program is free software; you can redistribute it and/or modify
+--  it under the terms of the GNU General Public License as published by
+--  the Free Software Foundation; either version 3 of the License, or
+--  (at your option) any later version.
+--
+--  This program is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY; without even the implied warranty of
+--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+--  GNU General Public License for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+package body Pck is
+
+   procedure Do_Nothing (A : System.Address) is
+   begin
+      null;
+   end Do_Nothing;
+
+end Pck;

gdb/testsuite/gdb.ada/array_of_symbolic_length/pck.ads

@@ -0,0 +1,43 @@
+--  Copyright 2021 Free Software Foundation, Inc.
+--
+--  This program is free software; you can redistribute it and/or modify
+--  it under the terms of the GNU General Public License as published by
+--  the Free Software Foundation; either version 3 of the License, or
+--  (at your option) any later version.
+--
+--  This program is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY; without even the implied warranty of
+--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+--  GNU General Public License for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+with System;
+with Gl; use Gl;
+
+package Pck is
+
+   subtype My_Length is Natural range 1 .. Length;
+   type My_Array is array (My_Length) of Natural;
+
+   N_A : Integer := 2;
+   N_T : Integer := 2;
+
+   type Arr is array (Positive range <>) of Integer;
+
+   type Inner is
+      record
+         A1 : Arr (1 .. N_A);
+         A2 : Arr (1 .. N_A);
+      end record;
+   type Inner_Arr is array (Positive range <>) of Inner;
+
+   type Outer is
+      record
+         A : Inner_Arr (1 .. N_T);
+      end record;
+
+   procedure Do_Nothing (A : System.Address);
+
+end Pck;