[1/5] Fix bug in Ada aggregate assignment

Message ID 20210310175612.1759272-2-tromey@adacore.com
State New
Headers show
Series
  • Fix Ada expression regressions
Related show

Commit Message

Tom Tromey March 10, 2021, 5:56 p.m.
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

-- 
2.26.2

Patch

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;