Normalize Ada ptype to use a single "?"

Sometimes -- notably with unchecked unions -- the Ada "ptype" code
will print a "?" or "??" to indicate something unknown.  The choice of
what was printed was somewhat arbitrary, and in one case, Ada would
print an empty string rather than "?".

This patch normalizes the Ada code to use "?" rather than an empty
string or "??".  My reasoning here is that a single question mark is
enough to convey unknown-ness.

gdb/ChangeLog
2019-12-10  Tom Tromey  <tromey@adacore.com>

	* ada-typeprint.c (print_choices): Use a single "?".
	(print_variant_part): Print "?" if the discriminant name
	is not known.

gdb/testsuite/ChangeLog
2019-12-10  Tom Tromey  <tromey@adacore.com>

	* gdb.ada/unchecked_union.exp: New file.
	* gdb.ada/unchecked_union/pck.adb: New file.
	* gdb.ada/unchecked_union/pck.ads: New file.
	* gdb.ada/unchecked_union/unchecked_union.adb: New file.
	* gdb-utils.exp (string_to_regexp): Also quote "?".

Change-Id: I3403040780a155ffa2c44c8e6a04ba86bc810e29

diff --git a/gdb/ChangeLog b/gdb/ChangeLog
index 98a6285dd840301bdcd7e8074a3ca0e16e41c10e..ac58517ce17f8fd835cbc191430fc40e3007474d 100644 (file)
--- a/gdb/ChangeLog
+++ b/gdb/ChangeLog
@@ -1,3 +1,9 @@
+2019-12-10  Tom Tromey  <tromey@adacore.com>
+
+       * ada-typeprint.c (print_choices): Use a single "?".
+       (print_variant_part): Print "?" if the discriminant name
+       is not known.
+
 2019-12-10  George Barrett  <bob@bob131.so>
 
        Fix scripted probe breakpoints.

diff --git a/gdb/ada-typeprint.c b/gdb/ada-typeprint.c
index f89dd23ed8274e184c75311d4cd14a48c7fb4582..70fad1c3268b341102be8000a18f668b90c43077 100644 (file)
--- a/gdb/ada-typeprint.c
+++ b/gdb/ada-typeprint.c
@@ -526,7 +526,7 @@ print_choices (struct type *type, int field_num, struct ui_file *stream,
     }
 
 Huh:
-  fprintf_filtered (stream, "?? =>");
+  fprintf_filtered (stream, "? =>");
   return 0;
 }
 
