[PATCH 170/203] Implement Ada assignment

Tom Tromey
2021-01-01T21:49:34Z

Assignment is the most complicated Ada expression, because
implementing aggregate assignment involves several specialized
opcodes.

This patch does this implementation by introducing new abstract
classes that are used to represent the various parts of aggregate
assignment. This makes the code somewhat cleaner, and, by avoiding
the over-use of 'operation' subclasses, avoids the need for dissection
using dynamic_cast (though a few are still needed here).

I believe this patch fixes a latent bug in the handling of
aggregate_assign_from_choices. That code does:

if (op == OP_DISCRETE_RANGE)
{
choice_pos += 1;
lower = value_as_long (ada_evaluate_subexp (NULL, exp, pos,
EVAL_NORMAL));
upper = value_as_long (ada_evaluate_subexp (NULL, exp, pos,
EVAL_NORMAL));
}

However, I think 'choice_pos' should be used in the calls, rather than
'pos'.

gdb/ChangeLog
2021-01-01 Tom Tromey <tom@tromey.com>

* expprint.c (dump_for_expression): New overload.
* expop.h (check_objfile, dump_for_expression): Declare new
overloads.
* ada-lang.c (check_objfile): New overload.
(assign_component, ada_aggregate_component::uses_objfile)
(ada_aggregate_component::dump, ada_aggregate_component::assign)
(ada_aggregate_component::assign_aggregate)
(ada_positional_component::uses_objfile)
(ada_positional_component::dump, ada_positional_component::assign)
(ada_discrete_range_association::uses_objfile)
(ada_discrete_range_association::dump)
(ada_discrete_range_association::assign)
(ada_name_association::uses_objfile, ada_name_association::dump)
(ada_name_association::assign)
(ada_choices_component::uses_objfile, ada_choices_component::dump)
(ada_choices_component::assign)
(ada_others_component::uses_objfile, ada_others_component::dump)
(ada_others_component::assign, ada_assign_operation::evaluate):
New methods.
* ada-exp.h (ada_string_operation) <get_name>: New method.
(class ada_assign_operation): New.
(class ada_component): New.
(ada_component_up): New typedef.
(class ada_aggregate_operation, class ada_aggregate_component)
(class ada_positional_component, class ada_others_component)
(class ada_association): New.
(ada_association_up): New typedef.
(class ada_choices_component)
(class ada_discrete_range_association)
(class ada_name_association): New.
---
gdb/ChangeLog | 33 +++++
gdb/ada-exp.h | 279 +++++++++++++++++++++++++++++++++++++++
gdb/ada-lang.c | 344 +++++++++++++++++++++++++++++++++++++++++++++++++
gdb/expop.h | 7 +
gdb/expprint.c | 8 ++
5 files changed, 671 insertions(+)

diff --git a/gdb/ada-exp.h b/gdb/ada-exp.h
index 2c5696cab76..7dfc64e2ec7 100644
--- a/gdb/ada-exp.h
+++ b/gdb/ada-exp.h
@@ -104,6 +104,12 @@ class ada_string_operation

using string_operation::string_operation;

+ /* Return the underlying string. */
+ const char *get_name () const
+ {
+ return std::get<0> (m_storage).c_str ();
+ }
+
value *evaluate (struct type *expect_type,
struct expression *exp,
enum noside noside) override;
@@ -440,6 +446,279 @@ class ada_funcall_operation
{ return OP_FUNCALL; }
};

