@@ -611,6 +611,15 @@ struct aggregate_assigner
to. */
std::vector<LONGEST> indices;
+private:
+
+ /* The current index value. This is only valid during the 'assign'
+ operation and is part of the implementation of iterated component
+ association. */
+ LONGEST m_current_index = 0;
+
+public:
+
/* Assign the result of evaluating ARG to the INDEXth component of
LHS (a simple array or a record). Does not modify the inferior's
memory, nor does it modify LHS (unless LHS == CONTAINER). */
@@ -620,6 +629,10 @@ struct aggregate_assigner
[ INDICES[0] .. INDICES[1] ],... The resulting intervals do not
overlap. */
void add_interval (LONGEST low, LONGEST high);
+
+ /* Return the current index as a value, using the index type of
+ LHS. */
+ value *current_value () const;
};
/* This abstract class represents a single component in an Ada
@@ -800,16 +813,80 @@ class ada_choices_component : public ada_component
m_assocs = std::move (assoc);
}
+ /* Set the underlying operation */
+ void set_operation (operation_up op)
+ { m_op = std::move (op); }
+
+ /* Set the index variable name for an iterated association. */
+ void set_name (std::string &&name)
+ { m_name = std::move (name); }
+
+ /* The name of this choice component. This is empty unless this is
+ an iterated association. */
+ const std::string &name () const
+ { return m_name; }
+
void assign (aggregate_assigner &assigner) override;
bool uses_objfile (struct objfile *objfile) override;
void dump (ui_file *stream, int depth) override;
+ /* Return the current value of the index variable. This may only be
+ called underneath a call to 'assign'. */
+ value *current_value () const
+ { return m_assigner->current_value (); }
+
private:
std::vector<ada_association_up> m_assocs;
operation_up m_op;
+
+ /* Name of the variable used for iteration. This isn't needed for
+ evaluation, only for debug dumping. This is the empty string for
+ ordinary (non-iterated) choices. */
+ std::string m_name;
+
+ /* A pointer to the current assignment operation; only valid when in
+ a call to the 'assign' method. This is used to find the index
+ variable value during the evaluation of the RHS of the =>, via
+ ada_index_var_operation. */
+ const aggregate_assigner *m_assigner = nullptr;
+};
+
+/* Implement the index variable for iterated component
+ association. */
+class ada_index_var_operation : public operation
+{
+public:
+
+ ada_index_var_operation ()
+ { }
+
+ /* Link this variable to the choices object. May only be called
+ once. */
+ void set_choices (ada_choices_component *var)
+ {
+ gdb_assert (m_var == nullptr && var != nullptr);
+ m_var = var;
+ }
+
+ value *evaluate (struct type *expect_type,
+ struct expression *exp,
+ enum noside noside) override;
+
+ enum exp_opcode opcode () const override
+ {
+ /* It doesn't really matter. */
+ return OP_VAR_VALUE;
+ }
+
+ void dump (struct ui_file *stream, int depth) const override;
+
+private:
+
+ /* The choices component that introduced the index variable. */
+ ada_choices_component *m_var = nullptr;
};
/* An association that uses a discrete range. */
@@ -422,6 +422,10 @@ typedef std::unique_ptr<ada_assign_operation> ada_assign_up;
to implement '@', the target name symbol. */
static std::vector<ada_assign_up> assignments;
+/* Track currently active iterated assignment names. */
+static std::unordered_map<std::string, std::vector<ada_index_var_operation *>>
+ iterated_associations;
+
%}
%union
@@ -488,7 +492,7 @@ static std::vector<ada_assign_up> assignments;
forces a.b.c, e.g., to be LEFT-associated. */
%right '.' '(' '[' DOT_ID DOT_COMPLETE
-%token NEW OTHERS
+%token NEW OTHERS FOR
%%
@@ -1098,6 +1102,33 @@ component_group :
ada_choices_component *choices = choice_component ();
choices->set_associations (pop_associations ($1));
}
+ | FOR NAME IN
+ {
+ std::string name = copy_name ($2);
+
+ auto iter = iterated_associations.find (name);
+ if (iter != iterated_associations.end ())
+ error (_("Nested use of index parameter '%s'"),
+ name.c_str ());
+
+ iterated_associations[name] = {};
+ }
+ component_associations
+ {
+ std::string name = copy_name ($2);
+
+ ada_choices_component *choices = choice_component ();
+ choices->set_associations (pop_associations ($5));
+
+ auto iter = iterated_associations.find (name);
+ gdb_assert (iter != iterated_associations.end ());
+ for (ada_index_var_operation *var : iter->second)
+ var->set_choices (choices);
+
+ iterated_associations.erase (name);
+
+ choices->set_name (std::move (name));
+ }
;
/* We use this somewhat obscure definition in order to handle NAME => and
@@ -1207,6 +1238,7 @@ ada_parse (struct parser_state *par_state)
associations.clear ();
int_storage.clear ();
assignments.clear ();
+ iterated_associations.clear ();
int result = yyparse ();
if (!result)
@@ -1652,10 +1684,22 @@ write_var_or_type (struct parser_state *par_state,
char *encoded_name;
int name_len;
- if (block == NULL)
- block = par_state->expression_context_block;
-
std::string name_storage = ada_encode (name0.ptr);
+
+ if (block == nullptr)
+ {
+ auto iter = iterated_associations.find (name_storage);
+ if (iter != iterated_associations.end ())
+ {
+ auto op = std::make_unique<ada_index_var_operation> ();
+ iter->second.push_back (op.get ());
+ par_state->push (std::move (op));
+ return nullptr;
+ }
+
+ block = par_state->expression_context_block;
+ }
+
name_len = name_storage.size ();
encoded_name = obstack_strndup (&temp_parse_space, name_storage.c_str (),
name_len);
@@ -9343,6 +9343,8 @@ aggregate_assigner::assign (LONGEST index, operation_up &arg)
elt = ada_to_fixed_value (elt);
}
+ scoped_restore save_index = make_scoped_restore (&m_current_index, index);
+
ada_aggregate_operation *ag_op
= dynamic_cast<ada_aggregate_operation *> (arg.get ());
if (ag_op != nullptr)
@@ -9353,6 +9355,18 @@ aggregate_assigner::assign (LONGEST index, operation_up &arg)
EVAL_NORMAL));
}
+/* See ada-exp.h. */
+
+value *
+aggregate_assigner::current_value () const
+{
+ /* Note that using an integer type here is incorrect -- the type
+ should be the array's index type. Unfortunately, though, this
+ isn't currently available during parsing and type resolution. */
+ struct type *index_type = builtin_type (exp->gdbarch)->builtin_int;
+ return value_from_longest (index_type, m_current_index);
+}
+
bool
ada_aggregate_component::uses_objfile (struct objfile *objfile)
{
@@ -9598,8 +9612,15 @@ ada_choices_component::uses_objfile (struct objfile *objfile)
void
ada_choices_component::dump (ui_file *stream, int depth)
{
- gdb_printf (stream, _("%*sChoices:\n"), depth, "");
+ if (m_name.empty ())
+ gdb_printf (stream, _("%*sChoices:\n"), depth, "");
+ else
+ {
+ gdb_printf (stream, _("%*sIterated choices:\n"), depth, "");
+ gdb_printf (stream, _("%*sName: %s\n"), depth + 1, "", m_name.c_str ());
+ }
m_op->dump (stream, depth + 1);
+
for (const auto &item : m_assocs)
item->dump (stream, depth + 1);
}
@@ -9611,10 +9632,36 @@ ada_choices_component::dump (ui_file *stream, int depth)
void
ada_choices_component::assign (aggregate_assigner &assigner)
{
+ scoped_restore save_index = make_scoped_restore (&m_assigner, &assigner);
for (auto &item : m_assocs)
item->assign (assigner, m_op);
}
+void
+ada_index_var_operation::dump (struct ui_file *stream, int depth) const
+{
+ gdb_printf (stream, _("%*sIndex variable: %s\n"), depth, "",
+ m_var->name ().c_str ());
+}
+
+value *
+ada_index_var_operation::evaluate (struct type *expect_type,
+ struct expression *exp,
+ enum noside noside)
+{
+ if (noside == EVAL_AVOID_SIDE_EFFECTS)
+ {
+ /* Note that using an integer type here is incorrect -- the type
+ should be the array's index type. Unfortunately, though,
+ this isn't currently available during parsing and type
+ resolution. */
+ struct type *index_type = builtin_type (exp->gdbarch)->builtin_int;
+ return value::zero (index_type, not_lval);
+ }
+
+ return m_var->current_value ();
+}
+
bool
ada_others_component::uses_objfile (struct objfile *objfile)
{
@@ -227,6 +227,7 @@ abs { return ABS; }
and { return _AND_; }
delta { return DELTA; }
else { return ELSE; }
+for { return FOR; }
in { return IN; }
mod { return MOD; }
new { return NEW; }
new file mode 100644
@@ -0,0 +1,37 @@
+# Copyright 2024 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"
+
+require allow_ada_tests
+
+standard_ada_testfile main
+
+if {[gdb_compile_ada "${srcfile}" "${binfile}" executable [list debug]] != "" } {
+ return -1
+}
+
+clean_restart ${testfile}
+
+set bp_location [gdb_get_line_number "STOP" ${testdir}/main.adb]
+runto "main.adb:$bp_location"
+
+gdb_test "print a1 := (for i in 1..4 => 2 * i + 1)" \
+ " = \\(3, 5, 7, 9\\)" \
+ "simple iterated assignment"
+
+gdb_test "print a2 := (for i in 1..2 => (for j in 1..2 => 3 * i + j))" \
+ " = \\(\\(4, 5\\), \\(7, 8\\)\\)" \
+ "nested iterated assignment"
new file mode 100644
@@ -0,0 +1,24 @@
+-- Copyright 2024 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 Main is
+ A1 : Other_Array_Type := (2, 4, 6, 8);
+ A2 : MD_Array_Type := ((1, 2), (3, 4));
+begin
+ Do_Nothing (A1'Address); -- STOP
+ Do_Nothing (A2'Address);
+end Main;
new file mode 100644
@@ -0,0 +1,23 @@
+-- Copyright 2024 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;
new file mode 100644
@@ -0,0 +1,26 @@
+-- Copyright 2024 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 Other_Array_Type is array (1 .. 4) of Integer;
+
+ type MD_Array_Type is array (1 .. 2, 1 .. 2) of Integer;
+
+ procedure Do_Nothing (A : System.Address);
+
+end Pck;