[PATCH 0/5] Fix Ada expression regressions

[PATCH 0/5] Fix Ada expression regressions

[Tom Tromey]

The expression rewrite caused some regressions in the internal AdaCore
test suite.  This series fixes all the problems I found.

These are all Ada-specific.

Tested on x86-64 Fedora 32.

Tom

[PATCH 1/5] Fix bug in Ada aggregate assignment

[Tom Tromey]

The expression rewrite caused a regression in the internal AdaCore
test suite.  The bug was that I had dropped a bit of code from
aggregate assignment -- assign_aggregate used to return the container,
which I thought was redundant, but which can actually change during
the call.  There was no test for this case in the tree, so I've added
one.

gdb/ChangeLog
2021-03-10  Tom Tromey  <tromey@adacore.com>

	* ada-lang.c (ada_aggregate_operation::assign_aggregate): Return
	container.
	(ada_assign_operation::evaluate): Update.
	* ada-exp.h (class ada_aggregate_operation) <assign_aggregate>:
	Change return type.

gdb/testsuite/ChangeLog
2021-03-10  Tom Tromey  <tromey@adacore.com>

	* gdb.ada/assign_arr/target_wrapper.ads (IArray, Put, Do_Nothing):
	Declare.
	* gdb.ada/assign_arr/target_wrapper.adb: New file.
	* gdb.ada/assign_arr/main_p324_051.adb (IValue): New variable.
	Call Put.
	* gdb.ada/assign_arr.exp: Update.
---
 gdb/ChangeLog                                 |  8 ++++++
 gdb/ada-exp.h                                 |  9 +++---
 gdb/ada-lang.c                                | 12 ++++----
 gdb/testsuite/ChangeLog                       |  9 ++++++
 gdb/testsuite/gdb.ada/assign_arr.exp          |  7 +++++
 .../gdb.ada/assign_arr/main_p324_051.adb      |  2 ++
 .../gdb.ada/assign_arr/target_wrapper.adb     | 28 +++++++++++++++++++
 .../gdb.ada/assign_arr/target_wrapper.ads     |  8 ++++++
 8 files changed, 72 insertions(+), 11 deletions(-)
 create mode 100644 gdb/testsuite/gdb.ada/assign_arr/target_wrapper.adb

diff --git a/gdb/ada-exp.h b/gdb/ada-exp.h
index 0b6f1f22e79..82941dd0634 100644
--- a/gdb/ada-exp.h
+++ b/gdb/ada-exp.h
@@ -510,11 +510,12 @@ class ada_aggregate_operation
      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).  */
+     contents of LHS (unless == CONTAINER).  Returns the modified
+     CONTAINER.  */
 
