[pushed 0/2] Two small Ada type-printing fixes

[pushed 0/2] Two small Ada type-printing fixes

[Tom Tromey]

This series fixes two small Ada type-printing bugs that were reported
to AdaCore.  Each patch should be self-explanatory, though you may
need to read a bit about GNAT encodings if you really want to follow
along.  New test cases are included.

Because these are Ada-specific and were already reviewed internally by
Joel, I am checking them in.

Tom

[pushed 1/2] Print Ada type name in more cases

[Tom Tromey]

In some cases the name of an Ada type cannot be decoded by
decoded_type_name.  For example, the name
"p__complex_variable_record_type__T9s" in the included test case is
rejected due to the "T".  This causes ptype to display the full
contents of a record type -- when in fact the name is available and
ought to be printed.

Fixing this in decoded_type_name isn't possible because the "__T" name
is not the real name of the type -- it is just a compiler-assigned
name of convenience.

This patch fixes the problem by using the resolved type's name when
the original type's name isn't suitable.

gdb/ChangeLog
2020-11-04  Tom Tromey  <tromey@adacore.com>

	* ada-typeprint.c (ada_print_type): Handle __T types.

gdb/testsuite/ChangeLog
2020-11-04  Tom Tromey  <tromey@adacore.com>

	* gdb.ada/rec_ptype.exp: New file.
	* gdb.ada/rec_ptype/main.adb: New file.
	* gdb.ada/rec_ptype/p.ads: New file.
---
 gdb/ChangeLog                            |  4 ++
 gdb/ada-typeprint.c                      | 15 +++++++-
 gdb/testsuite/ChangeLog                  |  6 +++
 gdb/testsuite/gdb.ada/rec_ptype.exp      | 42 +++++++++++++++++++++
 gdb/testsuite/gdb.ada/rec_ptype/main.adb | 23 ++++++++++++
 gdb/testsuite/gdb.ada/rec_ptype/p.ads    | 48 ++++++++++++++++++++++++
 6 files changed, 137 insertions(+), 1 deletion(-)
 create mode 100644 gdb/testsuite/gdb.ada/rec_ptype.exp
 create mode 100644 gdb/testsuite/gdb.ada/rec_ptype/main.adb
 create mode 100644 gdb/testsuite/gdb.ada/rec_ptype/p.ads

diff --git a/gdb/ada-typeprint.c b/gdb/ada-typeprint.c
index 11cc51cf106..0892c7c3dcd 100644
--- a/gdb/ada-typeprint.c
+++ b/gdb/ada-typeprint.c
@@ -955,7 +955,20 @@ ada_print_type (struct type *type0, const char *varstring,
 		const struct type_print_options *flags)
 {
   struct type *type = ada_check_typedef (ada_get_base_type (type0));
-  char *type_name = decoded_type_name (type0);
+  /* If we can decode the original type name, use it.  However, there
+     are cases where the original type is an internally-generated type
+     with a name that can't be decoded (and whose encoded name might
+     not actually bear any relation to the type actually declared in
+     the sources). In that case, try using the name of the base type
+     in its place.
+
+     Note that we looked at the possibility of always using the name
+     of the base type. This does not always work, unfortunately, as
+     there are situations where it's the base type which has an
+     internally-generated name.  */
+  const char *type_name = decoded_type_name (type0);
+  if (type_name == nullptr)
+    type_name = decoded_type_name (type);
   int is_var_decl = (varstring != NULL && varstring[0] != '\0');
 
   if (type == NULL)
diff --git a/gdb/testsuite/gdb.ada/rec_ptype.exp b/gdb/testsuite/gdb.ada/rec_ptype.exp
new file mode 100644
index 00000000000..0639f5505b0
--- /dev/null
+++ b/gdb/testsuite/gdb.ada/rec_ptype.exp
@@ -0,0 +1,42 @@
+# Copyright 2020 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 main
+
+# Note we don't test the "none" (no -fgnat-encodings option) scenario
+# here, because "all" and "minimal" cover the cases, and this way we
+# don't have to update the test when gnat changes its default.
+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 "STOP" ${testdir}/main.adb]
+    runto "main.adb:$bp_location"
+
+    gdb_test "ptype Test.top_level_record_complex_record" \
+	[multi_line "type = record" \
+	     "    kind: p.kind_type;" \
+	     "    complex_variable_record_variable_record: p.variable_record_type;" \
+	     "end record"]
+}
diff --git a/gdb/testsuite/gdb.ada/rec_ptype/main.adb b/gdb/testsuite/gdb.ada/rec_ptype/main.adb
new file mode 100644
index 00000000000..b54ce78564e
--- /dev/null
+++ b/gdb/testsuite/gdb.ada/rec_ptype/main.adb
@@ -0,0 +1,23 @@
+--  Copyright 2020 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 P; use P;
+
+procedure Main is
+   Test : Top_Level_Record_Type := Top_Level_Record_Type'
+     (Top_Level_Record_Complex_Record => (Kind => A_Kind, others => <>));
+begin
+   null; -- STOP
+end Main;
diff --git a/gdb/testsuite/gdb.ada/rec_ptype/p.ads b/gdb/testsuite/gdb.ada/rec_ptype/p.ads
new file mode 100644
index 00000000000..a175f4a9778
--- /dev/null
+++ b/gdb/testsuite/gdb.ada/rec_ptype/p.ads
@@ -0,0 +1,48 @@
+--  Copyright 2020 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 P is
+
+   type Kind_Type is (No_Kind, A_Kind, B_Kind);
+
+   type PID_Type is new Integer;
+   Default_Value : constant PID_Type := 0;
+
+   type Name_Type is array (1 ..3) of Character;
+   Name_Default_Value : constant Name_Type := "AAA";
+
+   type Variable_Record_Type(Kind : Kind_Type := No_Kind) is record
+      case Kind is
+         when A_Kind =>
+            Variable_Record_A : PID_Type := Default_Value;
+
+         when B_Kind =>
+            Variable_Record_B : Name_Type := Name_Default_Value;
+
+         when No_Kind =>
+            null;
+
+      end case;
+   end record;
+
+   type Complex_Variable_Record_Type (Kind : Kind_Type := No_Kind) is record
+      Complex_Variable_Record_Variable_Record : Variable_Record_Type(Kind);
+   end record;
+
+   type Top_Level_Record_Type is record
+      Top_Level_Record_Complex_Record : Complex_Variable_Record_Type;
+   end record;
+
+end P;
-- 
2.26.2

