From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: by sourceware.org (Postfix, from userid 2126) id 25CBF3858403; Thu, 21 Mar 2024 18:51:09 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 25CBF3858403 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=sourceware.org; s=default; t=1711047070; bh=Gw5bdwU4uuKVRakx0q+ozPbdhycszTNownndj3FrQZE=; h=From:To:Subject:Date:From; b=P9GjGFatCjsf3ulfpuPTEVMb4GfhGpf8V3A/ZCLsbTSo77o+iDD0GuvyD/M+Ps8s/ u6AUU1QsPUGR3QW6+tZx93bwY5DEcTLd3LkuPl02X/SwtsIAp2tXoU7jJxZH+uJQMa 52TyN/EXuvfjLULQv98W9XeoEl67ax7z2YNQuayQ= Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: quoted-printable From: Tom Tromey To: gdb-cvs@sourceware.org Subject: [binutils-gdb] Implement Ada 2022 delta aggregates X-Act-Checkin: binutils-gdb X-Git-Author: Tom Tromey X-Git-Refname: refs/heads/master X-Git-Oldrev: 7f032bbedf3e66f6695d4df0d149c2e8033224da X-Git-Newrev: 7e949f08700b077b78e955c653eb4e9455027101 Message-Id: <20240321185110.25CBF3858403@sourceware.org> Date: Thu, 21 Mar 2024 18:51:09 +0000 (GMT) List-Id: https://sourceware.org/git/gitweb.cgi?p=3Dbinutils-gdb.git;h=3D7e949f08700b= 077b78e955c653eb4e9455027101 commit 7e949f08700b077b78e955c653eb4e9455027101 Author: Tom Tromey Date: Thu Feb 29 13:54:19 2024 -0700 Implement Ada 2022 delta aggregates =20 Ada 2022 includes a "delta aggregates" feature that can sometimes simplify aggregate creation. This patch implements this feature for GDB. Diff: --- gdb/ada-exp.h | 8 +++++ gdb/ada-exp.y | 12 ++++++- gdb/ada-lang.c | 42 ++++++++++++++++++++++--- gdb/ada-lex.l | 2 ++ gdb/testsuite/gdb.ada/delta-assign.exp | 49 +++++++++++++++++++++++++= ++++ gdb/testsuite/gdb.ada/delta-assign/main.adb | 24 ++++++++++++++ gdb/testsuite/gdb.ada/delta-assign/pck.adb | 23 ++++++++++++++ gdb/testsuite/gdb.ada/delta-assign/pck.ads | 42 +++++++++++++++++++++++++ 8 files changed, 197 insertions(+), 5 deletions(-) diff --git a/gdb/ada-exp.h b/gdb/ada-exp.h index 9abdd6f3f70..69d4e90e410 100644 --- a/gdb/ada-exp.h +++ b/gdb/ada-exp.h @@ -660,6 +660,10 @@ public: { } =20 + /* This is the "with delta" form -- BASE is the base expression. */ + ada_aggregate_component (operation_up &&base, + std::vector &&components); + void assign (struct value *container, struct value *lhs, struct expression *exp, std::vector &indices, @@ -671,6 +675,10 @@ public: =20 private: =20 + /* If the assignment has a "with delta" clause, this is the + base expression. */ + operation_up m_base; + /* The individual components to assign. */ std::vector m_components; }; =20 diff --git a/gdb/ada-exp.y b/gdb/ada-exp.y index 26963f78884..2b205714d7a 100644 --- a/gdb/ada-exp.y +++ b/gdb/ada-exp.y @@ -453,6 +453,7 @@ static std::vector assignments; %token CHARLIT %token FLOAT %token TRUEKEYWORD FALSEKEYWORD +%token WITH DELTA %token COLONCOLON %token STRING NAME DOT_ID TICK_COMPLETE DOT_COMPLETE NAME_COMPLETE %type block @@ -1032,7 +1033,16 @@ block : NAME COLONCOLON ; =20 aggregate : - '(' aggregate_component_list ')' =20 + '(' exp WITH DELTA aggregate_component_list ')' + { + std::vector components + =3D pop_components ($5); + operation_up base =3D ada_pop (); + + push_component + (std::move (base), std::move (components)); + } + | '(' aggregate_component_list ')' { std::vector components =3D pop_components ($2); diff --git a/gdb/ada-lang.c b/gdb/ada-lang.c index 2a904950241..493ef3b6c7d 100644 --- a/gdb/ada-lang.c +++ b/gdb/ada-lang.c @@ -9323,10 +9323,9 @@ check_objfile (const std::unique_ptr = &comp, return comp->uses_objfile (objfile); } =20 -/* Assign the result of evaluating ARG starting at *POS to the INDEXth - component of LHS (a simple array or a record). Does not modify the - inferior's memory, nor does it modify LHS (unless LHS =3D=3D - CONTAINER). */ +/* Assign the result of evaluating ARG to the INDEXth component of LHS + (a simple array or a record). Does not modify the inferior's + memory, nor does it modify LHS (unless LHS =3D=3D CONTAINER). */ =20 static void assign_component (struct value *container, struct value *lhs, LONGEST inde= x, @@ -9363,6 +9362,8 @@ assign_component (struct value *container, struct val= ue *lhs, LONGEST index, bool ada_aggregate_component::uses_objfile (struct objfile *objfile) { + if (m_base !=3D nullptr && m_base->uses_objfile (objfile)) + return true; for (const auto &item : m_components) if (item->uses_objfile (objfile)) return true; @@ -9373,6 +9374,11 @@ void ada_aggregate_component::dump (ui_file *stream, int depth) { gdb_printf (stream, _("%*sAggregate\n"), depth, ""); + if (m_base !=3D nullptr) + { + gdb_printf (stream, _("%*swith delta\n"), depth + 1, ""); + m_base->dump (stream, depth + 2); + } for (const auto &item : m_components) item->dump (stream, depth + 1); } @@ -9383,12 +9389,40 @@ ada_aggregate_component::assign (struct value *cont= ainer, std::vector &indices, LONGEST low, LONGEST high) { + if (m_base !=3D nullptr) + { + value *base =3D m_base->evaluate (nullptr, exp, EVAL_NORMAL); + if (ada_is_direct_array_type (base->type ())) + base =3D ada_coerce_to_simple_array (base); + if (!types_deeply_equal (container->type (), base->type ())) + error (_("Type mismatch in delta aggregate")); + value_assign_to_component (container, container, base); + } + for (auto &item : m_components) item->assign (container, lhs, exp, indices, low, high); } =20 /* See ada-exp.h. */ =20 +ada_aggregate_component::ada_aggregate_component + (operation_up &&base, std::vector &&components) + : m_base (std::move (base)), + m_components (std::move (components)) +{ + for (const auto &component : m_components) + if (dynamic_cast (component.get ()) + !=3D nullptr) + { + /* It's invalid and nonsensical to have 'others =3D> ...' with a + delta aggregate. It was simpler to enforce this + restriction here as opposed to in the parser. */ + error (_("'others' invalid in delta aggregate")); + } +} + +/* See ada-exp.h. */ + value * ada_aggregate_operation::assign_aggregate (struct value *container, struct value *lhs, diff --git a/gdb/ada-lex.l b/gdb/ada-lex.l index 828ff9a9215..c54cd5e452a 100644 --- a/gdb/ada-lex.l +++ b/gdb/ada-lex.l @@ -225,6 +225,7 @@ thread{WHITE}+{DIG} { =20 abs { return ABS; } and { return _AND_; } +delta { return DELTA; } else { return ELSE; } in { return IN; } mod { return MOD; } @@ -235,6 +236,7 @@ or { return OR; } others { return OTHERS; } rem { return REM; } then { return THEN; } +with { return WITH; } xor { return XOR; } =20 /* BOOLEAN "KEYWORDS" */ diff --git a/gdb/testsuite/gdb.ada/delta-assign.exp b/gdb/testsuite/gdb.ada= /delta-assign.exp new file mode 100644 index 00000000000..d7339523e29 --- /dev/null +++ b/gdb/testsuite/gdb.ada/delta-assign.exp @@ -0,0 +1,49 @@ +# Copyright 2024 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 . + +load_lib "ada.exp" + +require allow_ada_tests + +standard_ada_testfile main + +if {[gdb_compile_ada "${srcfile}" "${binfile}" executable [list debug]] != =3D "" } { + return -1 +} + +clean_restart ${testfile} + +set bp_location [gdb_get_line_number "STOP" ${testdir}/main.adb] +runto "main.adb:$bp_location" + +gdb_test "print local :=3D (pck.v1 with delta b =3D> 23)" \ + [string_to_regexp " =3D (a =3D> 23, b =3D> 23)"] \ + "delta aggregate record" + +gdb_test "print local :=3D (pck.v1 with delta others =3D> 23)" \ + "'others' invalid in delta aggregate" \ + "invalid record delta aggregate" + +gdb_test "print local :=3D (pck.v3 with delta b =3D> 19)" \ + "Type mismatch in delta aggregate" \ + "wrong type in delta aggregate" + +gdb_test "print a :=3D (pck.a1 with delta 2 =3D> 7)" \ + [string_to_regexp " =3D (2, 7, 6)"] \ + "delta aggregate array" + +gdb_test "print a :=3D (pck.a1 with delta others =3D> 88)" \ + "'others' invalid in delta aggregate" \ + "invalid array delta aggregate" diff --git a/gdb/testsuite/gdb.ada/delta-assign/main.adb b/gdb/testsuite/gd= b.ada/delta-assign/main.adb new file mode 100644 index 00000000000..75d51cf2249 --- /dev/null +++ b/gdb/testsuite/gdb.ada/delta-assign/main.adb @@ -0,0 +1,24 @@ +-- Copyright 2024 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 . + +with pck; use pck; + +procedure Main is + Local : Record_Type :=3D (A =3D> 1, B =3D> 2); + A : Array_Type :=3D (1, 3, 5); +begin + Do_Nothing (Local'Address); -- STOP + Do_Nothing (A'Address); +end Main; diff --git a/gdb/testsuite/gdb.ada/delta-assign/pck.adb b/gdb/testsuite/gdb= .ada/delta-assign/pck.adb new file mode 100644 index 00000000000..14580e66be1 --- /dev/null +++ b/gdb/testsuite/gdb.ada/delta-assign/pck.adb @@ -0,0 +1,23 @@ +-- Copyright 2024 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 Pck is + + procedure Do_Nothing (A : System.Address) is + begin + null; + end Do_Nothing; + +end Pck; diff --git a/gdb/testsuite/gdb.ada/delta-assign/pck.ads b/gdb/testsuite/gdb= .ada/delta-assign/pck.ads new file mode 100644 index 00000000000..6f09a8e2c9d --- /dev/null +++ b/gdb/testsuite/gdb.ada/delta-assign/pck.ads @@ -0,0 +1,42 @@ +-- Copyright 2024 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 . + +with System; + +package Pck is + + type Record_Type is record + A : Integer; + B : Integer; + end record; + + V1 : Record_Type :=3D (A =3D> 23, B =3D> 24); + V2 : Record_Type :=3D (A =3D> 47, B =3D> 91); + + type Other_Record_Type is record + A : Integer; + B : Integer; + C : Integer; + end record; + + V3 : Other_Record_Type :=3D (A =3D> 47, B =3D> 91, C =3D> 102); + + type Array_Type is array (1 .. 3) of Integer; + + A1 : Array_Type :=3D (2, 4, 6); + + procedure Do_Nothing (A : System.Address); + +end Pck;