diff --git a/gdb/ada-exp.h b/gdb/ada-exp.h index 7e59267192a..54ae4529def 100644 --- a/gdb/ada-exp.h +++ b/gdb/ada-exp.h @@ -130,6 +130,14 @@ public: enum exp_opcode opcode () const override { return std::get<0> (m_storage)->opcode (); } + +protected: + + void do_generate_ax (struct expression *exp, + struct agent_expr *ax, + struct axs_value *value, + struct type *cast_type) + override; }; /* An Ada string constant. */ @@ -255,6 +263,18 @@ public: arg1, arg2); } + void do_generate_ax (struct expression *exp, + struct agent_expr *ax, + struct axs_value *value, + struct type *cast_type) + override + { + gen_expr_binop (exp, opcode (), + std::get<1> (this->m_storage).get (), + std::get<2> (this->m_storage).get (), + ax, value); + } + enum exp_opcode opcode () const override { return std::get<0> (m_storage); } }; @@ -380,7 +400,11 @@ public: protected: - using operation::do_generate_ax; + void do_generate_ax (struct expression *exp, + struct agent_expr *ax, + struct axs_value *value, + struct type *cast_type) + override; }; /* Variant of var_msym_value_operation for Ada. */ diff --git a/gdb/ada-lang.c b/gdb/ada-lang.c index 7c528ab629f..39cca3b9e80 100644 --- a/gdb/ada-lang.c +++ b/gdb/ada-lang.c @@ -60,6 +60,7 @@ #include #include "ada-exp.h" #include "charset.h" +#include "ax-gdb.h" /* Define whether or not the C operator '/' truncates towards zero for differently signed operands (truncation direction is undefined in C). @@ -9189,6 +9190,23 @@ ada_enum_name (const char *name) } } +/* If TYPE is a dynamic type, return the base type. Otherwise, if + there is no parallel type, return nullptr. */ + +static struct type * +find_base_type (struct type *type) +{ + struct type *raw_real_type + = ada_check_typedef (ada_get_base_type (type)); + + /* No parallel XVS or XVE type. */ + if (type == raw_real_type + && ada_find_parallel_type (type, "___XVE") == nullptr) + return nullptr; + + return raw_real_type; +} + /* If VAL is wrapped in an aligner or subtype wrapper, return the value it wraps. */ @@ -9209,13 +9227,8 @@ unwrap_value (struct value *val) } else { - struct type *raw_real_type = - ada_check_typedef (ada_get_base_type (type)); - - /* If there is no parallel XVS or XVE type, then the value is - already unwrapped. Return it without further modification. */ - if ((type == raw_real_type) - && ada_find_parallel_type (type, "___XVE") == NULL) + struct type *raw_real_type = find_base_type (type); + if (raw_real_type == nullptr) return val; return @@ -10641,6 +10654,21 @@ ada_wrapped_operation::evaluate (struct type *expect_type, return result; } +void +ada_wrapped_operation::do_generate_ax (struct expression *exp, + struct agent_expr *ax, + struct axs_value *value, + struct type *cast_type) +{ + std::get<0> (m_storage)->generate_ax (exp, ax, value, cast_type); + + struct type *type = value->type; + if (ada_is_aligner_type (type)) + error (_("Aligner types cannot be handled in agent expressions")); + else if (find_base_type (type) != nullptr) + error (_("Dynamic types cannot be handled in agent expressions")); +} + value * ada_string_operation::evaluate (struct type *expect_type, struct expression *exp, @@ -10991,6 +11019,33 @@ ada_var_value_operation::resolve (struct expression *exp, return false; } +void +ada_var_value_operation::do_generate_ax (struct expression *exp, + struct agent_expr *ax, + struct axs_value *value, + struct type *cast_type) +{ + symbol *sym = std::get<0> (m_storage).symbol; + + if (sym->domain () == UNDEF_DOMAIN) + error (_("Unexpected unresolved symbol, %s, during evaluation"), + sym->print_name ()); + + struct type *type = static_unwrap_type (sym->type ()); + if (ada_is_tagged_type (type, 0) + || (type->code () == TYPE_CODE_REF + && ada_is_tagged_type (type->target_type (), 0))) + error (_("Tagged types cannot be handled in agent expressions")); + + if ((type->code () == TYPE_CODE_STRUCT + && dynamic_template_type (type) != NULL) + || (type->code () == TYPE_CODE_UNION + && ada_find_parallel_type (type, "___XVU") != NULL)) + error (_("Dynamic types cannot be handled in agent expressions")); + + var_value_operation::do_generate_ax (exp, ax, value, cast_type); +} + value * ada_atr_val_operation::evaluate (struct type *expect_type, struct expression *exp, diff --git a/gdb/testsuite/gdb.ada/ax-ada.exp b/gdb/testsuite/gdb.ada/ax-ada.exp new file mode 100644 index 00000000000..d958224ec07 --- /dev/null +++ b/gdb/testsuite/gdb.ada/ax-ada.exp @@ -0,0 +1,31 @@ +# Copyright 2023 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 . + +load_lib "ada.exp" + +require allow_ada_tests + +standard_ada_testfile prog + +if {[gdb_compile_ada "${srcfile}" "${binfile}" executable {debug}] != ""} { + return -1 +} + +clean_restart ${testfile} + +set bp_location [gdb_get_line_number "START" ${testdir}/prog.adb] +runto "prog.adb:$bp_location" + +gdb_test "maint agent-eval variable = 23" ".*end" diff --git a/gdb/testsuite/gdb.ada/ax-ada/prog.adb b/gdb/testsuite/gdb.ada/ax-ada/prog.adb new file mode 100644 index 00000000000..3852711e88c --- /dev/null +++ b/gdb/testsuite/gdb.ada/ax-ada/prog.adb @@ -0,0 +1,20 @@ +-- Copyright 2023 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 . + +procedure Prog is + Variable : Integer := 23; +begin + null; -- START +end Prog;