From patchwork Fri Mar 8 16:08:27 2024 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Tom Tromey X-Patchwork-Id: 86980 Return-Path: X-Original-To: patchwork@sourceware.org Delivered-To: patchwork@sourceware.org Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id B18EB385E038 for ; Fri, 8 Mar 2024 16:09:10 +0000 (GMT) X-Original-To: gdb-patches@sourceware.org Delivered-To: gdb-patches@sourceware.org Received: from mail-il1-x12b.google.com (mail-il1-x12b.google.com [IPv6:2607:f8b0:4864:20::12b]) by sourceware.org (Postfix) with ESMTPS id 09320385E000 for ; Fri, 8 Mar 2024 16:08:36 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org 09320385E000 Authentication-Results: sourceware.org; dmarc=pass (p=quarantine dis=none) header.from=adacore.com Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=adacore.com ARC-Filter: OpenARC Filter v1.0.0 sourceware.org 09320385E000 Authentication-Results: server2.sourceware.org; arc=none smtp.remote-ip=2607:f8b0:4864:20::12b ARC-Seal: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1709914118; cv=none; b=b8JmtrL70oluNPHd1fLGGBW6snduoLl8DipUvgIPMIV5y4xfI7PcogGQeOM1V1SGx691K6e/ZBVBt19PaFYOPLMMDKUve4DrrZiqEm6ckiee8FVM3ME2X+G7PXMZ0YKZU4XCAwKEe8BckQXFp09e99GcIToB1I1cLkJ2D9aT0OQ= ARC-Message-Signature: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1709914118; c=relaxed/simple; bh=ua9yiRgWCbIYssW+MDE5MD1POb8Ts77S/kQxmGYKRms=; h=DKIM-Signature:From:To:Subject:Date:Message-ID:MIME-Version; b=lu1Odbq3Zy//2QC59J/S3uWQlISyy1QQ2/YTDk68OvmsACDcNiWPADTm9JIRsymwHK65VB3dE4+eOVaddwQgMAx3i3gDMI0dsDjGiKA2fPmv2rvgEx78s9N2GRJFWfVRm8RyiHK4pOt23dswRKA1JMMu3n/hG6RFABj9KGXWBd0= ARC-Authentication-Results: i=1; server2.sourceware.org Received: by mail-il1-x12b.google.com with SMTP id e9e14a558f8ab-366302e3cd2so1521325ab.1 for ; Fri, 08 Mar 2024 08:08:36 -0800 (PST) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=adacore.com; s=google; t=1709914115; x=1710518915; darn=sourceware.org; h=content-transfer-encoding:mime-version:message-id:date:subject:cc :to:from:from:to:cc:subject:date:message-id:reply-to; bh=GjPqRhT6bFBXbnPVslH6SdtwYnYWPmb/q/O4HpegA3k=; b=W8hIe5ZaqNpyfhaFHj+e8vc7gaWS2pgb5ggnm5Dz12rjz5SQawjonpLe78rYtWgrtI Mf6qvW6JHcSYJH+ZUwBr9woWQfGFHO1fCfItjbL8ca/uBYYtleJPv2T7cBFdJIUL7yIi kfxCX64tFPlVnCeat+/+MfD+VJrfweOWc2YxFYtB0tkeG7HjXaSpnzqgrm6vn9l0vHNi q5ngQ1GqLAyEHyCPs5hp79SLvs4RdkT918VdRAiIBYKwMdXFyLG7otj3+nxBJflISGpY EDpAzjSB99nxKwpg7UlS1ZbIXk0T4Vezux48bqCep/1DAAFf6OYT6VlpqbWMirdn3TPn 3mkg== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20230601; t=1709914115; x=1710518915; h=content-transfer-encoding:mime-version:message-id:date:subject:cc :to:from:x-gm-message-state:from:to:cc:subject:date:message-id :reply-to; bh=GjPqRhT6bFBXbnPVslH6SdtwYnYWPmb/q/O4HpegA3k=; b=RdET1ku3XLFDe7LDw2jNWaw9ZGUeVV3CUG3zra7F25mBbg3r4Cba9p4v6ceu0qkBas 3mFhPjmIWO0YWEyxsaLGrfo7zppsrdnqYc7IfEn34QZaCifHPuzOefiwvgRDpt8JOmbY WD644uuwyZX87vEbx2yhp+LjNlCSy4qqzXWOJEMC+rM2RGfopb2pFN6It+34TRoVRqKB wzjXkJsEuZY/DbPwwbxwKeTESbOJMu4IvsERawDoXKSvIaON1rRIVJQAv81Qnq25nWjT 6zFJI7y+VO3BQqJ6H0Mumvs0cRdY3Fb90Y4nGJOmpOOMl4K2lHk+QtLHahb2RmjHZUb4 w9dQ== X-Gm-Message-State: AOJu0YypANXr5znnNqHZlty9jULgo3w52p+bps7MDduuz7ENwae33wb2 4I+k933JV7cuakd2nQfDL37cWhC38QkUcApxDCeeK+7eUws42st0l+LiPmjGIc/0DOOa2BKrJHU = X-Google-Smtp-Source: AGHT+IEiT9U5HCgwuLa95E5IiQZC7DIsyl9yQYqiamClTVn0zznY1kzCs1dbiZdoiqSij078tuyA9Q== X-Received: by 2002:a05:6e02:b4f:b0:365:21f9:fb22 with SMTP id f15-20020a056e020b4f00b0036521f9fb22mr674664ilu.14.1709914115084; Fri, 08 Mar 2024 08:08:35 -0800 (PST) Received: from localhost.localdomain (97-122-82-115.hlrn.qwest.net. [97.122.82.115]) by smtp.gmail.com with ESMTPSA id t22-20020a02b196000000b004752d5fcf14sm1704640jah.115.2024.03.08.08.08.34 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Fri, 08 Mar 2024 08:08:34 -0800 (PST) From: Tom Tromey To: gdb-patches@sourceware.org Cc: Tom Tromey Subject: [PATCH] Implement Ada 2022 delta aggregates Date: Fri, 8 Mar 2024 09:08:27 -0700 Message-ID: <20240308160827.3497813-1-tromey@adacore.com> X-Mailer: git-send-email 2.43.0 MIME-Version: 1.0 X-Spam-Status: No, score=-11.6 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, DKIM_VALID_AU, DKIM_VALID_EF, GIT_PATCH_0, KAM_SHORT, RCVD_IN_DNSWL_NONE, SPF_HELO_NONE, SPF_PASS, TXREP, T_SCC_BODY_TEXT_LINE autolearn=ham autolearn_force=no version=3.4.6 X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on server2.sourceware.org X-BeenThere: gdb-patches@sourceware.org X-Mailman-Version: 2.1.30 Precedence: list List-Id: Gdb-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: gdb-patches-bounces+patchwork=sourceware.org@sourceware.org Ada 2022 includes a "delta aggregates" feature that can sometimes simplify aggregate creation. This patch implements this feature for GDB. --- 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(-) create mode 100644 gdb/testsuite/gdb.ada/delta-assign.exp create mode 100644 gdb/testsuite/gdb.ada/delta-assign/main.adb create mode 100644 gdb/testsuite/gdb.ada/delta-assign/pck.adb create mode 100644 gdb/testsuite/gdb.ada/delta-assign/pck.ads diff --git a/gdb/ada-exp.h b/gdb/ada-exp.h index 1d8615b2e87..84ef192f123 100644 --- a/gdb/ada-exp.h +++ b/gdb/ada-exp.h @@ -687,6 +687,10 @@ class ada_aggregate_component : public ada_component { } + /* 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, @@ -698,6 +702,10 @@ class ada_aggregate_component : public ada_component 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 m_components; }; diff --git a/gdb/ada-exp.y b/gdb/ada-exp.y index ab936ae4733..34d40cf3119 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 ; aggregate : - '(' aggregate_component_list ')' + '(' exp WITH DELTA aggregate_component_list ')' + { + std::vector components + = pop_components ($5); + operation_up base = ada_pop (); + + push_component + (std::move (base), std::move (components)); + } + | '(' aggregate_component_list ')' { std::vector components = pop_components ($2); diff --git a/gdb/ada-lang.c b/gdb/ada-lang.c index 1c26ebf7b30..0762f122104 100644 --- a/gdb/ada-lang.c +++ b/gdb/ada-lang.c @@ -9321,10 +9321,9 @@ check_objfile (const std::unique_ptr &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, @@ -9361,6 +9360,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; @@ -9371,6 +9372,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); } @@ -9381,12 +9387,40 @@ ada_aggregate_component::assign (struct value *container, std::vector &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 &&components) + : m_base (std::move (base)), + m_components (std::move (components)) +{ + for (const auto &component : m_components) + if (dynamic_cast (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 . + +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 . + +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 . + +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 := (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;