From cc330e39bc938cefd4cfc581639177ef4c6bcbe3 Mon Sep 17 00:00:00 2001 From: Xavier Roirand Date: Mon, 10 Sep 2018 10:34:59 -0500 Subject: [PATCH] (Ada) Fix printing of access to unconstrained arrays Using this Ada code: type String_Access is access String; type Array_Of_String is array (1 .. 2) of String_Access; Aos : Array_Of_String := (new String'("ab"), new String'("cd")); When debugging with GDB, printing each Aos element displays: (gdb) print Aos(1) $2 = "ab" (gdb) print Aos(2) $3 = "cd" Whereas it should display: (gdb) print Aos(1) $2 = (foo_r118_024.string_access) 0x635018 (gdb) print Aos(2) $3 = (foo_r118_024.string_access) 0x635038 Notice that printing the entire array works: (gdb) print Aos $1 = (0x635018, 0x635038) The problem was located in ada_value_print function and due to the fact that the value_type used in this function was based on value_enclosing_type rather than value_type itself. In our example, the difference between the value_type and the value_enclosing_type of the value is that the value_type contains an additional typedef layer which is not present in the value_enclosing_type. This typedef layer is GNAT's way to specify that the element is, at the source level, an access to the unconstrained array, rather than the unconstrained array. Moreover, the value_enclosing_type is not really needed in that case and the value_type can be used instead in this function, and this patch fixes this. gdb/ChangeLog: * ada-valprint.c (ada_value_print): Use type instead of enclosing type. testsuite/ChangeLog: * gdb.ada/access_to_unbounded_array.exp: New testcase. * gdb.ada/access_to_unbounded_array/foo.adb: New file. * gdb.ada/access_to_unbounded_array/pack.adb: New file. * gdb.ada/access_to_unbounded_array/pack.ads: New file. Tested: x86_64-linux --- gdb/ChangeLog | 5 ++++ gdb/ada-valprint.c | 2 +- gdb/testsuite/ChangeLog | 7 +++++ .../gdb.ada/access_to_unbounded_array.exp | 30 +++++++++++++++++++ .../gdb.ada/access_to_unbounded_array/foo.adb | 24 +++++++++++++++ .../access_to_unbounded_array/pack.adb | 23 ++++++++++++++ .../access_to_unbounded_array/pack.ads | 19 ++++++++++++ 7 files changed, 109 insertions(+), 1 deletion(-) create mode 100644 gdb/testsuite/gdb.ada/access_to_unbounded_array.exp create mode 100644 gdb/testsuite/gdb.ada/access_to_unbounded_array/foo.adb create mode 100644 gdb/testsuite/gdb.ada/access_to_unbounded_array/pack.adb create mode 100644 gdb/testsuite/gdb.ada/access_to_unbounded_array/pack.ads diff --git a/gdb/ChangeLog b/gdb/ChangeLog index 40b7978e83f..524d218d961 100644 --- a/gdb/ChangeLog +++ b/gdb/ChangeLog @@ -1,3 +1,8 @@ +2018-09-10 Xavier Roirand + + * ada-valprint.c (ada_value_print): Use type instead of + enclosing type. + 2018-09-10 Xavier Roirand * ada-lang.c (ada_value_subscript): Handle case when parameter is diff --git a/gdb/ada-valprint.c b/gdb/ada-valprint.c index a4869198a44..af289e2db39 100644 --- a/gdb/ada-valprint.c +++ b/gdb/ada-valprint.c @@ -1224,7 +1224,7 @@ ada_value_print (struct value *val0, struct ui_file *stream, { struct value *val = ada_to_fixed_value (val0); CORE_ADDR address = value_address (val); - struct type *type = ada_check_typedef (value_enclosing_type (val)); + struct type *type = ada_check_typedef (value_type (val)); struct value_print_options opts; /* If it is a pointer, indicate what it points to. */ diff --git a/gdb/testsuite/ChangeLog b/gdb/testsuite/ChangeLog index 8c47e86baaf..bad86cf768f 100644 --- a/gdb/testsuite/ChangeLog +++ b/gdb/testsuite/ChangeLog @@ -1,3 +1,10 @@ +2018-09-10 Xavier Roirand + + * gdb.ada/access_to_unbounded_array.exp: New testcase. + * gdb.ada/access_to_unbounded_array/foo.adb: New file. + * gdb.ada/access_to_unbounded_array/pack.adb: New file. + * gdb.ada/access_to_unbounded_array/pack.ads: New file. + 2018-09-10 Xavier Roirand * gdb.ada/mi_string_access.exp: New testcase. diff --git a/gdb/testsuite/gdb.ada/access_to_unbounded_array.exp b/gdb/testsuite/gdb.ada/access_to_unbounded_array.exp new file mode 100644 index 00000000000..3a22d32d721 --- /dev/null +++ b/gdb/testsuite/gdb.ada/access_to_unbounded_array.exp @@ -0,0 +1,30 @@ +# Copyright 2018 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 . + +load_lib "ada.exp" + +standard_ada_testfile foo + +if {[gdb_compile_ada "${srcfile}" "${binfile}" executable [list debug]] != "" } { + return -1 +} + +clean_restart ${testfile} + +set bp_location [gdb_get_line_number "BREAK" ${testdir}/foo.adb] +runto "foo.adb:$bp_location" + +gdb_test "print Aos(1)" " = \\(foo.string_access\\) $hex" +gdb_test "print Aos(2)" " = \\(foo.string_access\\) $hex" diff --git a/gdb/testsuite/gdb.ada/access_to_unbounded_array/foo.adb b/gdb/testsuite/gdb.ada/access_to_unbounded_array/foo.adb new file mode 100644 index 00000000000..b0804c09f1e --- /dev/null +++ b/gdb/testsuite/gdb.ada/access_to_unbounded_array/foo.adb @@ -0,0 +1,24 @@ +-- Copyright 2018 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 . + +with Pack; use Pack; + +procedure Foo is + type String_Access is access String; + type Array_Of_String is array (1 .. 2) of String_Access; + Aos : Array_Of_String := (new String'("ab"), new String'("cd")); +begin + Do_Nothing (Aos'Address); -- BREAK +end Foo; diff --git a/gdb/testsuite/gdb.ada/access_to_unbounded_array/pack.adb b/gdb/testsuite/gdb.ada/access_to_unbounded_array/pack.adb new file mode 100644 index 00000000000..b42e98177f0 --- /dev/null +++ b/gdb/testsuite/gdb.ada/access_to_unbounded_array/pack.adb @@ -0,0 +1,23 @@ +-- Copyright 2018 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 . + +package body Pack is + + procedure Do_Nothing (A : System.Address) is + begin + null; + end Do_Nothing; + +end Pack; diff --git a/gdb/testsuite/gdb.ada/access_to_unbounded_array/pack.ads b/gdb/testsuite/gdb.ada/access_to_unbounded_array/pack.ads new file mode 100644 index 00000000000..400c623fc83 --- /dev/null +++ b/gdb/testsuite/gdb.ada/access_to_unbounded_array/pack.ads @@ -0,0 +1,19 @@ +-- Copyright 2018 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 . + +with System; +package Pack is + procedure Do_Nothing (A : System.Address); +end Pack; -- 2.30.2