+/* An Ada assignment operation. */
+class ada_assign_operation
+ : public assign_operation
+{
+public:
+
+ using assign_operation::assign_operation;
+
+ value *evaluate (struct type *expect_type,
+ struct expression *exp,
+ enum noside noside) override;
+
+ enum exp_opcode opcode () const override
+ { return BINOP_ASSIGN; }
+};
+
+/* This abstract class represents a single component in an Ada
+ aggregate assignment. */
+class ada_component
+{
+public:
+
+ /* Assign to LHS, which is part of CONTAINER. EXP is the expression
+ being evaluated. INDICES, LOW, and HIGH indicate which
+ sub-components have already been assigned; INDICES should be
+ updated by this call. */
+ virtual void assign (struct value *container,
+ struct value *lhs, struct expression *exp,
+ std::vector<LONGEST> &indices,
+ LONGEST low, LONGEST high) = 0;
+
+ /* Same as operation::uses_objfile. */
+ virtual bool uses_objfile (struct objfile *objfile) = 0;
+
+ /* Same as operation::dump. */
+ virtual void dump (ui_file *stream, int depth) = 0;
+
+ virtual ~ada_component () = default;
+
+protected:
+
+ ada_component () = default;
+ DISABLE_COPY_AND_ASSIGN (ada_component);
+};
+
+/* Unique pointer specialization for Ada assignment components. */
+typedef std::unique_ptr<ada_component> ada_component_up;
+
+/* An operation that holds a single component. */
+class ada_aggregate_operation
+ : public tuple_holding_operation<ada_component_up>
+{
+public:
+
+ using tuple_holding_operation::tuple_holding_operation;
+
+ /* Assuming that LHS represents an lvalue having a record or array
+ type, evaluate an assignment of this aggregate's value to LHS.
+ CONTAINER is an lvalue containing LHS (possibly LHS itself).
+ Does not modify the inferior's memory, nor does it modify the
+ contents of LHS (unless == CONTAINER). */
+
+ void assign_aggregate (struct value *container,
+ struct value *lhs,
+ struct expression *exp);
+
+ value *evaluate (struct type *expect_type,
+ struct expression *exp,
+ enum noside noside) override
+ {
+ error (_("Aggregates only allowed on the right of an assignment"));
+ }
+
+ enum exp_opcode opcode () const override
+ { return OP_AGGREGATE; }
+};
+
+/* A component holding a vector of other components to assign. */
+class ada_aggregate_component : public ada_component
+{
+public:
+
+ explicit ada_aggregate_component (std::vector<ada_component_up> &&components)
+ : m_components (std::move (components))
+ {
+ }
+
+ void assign (struct value *container,
+ struct value *lhs, struct expression *exp,
+ std::vector<LONGEST> &indices,
+ LONGEST low, LONGEST high) override;
+
+ bool uses_objfile (struct objfile *objfile) override;
+
+ void dump (ui_file *stream, int depth) override;
+
+private:
+
+ std::vector<ada_component_up> m_components;
+};
+
+/* A component that assigns according to a provided index (which is
+ relative to the "low" value). */
+class ada_positional_component : public ada_component
+{
+public:
+
+ ada_positional_component (int index, operation_up &&op)
+ : m_index (index),
+ m_op (std::move (op))
+ {
+ }
+
+ void assign (struct value *container,
+ struct value *lhs, struct expression *exp,
+ std::vector<LONGEST> &indices,
+ LONGEST low, LONGEST high) override;
+
+ bool uses_objfile (struct objfile *objfile) override;
+
+ void dump (ui_file *stream, int depth) override;
+
+private:
+
+ int m_index;
+ operation_up m_op;
+};
+
+/* A component which handles an "others" clause. */
+class ada_others_component : public ada_component
+{
+public:
+
+ explicit ada_others_component (operation_up &&op)
+ : m_op (std::move (op))
+ {
+ }
+
+ void assign (struct value *container,
+ struct value *lhs, struct expression *exp,
+ std::vector<LONGEST> &indices,
+ LONGEST low, LONGEST high) override;
+
+ bool uses_objfile (struct objfile *objfile) override;
+
+ void dump (ui_file *stream, int depth) override;
+
+private:
+
+ operation_up m_op;
+};
+
+/* An interface that represents an association that is used in
+ aggregate assignment. */
+class ada_association
+{
+public:
+
+ /* Like ada_component::assign, but takes an operation as a
+ parameter. The operation is evaluated and then assigned into LHS
+ according to the rules of the concrete implementation. */
+ virtual void assign (struct value *container,
+ struct value *lhs,
+ struct expression *exp,
+ std::vector<LONGEST> &indices,
+ LONGEST low, LONGEST high,
+ operation_up &op) = 0;
+
+ /* Same as operation::uses_objfile. */
+ virtual bool uses_objfile (struct objfile *objfile) = 0;
+
+ /* Same as operation::dump. */
+ virtual void dump (ui_file *stream, int depth) = 0;
+
+ virtual ~ada_association () = default;
+
+protected:
+
+ ada_association () = default;
+ DISABLE_COPY_AND_ASSIGN (ada_association);
+};
+
+/* Unique pointer specialization for Ada assignment associations. */
+typedef std::unique_ptr<ada_association> ada_association_up;
+
+/* A component that holds a vector of associations and an operation.
+ The operation is re-evaluated for each choice. */
+class ada_choices_component : public ada_component
+{
+public:
+
+ explicit ada_choices_component (operation_up &&op)
+ : m_op (std::move (op))
+ {
+ }
+
+ /* Set the vector of associations. This is done separately from the
+ constructor because it was simpler for the implementation of the
+ parser. */
+ void set_associations (std::vector<ada_association_up> &&assoc)
+ {
+ m_assocs = std::move (assoc);
+ }
+
+ void assign (struct value *container,
+ struct value *lhs, struct expression *exp,
+ std::vector<LONGEST> &indices,
+ LONGEST low, LONGEST high) override;
+
+ bool uses_objfile (struct objfile *objfile) override;
+
+ void dump (ui_file *stream, int depth) override;
+
+private:
+
+ std::vector<ada_association_up> m_assocs;
+ operation_up m_op;
+};
+
+/* An association that uses a discrete range. */
+class ada_discrete_range_association : public ada_association
+{
+public:
+
+ ada_discrete_range_association (operation_up &&low, operation_up &&high)
+ : m_low (std::move (low)),
+ m_high (std::move (high))
+ {
+ }
+
+ void assign (struct value *container,
+ struct value *lhs, struct expression *exp,
+ std::vector<LONGEST> &indices,
+ LONGEST low, LONGEST high,
+ operation_up &op) override;
+
+ bool uses_objfile (struct objfile *objfile) override;
+
+ void dump (ui_file *stream, int depth) override;
+
+private:
+
+ operation_up m_low;
+ operation_up m_high;
+};
+
+/* An association that uses a name. The name may be an expression
+ that evaluates to an integer (for arrays), or an Ada string or
+ variable value operation. */
+class ada_name_association : public ada_association
+{
+public:
+
+ explicit ada_name_association (operation_up val)
+ : m_val (std::move (val))
+ {
+ }
+
+ void assign (struct value *container,
+ struct value *lhs, struct expression *exp,
+ std::vector<LONGEST> &indices,
+ LONGEST low, LONGEST high,
+ operation_up &op) override;
+
+ bool uses_objfile (struct objfile *objfile) override;
+
+ void dump (ui_file *stream, int depth) override;
+
+private:
+
+ operation_up m_val;
+};
+
} /* namespace expr */

