[Ada] Full view of tagged type with ptype
When evaluating an expression, if it is of a tagged type, GDB reads the tag in memory and deduces the full view. At parsing time, however, this operation is done only in the case of OP_VAR_VALUE. ptype does not go through a full evaluation of expressions so it may return some odd results: (gdb) print c.menu_name $1 = 0x0 (gdb) ptype $ type = system.strings.string_access (gdb) ptype c.menu_name type = <void> This change removes this peculiarity by extending the tag resolution to UNOP_IND and STRUCTOP_STRUCT. As in the case of OP_VAR_VALUE, this implies switching from EVAL_AVOID_SIDE_EFFECTS to EVAL_NORMAL when a tagged type is dereferenced. gdb/ * ada-lang.c (ada_evaluate_subexp): Resolve tagged types to full view in the case of UNOP_IND and STRUCTOP_STRUCT. gdb/testsuite/ * gdb.ada/tagged_access: New testcase.
This commit is contained in:
Jerome Guitton
Joel Brobecker
parent
7d03f2eb64
commit
5ec18f2b48
|
|
@ -1,3 +1,8 @@
|
|||
2014-03-10 Jerome Guitton <guitton@adacore.com>
|
||||
|
||||
* ada-lang.c (ada_evaluate_subexp): Resolve tagged types to
|
||||
full view in the case of UNOP_IND and STRUCTOP_STRUCT.
|
||||
|
||||
2014-03-10 Hui Zhu <hui@codesourcery.com>
|
||||
|
||||
* target.h (target_insert_breakpoint): Remove "hardware" from its
|
||||
|
|
|
|||
|
|
@ -9878,6 +9878,7 @@ ada_evaluate_subexp (struct type *expect_type, struct expression *exp,
|
|||
enum exp_opcode op;
|
||||
int tem;
|
||||
int pc;
|
||||
int preeval_pos;
|
||||
struct value *arg1 = NULL, *arg2 = NULL, *arg3;
|
||||
struct type *type;
|
||||
int nargs, oplen;
|
||||
|
|
@ -10713,6 +10714,7 @@ ada_evaluate_subexp (struct type *expect_type, struct expression *exp,
|
|||
return arg1;
|
||||
|
||||
case UNOP_IND:
|
||||
preeval_pos = *pos;
|
||||
arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
|
||||
if (noside == EVAL_SKIP)
|
||||
goto nosideret;
|
||||
|
|
@ -10733,10 +10735,26 @@ ada_evaluate_subexp (struct type *expect_type, struct expression *exp,
|
|||
/* In C you can dereference an array to get the 1st elt. */
|
||||
|| TYPE_CODE (type) == TYPE_CODE_ARRAY)
|
||||
{
|
||||
type = to_static_fixed_type
|
||||
(ada_aligned_type
|
||||
(ada_check_typedef (TYPE_TARGET_TYPE (type))));
|
||||
check_size (type);
|
||||
/* As mentioned in the OP_VAR_VALUE case, tagged types can
|
||||
only be determined by inspecting the object's tag.
|
||||
This means that we need to evaluate completely the
|
||||
expression in order to get its type. */
|
||||
|
||||
if ((TYPE_CODE(type) == TYPE_CODE_REF
|
||||
|| TYPE_CODE(type) == TYPE_CODE_PTR)
|
||||
&& ada_is_tagged_type (TYPE_TARGET_TYPE (type), 0))
|
||||
{
|
||||
arg1 = evaluate_subexp (NULL_TYPE, exp, &preeval_pos,
|
||||
EVAL_NORMAL);
|
||||
type = value_type (ada_value_ind (arg1));
|
||||
}
|
||||
else
|
||||
{
|
||||
type = to_static_fixed_type
|
||||
(ada_aligned_type
|
||||
(ada_check_typedef (TYPE_TARGET_TYPE (type))));
|
||||
}
|
||||
check_size (type);
|
||||
return value_zero (type, lval_memory);
|
||||
}
|
||||
else if (TYPE_CODE (type) == TYPE_CODE_INT)
|
||||
|
|
@ -10780,6 +10798,7 @@ ada_evaluate_subexp (struct type *expect_type, struct expression *exp,
|
|||
case STRUCTOP_STRUCT:
|
||||
tem = longest_to_int (exp->elts[pc + 1].longconst);
|
||||
(*pos) += 3 + BYTES_TO_EXP_ELEM (tem + 1);
|
||||
preeval_pos = *pos;
|
||||
arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
|
||||
if (noside == EVAL_SKIP)
|
||||
goto nosideret;
|
||||
|
|
@ -10792,13 +10811,21 @@ ada_evaluate_subexp (struct type *expect_type, struct expression *exp,
|
|||
type = ada_lookup_struct_elt_type (type1,
|
||||
&exp->elts[pc + 2].string,
|
||||
1, 1, NULL);
|
||||
|
||||
/* If the field is not found, check if it exists in the
|
||||
extension of this object's type. This means that we
|
||||
need to evaluate completely the expression. */
|
||||
|
||||
if (type == NULL)
|
||||
/* In this case, we assume that the field COULD exist
|
||||
in some extension of the type. Return an object of
|
||||
"type" void, which will match any formal
|
||||
(see ada_type_match). */
|
||||
return value_zero (builtin_type (exp->gdbarch)->builtin_void,
|
||||
lval_memory);
|
||||
{
|
||||
arg1 = evaluate_subexp (NULL_TYPE, exp, &preeval_pos,
|
||||
EVAL_NORMAL);
|
||||
arg1 = ada_value_struct_elt (arg1,
|
||||
&exp->elts[pc + 2].string,
|
||||
0);
|
||||
arg1 = unwrap_value (arg1);
|
||||
type = value_type (ada_to_fixed_value (arg1));
|
||||
}
|
||||
}
|
||||
else
|
||||
type =
|
||||
|
|
|
|||
|
|
@ -1,3 +1,7 @@
|
|||
2014-03-10 Joel Brobecker <brobecker@adacore.com>
|
||||
|
||||
* gdb.ada/tagged_access: New testcase.
|
||||
|
||||
2014-03-07 Markus Metzger <markus.t.metzger@intel.com>
|
||||
|
||||
* gdb.btrace/data.exp: Update expected output.
|
||||
|
|
|
|||
|
|
@ -0,0 +1,33 @@
|
|||
# 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 p
|
||||
|
||||
if {[gdb_compile_ada "${srcfile}" "${binfile}" executable [list debug]] != "" } {
|
||||
return -1
|
||||
}
|
||||
|
||||
clean_restart ${testfile}
|
||||
|
||||
set bp_location [gdb_get_line_number "BREAK" ${testdir}/p.adb]
|
||||
runto "p.adb:$bp_location"
|
||||
|
||||
gdb_test "ptype c.all" \
|
||||
" = new pack\\.interactive_command with record\r\n\\s+menu_name: pack\\.string_access;\r\nend record"
|
||||
|
||||
gdb_test "ptype c.menu_name" \
|
||||
" = access array \\(<>\\) of character"
|
||||
|
|
@ -0,0 +1,22 @@
|
|||
-- 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 Pack;
|
||||
|
||||
procedure P is
|
||||
C : Pack.Interactive_Command_Access := Pack.New_Command;
|
||||
begin
|
||||
Pack.Id (C); -- BREAK
|
||||
end P;
|
||||
|
|
@ -0,0 +1,30 @@
|
|||
-- 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 Pack is
|
||||
|
||||
Global_Command : aliased My_Command := My_Command'(menu_name => null);
|
||||
|
||||
function New_Command return Interactive_Command_Access is
|
||||
begin
|
||||
return Global_Command'access;
|
||||
end New_Command;
|
||||
|
||||
procedure Id (C : in out Interactive_Command_Access) is
|
||||
begin
|
||||
null;
|
||||
end Id;
|
||||
|
||||
end Pack;
|
||||
|
|
@ -0,0 +1,31 @@
|
|||
-- 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 Pack is
|
||||
|
||||
type Interactive_Command is abstract tagged null record;
|
||||
type Interactive_Command_Access is access all Interactive_Command'Class;
|
||||
|
||||
type String_Access is access all String;
|
||||
|
||||
type My_Command is new Interactive_Command with record
|
||||
menu_name : String_Access;
|
||||
end record;
|
||||
|
||||
function New_Command return Interactive_Command_Access;
|
||||
|
||||
procedure Id (C : in out Interactive_Command_Access);
|
||||
|
||||
end Pack;
|
||||
Loading…
Reference in New Issue