diff options
| -rw-r--r-- | gdb/ChangeLog | 6 | ||||
| -rw-r--r-- | gdb/ada-typeprint.c | 11 | ||||
| -rw-r--r-- | gdb/testsuite/ChangeLog | 8 | ||||
| -rw-r--r-- | gdb/testsuite/gdb.ada/unchecked_union.exp | 58 | ||||
| -rw-r--r-- | gdb/testsuite/gdb.ada/unchecked_union/pck.adb | 21 | ||||
| -rw-r--r-- | gdb/testsuite/gdb.ada/unchecked_union/pck.ads | 19 | ||||
| -rw-r--r-- | gdb/testsuite/gdb.ada/unchecked_union/unchecked_union.adb | 51 | ||||
| -rw-r--r-- | gdb/testsuite/lib/gdb-utils.exp | 2 |
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 } |