aboutsummaryrefslogtreecommitdiff
path: root/gdb
diff options
context:
space:
mode:
Diffstat (limited to 'gdb')
-rw-r--r--gdb/ChangeLog6
-rw-r--r--gdb/ada-typeprint.c11
-rw-r--r--gdb/testsuite/ChangeLog8
-rw-r--r--gdb/testsuite/gdb.ada/unchecked_union.exp58
-rw-r--r--gdb/testsuite/gdb.ada/unchecked_union/pck.adb21
-rw-r--r--gdb/testsuite/gdb.ada/unchecked_union/pck.ads19
-rw-r--r--gdb/testsuite/gdb.ada/unchecked_union/unchecked_union.adb51
-rw-r--r--gdb/testsuite/lib/gdb-utils.exp2
8 files changed, 171 insertions, 5 deletions
diff --git a/gdb/ChangeLog b/gdb/ChangeLog
index 98a6285..ac58517 100644
--- 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 f89dd23..70fad1c 100644
--- 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 c14c341..52edbc1 100644
--- 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
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
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
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
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 95ca348..17c1adf 100644
--- 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
}
generated by cgit v1.1 at 2024-10-20 19:52:46 +0000