diff options
| -rw-r--r-- | gdb/ChangeLog | 5 | ||||
| -rw-r--r-- | gdb/ada-lang.c | 47 | ||||
| -rw-r--r-- | gdb/testsuite/ChangeLog | 4 | ||||
| -rw-r--r-- | gdb/testsuite/gdb.ada/tagged_access.exp | 33 | ||||
| -rw-r--r-- | gdb/testsuite/gdb.ada/tagged_access/p.adb | 22 | ||||
| -rw-r--r-- | gdb/testsuite/gdb.ada/tagged_access/pack.adb | 30 | ||||
| -rw-r--r-- | gdb/testsuite/gdb.ada/tagged_access/pack.ads | 31 |
7 files changed, 162 insertions, 10 deletions
diff --git a/gdb/ChangeLog b/gdb/ChangeLog index 60087c7..73ab666 100644 --- a/gdb/ChangeLog +++ b/gdb/ChangeLog @@ -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 diff --git a/gdb/ada-lang.c b/gdb/ada-lang.c index 92f437f..e36a64b 100644 --- a/gdb/ada-lang.c +++ b/gdb/ada-lang.c @@ -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 = diff --git a/gdb/testsuite/ChangeLog b/gdb/testsuite/ChangeLog index 6cbf534..44fb290 100644 --- a/gdb/testsuite/ChangeLog +++ b/gdb/testsuite/ChangeLog @@ -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. diff --git a/gdb/testsuite/gdb.ada/tagged_access.exp b/gdb/testsuite/gdb.ada/tagged_access.exp new file mode 100644 index 0000000..c5832e8 --- /dev/null +++ b/gdb/testsuite/gdb.ada/tagged_access.exp @@ -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" diff --git a/gdb/testsuite/gdb.ada/tagged_access/p.adb b/gdb/testsuite/gdb.ada/tagged_access/p.adb new file mode 100644 index 0000000..b1f4d1f --- /dev/null +++ b/gdb/testsuite/gdb.ada/tagged_access/p.adb @@ -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; diff --git a/gdb/testsuite/gdb.ada/tagged_access/pack.adb b/gdb/testsuite/gdb.ada/tagged_access/pack.adb new file mode 100644 index 0000000..1bf5500 --- /dev/null +++ b/gdb/testsuite/gdb.ada/tagged_access/pack.adb @@ -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; diff --git a/gdb/testsuite/gdb.ada/tagged_access/pack.ads b/gdb/testsuite/gdb.ada/tagged_access/pack.ads new file mode 100644 index 0000000..6074009 --- /dev/null +++ b/gdb/testsuite/gdb.ada/tagged_access/pack.ads @@ -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; |