From patchwork Mon Sep 10 15:42:06 2018 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Joel Brobecker X-Patchwork-Id: 29292 Received: (qmail 86196 invoked by alias); 10 Sep 2018 15:42:26 -0000 Mailing-List: contact gdb-patches-help@sourceware.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Subscribe: List-Archive: List-Post: List-Help: , Sender: gdb-patches-owner@sourceware.org Delivered-To: mailing list gdb-patches@sourceware.org Received: (qmail 86093 invoked by uid 89); 10 Sep 2018 15:42:25 -0000 Authentication-Results: sourceware.org; auth=none X-Spam-SWARE-Status: No, score=-26.0 required=5.0 tests=AWL, BAYES_00, GIT_PATCH_0, GIT_PATCH_1, GIT_PATCH_2, GIT_PATCH_3, KAM_SHORT, RCVD_IN_DNSWL_NONE, SPF_PASS autolearn=ham version=3.3.2 spammy=aos X-HELO: rock.gnat.com Received: from rock.gnat.com (HELO rock.gnat.com) (205.232.38.15) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Mon, 10 Sep 2018 15:42:22 +0000 Received: from localhost (localhost.localdomain [127.0.0.1]) by filtered-rock.gnat.com (Postfix) with ESMTP id 0420E116263; Mon, 10 Sep 2018 11:42:21 -0400 (EDT) Received: from rock.gnat.com ([127.0.0.1]) by localhost (rock.gnat.com [127.0.0.1]) (amavisd-new, port 10024) with LMTP id DWHOVL2kOdKf; Mon, 10 Sep 2018 11:42:20 -0400 (EDT) Received: from tron.gnat.com (tron.gnat.com [205.232.38.10]) by rock.gnat.com (Postfix) with ESMTP id E76B91161AB; Mon, 10 Sep 2018 11:42:20 -0400 (EDT) Received: by tron.gnat.com (Postfix, from userid 4233) id E68DD55F; Mon, 10 Sep 2018 11:42:20 -0400 (EDT) From: Joel Brobecker To: gdb-patches@sourceware.org Cc: Xavier Roirand Subject: [PATCH 4/6] (Ada) Fix printing of access to unconstrained arrays Date: Mon, 10 Sep 2018 11:42:06 -0400 Message-Id: <1536594128-6487-5-git-send-email-brobecker@adacore.com> In-Reply-To: <1536594128-6487-1-git-send-email-brobecker@adacore.com> References: <1536594128-6487-1-git-send-email-brobecker@adacore.com> From: Xavier Roirand 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 +++++++++++++++++ .../gdb.ada/access_to_unbounded_array/pack.adb | 23 +++++++++++++++++ .../gdb.ada/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 40b7978..524d218 100644 --- a/gdb/ChangeLog +++ b/gdb/ChangeLog @@ -1,5 +1,10 @@ 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 an array of access to unconstrained array. diff --git a/gdb/ada-valprint.c b/gdb/ada-valprint.c index a486919..af289e2 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 8c47e86..bad86cf 100644 --- a/gdb/testsuite/ChangeLog +++ b/gdb/testsuite/ChangeLog @@ -1,5 +1,12 @@ 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. * gdb.ada/mi_string_access/bar.adb: New file. * gdb.ada/mi_string_access/pck.adb: New file. 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 0000000..3a22d32 --- /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 0000000..b0804c0 --- /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 0000000..b42e981 --- /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 0000000..400c623 --- /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;