From b9c50e9a9ac48662b2132583c52d46976efb3512 Mon Sep 17 00:00:00 2001 From: Xavier Roirand Date: Mon, 10 Sep 2018 10:33:32 -0500 Subject: [PATCH] (Ada/MI) Fix -var-evaluate-expression for 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")); 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.ada/mi_string_access/bar.adb | 24 +++++++ .../gdb.ada/mi_string_access/pck.adb | 21 ++++++ .../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 5401864c21a..40b7978e83f 100644 --- a/gdb/ChangeLog +++ b/gdb/ChangeLog @@ -1,3 +1,8 @@ +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. diff --git a/gdb/ada-lang.c b/gdb/ada-lang.c index 83421ac24e5..5f39def2092 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 3911b8cd242..8c47e86baaf 100644 --- a/gdb/testsuite/ChangeLog +++ b/gdb/testsuite/ChangeLog @@ -1,3 +1,10 @@ +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. 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 00000000000..8ecf907b1e2 --- /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 00000000000..544376c66d4 --- /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 00000000000..dcfb3068d3b --- /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 00000000000..33e369ef860 --- /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; -- 2.30.2