[pushed 2/2] Handle __XVL fields in Ada type printing

[Tom Tromey]

Sometimes the Ada compiler will emit an "__XVL" name for a field.  The
Ada compiler describes:

--  Second, the variable-length fields themselves are represented by
--  replacing the type by a special access type. The designated type of
--  this access type is the original variable-length type, and the fact
--  that this field has been transformed in this way is signalled by
--  encoding the field name as:

--    field___XVL

Currently gdb describes such fields as having "access" type, but this
is inaccurate.  This patch changes gdb to avoid printing "access" in
this case.

gdb/ChangeLog
2020-11-04  Tom Tromey  <tromey@adacore.com>

	* ada-typeprint.c (ada_print_type): Handle __XVL fields.

gdb/testsuite/ChangeLog
2020-11-04  Tom Tromey  <tromey@adacore.com>

	* gdb.ada/funcall_ref.exp: Update.
	* gdb.ada/var_rec_arr.exp: Update.
---
 gdb/ChangeLog                         |  4 ++++
 gdb/ada-typeprint.c                   |  6 +++++-
 gdb/testsuite/ChangeLog               |  5 +++++
 gdb/testsuite/gdb.ada/funcall_ref.exp |  2 +-
 gdb/testsuite/gdb.ada/var_rec_arr.exp | 22 +++++-----------------
 5 files changed, 20 insertions(+), 19 deletions(-)

diff --git a/gdb/ada-typeprint.c b/gdb/ada-typeprint.c
index 0892c7c3dcd..5388247957b 100644
--- a/gdb/ada-typeprint.c
+++ b/gdb/ada-typeprint.c
@@ -1006,7 +1006,11 @@ ada_print_type (struct type *type0, const char *varstring,
 	break;
       case TYPE_CODE_PTR:
       case TYPE_CODE_TYPEDEF:
-	fprintf_filtered (stream, "access ");
+	/* An __XVL field is not truly a pointer, so don't print
+	   "access" in this case.  */
+	if (type->code () != TYPE_CODE_PTR
+	    || strstr (varstring, "___XVL") == nullptr)
+	  fprintf_filtered (stream, "access ");
 	ada_print_type (TYPE_TARGET_TYPE (type), "", stream, show, level,
 			flags);
 	break;
diff --git a/gdb/testsuite/gdb.ada/funcall_ref.exp b/gdb/testsuite/gdb.ada/funcall_ref.exp
index 1768c1d480a..d3c6e54c8e0 100644
--- a/gdb/testsuite/gdb.ada/funcall_ref.exp
+++ b/gdb/testsuite/gdb.ada/funcall_ref.exp
@@ -41,7 +41,7 @@ foreach_with_prefix scenario {all minimal} {
     # references).
     set pass_re [multi_line "type = <ref> record" \
 		     "    n: natural;" \
-		     "    s: access array \\(1 \\.\\. n\\) of character;" \
+		     "    s: array \\(1 \\.\\. n\\) of character;" \
 		     "end record"]
     # With DWARF we get debuginfo that could in theory show "1..n" for
     # the range:
diff --git a/gdb/testsuite/gdb.ada/var_rec_arr.exp b/gdb/testsuite/gdb.ada/var_rec_arr.exp
index c2ad97b31e2..da906dc5d8c 100644
--- a/gdb/testsuite/gdb.ada/var_rec_arr.exp
+++ b/gdb/testsuite/gdb.ada/var_rec_arr.exp
@@ -58,21 +58,9 @@ foreach_with_prefix scenario {all minimal} {
     gdb_test "print a2(3)" \
 	" = \\(i => 0, s => \"\"\\)"
 
-    # Note that the "access" is only printed when the gnat encodings
-    # are used.  This is due to how the encodings work -- the type
-    # doesn't actually have the "access", and so here the DWARF
-    # encoding is more correct.
-    if {$scenario == "all"} {
-	set ex [multi_line "type = record" \
-		    "    i: pck\\.small_type;" \
-		    "    s: access array \\((<>|1 \\.\\. i)\\) of character;" \
-		    "end record"]
-    } else {
-	set ex [multi_line "type = record" \
-		    "    i: pck\\.small_type;" \
-		    "    s: array \\((<>|1 \\.\\. i)\\) of character;" \
-		    "end record"]
-    }
-
-    gdb_test "ptype a1(1)" $ex
+    gdb_test "ptype a1(1)" \
+	[multi_line "type = record" \
+	     "    i: pck\\.small_type;" \
+	     "    s: array \\((<>|1 \\.\\. i)\\) of character;" \
+	     "end record"]
 }
-- 
2.26.2