#endif /* ADA_EXP_H */
diff --git a/gdb/ada-lang.c b/gdb/ada-lang.c
index fa323331047..f3f8642cf9d 100644
--- a/gdb/ada-lang.c
+++ b/gdb/ada-lang.c
@@ -9763,6 +9763,350 @@ aggregate_assign_others (struct value *container,
ada_evaluate_subexp (NULL, exp, pos, EVAL_SKIP);
}

+namespace expr
+{
+
+bool
+check_objfile (const std::unique_ptr<ada_component> &comp,
+ struct objfile *objfile)
+{
+ return comp->uses_objfile (objfile);
+}
+
+/* Assign the result of evaluating ARG starting at *POS 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). */
+
+static void
+assign_component (struct value *container, struct value *lhs, LONGEST index,
+ struct expression *exp, operation_up &arg)
+{
+ scoped_value_mark mark;
+
+ struct value *elt;
+ struct type *lhs_type = check_typedef (value_type (lhs));
+
+ if (lhs_type->code () == TYPE_CODE_ARRAY)
+ {
+ struct type *index_type = builtin_type (exp->gdbarch)->builtin_int;
+ struct value *index_val = value_from_longest (index_type, index);
+
+ elt = unwrap_value (ada_value_subscript (lhs, 1, &index_val));
+ }
+ else
+ {
+ elt = ada_index_struct_field (index, lhs, 0, value_type (lhs));
+ elt = ada_to_fixed_value (elt);
+ }
+
+ ada_aggregate_operation *ag_op
+ = dynamic_cast<ada_aggregate_operation *> (arg.get ());
+ if (ag_op != nullptr)
+ ag_op->assign_aggregate (container, elt, exp);
+ else
+ value_assign_to_component (container, elt,
+ arg->evaluate (nullptr, exp,
+ EVAL_NORMAL));
+}
+
+bool
+ada_aggregate_component::uses_objfile (struct objfile *objfile)
+{
+ for (const auto &item : m_components)
+ if (item->uses_objfile (objfile))
+ return true;
+ return false;
+}
+
+void
+ada_aggregate_component::dump (ui_file *stream, int depth)
+{
+ fprintf_filtered (stream, _("%*sAggregate\n"), depth, "");
+ for (const auto &item : m_components)
+ item->dump (stream, depth + 1);
+}
+
+void
+ada_aggregate_component::assign (struct value *container,
+ struct value *lhs, struct expression *exp,
+ std::vector<LONGEST> &indices,
+ LONGEST low, LONGEST high)
+{
+ for (auto &item : m_components)
+ item->assign (container, lhs, exp, indices, low, high);
+}
+
+void
+ada_aggregate_operation::assign_aggregate (struct value *container,
+ struct value *lhs,
+ struct expression *exp)
+{
+ struct type *lhs_type;
+ LONGEST low_index, high_index;
+
+ container = ada_coerce_ref (container);
+ if (ada_is_direct_array_type (value_type (container)))
+ container = ada_coerce_to_simple_array (container);
+ lhs = ada_coerce_ref (lhs);
+ if (!deprecated_value_modifiable (lhs))
+ error (_("Left operand of assignment is not a modifiable lvalue."));
+
+ lhs_type = check_typedef (value_type (lhs));
+ if (ada_is_direct_array_type (lhs_type))
+ {
+ lhs = ada_coerce_to_simple_array (lhs);
+ lhs_type = check_typedef (value_type (lhs));
+ low_index = lhs_type->bounds ()->low.const_val ();
+ high_index = lhs_type->bounds ()->high.const_val ();
+ }
+ else if (lhs_type->code () == TYPE_CODE_STRUCT)
+ {
+ low_index = 0;
+ high_index = num_visible_fields (lhs_type) - 1;
+ }
+ else
+ error (_("Left-hand side must be array or record."));
+
+ std::vector<LONGEST> indices (4);
+ indices[0] = indices[1] = low_index - 1;
+ indices[2] = indices[3] = high_index + 1;
+
+ std::get<0> (m_storage)->assign (container, lhs, exp, indices,
+ low_index, high_index);
+}
+
+bool
+ada_positional_component::uses_objfile (struct objfile *objfile)
+{
+ return m_op->uses_objfile (objfile);
+}
+
+void
+ada_positional_component::dump (ui_file *stream, int depth)
+{
+ fprintf_filtered (stream, _("%*sPositional, index = %d\n"),
+ depth, "", m_index);
+ m_op->dump (stream, depth + 1);
+}
+
+/* Assign into the component of LHS indexed by the OP_POSITIONAL
+ construct, given that the positions are relative to lower bound
+ LOW, where HIGH is the upper bound. Record the position in
+ INDICES. CONTAINER is as for assign_aggregate. */
+void
+ada_positional_component::assign (struct value *container,
+ struct value *lhs, struct expression *exp,
+ std::vector<LONGEST> &indices,
+ LONGEST low, LONGEST high)
+{
+ LONGEST ind = m_index + low;
+
+ if (ind - 1 == high)
+ warning (_("Extra components in aggregate ignored."));
+ if (ind <= high)
+ {
+ add_component_interval (ind, ind, indices);
+ assign_component (container, lhs, ind, exp, m_op);
+ }
+}
+
+bool
+ada_discrete_range_association::uses_objfile (struct objfile *objfile)
+{
+ return m_low->uses_objfile (objfile) || m_high->uses_objfile (objfile);
+}
+
+void
+ada_discrete_range_association::dump (ui_file *stream, int depth)
+{
+ fprintf_filtered (stream, _("%*sDiscrete range:\n"), depth, "");
+ m_low->dump (stream, depth + 1);
+ m_high->dump (stream, depth + 1);
+}
+
+void
+ada_discrete_range_association::assign (struct value *container,
+ struct value *lhs,
+ struct expression *exp,
+ std::vector<LONGEST> &indices,
+ LONGEST low, LONGEST high,
+ operation_up &op)
+{
+ LONGEST lower = value_as_long (m_low->evaluate (nullptr, exp, EVAL_NORMAL));
+ LONGEST upper = value_as_long (m_high->evaluate (nullptr, exp, EVAL_NORMAL));
+
+ if (lower <= upper && (lower < low || upper > high))
+ error (_("Index in component association out of bounds."));
+
+ add_component_interval (lower, upper, indices);
+ while (lower <= upper)
+ {
+ assign_component (container, lhs, lower, exp, op);
+ lower += 1;
+ }
+}
+
+bool
+ada_name_association::uses_objfile (struct objfile *objfile)
+{
+ return m_val->uses_objfile (objfile);
+}
+
+void
+ada_name_association::dump (ui_file *stream, int depth)
+{
+ fprintf_filtered (stream, _("%*sName:\n"), depth, "");
+ m_val->dump (stream, depth + 1);
+}
+
+void
+ada_name_association::assign (struct value *container,
+ struct value *lhs,
+ struct expression *exp,
+ std::vector<LONGEST> &indices,
+ LONGEST low, LONGEST high,
+ operation_up &op)
+{
+ int index;
+
+ if (ada_is_direct_array_type (value_type (lhs)))
+ index = longest_to_int (value_as_long (m_val->evaluate (nullptr, exp,
+ EVAL_NORMAL)));
+ else
+ {
+ ada_string_operation *strop
+ = dynamic_cast<ada_string_operation *> (m_val.get ());
+
+ const char *name;
+ if (strop != nullptr)
+ name = strop->get_name ();
+ else
+ {
+ ada_var_value_operation *vvo
+ = dynamic_cast<ada_var_value_operation *> (m_val.get ());
+ if (vvo != nullptr)
+ error (_("Invalid record component association."));
+ name = vvo->get_symbol ()->natural_name ();
+ }
+
+ index = 0;
+ if (! find_struct_field (name, value_type (lhs), 0,
+ NULL, NULL, NULL, NULL, &index))
+ error (_("Unknown component name: %s."), name);
+ }
+
+ add_component_interval (index, index, indices);
+ assign_component (container, lhs, index, exp, op);
+}
+
+bool
+ada_choices_component::uses_objfile (struct objfile *objfile)
+{
+ if (m_op->uses_objfile (objfile))
+ return true;
+ for (const auto &item : m_assocs)
+ if (item->uses_objfile (objfile))
+ return true;
+ return false;
+}
+
+void
+ada_choices_component::dump (ui_file *stream, int depth)
+{
+ fprintf_filtered (stream, _("%*sChoices:\n"), depth, "");
+ m_op->dump (stream, depth + 1);
+ for (const auto &item : m_assocs)
+ item->dump (stream, depth + 1);
+}
+
+/* Assign into the components of LHS indexed by the OP_CHOICES
+ construct at *POS, updating *POS past the construct, given that
+ the allowable indices are LOW..HIGH. Record the indices assigned
+ to in INDICES. CONTAINER is as for assign_aggregate. */
+void
+ada_choices_component::assign (struct value *container,
+ struct value *lhs, struct expression *exp,
+ std::vector<LONGEST> &indices,
+ LONGEST low, LONGEST high)
+{
+ for (auto &item : m_assocs)
+ item->assign (container, lhs, exp, indices, low, high, m_op);
+}
+
+bool
+ada_others_component::uses_objfile (struct objfile *objfile)
+{
+ return m_op->uses_objfile (objfile);
+}
+
+void
+ada_others_component::dump (ui_file *stream, int depth)
+{
+ fprintf_filtered (stream, _("%*sOthers:\n"), depth, "");
+ m_op->dump (stream, depth + 1);
+}
+
+/* Assign the value of the expression in the OP_OTHERS construct in
+ EXP at *POS into the components of LHS indexed from LOW .. HIGH that
+ have not been previously assigned. The index intervals already assigned
+ are in INDICES. CONTAINER is as for assign_aggregate. */
+void
+ada_others_component::assign (struct value *container,
+ struct value *lhs, struct expression *exp,
+ std::vector<LONGEST> &indices,
+ LONGEST low, LONGEST high)
+{
+ int num_indices = indices.size ();
+ for (int i = 0; i < num_indices - 2; i += 2)
+ {
+ for (LONGEST ind = indices[i + 1] + 1; ind < indices[i + 2]; ind += 1)
+ assign_component (container, lhs, ind, exp, m_op);
+ }
+}
+
+struct value *
+ada_assign_operation::evaluate (struct type *expect_type,
+ struct expression *exp,
+ enum noside noside)
+{
+ value *arg1 = std::get<0> (m_storage)->evaluate (nullptr, exp, noside);
+
+ ada_aggregate_operation *ag_op
+ = dynamic_cast<ada_aggregate_operation *> (std::get<1> (m_storage).get ());
+ if (ag_op != nullptr)
+ {
+ if (noside != EVAL_NORMAL)
+ return arg1;
+
+ ag_op->assign_aggregate (arg1, arg1, exp);
+ return ada_value_assign (arg1, arg1);
+ }
+ /* Force the evaluation of the rhs ARG2 to the type of the lhs ARG1,
+ except if the lhs of our assignment is a convenience variable.
+ In the case of assigning to a convenience variable, the lhs
+ should be exactly the result of the evaluation of the rhs. */
+ struct type *type = value_type (arg1);
+ if (VALUE_LVAL (arg1) == lval_internalvar)
+ type = NULL;
+ value *arg2 = std::get<1> (m_storage)->evaluate (type, exp, noside);
+ if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
+ return arg1;
+ if (VALUE_LVAL (arg1) == lval_internalvar)
+ {
+ /* Nothing. */
+ }
+ else if (ada_is_gnat_encoded_fixed_point_type (value_type (arg1)))
+ arg2 = cast_to_gnat_encoded_fixed_point_type (value_type (arg1), arg2);
+ else if (ada_is_gnat_encoded_fixed_point_type (value_type (arg2)))
+ error (_("Fixed-point values must be assigned to fixed-point variables"));
+ else
+ arg2 = coerce_for_assign (value_type (arg1), arg2);
+ return ada_value_assign (arg1, arg2);
+}
+
+} /* namespace expr */
+
/* Add the interval [LOW .. HIGH] to the sorted set of intervals
[ INDICES[0] .. INDICES[1] ],... The resulting intervals do not
overlap. */
diff --git a/gdb/expop.h b/gdb/expop.h
index de4b876de39..f433dd3d08f 100644
--- a/gdb/expop.h
+++ b/gdb/expop.h
@@ -206,6 +206,8 @@ extern struct value *eval_binop_assign_modify (struct type *expect_type,
namespace expr
{

+class ada_component;
+
/* The check_objfile overloads are used to check whether a particular
component of some operation references an objfile. The passed-in
objfile will never be a debug objfile. */
@@ -305,6 +307,9 @@ check_objfile (const std::pair<S, T> &item, struct objfile *objfile)
|| check_objfile (item.second, objfile));
}

