varobj/Ada: Missing children for interface-wide tagged types
Consider the following code: type Element is abstract tagged null record; type GADataType is interface; type Data_Type is new Element and GADataType with record I : Integer := 42; end record; Result1 : Data_Type; GGG1 : GADataType'Class := GADataType'Class (Result1); When trying to create a varobj for variable ggg1, GDB currently returns an object which has no child: -var-create ggg1 * ggg1 ^done,name="ggg1",numchild="0",[...] This is incorrect, it should return an object which has one child (field "i"). This is because tagged-type objects are dynamic, and we need to apply a small transformation in order to get their actual type. This is already done on the GDB/CLI side in ada-valprint, and it needs to be done on the ada-varobj side as well. gdb/ChangeLog: * ada-varobj.c (ada_varobj_adjust_for_child_access): Convert tagged type objects to their actual type. gdb/testsuite/ChangeLog: * gdb.ada/mi_interface: New testcase.
This commit is contained in:
parent
8e355c5d24
commit
f30b8b38d4
|
@ -219,6 +219,15 @@ ada_varobj_adjust_for_child_access (struct value **value,
|
|||
&& !ada_is_array_descriptor_type (TYPE_TARGET_TYPE (*type))
|
||||
&& !ada_is_constrained_packed_array_type (TYPE_TARGET_TYPE (*type)))
|
||||
ada_varobj_ind (*value, *type, value, type);
|
||||
|
||||
/* If this is a tagged type, we need to transform it a bit in order
|
||||
to be able to fetch its full view. As always with tagged types,
|
||||
we can only do that if we have a value. */
|
||||
if (*value != NULL && ada_is_tagged_type (*type, 1))
|
||||
{
|
||||
*value = ada_tag_value_at_base_address (*value);
|
||||
*type = value_type (*value);
|
||||
}
|
||||
}
|
||||
|
||||
/* Assuming that the (PARENT_VALUE, PARENT_TYPE) pair is an array
|
||||
|
|
|
@ -0,0 +1,52 @@
|
|||
# Copyright 2014 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 foo
|
||||
|
||||
if {[gdb_compile_ada "${srcfile}" "${binfile}" executable [list debug additional_flags=-gnat12 ]] != "" } {
|
||||
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 "BREAK" ${testdir}/foo.adb]
|
||||
mi_continue_to_line \
|
||||
"foo.adb:$bp_location" \
|
||||
"stop at start of main Ada procedure"
|
||||
|
||||
mi_gdb_test "-var-create ggg1 * ggg1" \
|
||||
"\\^done,name=\"ggg1\",numchild=\"1\",value=\"{...}\",type=\"<ref> pck.gadatatype\",has_more=\"0\"" \
|
||||
"Create ggg1 varobj"
|
||||
|
||||
mi_gdb_test "-var-list-children 1 ggg1" \
|
||||
"\\^done,numchild=\"1\",children=\\\[child={name=\"ggg1.i\",exp=\"i\",numchild=\"0\",value=\"42\",type=\"integer\"}\\\],has_more=\"0\"" \
|
||||
"list ggg1's children"
|
|
@ -0,0 +1,23 @@
|
|||
-- Copyright 2014 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 Foo is
|
||||
Result1 : Data_Type;
|
||||
GGG1 : GADataType'Class := GADataType'Class (Result1);
|
||||
begin
|
||||
Do_Nothing (GGG1'Address); -- BREAK
|
||||
end Foo;
|
|
@ -0,0 +1,21 @@
|
|||
-- Copyright 2014 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,28 @@
|
|||
-- Copyright 2014 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
|
||||
|
||||
type Element is abstract tagged null record;
|
||||
type GADataType is interface;
|
||||
|
||||
type Data_Type is new Element and GADataType with record
|
||||
I : Integer := 42;
|
||||
end record;
|
||||
|
||||
procedure Do_Nothing (A : System.Address);
|
||||
end Pck;
|
Loading…
Reference in New Issue