Select variant field when printing variant (no-tn-check)

Message ID 20200330185547.18256-1-tromey@adacore.com
State New
Headers show
Series
  • Select variant field when printing variant (no-tn-check)
Related show

Commit Message

Tom Tromey March 30, 2020, 6:55 p.m.
When I updated the Ada variant-printing code to be value-based, I
neglected a couple of issues.  First, print_variant_part must first
extract the variant field before finding the active component; second,
print_field_values should pass in the field value as the outer value
when recursing.

This patch fixes both of these issues.

gdb/ChangeLog
2020-03-30  Tom Tromey  <tromey@adacore.com>

	* ada-valprint.c (print_variant_part): Extract the variant field.
	(print_field_values): Use the field as the outer value when
	recursing.

gdb/testsuite/ChangeLog
2020-03-30  Tom Tromey  <tromey@adacore.com>

	* gdb.ada/variant-record/proc.adb: New file.
	* gdb.ada/variant-record/value.adb: New file.
	* gdb.ada/variant-record/value.s: New file.
	* gdb.ada/variant-record.exp: New file.
---
 gdb/ChangeLog                                 |  6 +++
 gdb/ada-valprint.c                            |  6 ++-
 gdb/testsuite/ChangeLog                       |  7 +++
 gdb/testsuite/gdb.ada/variant-record.exp      | 30 ++++++++++++
 gdb/testsuite/gdb.ada/variant-record/proc.adb | 21 ++++++++
 .../gdb.ada/variant-record/value.adb          | 30 ++++++++++++
 .../gdb.ada/variant-record/value.ads          | 48 +++++++++++++++++++
 7 files changed, 146 insertions(+), 2 deletions(-)
 create mode 100644 gdb/testsuite/gdb.ada/variant-record.exp
 create mode 100644 gdb/testsuite/gdb.ada/variant-record/proc.adb
 create mode 100644 gdb/testsuite/gdb.ada/variant-record/value.adb
 create mode 100644 gdb/testsuite/gdb.ada/variant-record/value.ads

-- 
2.21.1

Comments

Tom Tromey April 6, 2020, 6:58 p.m. | #1
>>>>> "Tom" == Tom Tromey <tromey@adacore.com> writes:


Tom> When I updated the Ada variant-printing code to be value-based, I
Tom> neglected a couple of issues.  First, print_variant_part must first
Tom> extract the variant field before finding the active component; second,
Tom> print_field_values should pass in the field value as the outer value
Tom> when recursing.

Tom> This patch fixes both of these issues.

Tom> gdb/ChangeLog
Tom> 2020-03-30  Tom Tromey  <tromey@adacore.com>

Tom> 	* ada-valprint.c (print_variant_part): Extract the variant field.
Tom> 	(print_field_values): Use the field as the outer value when
Tom> 	recursing.

I'm checking this in now.

Tom

Patch

diff --git a/gdb/ada-valprint.c b/gdb/ada-valprint.c
index 2f2375a0ffa..2768829cdb3 100644
--- a/gdb/ada-valprint.c
+++ b/gdb/ada-valprint.c
@@ -565,7 +565,8 @@  print_variant_part (struct value *value, int field_num,
   if (which < 0)
     return 0;
 
-  struct value *active_component = value_field (value, which);
+  struct value *variant_field = value_field (value, field_num);
+  struct value *active_component = value_field (variant_field, which);
   return print_field_values (active_component, outer_value, stream, recurse,
 			     options, comma_needed, language);
 }
@@ -603,8 +604,9 @@  print_field_values (struct value *value, struct value *outer_value,
 
       if (ada_is_wrapper_field (type, i))
 	{
+	  struct value *field_val = value_field (value, i);
 	  comma_needed =
-	    print_field_values (value_field (value, i), outer_value,
+	    print_field_values (field_val, field_val,
 				stream, recurse, options,
 				comma_needed, language);
 	  continue;
diff --git a/gdb/testsuite/gdb.ada/variant-record.exp b/gdb/testsuite/gdb.ada/variant-record.exp
new file mode 100644
index 00000000000..82b73c6a596
--- /dev/null
+++ b/gdb/testsuite/gdb.ada/variant-record.exp
@@ -0,0 +1,30 @@ 
+# 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"
+
+standard_ada_testfile proc
+
+if {[gdb_compile_ada "${srcfile}" "${binfile}" executable debug] != ""} {
+  return -1
+}
+
+clean_restart ${testfile}
+
+set bp_location [gdb_get_line_number "STOP" ${testdir}/proc.adb]
+runto "proc.adb:$bp_location"
+
+gdb_test "print Value.Name(My_Value)" \
+    "= \\(well => yes, name => \"abcdefgh\"\\)"
diff --git a/gdb/testsuite/gdb.ada/variant-record/proc.adb b/gdb/testsuite/gdb.ada/variant-record/proc.adb
new file mode 100644
index 00000000000..4becfb357eb
--- /dev/null
+++ b/gdb/testsuite/gdb.ada/variant-record/proc.adb
@@ -0,0 +1,21 @@ 
+--  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 Value;
+procedure Proc is
+  My_Value : Value.T := Value.Create;
+begin
+  null; -- STOP
+end;
diff --git a/gdb/testsuite/gdb.ada/variant-record/value.adb b/gdb/testsuite/gdb.ada/variant-record/value.adb
new file mode 100644
index 00000000000..993483d41b8
--- /dev/null
+++ b/gdb/testsuite/gdb.ada/variant-record/value.adb
@@ -0,0 +1,30 @@ 
+--  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 body Value is
+  function Create return T is
+  begin
+    return (One => (Well => Value_Name.No,
+                    Unique_Name => (X1 => 1, X2 => 2)),
+            Two => (Well => Value_Name.Yes,
+                    Name => "abcdefgh"));
+  end Create;
+
+  function Name (Of_Value : T) return Value_Name.T is
+  begin
+    return Of_Value.Two;
+  end Name;
+
+end Value;
diff --git a/gdb/testsuite/gdb.ada/variant-record/value.ads b/gdb/testsuite/gdb.ada/variant-record/value.ads
new file mode 100644
index 00000000000..f2af7d025a7
--- /dev/null
+++ b/gdb/testsuite/gdb.ada/variant-record/value.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 Value is
+  package Value_Name is
+    Length : constant Positive := 8;
+    subtype Name_T is String (1 .. Length);
+
+    type A_Record_T is
+      record
+        X1 : Natural;
+        X2 : Natural;
+      end record;
+
+    type Yes_No_T is (Yes, No);
+    type T (Well : Yes_No_T := Yes) is
+      record
+        case Well is
+          when Yes =>
+            Name : Name_T;
+          when No =>
+            Unique_Name : A_Record_T;
+        end case;
+      end record;
+  end;
+
+  type T is private;
+  function Create return T;
+  function Name (Of_Value : T) return Value_Name.T;
+private
+  type T is
+    record
+      One : Value_Name.T (Well => Value_Name.No);
+      Two : Value_Name.T (Well => Value_Name.Yes);
+    end record;
+end;