-  void assign_aggregate (struct value *container,
-			 struct value *lhs,
-			 struct expression *exp);
+  value *assign_aggregate (struct value *container,
+			   struct value *lhs,
+			   struct expression *exp);
 
   value *evaluate (struct type *expect_type,
 		   struct expression *exp,
diff --git a/gdb/ada-lang.c b/gdb/ada-lang.c
index 8330cbcc0b9..7e53ae07c18 100644
--- a/gdb/ada-lang.c
+++ b/gdb/ada-lang.c
@@ -9101,13 +9101,9 @@ ada_aggregate_component::assign (struct value *container,
     item->assign (container, lhs, exp, indices, low, high);
 }
 
-/* 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).  */
+/* See ada-exp.h.  */
 
-void
+value *
 ada_aggregate_operation::assign_aggregate (struct value *container,
 					   struct value *lhs,
 					   struct expression *exp)
@@ -9144,6 +9140,8 @@ ada_aggregate_operation::assign_aggregate (struct value *container,
 
   std::get<0> (m_storage)->assign (container, lhs, exp, indices,
 				   low_index, high_index);
+
+  return container;
 }
 
 bool
@@ -9349,7 +9347,7 @@ ada_assign_operation::evaluate (struct type *expect_type,
       if (noside != EVAL_NORMAL)
 	return arg1;
 
-      ag_op->assign_aggregate (arg1, arg1, exp);
+      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,
diff --git a/gdb/testsuite/gdb.ada/assign_arr.exp b/gdb/testsuite/gdb.ada/assign_arr.exp
index ca894f057e2..08090271afc 100644
--- a/gdb/testsuite/gdb.ada/assign_arr.exp
+++ b/gdb/testsuite/gdb.ada/assign_arr.exp
@@ -33,3 +33,10 @@ gdb_test "print assign_arr_input.u2 :=(0.25,0.5,0.75)" \
 
 gdb_test "print assign_arr_input.u2 :=(0.25, others => 0.125)" \
          " = \\(0\\.25, 0\\.125, 0\\.125\\)"
+
+set line [gdb_get_line_number "STOP2" ${testdir}/target_wrapper.adb]
+gdb_breakpoint target_wrapper.adb:$line
+gdb_continue_to_breakpoint STOP2
+
+gdb_test "print a" " = \\(8, 10, 12\\)"
+gdb_test "print a := (2, 4, 6)" " = \\(2, 4, 6\\)" "assign to a"
diff --git a/gdb/testsuite/gdb.ada/assign_arr/main_p324_051.adb b/gdb/testsuite/gdb.ada/assign_arr/main_p324_051.adb
index f140118704e..f352d91cdf9 100644
--- a/gdb/testsuite/gdb.ada/assign_arr/main_p324_051.adb
+++ b/gdb/testsuite/gdb.ada/assign_arr/main_p324_051.adb
@@ -16,6 +16,8 @@
 with target_wrapper; use target_wrapper;
 
 procedure Main_P324_051 is
+   IValue : IArray (1 .. 3) := (8, 10, 12);
 begin
    Assign_Arr_Input.u2 := (0.2,0.3,0.4);  -- STOP
+   Put (IValue);
 end Main_P324_051;
diff --git a/gdb/testsuite/gdb.ada/assign_arr/target_wrapper.adb b/gdb/testsuite/gdb.ada/assign_arr/target_wrapper.adb
new file mode 100644
index 00000000000..888c5e4a5c3
--- /dev/null
+++ b/gdb/testsuite/gdb.ada/assign_arr/target_wrapper.adb
@@ -0,0 +1,28 @@
+--  Copyright 2021 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 target_wrapper is
+
+   procedure Do_Nothing (A : System.Address) is
+   begin
+      null;
+   end Do_Nothing;
+
+   procedure Put (A : in out IArray) is
+   begin
+      Do_Nothing (A'Address); -- STOP2
+   end Put;
+
+end target_wrapper;
diff --git a/gdb/testsuite/gdb.ada/assign_arr/target_wrapper.ads b/gdb/testsuite/gdb.ada/assign_arr/target_wrapper.ads
index 24bb1f56e4a..743964a2ecd 100644
--- a/gdb/testsuite/gdb.ada/assign_arr/target_wrapper.ads
+++ b/gdb/testsuite/gdb.ada/assign_arr/target_wrapper.ads
@@ -13,6 +13,8 @@
 --  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 target_wrapper is
 
    type Float_Array_3 is array (1 .. 3) of Float;
@@ -23,4 +25,10 @@ package target_wrapper is
 
    Assign_Arr_Input : parameters;
 
+   type IArray is array (Integer range <>) of Integer;
+
+   procedure Put (A : in out IArray);
+
+   procedure Do_Nothing (A : System.Address);
+
 end target_wrapper;
-- 
2.26.2

[PATCH 2/5] Fix Ada assignment resolution

[Tom Tromey]

The expression rewrite missed an Ada resolution case.  GDB previously
knew how to disambiguate the right hand side of an assignment, but now
it does not.

This patch fixes the problem and adds the missing test case.

gdb/ChangeLog
2021-03-10  Tom Tromey  <tromey@adacore.com>

	* ada-exp.y (exp1): Handle resolution of the right hand side of an
	assignment.

gdb/testsuite/ChangeLog
2021-03-10  Tom Tromey  <tromey@adacore.com>

	* gdb.ada/enums_overload/enums_overload_main.adb: New file.
	* gdb.ada/enums_overload/enums_overload.ads: New file.
	* gdb.ada/enums_overload/enums_overload.adb: New file.
	* gdb.ada/enums_overload.exp: New file.
---
 gdb/ChangeLog                                 |  5 +++
 gdb/ada-exp.y                                 | 12 +++++-
 gdb/testsuite/ChangeLog                       |  7 ++++
 gdb/testsuite/gdb.ada/enums_overload.exp      | 37 ++++++++++++++++++
 .../gdb.ada/enums_overload/enums_overload.adb | 38 +++++++++++++++++++
 .../gdb.ada/enums_overload/enums_overload.ads | 24 ++++++++++++
 .../enums_overload/enums_overload_main.adb    | 20 ++++++++++
 7 files changed, 142 insertions(+), 1 deletion(-)
 create mode 100644 gdb/testsuite/gdb.ada/enums_overload.exp
 create mode 100644 gdb/testsuite/gdb.ada/enums_overload/enums_overload.adb
 create mode 100644 gdb/testsuite/gdb.ada/enums_overload/enums_overload.ads
 create mode 100644 gdb/testsuite/gdb.ada/enums_overload/enums_overload_main.adb

diff --git a/gdb/ada-exp.y b/gdb/ada-exp.y
index 222fec536f3..4300907685c 100644
--- a/gdb/ada-exp.y
+++ b/gdb/ada-exp.y
@@ -413,7 +413,17 @@ exp1	:	exp
 	|	exp1 ';' exp
 			{ ada_wrap2<comma_operation> (); }
 	| 	primary ASSIGN exp   /* Extension for convenience */
-			{ ada_wrap2<ada_assign_operation> (); }
+			{
+			  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,
+					 value_type (lhs_val));
+			  pstate->push_new<ada_assign_operation>
+			    (std::move (lhs), std::move (rhs));
+			}
 	;
 
 /* Expressions, not including the sequencing operator.  */
diff --git a/gdb/testsuite/gdb.ada/enums_overload.exp b/gdb/testsuite/gdb.ada/enums_overload.exp
new file mode 100644
index 00000000000..165ee1e1147
--- /dev/null
+++ b/gdb/testsuite/gdb.ada/enums_overload.exp
@@ -0,0 +1,37 @@
+# Copyright 2021 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"
+
+if { [skip_ada_tests] } { return -1 }
+
+standard_ada_testfile enums_overload_main
+
+if {[gdb_compile_ada "${srcfile}" "${binfile}" executable [list debug]] != "" } {
+  return -1
+}
+
+clean_restart ${testfile}
+
+set bp_location [gdb_get_line_number "STOP" ${testdir}/enums_overload.adb]
+runto "enums_overload.adb:$bp_location"
+
+gdb_test "ptype x" "type = range red \\.\\. yellow"
+gdb_test "print x := red" " = red"
+gdb_test "print x" " = red"
+gdb_test "print enums_overload.reddish'(red)" " = red" \
+    "function call disambiguates enum"
+gdb_test "print y := red" " = red"
+gdb_test "print y" " = red"
diff --git a/gdb/testsuite/gdb.ada/enums_overload/enums_overload.adb b/gdb/testsuite/gdb.ada/enums_overload/enums_overload.adb
new file mode 100644
index 00000000000..a245d58b24d
--- /dev/null
+++ b/gdb/testsuite/gdb.ada/enums_overload/enums_overload.adb
@@ -0,0 +1,38 @@
+--  Copyright 2021 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 Enums_Overload is
+
+   subtype Reddish is Color range Red .. Yellow;
+
+   procedure Test_Enums_Overload is
+      X: Reddish := Orange;
+      Y: Traffic_Signal := Yellow;
+   begin
+      --gdb: next
+      X := Orange;
+      --gdb: next
+      Y := Yellow;
+      --gdb: ptype x range red .. yellow
+      --gdb: set x := red
+      --gdb: print x red
+      --gdb: print enums_overload.reddish'(red) red
+      --gdb: set y := red
+      --gdb: print y red
+      --gdb: cont
+      null; -- STOP
+   end Test_Enums_Overload;
+
+end Enums_Overload;
diff --git a/gdb/testsuite/gdb.ada/enums_overload/enums_overload.ads b/gdb/testsuite/gdb.ada/enums_overload/enums_overload.ads
new file mode 100644
index 00000000000..f3158fa1509
--- /dev/null
+++ b/gdb/testsuite/gdb.ada/enums_overload/enums_overload.ads
@@ -0,0 +1,24 @@
+--  Copyright 2021 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 Enums_Overload is
+
+   type Color is (Red, Orange, Yellow, Green, Blue, Violet, Indigo);
+
+   type Traffic_Signal is (Green, Yellow, Red);
+
+   procedure Test_Enums_Overload;
+
+end Enums_Overload;
diff --git a/gdb/testsuite/gdb.ada/enums_overload/enums_overload_main.adb b/gdb/testsuite/gdb.ada/enums_overload/enums_overload_main.adb
new file mode 100644
index 00000000000..954243337ec
--- /dev/null
+++ b/gdb/testsuite/gdb.ada/enums_overload/enums_overload_main.adb
@@ -0,0 +1,20 @@
+--  Copyright 2021 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 Enums_Overload;
+procedure Enums_Overload_Main is
+begin
+   Enums_Overload.Test_Enums_Overload;
+end Enums_Overload_Main;
-- 
2.26.2

[PATCH 3/5] Fix regression in Ada ptype

[Tom Tromey]

This fixes PR ada/27545, which points out that a test in
gdb.ada/tagged.exp started failing due to the expression rewrite.  I
didn't notice this failure because my system gcc-gnat debuginfo was
out of date, and so the test was already failing in the baseline.

Previously, the OP_VAR_VALUE case in ada_evaluate_subexp ended up
doing a recursive call:

    arg1 = evaluate_subexp (nullptr, exp, pos, EVAL_NORMAL);

However, during the rewrite I missed this fact and had the new code
call the superclass implementation.

This patch fixes the bug by changing this code to use a recursive call
instead.

gdb/ChangeLog
2021-03-10  Tom Tromey  <tromey@adacore.com>

	PR ada/27545:
	* ada-lang.c (ada_var_value_operation::evaluate): Use recursive
	call for tagged type.
---
 gdb/ChangeLog  | 6 ++++++
 gdb/ada-lang.c | 3 +--
 2 files changed, 7 insertions(+), 2 deletions(-)

diff --git a/gdb/ada-lang.c b/gdb/ada-lang.c
index 7e53ae07c18..38f4ec0452b 100644
--- a/gdb/ada-lang.c
+++ b/gdb/ada-lang.c
@@ -10320,8 +10320,7 @@ ada_var_value_operation::evaluate (struct type *expect_type,
 	     a fixed type would result in the loss of that type name,
 	     thus preventing us from printing the name of the ancestor
 	     type in the type description.  */
-	  value *arg1 = var_value_operation::evaluate (nullptr, exp,
-						       EVAL_NORMAL);
+	  value *arg1 = evaluate (nullptr, exp, EVAL_NORMAL);
 
 	  if (type->code () != TYPE_CODE_REF)
 	    {
-- 
2.26.2

[PATCH 4/5] Implement Ada operator overloading

[Tom Tromey]

In the expression rewrite, I neglected to carry over support for Ada
operator overloading.  It turns out that there were no tests for this
in-tree.

This patch adds support for operator overloading, and adds the missing
test.

gdb/ChangeLog
2021-03-10  Tom Tromey  <tromey@adacore.com>

	* ada-lang.c (numeric_type_p, integer_type_p): Return true for
	fixed-point.
	* ada-exp.y (maybe_overload): New function.
	(ada_wrap_overload): New function.
	(ada_un_wrap2, ada_wrap2, ada_wrap_op): Use maybe_overload.
	(exp1, simple_exp, relation, and_exp, and_then_exp, or_exp)
	(or_else_exp, xor_exp, primary): Update.

gdb/testsuite/ChangeLog
2021-03-10  Tom Tromey  <tromey@adacore.com>

	* gdb.ada/operator_call/twovecs.ads: New file.
	* gdb.ada/operator_call/twovecs.adb: New file.
	* gdb.ada/operator_call/opcall.adb: New file.
	* gdb.ada/operator_call.exp: New file.
---
 gdb/ChangeLog                                 |  10 ++
 gdb/ada-exp.y                                 | 155 ++++++++++++++----
 gdb/ada-lang.c                                |   2 +
 gdb/testsuite/ChangeLog                       |   7 +
 gdb/testsuite/gdb.ada/operator_call.exp       | 115 +++++++++++++
 .../gdb.ada/operator_call/opcall.adb          |  25 +++
 .../gdb.ada/operator_call/twovecs.adb         | 133 +++++++++++++++
 .../gdb.ada/operator_call/twovecs.ads         |  55 +++++++
 8 files changed, 467 insertions(+), 35 deletions(-)
 create mode 100644 gdb/testsuite/gdb.ada/operator_call.exp
 create mode 100644 gdb/testsuite/gdb.ada/operator_call/opcall.adb
 create mode 100644 gdb/testsuite/gdb.ada/operator_call/twovecs.adb
 create mode 100644 gdb/testsuite/gdb.ada/operator_call/twovecs.ads

diff --git a/gdb/ada-exp.y b/gdb/ada-exp.y
index 4300907685c..e8ffb8e1040 100644
--- a/gdb/ada-exp.y
+++ b/gdb/ada-exp.y
@@ -166,17 +166,77 @@ ada_addrof (struct type *type = nullptr)
   pstate->push (std::move (wrapped));
 }
 
+/* Handle operator overloading.  Either returns a function all
+   operation wrapping the arguments, or it returns null, leaving the
+   caller to construct the appropriate operation.  If RHS is null, a
+   unary operator is assumed.  */
+static operation_up
+maybe_overload (enum exp_opcode op, operation_up &lhs, operation_up &rhs)
+{
+  struct value *args[2];
+
+  int nargs = 1;
+  args[0] = lhs->evaluate (nullptr, pstate->expout.get (),
+			   EVAL_AVOID_SIDE_EFFECTS);
+  if (rhs == nullptr)
+    args[1] = nullptr;
+  else
+    {
+      args[1] = rhs->evaluate (nullptr, pstate->expout.get (),
+			       EVAL_AVOID_SIDE_EFFECTS);
+      ++nargs;
+    }
+
+  block_symbol fn = ada_find_operator_symbol (op, pstate->parse_completion,
+					      nargs, args);
+  if (fn.symbol == nullptr)
+    return {};
+
+  if (symbol_read_needs_frame (fn.symbol))
+    pstate->block_tracker->update (fn.block, INNERMOST_BLOCK_FOR_SYMBOLS);
+  operation_up callee
+    = make_operation<ada_var_value_operation> (fn.symbol, fn.block);
+
+  std::vector<operation_up> argvec;
+  argvec.push_back (std::move (lhs));
+  if (rhs != nullptr)
+    argvec.push_back (std::move (rhs));
+  return make_operation<ada_funcall_operation> (std::move (callee),
+						std::move (argvec));
+}
+
+/* Like parser_state::wrap, but use ada_pop to pop the value, and
+   handle unary overloading.  */
+template<typename T>
+void
+ada_wrap_overload (enum exp_opcode op)
+{
+  operation_up arg = ada_pop ();
+  operation_up empty;
+
+  operation_up call = maybe_overload (op, arg, empty);
+  if (call == nullptr)
+    call = make_operation<T> (std::move (arg));
+  pstate->push (std::move (call));
+}
+
 /* A variant of parser_state::wrap2 that uses ada_pop to pop both
    operands, and then pushes a new Ada-wrapped operation of the
    template type T.  */
 template<typename T>
 void
-ada_un_wrap2 ()
+ada_un_wrap2 (enum exp_opcode op)
 {
   operation_up rhs = ada_pop ();
   operation_up lhs = ada_pop ();
-  operation_up wrapped = make_operation<T> (std::move (lhs), std::move (rhs));
-  pstate->push_new<ada_wrapped_operation> (std::move (wrapped));
+
+  operation_up wrapped = maybe_overload (op, lhs, rhs);
+  if (wrapped == nullptr)
+    {
+      wrapped = make_operation<T> (std::move (lhs), std::move (rhs));
+      wrapped = make_operation<ada_wrapped_operation> (std::move (wrapped));
+    }
+  pstate->push (std::move (wrapped));
 }
 
 /* A variant of parser_state::wrap2 that uses ada_pop to pop both
@@ -184,11 +244,14 @@ ada_un_wrap2 ()
    used.  */
 template<typename T>
 void
-ada_wrap2 ()
+ada_wrap2 (enum exp_opcode op)
 {
   operation_up rhs = ada_pop ();
   operation_up lhs = ada_pop ();
-  pstate->push_new<T> (std::move (lhs), std::move (rhs));
+  operation_up call = maybe_overload (op, lhs, rhs);
+  if (call == nullptr)
+    call = make_operation<T> (std::move (lhs), std::move (rhs));
+  pstate->push (std::move (call));
 }
 
 /* A variant of parser_state::wrap2 that uses ada_pop to pop both
@@ -200,7 +263,10 @@ ada_wrap_op (enum exp_opcode op)
 {
   operation_up rhs = ada_pop ();
   operation_up lhs = ada_pop ();
-  pstate->push_new<T> (op, std::move (lhs), std::move (rhs));
+  operation_up call = maybe_overload (op, lhs, rhs);
+  if (call == nullptr)
+    call = make_operation<T> (op, std::move (lhs), std::move (rhs));
+  pstate->push (std::move (call));
 }
 
 /* Pop three operands using ada_pop, then construct a new ternary
@@ -411,7 +477,7 @@ start   :	exp1
 /* Expressions, including the sequencing operator.  */
 exp1	:	exp
 	|	exp1 ';' exp
-			{ ada_wrap2<comma_operation> (); }
+			{ ada_wrap2<comma_operation> (BINOP_COMMA); }
 	| 	primary ASSIGN exp   /* Extension for convenience */
 			{
 			  operation_up rhs = pstate->pop ();
@@ -515,21 +581,32 @@ simple_exp : 	primary
 	;
 
 simple_exp :	'-' simple_exp    %prec UNARY
-			{ ada_wrap<ada_neg_operation> (); }
+			{ ada_wrap_overload<ada_neg_operation> (UNOP_NEG); }
 	;
 
 simple_exp :	'+' simple_exp    %prec UNARY
 			{
-			  /* No need to do anything.  */
+			  operation_up arg = ada_pop ();
+			  operation_up empty;
+
+			  /* We only need to handle the overloading
+			     case here, not anything else.  */
+			  operation_up call = maybe_overload (UNOP_PLUS, arg,
+							      empty);
+			  if (call != nullptr)
+			    pstate->push (std::move (call));
 			}
 	;
 
 simple_exp :	NOT simple_exp    %prec UNARY
-			{ ada_wrap<unary_logical_not_operation> (); }
+			{
+			  ada_wrap_overload<unary_logical_not_operation>
+			    (UNOP_LOGICAL_NOT);
+			}
 	;
 
 simple_exp :    ABS simple_exp	   %prec UNARY
-			{ ada_wrap<ada_abs_operation> (); }
+			{ ada_wrap_overload<ada_abs_operation> (UNOP_ABS); }
 	;
 
 arglist	:		{ $$ = 0; }
@@ -559,27 +636,27 @@ primary :	'{' var_or_type '}' primary  %prec '.'
 /* Binary operators in order of decreasing precedence.  */
 
 simple_exp 	: 	simple_exp STARSTAR simple_exp
-			{ ada_wrap2<ada_binop_exp_operation> (); }
+			{ ada_wrap2<ada_binop_exp_operation> (BINOP_EXP); }
 	;
 
 simple_exp	:	simple_exp '*' simple_exp
-			{ ada_wrap2<ada_binop_mul_operation> (); }
+			{ ada_wrap2<ada_binop_mul_operation> (BINOP_MUL); }
 	;
 
 simple_exp	:	simple_exp '/' simple_exp
-			{ ada_wrap2<ada_binop_div_operation> (); }
+			{ ada_wrap2<ada_binop_div_operation> (BINOP_DIV); }
 	;
 
 simple_exp	:	simple_exp REM simple_exp /* May need to be fixed to give correct Ada REM */
-			{ ada_wrap2<ada_binop_rem_operation> (); }
+			{ ada_wrap2<ada_binop_rem_operation> (BINOP_REM); }
 	;
 
 simple_exp	:	simple_exp MOD simple_exp
-			{ ada_wrap2<ada_binop_mod_operation> (); }
+			{ ada_wrap2<ada_binop_mod_operation> (BINOP_MOD); }
 	;
 
 simple_exp	:	simple_exp '@' simple_exp	/* GDB extension */
-			{ ada_wrap2<repeat_operation> (); }
+			{ ada_wrap2<repeat_operation> (BINOP_REPEAT); }
 	;
 
 simple_exp	:	simple_exp '+' simple_exp
@@ -587,7 +664,7 @@ simple_exp	:	simple_exp '+' simple_exp
 	;
 
 simple_exp	:	simple_exp '&' simple_exp
-			{ ada_wrap2<concat_operation> (); }
+			{ ada_wrap2<concat_operation> (BINOP_CONCAT); }
 	;
 
 simple_exp	:	simple_exp '-' simple_exp
@@ -606,7 +683,7 @@ relation :	simple_exp NOTEQUAL simple_exp
 	;
 
 relation :	simple_exp LEQ simple_exp
-			{ ada_un_wrap2<leq_operation> (); }
+			{ ada_un_wrap2<leq_operation> (BINOP_LEQ); }
 	;
 
 relation :	simple_exp IN simple_exp DOTDOT simple_exp
@@ -649,15 +726,15 @@ relation :	simple_exp IN simple_exp DOTDOT simple_exp
 	;
 
 relation :	simple_exp GEQ simple_exp
-			{ ada_un_wrap2<geq_operation> (); }
+			{ ada_un_wrap2<geq_operation> (BINOP_GEQ); }
 	;
 
 relation :	simple_exp '<' simple_exp
-			{ ada_un_wrap2<less_operation> (); }
+			{ ada_un_wrap2<less_operation> (BINOP_LESS); }
 	;
 
 relation :	simple_exp '>' simple_exp
-			{ ada_un_wrap2<gtr_operation> (); }
+			{ ada_un_wrap2<gtr_operation> (BINOP_GTR); }
 	;
 
 exp	:	relation
@@ -670,36 +747,44 @@ exp	:	relation
 
 and_exp :
 		relation _AND_ relation 
-			{ ada_wrap2<ada_bitwise_and_operation> (); }
+			{ ada_wrap2<ada_bitwise_and_operation>
+			    (BINOP_BITWISE_AND); }
 	|	and_exp _AND_ relation
-			{ ada_wrap2<ada_bitwise_and_operation> (); }
+			{ ada_wrap2<ada_bitwise_and_operation>
+			    (BINOP_BITWISE_AND); }
 	;
 
 and_then_exp :
 	       relation _AND_ THEN relation
-			{ ada_wrap2<logical_and_operation> (); }
+			{ ada_wrap2<logical_and_operation>
+			    (BINOP_LOGICAL_AND); }
 	|	and_then_exp _AND_ THEN relation
-			{ ada_wrap2<logical_and_operation> (); }
+			{ ada_wrap2<logical_and_operation>
+			    (BINOP_LOGICAL_AND); }
 	;
 
 or_exp :
 		relation OR relation 
-			{ ada_wrap2<ada_bitwise_ior_operation> (); }
+			{ ada_wrap2<ada_bitwise_ior_operation>
+			    (BINOP_BITWISE_IOR); }
 	|	or_exp OR relation
-			{ ada_wrap2<ada_bitwise_ior_operation> (); }
+			{ ada_wrap2<ada_bitwise_ior_operation>
+			    (BINOP_BITWISE_IOR); }
 	;
 
 or_else_exp :
 	       relation OR ELSE relation
-			{ ada_wrap2<logical_or_operation> (); }
+			{ ada_wrap2<logical_or_operation> (BINOP_LOGICAL_OR); }
 	|      or_else_exp OR ELSE relation
-			{ ada_wrap2<logical_or_operation> (); }
+			{ ada_wrap2<logical_or_operation> (BINOP_LOGICAL_OR); }
 	;
 
 xor_exp :       relation XOR relation
-			{ ada_wrap2<ada_bitwise_xor_operation> (); }
+			{ ada_wrap2<ada_bitwise_xor_operation>
+			    (BINOP_BITWISE_XOR); }
 	|	xor_exp XOR relation
-			{ ada_wrap2<ada_bitwise_xor_operation> (); }
+			{ ada_wrap2<ada_bitwise_xor_operation>
+			    (BINOP_BITWISE_XOR); }
 	;
 
 /* Primaries can denote types (OP_TYPE).  In cases such as 
@@ -737,9 +822,9 @@ primary :	primary TICK_ACCESS
 	|	primary TICK_TAG
 			{ ada_wrap<ada_atr_tag_operation> (); }
 	|       opt_type_prefix TICK_MIN '(' exp ',' exp ')'
-			{ ada_wrap2<ada_binop_min_operation> (); }
+			{ ada_wrap2<ada_binop_min_operation> (BINOP_MIN); }
 	|       opt_type_prefix TICK_MAX '(' exp ',' exp ')'
-			{ ada_wrap2<ada_binop_max_operation> (); }
+			{ ada_wrap2<ada_binop_max_operation> (BINOP_MAX); }
 	| 	opt_type_prefix TICK_POS '(' exp ')'
 			{ ada_wrap<ada_pos_operation> (); }
 	|	type_prefix TICK_VAL '(' exp ')'
@@ -970,7 +1055,7 @@ primary	:	'*' primary		%prec '.'
 			{ ada_addrof (); }
 	|	primary '[' exp ']'
 			{
-			  ada_wrap2<subscript_operation> ();
+			  ada_wrap2<subscript_operation> (BINOP_SUBSCRIPT);
 			  ada_wrap<ada_wrapped_operation> ();
 			}
 	;
diff --git a/gdb/ada-lang.c b/gdb/ada-lang.c
index 38f4ec0452b..f63891b2955 100644
--- a/gdb/ada-lang.c
+++ b/gdb/ada-lang.c
@@ -3690,6 +3690,7 @@ numeric_type_p (struct type *type)
 	{
 	case TYPE_CODE_INT:
 	case TYPE_CODE_FLT:
+	case TYPE_CODE_FIXED_POINT:
 	  return 1;
 	case TYPE_CODE_RANGE:
 	  return (type == TYPE_TARGET_TYPE (type)
@@ -3737,6 +3738,7 @@ scalar_type_p (struct type *type)
 	case TYPE_CODE_RANGE:
 	case TYPE_CODE_ENUM:
 	case TYPE_CODE_FLT:
+	case TYPE_CODE_FIXED_POINT:
 	  return 1;
 	default:
 	  return 0;
diff --git a/gdb/testsuite/gdb.ada/operator_call.exp b/gdb/testsuite/gdb.ada/operator_call.exp
new file mode 100644
index 00000000000..4a35c5c6000
--- /dev/null
+++ b/gdb/testsuite/gdb.ada/operator_call.exp
@@ -0,0 +1,115 @@
+# Copyright 2021 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"
+
+if { [skip_ada_tests] } { return -1 }
+
+standard_ada_testfile opcall
+
+if {[gdb_compile_ada "${srcfile}" "${binfile}" executable {debug}] != ""} {
+    return -1
+}
+
+clean_restart ${testfile}
+
+set bp_location [gdb_get_line_number "STOP" ${testdir}/opcall.adb]
+runto "opcall.adb:$bp_location"
+
+gdb_test "print p" " = \\(x => 4, y => 5\\)"
+
+proc test_with_menu {command result} {
+    global expect_out
+
+    set rxcmd [string_to_regexp $command]
+
+    set num {}
+    send_gdb "$command\n"
+    gdb_expect 30 {
+	-re "^$rxcmd\r\n" {
+	    exp_continue
+	}
+	-re "Multiple matches for \[^\r\n\]*\r\n" {
+	    exp_continue
+	}
+	-re "^\\\[(\[0-9\]+)\\\] twovecs\\.*\[^\r\n\]*\r\n" {
+	    set num $expect_out(1,string)
+	    exp_continue
+	}
+	-re "^\\\[\[0-9\]+\\\] \[^\r\n\]*\r\n" {
+	    # Any other match, we don't want.
+	    exp_continue
+	}
+	-re "^> " {
+	    if {$num == ""} {
+		fail $command
+		set num 0
+	    }
+	    send_gdb "$num\n"
+	    exp_continue
+	}
+	-re "^\[0-9\]+\r\n" {
+	    # The number we just sent, ignore.
+	    exp_continue
+	}
+	-re "\\\$\[0-9\]+ = (\[^\r\n\]+)\r\n" {
+	    if {[regexp $result $expect_out(1,string)]} {
+		pass $command
+	    } else {
+		fail $command
+	    }
+	}
+	timeout {
+	    fail "$command (timeout)"
+	}
+    }
+}
+
+test_with_menu "print p + p" "\\(x => 8, y => 10\\)"
+test_with_menu "print p - p" "\\(x => 0, y => 0\\)"
+test_with_menu "print p * p" "\\(x => 16, y => 25\\)"
+test_with_menu "print p / p" "\\(x => 1, y => 1\\)"
+
+# See the code to understand the weird numbers here.
+test_with_menu "print p mod p" "\\(x => 17, y => 18\\)"
+test_with_menu "print p rem p" "\\(x => 38, y => 39\\)"
+test_with_menu "print p ** p" "\\(x => 84, y => 105\\)"
+
+test_with_menu "print p < p" "false"
+test_with_menu "print p < p2" "true"
+test_with_menu "print p <= p" "true"
+test_with_menu "print p <= p2" "true"
+test_with_menu "print p > p" "false"
+test_with_menu "print p2 > p" "true"
+test_with_menu "print p >= p" "true"
+test_with_menu "print p2 >= p" "true"
+test_with_menu "print p = p" "true"
+test_with_menu "print p = p2" "false"
+test_with_menu "print p /= p" "false"
+test_with_menu "print p /= p2" "true"
+
+test_with_menu "print p and p2" "\\(x => 4, y => 4\\)"
+test_with_menu "print p or p2" "\\(x => 12, y => 13\\)"
+test_with_menu "print p xor p2" "\\(x => 8, y => 9\\)"
+
+# See the code to understand the weird numbers here.
+test_with_menu "print p & p" "\\(x => 44, y => 55\\)"
+
+test_with_menu "print -p" "\\(x => 65532, y => 65531\\)"
+test_with_menu "print abs(-p)" "\\(x => 65532, y => 65531\\)"
+test_with_menu "print not(p)" "\\(x => 65531, y => 65530\\)"
+
+# See the code to understand the weird numbers here.
+test_with_menu "print +(p)" "\\(x => 5, y => 4\\)"
diff --git a/gdb/testsuite/gdb.ada/operator_call/opcall.adb b/gdb/testsuite/gdb.ada/operator_call/opcall.adb
new file mode 100644
index 00000000000..3b0de905fc7
--- /dev/null
+++ b/gdb/testsuite/gdb.ada/operator_call/opcall.adb
@@ -0,0 +1,25 @@
+--  Copyright 2021 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 Twovecs; use Twovecs;
+
+procedure Opcall is
+   P : Twovec;
+   P2 : Twovec;
+begin
+   P := Pt (4, 5);
+   P2 := Pt (12, 12);
+   Do_Nothing (P); -- STOP
+end Opcall;
diff --git a/gdb/testsuite/gdb.ada/operator_call/twovecs.adb b/gdb/testsuite/gdb.ada/operator_call/twovecs.adb
new file mode 100644
index 00000000000..477e1934dc5
--- /dev/null
+++ b/gdb/testsuite/gdb.ada/operator_call/twovecs.adb
@@ -0,0 +1,133 @@
+--  Copyright 2021 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 Twovecs is
+
+   function Pt (X, Y : My_Integer) return Twovec is
+   begin
+      return Twovec'(X, Y);
+   end Pt;
+
+   function "+" (P0, P1 : Twovec) return Twovec is
+   begin
+      return Twovec' (P0.X + P1.X, P0.Y + P1.Y);
+   end "+";
+
+   function "-" (P0, P1 : Twovec) return Twovec is
+   begin
+      return Twovec' (P0.X - P1.X, P0.Y - P1.Y);
+   end "-";
+
+   function "*" (P0, P1 : Twovec) return Twovec is
+   begin
+      return Twovec' (P0.X * P1.X, P0.Y * P1.Y);
+   end "*";
+
+   function "/" (P0, P1 : Twovec) return Twovec is
+   begin
+      return Twovec' (P0.X / P1.X, P0.Y / P1.Y);
+   end "/";
+
+   function "mod" (P0, P1 : Twovec) return Twovec is
+   begin
+      -- Make sure we get a different answer than "-".
+      return Twovec' (17, 18);
+   end "mod";
+
+   function "rem" (P0, P1 : Twovec) return Twovec is
+   begin
+      -- Make sure we get a different answer than "-".
+      return Twovec' (38, 39);
+   end "rem";
+
+   function "**" (P0, P1 : Twovec) return Twovec is
+   begin
+      -- It just has to do something recognizable.
+      return Twovec' (20 * P0.X + P1.X, 20 * P0.Y + P1.Y);
+   end "**";
+
+   function "<" (P0, P1 : Twovec) return Boolean is
+   begin
+      return P0.X < P1.X and then P0.Y < P1.Y;
+   end "<";
+
+   function "<=" (P0, P1 : Twovec) return Boolean is
+   begin
+      return P0.X <= P1.X and then P0.Y <= P1.Y;
+   end "<=";
+
+   function ">" (P0, P1 : Twovec) return Boolean is
+   begin
+      return P0.X > P1.X and then P0.Y > P1.Y;
+   end ">";
+
+   function ">=" (P0, P1 : Twovec) return Boolean is
+   begin
+      return P0.X >= P1.X and then P0.Y >= P1.Y;
+   end ">=";
+
+   function "=" (P0, P1 : Twovec) return Boolean is
+   begin
+      return P0.X = P1.X and then P0.Y = P1.Y;
+   end "=";
+
+   function "and" (P0, P1 : Twovec) return Twovec is
+   begin
+      return Twovec' (P0.X and P1.X, P0.Y and P1.Y);
+   end "and";
+
+   function "or" (P0, P1 : Twovec) return Twovec is
+   begin
+      return Twovec' (P0.X or P1.X, P0.Y or P1.Y);
+   end "or";
+
+   function "xor" (P0, P1 : Twovec) return Twovec is
+   begin
+      return Twovec' (P0.X xor P1.X, P0.Y xor P1.Y);
+   end "xor";
+
+   function "&" (P0, P1 : Twovec) return Twovec is
+   begin
+      -- It just has to do something recognizable.
+      return Twovec' (10 * P0.X + P1.X, 10 * P0.Y + P1.Y);
+   end "&";
+
+   function "abs" (P0 : Twovec) return Twovec is
+   begin
+      return Twovec' (abs (P0.X), abs (P0.Y));
+   end "abs";
+
+   function "not" (P0 : Twovec) return Twovec is
+   begin
+      return Twovec' (not (P0.X), not (P0.Y));
+   end "not";
+
+   function "+" (P0 : Twovec) return Twovec is
+   begin
+      -- It just has to do something recognizable.
+      return Twovec' (+ (P0.Y), + (P0.X));
+   end "+";
+
+   function "-" (P0 : Twovec) return Twovec is
+   begin
+      return Twovec' (- (P0.X), - (P0.Y));
+   end "-";
+
+   procedure Do_Nothing (P : Twovec) is
+   begin
+      null;
+   end Do_Nothing;
+
+end Twovecs;
diff --git a/gdb/testsuite/gdb.ada/operator_call/twovecs.ads b/gdb/testsuite/gdb.ada/operator_call/twovecs.ads
new file mode 100644
index 00000000000..098261c012c
--- /dev/null
+++ b/gdb/testsuite/gdb.ada/operator_call/twovecs.ads
@@ -0,0 +1,55 @@
+--  Copyright 2021 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 Twovecs is
+   type My_Integer is mod 2**16	;
+
+   type Twovec is private;
+
+   function Pt (X, Y : My_Integer) return Twovec;
+
+   function "+" (P0, P1 : Twovec) return Twovec;
+   function "-" (P0, P1 : Twovec) return Twovec;
+   function "*" (P0, P1 : Twovec) return Twovec;
+   function "/" (P0, P1 : Twovec) return Twovec;
+   function "mod" (P0, P1 : Twovec) return Twovec;
+   function "rem" (P0, P1 : Twovec) return Twovec;
+   function "**" (P0, P1 : Twovec) return Twovec;
+
+   function "<" (P0, P1 : Twovec) return Boolean;
+   function "<=" (P0, P1 : Twovec) return Boolean;
+   function ">" (P0, P1 : Twovec) return Boolean;
+   function ">=" (P0, P1 : Twovec) return Boolean;
+   function "=" (P0, P1 : Twovec) return Boolean;
+
+   function "and" (P0, P1 : Twovec) return Twovec;
+   function "or" (P0, P1 : Twovec) return Twovec;
+   function "xor" (P0, P1 : Twovec) return Twovec;
+   function "&" (P0, P1 : Twovec) return Twovec;
+
+   function "abs" (P0 : Twovec) return Twovec;
+   function "not" (P0 : Twovec) return Twovec;
+   function "+" (P0 : Twovec) return Twovec;
+   function "-" (P0 : Twovec) return Twovec;
+
+   procedure Do_Nothing (P : Twovec);
+
+private
+
+   type Twovec is record
+      X, Y : My_Integer;
+   end record;
+
+end Twovecs;
-- 
2.26.2

[PATCH 5/5] Call ada_ensure_varsize_limit in indirection

[Tom Tromey]

Internal testing revealed yet another Ada regression from the
expression rewrite.  In this case, indirection did not use the Ada
varsize limit.  The old code relied on the expression resolution
process to evaluate this subexpression with EVAL_AVOID_SIDE_EFFECTS in
order to get this error.  However, this isn't always done in the new
approach; so this patch introduces another call to
ada_ensure_varsize_limit in the appropriate spot.

As with the earlier patches, this path was not tested in-tree, so this
patch also updates a test.

gdb/ChangeLog
2021-03-10  Tom Tromey  <tromey@adacore.com>

	* ada-lang.c (ada_unop_ind_operation::evaluate): Call
	ada_ensure_varsize_limit.

gdb/testsuite/ChangeLog
2021-03-10  Tom Tromey  <tromey@adacore.com>

	* gdb.ada/varsize_limit.exp: Add new test.
	* gdb.ada/varsize_limit/vsizelim.adb: Update.
---
 gdb/ChangeLog                                    |  5 +++++
 gdb/ada-lang.c                                   |  5 +++++
 gdb/testsuite/ChangeLog                          |  5 +++++
 gdb/testsuite/gdb.ada/varsize_limit.exp          |  2 +-
 gdb/testsuite/gdb.ada/varsize_limit/vsizelim.adb | 14 ++++++++++++++
 5 files changed, 30 insertions(+), 1 deletion(-)

diff --git a/gdb/ada-lang.c b/gdb/ada-lang.c
index f63891b2955..7c1a308edbb 100644
--- a/gdb/ada-lang.c
+++ b/gdb/ada-lang.c
@@ -10480,6 +10480,11 @@ ada_unop_ind_operation::evaluate (struct type *expect_type,
 			      (CORE_ADDR) value_as_address (arg1));
     }
 
+  struct type *target_type = (to_static_fixed_type
+			      (ada_aligned_type
+			       (ada_check_typedef (TYPE_TARGET_TYPE (type)))));
+  ada_ensure_varsize_limit (target_type);
+
   if (ada_is_array_descriptor_type (type))
     /* GDB allows dereferencing GNAT array descriptors.  */
     return ada_coerce_to_simple_array (arg1);
diff --git a/gdb/testsuite/gdb.ada/varsize_limit.exp b/gdb/testsuite/gdb.ada/varsize_limit.exp
index eebb5d05def..aca926a79ab 100644
--- a/gdb/testsuite/gdb.ada/varsize_limit.exp
+++ b/gdb/testsuite/gdb.ada/varsize_limit.exp
@@ -37,4 +37,4 @@ gdb_test "print small" " = \"1234567890\""
 
 gdb_test "print larger" "object size is larger than varsize-limit.*"
 
-
+gdb_test "print name.all" "object size is larger than varsize-limit.*"
diff --git a/gdb/testsuite/gdb.ada/varsize_limit/vsizelim.adb b/gdb/testsuite/gdb.ada/varsize_limit/vsizelim.adb
index 058994ce88a..3b19e722eb2 100644
--- a/gdb/testsuite/gdb.ada/varsize_limit/vsizelim.adb
+++ b/gdb/testsuite/gdb.ada/varsize_limit/vsizelim.adb
@@ -14,10 +14,24 @@
 --  along with this program.  If not, see <http://www.gnu.org/licenses/>.
 
 with Pck; use Pck;
+with System;
+with Unchecked_Conversion;
+
 procedure VsizeLim is
    Small : String := Ident ("1234567890");
    Larger : String := Ident ("1234567890|1234567890|1234567890");
+
+   type String_Ptr is access all String;
+   type Big_String_Ptr is access all String (Positive);
+
+   function To_Ptr is
+     new Unchecked_Conversion (System.Address, Big_String_Ptr);
+
+   Name_Str : String_Ptr := new String'(Larger);
+   Name : Big_String_Ptr := To_Ptr (Name_Str.all'Address);
+
 begin
    Do_Nothing (Small'Address); -- STOP
    Do_Nothing (Larger'Address);
+   Do_Nothing (Name'Address);
 end VsizeLim;
-- 
2.26.2

Re: [PATCH 0/5] Fix Ada expression regressions

[Tom Tromey]

>>>>> "Tom" == Tom Tromey <tromey@adacore.com> writes:

Tom> The expression rewrite caused some regressions in the internal AdaCore
Tom> test suite.  This series fixes all the problems I found.

Tom> These are all Ada-specific.

Tom> Tested on x86-64 Fedora 32.

I'm going to check these in now.
It's a bit sooner than I normally would, but considering that they are
Ada-specific, I think it's alright.  If you have comments, let me know
and I can fix them up later.

Tom