This is the mail archive of the
gdb-patches@sourceware.org
mailing list for the GDB project.
[commit/Ada] Full view of tagged type with ptype
- From: Joel Brobecker <brobecker at adacore dot com>
- To: gdb-patches at sourceware dot org
- Cc: Jerome Guitton <guitton at adacore dot com>
- Date: Mon, 10 Mar 2014 15:07:24 +0100
- Subject: [commit/Ada] Full view of tagged type with ptype
- Authentication-results: sourceware.org; auth=none
From: Jerome Guitton <guitton@adacore.com>
Hello,
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) <UNOP_IND, STRUCTOP_STRUCT>:
Resolve tagged types to full view.
gdb/testsuite/
* gdb.ada/tagged_access: New testcase.
Tested on x86_64-linux, and checked in.
---
gdb/ChangeLog | 5 +++
gdb/ada-lang.c | 47 ++++++++++++++++++++++------
gdb/testsuite/ChangeLog | 4 +++
gdb/testsuite/gdb.ada/tagged_access.exp | 33 +++++++++++++++++++
gdb/testsuite/gdb.ada/tagged_access/p.adb | 22 +++++++++++++
gdb/testsuite/gdb.ada/tagged_access/pack.adb | 30 ++++++++++++++++++
gdb/testsuite/gdb.ada/tagged_access/pack.ads | 31 ++++++++++++++++++
7 files changed, 162 insertions(+), 10 deletions(-)
create mode 100644 gdb/testsuite/gdb.ada/tagged_access.exp
create mode 100644 gdb/testsuite/gdb.ada/tagged_access/p.adb
create mode 100644 gdb/testsuite/gdb.ada/tagged_access/pack.adb
create mode 100644 gdb/testsuite/gdb.ada/tagged_access/pack.ads
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;
--
1.8.3.2