(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.
This commit is contained in:
parent
736ade86ea
commit
b9c50e9a9a
|
@ -1,3 +1,8 @@
|
||||||
|
2018-09-10 Xavier Roirand <roirand@adacore.com>
|
||||||
|
|
||||||
|
* ada-lang.c (ada_value_subscript): Handle case when parameter is
|
||||||
|
an array of access to unconstrained array.
|
||||||
|
|
||||||
2018-09-10 Xavier Roirand <roirand@adacore.com>
|
2018-09-10 Xavier Roirand <roirand@adacore.com>
|
||||||
|
|
||||||
* ada-lang.c (ada_is_access_to_unconstrained_array): New function.
|
* ada-lang.c (ada_is_access_to_unconstrained_array): New function.
|
||||||
|
|
|
@ -2861,10 +2861,34 @@ ada_value_subscript (struct value *arr, int arity, struct value **ind)
|
||||||
|
|
||||||
for (k = 0; k < arity; k += 1)
|
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)
|
if (TYPE_CODE (elt_type) != TYPE_CODE_ARRAY)
|
||||||
error (_("too many subscripts (%d expected)"), k);
|
error (_("too many subscripts (%d expected)"), k);
|
||||||
|
|
||||||
elt = value_subscript (elt, pos_atr (ind[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;
|
return elt;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
|
@ -1,3 +1,10 @@
|
||||||
|
2018-09-10 Xavier Roirand <roirand@adacore.com>
|
||||||
|
|
||||||
|
* 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 <roirand@adacore.com>
|
2018-09-10 Xavier Roirand <roirand@adacore.com>
|
||||||
|
|
||||||
* gdb.ada/mi_var_union.exp: New testcase.
|
* gdb.ada/mi_var_union.exp: New testcase.
|
||||||
|
|
|
@ -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 <http://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
|
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"
|
|
@ -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 <http://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
|
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;
|
|
@ -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 <http://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
|
package body Pck is
|
||||||
|
procedure Do_Nothing (A : System.Address) is
|
||||||
|
begin
|
||||||
|
null;
|
||||||
|
end Do_Nothing;
|
||||||
|
end Pck;
|
|
@ -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 <http://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
|
with System;
|
||||||
|
package Pck is
|
||||||
|
procedure Do_Nothing (A : System.Address);
|
||||||
|
end Pck;
|
Loading…
Reference in New Issue