aboutsummaryrefslogtreecommitdiff
path: root/gdb
diff options
context:
space:
mode:
authorTom Tromey <tromey@adacore.com>2021-03-15 06:23:12 -0600
committerTom Tromey <tromey@adacore.com>2021-03-15 06:23:12 -0600
commit207582c0758738447d2df8f778aeebf126c73b31 (patch)
tree986f9fbcef047e24e6742cb3f95e81102d4ec83d /gdb
parent1996d0f12cd57391e01e0eebe32e44510e6ec17d (diff)
downloadbinutils-207582c0758738447d2df8f778aeebf126c73b31.zip
binutils-207582c0758738447d2df8f778aeebf126c73b31.tar.gz
binutils-207582c0758738447d2df8f778aeebf126c73b31.tar.bz2
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.
Diffstat (limited to 'gdb')
-rw-r--r--gdb/ChangeLog8
-rw-r--r--gdb/ada-exp.h9
-rw-r--r--gdb/ada-lang.c12
-rw-r--r--gdb/testsuite/ChangeLog9
-rw-r--r--gdb/testsuite/gdb.ada/assign_arr.exp7
-rw-r--r--gdb/testsuite/gdb.ada/assign_arr/main_p324_051.adb2
-rw-r--r--gdb/testsuite/gdb.ada/assign_arr/target_wrapper.adb28
-rw-r--r--gdb/testsuite/gdb.ada/assign_arr/target_wrapper.ads8
8 files changed, 72 insertions, 11 deletions
diff --git a/gdb/ChangeLog b/gdb/ChangeLog
index 36f862a..da5c36b 100644
--- 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 0b6f1f2..82941dd 100644
--- 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 b2eff9d..ea43a25 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/ChangeLog b/gdb/testsuite/ChangeLog
index 4011230..25f072d 100644
--- 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 ca894f0..0809027 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 f140118..f352d91 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 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 24bb1f5..743964a 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;