From 207582c0758738447d2df8f778aeebf126c73b31 Mon Sep 17 00:00:00 2001 From: Tom Tromey Date: Mon, 15 Mar 2021 06:23:12 -0600 Subject: [PATCH] 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 * ada-lang.c (ada_aggregate_operation::assign_aggregate): Return container. (ada_assign_operation::evaluate): Update. * ada-exp.h (class ada_aggregate_operation) : Change return type. gdb/testsuite/ChangeLog 2021-03-15 Tom Tromey * 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/ChangeLog b/gdb/ChangeLog index 36f862a2c91..da5c36b6813 100644 --- a/gdb/ChangeLog +++ b/gdb/ChangeLog @@ -1,3 +1,11 @@ +2021-03-15 Tom Tromey + + * ada-lang.c (ada_aggregate_operation::assign_aggregate): Return + container. + (ada_assign_operation::evaluate): Update. + * ada-exp.h (class ada_aggregate_operation) : + Change return type. + 2021-03-15 Felix Willgerodt * 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 0b6f1f22e79..82941dd0634 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 b2eff9d3411..ea43a259f51 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 40112300b9c..25f072d6105 100644 --- a/gdb/testsuite/ChangeLog +++ b/gdb/testsuite/ChangeLog @@ -1,3 +1,12 @@ +2021-03-15 Tom Tromey + + * 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 * 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 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 . + +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 . +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.30.2