@@ -592,9 +592,12 @@ print_variant_part (struct type *type, int field_num, struct type *outer_type,
                    struct ui_file *stream, int show, int level,
                    const struct type_print_options *flags)
 {
-  fprintf_filtered (stream, "\n%*scase %s is", level + 4, "",
-                   ada_variant_discrim_name
-                   (TYPE_FIELD_TYPE (type, field_num)));
+  const char *variant
+    = ada_variant_discrim_name (TYPE_FIELD_TYPE (type, field_num));
+  if (*variant == '\0')
+    variant = "?";
+
+  fprintf_filtered (stream, "\n%*scase %s is", level + 4, "", variant);
   print_variant_clauses (type, field_num, outer_type, stream, show,
                         level + 4, flags);
   fprintf_filtered (stream, "\n%*send case;", level + 4, "");

diff --git a/gdb/testsuite/ChangeLog b/gdb/testsuite/ChangeLog
index c14c341ade86d5fc2a5ccadd1f913dea9fb2b0d8..52edbc13083df2cfc6387dc9b33014eea42043f7 100644 (file)
--- a/gdb/testsuite/ChangeLog
+++ b/gdb/testsuite/ChangeLog
@@ -1,3 +1,11 @@
+2019-12-10  Tom Tromey  <tromey@adacore.com>
+
+       * gdb.ada/unchecked_union.exp: New file.
+       * gdb.ada/unchecked_union/pck.adb: New file.
+       * gdb.ada/unchecked_union/pck.ads: New file.
+       * gdb.ada/unchecked_union/unchecked_union.adb: New file.
+       * gdb-utils.exp (string_to_regexp): Also quote "?".
+
 2019-12-10  George Barrett  <bob@bob131.so>
 
        Test scripted probe breakpoints.

diff --git a/gdb/testsuite/gdb.ada/unchecked_union.exp b/gdb/testsuite/gdb.ada/unchecked_union.exp
new file mode 100644 (file)
index 0000000..e522238
--- /dev/null
+++ b/gdb/testsuite/gdb.ada/unchecked_union.exp
@@ -0,0 +1,58 @@
+# Copyright 2019 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/>.
+
+# Test ptype of an unchecked union.
+
+load_lib "ada.exp"
+
+standard_ada_testfile unchecked_union
+
+if {[gdb_compile_ada "${srcfile}" "${binfile}" executable {debug}] != ""} {
+  return -1
+}
+
+clean_restart ${testfile}
+
+set bp_location [gdb_get_line_number "BREAK" ${testdir}/unchecked_union.adb]
+runto "unchecked_union.adb:$bp_location"
+
+proc multi_line_string {str} {
+    set result {}
+    foreach line [split $str \n] {
+       lappend result [string_to_regexp $line]
+    }
+    return [eval multi_line $result]
+}
+
+set inner_string {    case ? is
+        when ? =>
+            small: range 0 .. 255;
+        when ? =>
+            large: range 255 .. 510;
+    end case;
+}
+set inner_full "type = record (?) is\n${inner_string}end record"
+
+set pair_string {    case ? is
+        when ? =>
+            field_one: range 0 .. 255;
+        when ? =>
+            field_two: range 255 .. 510;
+    end case;
+}
+set pair_full "type = record\n${inner_string}${pair_string}end record"
+
+gdb_test "ptype Pair" [multi_line_string $pair_full]
+gdb_test "ptype Inner" [multi_line_string $inner_full]

diff --git a/gdb/testsuite/gdb.ada/unchecked_union/pck.adb b/gdb/testsuite/gdb.ada/unchecked_union/pck.adb
new file mode 100644 (file)
index 0000000..6535991
--- /dev/null
+++ b/gdb/testsuite/gdb.ada/unchecked_union/pck.adb
@@ -0,0 +1,21 @@
+--  Copyright 2019 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;

diff --git a/gdb/testsuite/gdb.ada/unchecked_union/pck.ads b/gdb/testsuite/gdb.ada/unchecked_union/pck.ads
new file mode 100644 (file)
index 0000000..b8d0010
--- /dev/null
+++ b/gdb/testsuite/gdb.ada/unchecked_union/pck.ads
@@ -0,0 +1,19 @@
+--  Copyright 2019 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;
+package Pck is
+   procedure Do_Nothing (A : System.Address);
+end Pck;

diff --git a/gdb/testsuite/gdb.ada/unchecked_union/unchecked_union.adb b/gdb/testsuite/gdb.ada/unchecked_union/unchecked_union.adb
new file mode 100644 (file)
index 0000000..d6de66d
--- /dev/null
+++ b/gdb/testsuite/gdb.ada/unchecked_union/unchecked_union.adb
@@ -0,0 +1,51 @@
+--  Copyright 2019 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 Pck; use Pck;
+
+procedure Foo is
+   type Key is (Alpha, Omega);
+
+   type Inner(Disc : Key := Omega) is record
+      case Disc is
+         when Alpha =>
+            Small : Integer range 0..255;
+         when others =>
+            Large : Integer range 255..510;
+      end case;
+   end record;
+   pragma Unchecked_Union (Inner);
+
+   type Outer(Disc : Key := Alpha) is record
+      case Disc is
+         when Alpha =>
+            Field_One : Integer range 0..255;
+         when others =>
+            Field_Two : Integer range 255..510;
+      end case;
+   end record;
+   pragma Unchecked_Union (Outer);
+
+   type Pair is record
+      Pone : Inner;
+      Ptwo : Outer;
+   end record;
+
+   Value : Pair;
+
+begin
+   Do_Nothing (Value'Address);          -- BREAK
+end Foo;

diff --git a/gdb/testsuite/lib/gdb-utils.exp b/gdb/testsuite/lib/gdb-utils.exp
index 95ca348dc3368b909bd6ab29f1b49c4abc79b99d..17c1adfa805e17040586a2e63b51257a0985c89a 100644 (file)
--- a/gdb/testsuite/lib/gdb-utils.exp
+++ b/gdb/testsuite/lib/gdb-utils.exp
@@ -34,7 +34,7 @@ proc gdb_init_commands {} {
 
 proc string_to_regexp {str} {
     set result $str
-    regsub -all {[]*+.|(){}^$\[\\]} $str {\\&} result
+    regsub -all {[]?*+.|(){}^$\[\\]} $str {\\&} result
     return $result
 }