Fix bug in Ada aggregate assignment

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-15  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-15  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.

diff --git a/gdb/ChangeLog b/gdb/ChangeLog
index 36f862a2c919bab70e1b299c0cf1f81c0a4caafb..da5c36b6813823e281c85a5a965f7755b949826f 100644 (file)
--- a/gdb/ChangeLog
+++ b/gdb/ChangeLog
@@ -1,3 +1,11 @@
+2021-03-15  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.
+
 2021-03-15  Felix Willgerodt  <felix.willgerodt@intel.com>
 
        * i386-tdep.c (i386_floatformat_for_type): Add COMPLEX*32 and REAL*16.

diff --git a/gdb/ada-exp.h b/gdb/ada-exp.h
index 0b6f1f22e79caef649756e30e587ccdb0fd5c195..82941dd063421d7cc6f38951cb6fcd1862ea78df 100644 (file)
--- a/gdb/ada-exp.h
+++ b/gdb/ada-exp.h
@@ -510,11 +510,12 @@ public:
      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 b2eff9d3411426ff04425090471bd950741229d9..ea43a259f5139ccfa9785405f0605276ad97778c 100644 (file)
--- 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/ChangeLog b/gdb/testsuite/ChangeLog
index 40112300b9ce1f98f33a2400c0beaf8ead7c82b2..25f072d6105b2a1d5a1a050c6897b8badffdbdea 100644 (file)
--- a/gdb/testsuite/ChangeLog
+++ b/gdb/testsuite/ChangeLog
@@ -1,3 +1,12 @@
+2021-03-15  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.
+
 2021-03-15  Andrew Burgess  <andrew.burgess@embecosm.com>
 
        * gdb.python/py-auto-load-chaining-f1.c: New file.

diff --git a/gdb/testsuite/gdb.ada/assign_arr.exp b/gdb/testsuite/gdb.ada/assign_arr.exp
index ca894f057e24bc881af5decd628a8cecc56d6dff..08090271afcee6dae4266fd33104723577613025 100644 (file)
--- 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 f140118704e2da5806e7605e3a9999536bf5df96..f352d91cdf9bd72fee3b67e7670f6dcaf19b2e2c 100644 (file)
--- 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 (file)
index 0000000..888c5e4
--- /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 24bb1f56e4aaef6ccda9dc0e36c13400117cd09b..743964a2ecd3ec5cbd914bcb255e03c55f75e4a3 100644 (file)
--- 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;