public inbox for gdb-cvs@sourceware.org help / color / mirror / Atom feed
From: Tom Tromey <tromey@sourceware.org> To: gdb-cvs@sourceware.org Subject: [binutils-gdb] Implement Ada 2022 delta aggregates Date: Thu, 21 Mar 2024 18:51:09 +0000 (GMT) [thread overview] Message-ID: <20240321185110.25CBF3858403@sourceware.org> (raw) https://sourceware.org/git/gitweb.cgi?p=binutils-gdb.git;h=7e949f08700b077b78e955c653eb4e9455027101 commit 7e949f08700b077b78e955c653eb4e9455027101 Author: Tom Tromey <tromey@adacore.com> Date: Thu Feb 29 13:54:19 2024 -0700 Implement Ada 2022 delta aggregates 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: { } + /* This is the "with delta" form -- BASE is the base expression. */ + ada_aggregate_component (operation_up &&base, + std::vector<ada_component_up> &&components); + void assign (struct value *container, struct value *lhs, struct expression *exp, std::vector<LONGEST> &indices, @@ -671,6 +675,10 @@ public: private: + /* If the assignment has a "with delta" clause, this is the + base expression. */ + operation_up m_base; + /* The individual components to assign. */ std::vector<ada_component_up> m_components; }; 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<ada_assign_up> assignments; %token <typed_char> CHARLIT %token <typed_val_float> FLOAT %token TRUEKEYWORD FALSEKEYWORD +%token WITH DELTA %token COLONCOLON %token <sval> STRING NAME DOT_ID TICK_COMPLETE DOT_COMPLETE NAME_COMPLETE %type <bval> block @@ -1032,7 +1033,16 @@ block : NAME COLONCOLON ; aggregate : - '(' aggregate_component_list ')' + '(' exp WITH DELTA aggregate_component_list ')' + { + std::vector<ada_component_up> components + = pop_components ($5); + operation_up base = ada_pop (); + + push_component<ada_aggregate_component> + (std::move (base), std::move (components)); + } + | '(' aggregate_component_list ')' { std::vector<ada_component_up> components = 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<ada_component> &comp, return comp->uses_objfile (objfile); } -/* 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 == - 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 == CONTAINER). */ static void assign_component (struct value *container, struct value *lhs, LONGEST index, @@ -9363,6 +9362,8 @@ assign_component (struct value *container, struct value *lhs, LONGEST index, bool ada_aggregate_component::uses_objfile (struct objfile *objfile) { + if (m_base != 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 != 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 *container, std::vector<LONGEST> &indices, LONGEST low, LONGEST high) { + if (m_base != nullptr) + { + value *base = m_base->evaluate (nullptr, exp, EVAL_NORMAL); + if (ada_is_direct_array_type (base->type ())) + base = 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); } /* See ada-exp.h. */ +ada_aggregate_component::ada_aggregate_component + (operation_up &&base, std::vector<ada_component_up> &&components) + : m_base (std::move (base)), + m_components (std::move (components)) +{ + for (const auto &component : m_components) + if (dynamic_cast<const ada_others_component *> (component.get ()) + != nullptr) + { + /* It's invalid and nonsensical to have 'others => ...' 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} { 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; } /* 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 <http://www.gnu.org/licenses/>. + +load_lib "ada.exp" + +require allow_ada_tests + +standard_ada_testfile main + +if {[gdb_compile_ada "${srcfile}" "${binfile}" executable [list debug]] != "" } { + 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 := (pck.v1 with delta b => 23)" \ + [string_to_regexp " = (a => 23, b => 23)"] \ + "delta aggregate record" + +gdb_test "print local := (pck.v1 with delta others => 23)" \ + "'others' invalid in delta aggregate" \ + "invalid record delta aggregate" + +gdb_test "print local := (pck.v3 with delta b => 19)" \ + "Type mismatch in delta aggregate" \ + "wrong type in delta aggregate" + +gdb_test "print a := (pck.a1 with delta 2 => 7)" \ + [string_to_regexp " = (2, 7, 6)"] \ + "delta aggregate array" + +gdb_test "print a := (pck.a1 with delta others => 88)" \ + "'others' invalid in delta aggregate" \ + "invalid array delta aggregate" diff --git a/gdb/testsuite/gdb.ada/delta-assign/main.adb b/gdb/testsuite/gdb.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 <http://www.gnu.org/licenses/>. + +with pck; use pck; + +procedure Main is + Local : Record_Type := (A => 1, B => 2); + A : Array_Type := (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 <http://www.gnu.org/licenses/>. + +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 <http://www.gnu.org/licenses/>. + +with System; + +package Pck is + + type Record_Type is record + A : Integer; + B : Integer; + end record; + + V1 : Record_Type := (A => 23, B => 24); + V2 : Record_Type := (A => 47, B => 91); + + type Other_Record_Type is record + A : Integer; + B : Integer; + C : Integer; + end record; + + V3 : Other_Record_Type := (A => 47, B => 91, C => 102); + + type Array_Type is array (1 .. 3) of Integer; + + A1 : Array_Type := (2, 4, 6); + + procedure Do_Nothing (A : System.Address); + +end Pck;
reply other threads:[~2024-03-21 18:51 UTC|newest] Thread overview: [no followups] expand[flat|nested] mbox.gz Atom feed
Reply instructions: You may reply publicly to this message via plain-text email using any one of the following methods: * Save the following mbox file, import it into your mail client, and reply-to-all from there: mbox Avoid top-posting and favor interleaved quoting: https://en.wikipedia.org/wiki/Posting_style#Interleaved_style * Reply using the --to, --cc, and --in-reply-to switches of git-send-email(1): git send-email \ --in-reply-to=20240321185110.25CBF3858403@sourceware.org \ --to=tromey@sourceware.org \ --cc=gdb-cvs@sourceware.org \ /path/to/YOUR_REPLY https://kernel.org/pub/software/scm/git/docs/git-send-email.html * If your mail client supports setting the In-Reply-To header via mailto: links, try the mailto: linkBe sure your reply has a Subject: header at the top and a blank line before the message body.
This is a public inbox, see mirroring instructions for how to clone and mirror all data and code used for this inbox; as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).