[PATCH] Implement Ada target name symbol

[Tom Tromey <tromey@adacore.com>]

Ada 2022 adds the "target name symbol", which can be used on the right
hand side of an assignment to refer to the left hand side.  This
allows for convenient updates.  This patch implements this for gdb's
Ada expression parser.
---
 gdb/NEWS                           |  3 ++
 gdb/ada-exp.h                      | 60 ++++++++++++++++++++++++++++++
 gdb/ada-exp.y                      | 41 ++++++++++++++++----
 gdb/ada-lang.c                     |  1 +
 gdb/testsuite/gdb.ada/assign_1.exp | 15 ++++++++
 5 files changed, 113 insertions(+), 7 deletions(-)

diff --git a/gdb/NEWS b/gdb/NEWS
index fd42864c692..4a07a776580 100644
--- a/gdb/NEWS
+++ b/gdb/NEWS
@@ -78,6 +78,9 @@
   functionality is also available for dprintf when dprintf-style is
   'gdb'.
 
+* The Ada 2022 target name symbol ('@') is now supported by the Ada
+  expression parser.
+
 * New commands
 
 maintenance print record-instruction [ N ]
diff --git a/gdb/ada-exp.h b/gdb/ada-exp.h
index 54ae4529def..efe9302228c 100644
--- a/gdb/ada-exp.h
+++ b/gdb/ada-exp.h
@@ -529,6 +529,66 @@ class ada_assign_operation
 
   enum exp_opcode opcode () const override
   { return BINOP_ASSIGN; }
+
+  value *current ()
+  { return m_current; }
+
+  /* A helper function for the parser to evaluate just the LHS of the
+     assignment.  */
+  value *eval_for_resolution (struct expression *exp)
+  {
+    return std::get<0> (m_storage)->evaluate (nullptr, exp,
+					      EVAL_AVOID_SIDE_EFFECTS);
+  }
+
+  /* The parser must construct the assignment node before parsing the
+     RHS, so that '@' can access the assignment, so this helper
+     function is needed to set the RHS after construction.  */
+  void set_rhs (operation_up rhs)
+  {
+    std::get<1> (m_storage) = std::move (rhs);
+  }
+
+private:
+
+  /* Temporary storage for the value of the left-hand-side.  */
+  value *m_current = nullptr;
+};
+
+/* Implement the Ada target name symbol ('@').  This is used to refer
+   to the LHS of an assignment from the RHS.  */
+class ada_target_operation : public operation
+{
+public:
+
+  explicit ada_target_operation (ada_assign_operation *lhs)
+    : m_lhs (lhs)
+  { }
+
+  value *evaluate (struct type *expect_type,
+		   struct expression *exp,
+		   enum noside noside) override
+  {
+    if (noside == EVAL_AVOID_SIDE_EFFECTS)
+      return m_lhs->eval_for_resolution (exp);
+    return m_lhs->current ();
+  }
+
+  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
+  {
+    gdb_printf (stream, _("%*sAda target symbol '@'\n"), depth, "");
+  }
+
+private:
+
+  /* The left hand side of the assignment.  */
+  ada_assign_operation *m_lhs;
 };
 
 /* This abstract class represents a single component in an Ada
diff --git a/gdb/ada-exp.y b/gdb/ada-exp.y
index 23aebf0e236..4aa38ce83c3 100644
--- a/gdb/ada-exp.y
+++ b/gdb/ada-exp.y
@@ -415,6 +415,13 @@ make_tick_completer (struct stoken tok)
 	  (new ada_tick_completer (std::string (tok.ptr, tok.length))));
 }
 
+/* A convenience typedef.  */
+typedef std::unique_ptr<ada_assign_operation> ada_assign_up;
+
+/* The stack of currently active assignment expressions.  This is used
+   to implement '@', the target name symbol.  */
+static std::vector<ada_assign_up> assignments;
+
 %}
 
 %union
@@ -492,17 +499,25 @@ start   :	exp1
 exp1	:	exp
 	|	exp1 ';' exp
 			{ ada_wrap2<comma_operation> (BINOP_COMMA); }
-	| 	primary ASSIGN exp   /* Extension for convenience */
+	| 	primary ASSIGN
+			{
+			  assignments.emplace_back
+			    (new ada_assign_operation (ada_pop (), nullptr));
+			}
+		exp   /* Extension for convenience */
 			{
+			  ada_assign_up assign
+			    = std::move (assignments.back ());
+			  assignments.pop_back ();
+			  value *lhs_val = (assign->eval_for_resolution
+					    (pstate->expout.get ()));
+
 			  operation_up rhs = pstate->pop ();
-			  operation_up lhs = ada_pop ();
-			  value *lhs_val
-			    = lhs->evaluate (nullptr, pstate->expout.get (),
-					     EVAL_AVOID_SIDE_EFFECTS);
 			  rhs = resolve (std::move (rhs), true,
 					 lhs_val->type ());
-			  pstate->push_new<ada_assign_operation>
-			    (std::move (lhs), std::move (rhs));
+
+			  assign->set_rhs (std::move (rhs));
+			  pstate->push (std::move (assign));
 			}
 	;
 
@@ -602,6 +617,17 @@ primary :     	aggregate
 			}
 	;        
 
+primary :	'@'
+			{
+			  if (assignments.empty ())
+			    error (_("the target name symbol ('@') may only "
+				     "appear in an assignment context"));
+			  ada_assign_operation *current
+			    = assignments.back ().get ();
+			  pstate->push_new<ada_target_operation> (current);
+			}
+	;
+
 simple_exp : 	primary
 	;
 
@@ -1158,6 +1184,7 @@ ada_parse (struct parser_state *par_state)
   components.clear ();
   associations.clear ();
   int_storage.clear ();
+  assignments.clear ();
 
   int result = yyparse ();
   if (!result)
diff --git a/gdb/ada-lang.c b/gdb/ada-lang.c
index 8e506bd4f2b..658cca44694 100644
--- a/gdb/ada-lang.c
+++ b/gdb/ada-lang.c
@@ -9660,6 +9660,7 @@ ada_assign_operation::evaluate (struct type *expect_type,
 				enum noside noside)
 {
   value *arg1 = std::get<0> (m_storage)->evaluate (nullptr, exp, noside);
+  scoped_restore save_lhs = make_scoped_restore (&m_current, arg1);
 
   ada_aggregate_operation *ag_op
     = dynamic_cast<ada_aggregate_operation *> (std::get<1> (m_storage).get ());
diff --git a/gdb/testsuite/gdb.ada/assign_1.exp b/gdb/testsuite/gdb.ada/assign_1.exp
index d5d81281e46..7d5f0b0b6d7 100644
--- a/gdb/testsuite/gdb.ada/assign_1.exp
+++ b/gdb/testsuite/gdb.ada/assign_1.exp
@@ -29,3 +29,18 @@ gdb_test "print \$xxx := 1" \
          "set convenience variable \$xxx to 1"
 
 
+gdb_test "print \$xxx := @ + 23 + @" \
+    " = 25" \
+    "update convenience using '@'"
+
+gdb_test "print \$y := 1" " = 1" "set y"
+
+gdb_test "print \$xxx := @ + (\$y := 1 + @)" \
+    " = 27" \
+    "nested assignment"
+
+gdb_test "print \$y" " = 2" "value of y after nested assignment"
+
+gdb_test "print 23 + @" \
+    "may only appear in an assignment context" \
+    "invalid use of '@' causes error"
-- 
2.40.1