From patchwork Mon Sep 10 15:42:05 2018 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Joel Brobecker X-Patchwork-Id: 29290 Received: (qmail 85869 invoked by alias); 10 Sep 2018 15:42:24 -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 85762 invoked by uid 89); 10 Sep 2018 15:42:23 -0000 Authentication-Results: sourceware.org; auth=none X-Spam-SWARE-Status: No, score=-25.8 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, forcing 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:19 +0000 Received: from localhost (localhost.localdomain [127.0.0.1]) by filtered-rock.gnat.com (Postfix) with ESMTP id 330201161AE; Mon, 10 Sep 2018 11:42:18 -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 dHFrqh5c8HFL; Mon, 10 Sep 2018 11:42:18 -0400 (EDT) Received: from tron.gnat.com (tron.gnat.com [205.232.38.10]) by rock.gnat.com (Postfix) with ESMTP id 201E71161AB; Mon, 10 Sep 2018 11:42:18 -0400 (EDT) Received: by tron.gnat.com (Postfix, from userid 4233) id 1F2EC55F; Mon, 10 Sep 2018 11:42:18 -0400 (EDT) From: Joel Brobecker To: gdb-patches@sourceware.org Cc: Xavier Roirand Subject: [PATCH 3/6] (Ada/MI) Fix -var-evaluate-expression for access to unconstrained arrays Date: Mon, 10 Sep 2018 11:42:05 -0400 Message-Id: <1536594128-6487-4-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")); In GDB/MI mode, create a variable which type is Aos, evaluate it: (gdb) -var-create var1 * Aos ^done,name="var1",numchild="2",value="[2]",type="bar.array_of_string",thread-id="1",has_more="0" Now print it: (gdb) -var-list-children 1 var1 ^done,numchild="2",children=[child={name="var1.1",exp="1",numchild="1",value="[2] \"ab\"", type="bar.string_access",thread-id="1"},child={name="var1.2",exp="2",numchild="1",value="[2] \"cd\"", type="bar.string_access",thread-id="1"}],has_more="0" But printed fields "value" are wrong, since it should be: ^done,numchild="2",children=[child={name="var1.1",exp="1",numchild="1",value="0x634018",type="bar.string_access",thread-id="1"},child={name="var1.2",exp="2",numchild="1",value="0x634038",type="bar.string_access",thread-id="1"}],has_more="0"^M Print each child of var1: (gdb) -var-evaluate-expression var1.1 ^done,value="[2] \"ab\"" (gdb) -var-evaluate-expression var1.2 ^done,value="[2] \"cd\"" Whereas it should be (gdb) -var-evaluate-expression var1.1 ^done,value="0x635018" (gdb) -var-evaluate-expression var1.2 ^done,value="0x635038" This patch fixes this. gdb/ChangeLog: * ada-lang.c (ada_value_subscript): Handle case when parameter is an array of access to unconstrained array. testsuite/ChangeLog * 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. * gdb.ada/mi_string_access/pck.asd: New file. Tested on x86_64-linux. --- gdb/ChangeLog | 5 ++ gdb/ada-lang.c | 24 ++++++++++ gdb/testsuite/ChangeLog | 7 +++ gdb/testsuite/gdb.ada/mi_string_access.exp | 64 ++++++++++++++++++++++++++ gdb/testsuite/gdb.ada/mi_string_access/bar.adb | 24 ++++++++++ gdb/testsuite/gdb.ada/mi_string_access/pck.adb | 21 +++++++++ gdb/testsuite/gdb.ada/mi_string_access/pck.ads | 19 ++++++++ 7 files changed, 164 insertions(+) create mode 100644 gdb/testsuite/gdb.ada/mi_string_access.exp create mode 100644 gdb/testsuite/gdb.ada/mi_string_access/bar.adb create mode 100644 gdb/testsuite/gdb.ada/mi_string_access/pck.adb create mode 100644 gdb/testsuite/gdb.ada/mi_string_access/pck.ads diff --git a/gdb/ChangeLog b/gdb/ChangeLog index 5401864..40b7978 100644 --- a/gdb/ChangeLog +++ b/gdb/ChangeLog @@ -1,5 +1,10 @@ 2018-09-10 Xavier Roirand + * ada-lang.c (ada_value_subscript): Handle case when parameter is + an array of access to unconstrained array. + +2018-09-10 Xavier Roirand + * ada-lang.c (ada_is_access_to_unconstrained_array): New function. (ada_check_typedef): Use it. diff --git a/gdb/ada-lang.c b/gdb/ada-lang.c index 83421ac..5f39def 100644 --- a/gdb/ada-lang.c +++ b/gdb/ada-lang.c @@ -2861,10 +2861,34 @@ ada_value_subscript (struct value *arr, int arity, struct value **ind) for (k = 0; k < arity; k += 1) { + struct type *saved_elt_type = TYPE_TARGET_TYPE (elt_type); + if (TYPE_CODE (elt_type) != TYPE_CODE_ARRAY) error (_("too many subscripts (%d expected)"), k); + elt = value_subscript (elt, pos_atr (ind[k])); + + if (ada_is_access_to_unconstrained_array (saved_elt_type) + && TYPE_CODE (value_type (elt)) != TYPE_CODE_TYPEDEF) + { + /* The element is a typedef to an unconstrained array, + except that the value_subscript call stripped the + typedef layer. The 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. So, we need to restore that + typedef layer, which we can do by forcing the element's + type back to its original type. Otherwise, the returned + value is going to be printed as the array, rather + than as an access. Another symptom of the same issue + would be that an expression trying to dereference the + element would also be improperly rejected. */ + deprecated_set_value_type (elt, saved_elt_type); + } + + elt_type = ada_check_typedef (value_type (elt)); } + return elt; } diff --git a/gdb/testsuite/ChangeLog b/gdb/testsuite/ChangeLog index 3911b8c..8c47e86 100644 --- a/gdb/testsuite/ChangeLog +++ b/gdb/testsuite/ChangeLog @@ -1,5 +1,12 @@ 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. + * gdb.ada/mi_string_access/pck.asd: New file. + +2018-09-10 Xavier Roirand + * gdb.ada/mi_var_union.exp: New testcase. * gdb.ada/mi_var_union/bar.adb: New file. * gdb.ada/mi_var_union/pck.adb: New file. diff --git a/gdb/testsuite/gdb.ada/mi_string_access.exp b/gdb/testsuite/gdb.ada/mi_string_access.exp new file mode 100644 index 0000000..8ecf907 --- /dev/null +++ b/gdb/testsuite/gdb.ada/mi_string_access.exp @@ -0,0 +1,64 @@ +# 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 bar + +if {[gdb_compile_ada "${srcfile}" "${binfile}" executable [list debug]] != "" } { + return -1 +} + +load_lib mi-support.exp +set MIFLAGS "-i=mi" + +gdb_exit +if [mi_gdb_start] { + continue +} + +mi_delete_breakpoints +mi_gdb_reinitialize_dir $srcdir/$subdir +mi_gdb_load ${binfile} + +if ![mi_run_to_main] then { + fail "Cannot run to main, testcase aborted" + return 0 +} + +set bp_location [gdb_get_line_number "STOP" ${testdir}/bar.adb] +mi_continue_to_line \ + "bar.adb:$bp_location" \ + "stop at start of main Ada procedure" + +mi_gdb_test "-var-create var1 * Aos" \ + "\\^done,name=\"var1\",numchild=\"2\",.*" \ + "Create var1 varobj" + +mi_gdb_test "-var-list-children 1 var1" \ + "\\^done,numchild=\"2\",children=\\\[child={name=\"var1.1\",exp=\"1\",numchild=\"1\",value=\"$hex\",type=\"bar.string_access\",thread-id=\"$decimal\"},child={name=\"var1.2\",exp=\"2\",numchild=\"1\",value=\"$hex\",type=\"bar.string_access\",thread-id=\"$decimal\"}\\\],has_more=\"0\"" \ + "list var1's children" + +mi_gdb_test "-var-evaluate-expression var1" \ + "\\^done,value=\"\\\[2\\\]\"" \ + "Print var1" + +mi_gdb_test "-var-evaluate-expression var1.1" \ + "\\^done,value=\"$hex\"" \ + "Print var1 first child" + +mi_gdb_test "-var-evaluate-expression var1.2" \ + "\\^done,value=\"$hex\"" \ + "Print var1 second child" diff --git a/gdb/testsuite/gdb.ada/mi_string_access/bar.adb b/gdb/testsuite/gdb.ada/mi_string_access/bar.adb new file mode 100644 index 0000000..544376c --- /dev/null +++ b/gdb/testsuite/gdb.ada/mi_string_access/bar.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 Pck; use Pck; + +procedure Bar 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); -- STOP +end Bar; diff --git a/gdb/testsuite/gdb.ada/mi_string_access/pck.adb b/gdb/testsuite/gdb.ada/mi_string_access/pck.adb new file mode 100644 index 0000000..dcfb306 --- /dev/null +++ b/gdb/testsuite/gdb.ada/mi_string_access/pck.adb @@ -0,0 +1,21 @@ +-- 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 Pck is + procedure Do_Nothing (A : System.Address) is + begin + null; + end Do_Nothing; +end Pck; diff --git a/gdb/testsuite/gdb.ada/mi_string_access/pck.ads b/gdb/testsuite/gdb.ada/mi_string_access/pck.ads new file mode 100644 index 0000000..33e369e --- /dev/null +++ b/gdb/testsuite/gdb.ada/mi_string_access/pck.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 Pck is + procedure Do_Nothing (A : System.Address); +end Pck;