+extern bool check_objfile (const std::unique_ptr<ada_component> &comp,
+ struct objfile *objfile);
+
static inline void
dump_for_expression (struct ui_file *stream, int depth,
const operation_up &op)
@@ -336,6 +341,8 @@ extern void dump_for_expression (struct ui_file *stream, int depth,
enum range_flag flags);
extern void dump_for_expression (struct ui_file *stream, int depth,
objfile *objf);
+extern void dump_for_expression (struct ui_file *stream, int depth,
+ const std::unique_ptr<ada_component> &comp);

template<typename T>
void
diff --git a/gdb/expprint.c b/gdb/expprint.c
index 0f4c8602f1c..ac954d2980d 100644
--- a/gdb/expprint.c
+++ b/gdb/expprint.c
@@ -32,6 +32,7 @@
#include "cli/cli-style.h"
#include "c-lang.h"
#include "expop.h"
+#include "ada-exp.h"

#include <ctype.h>

@@ -1276,6 +1277,13 @@ dump_for_expression (struct ui_file *stream, int depth,
fprintf_filtered (stream, "\n");
}

+void
+dump_for_expression (struct ui_file *stream, int depth,
+ const std::unique_ptr<ada_component> &comp)
+{
+ comp->dump (stream, depth);
+}
+
void
float_const_operation::dump (struct ui_file *stream, int depth) const
{
--
2.26.2