From patchwork Thu Mar 21 19:03:30 2024 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Tom Tromey X-Patchwork-Id: 87471 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 2B54838582A8 for ; Thu, 21 Mar 2024 19:04:59 +0000 (GMT) X-Original-To: gdb-patches@sourceware.org Delivered-To: gdb-patches@sourceware.org Received: from mail-io1-xd31.google.com (mail-io1-xd31.google.com [IPv6:2607:f8b0:4864:20::d31]) by sourceware.org (Postfix) with ESMTPS id 973C13858C98 for ; Thu, 21 Mar 2024 19:03:31 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org 973C13858C98 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 973C13858C98 Authentication-Results: server2.sourceware.org; arc=none smtp.remote-ip=2607:f8b0:4864:20::d31 ARC-Seal: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1711047815; cv=none; b=mcOpTpMGSVLKZ2kjKz5jvkCQzuvhYwmLSIadalHVypQIg4/1VXvPyK+UJA+iBsKNIHvSp29uSX7Cen6qH7MlJSWvnQnaH7hW0DAFWvZDcENP7hfqfqaqszfMgwK4LXdvKB9UC8azERFg89gidsWaePOFFWb9eTHjUNVvfbpgHe0= ARC-Message-Signature: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1711047815; c=relaxed/simple; bh=qRP5tx3O2HRdIaDfrSBvwCwcRim2hs08pimdlw88qCI=; h=DKIM-Signature:From:Date:Subject:MIME-Version:Message-Id:To; b=jsArCiQOmGv2nePXaDd8qxmWgCF61sEbF3piUGw1kEC1XB0UoC5T7qRQu82EnAwBMfBa/pdm9EWHXNezV0NaKtEIB9pJKE/CIZ7qFWe1VbAlMg1XmVSn/wsVqMwkuhWTk5KyTCANGX/31OFJF3grvevlvxXz9rkBdS28plKkh4k= ARC-Authentication-Results: i=1; server2.sourceware.org Received: by mail-io1-xd31.google.com with SMTP id ca18e2360f4ac-7c8bb44622eso38369839f.0 for ; Thu, 21 Mar 2024 12:03:31 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=adacore.com; s=google; t=1711047811; x=1711652611; darn=sourceware.org; h=to:in-reply-to:references:message-id:content-transfer-encoding :mime-version:subject:date:from:from:to:cc:subject:date:message-id :reply-to; bh=vlQ+VEDelG91pKGFzrDX4XGQi3DKFINdb7ElVDZR2o0=; b=VSZHWg1ls4maqUOnae4zHznPyPU8YBPV55eDchdddXzau2hiWNB4wVzZrK3xxDyTnA ZafAD1r6+24enL3dna/MNsHOgmNgCGUh9Zd1Iym0Z2z1A6azHKMG4fVr8LJUKBAGPYQ3 nsUPVdhRBbfEWx2bS2o32Cyiam9e6V62YIr86PcMpvsdLjKmQmFSs1EyWrsuzekhd/0X KUxRQDHOJ7+QOmBwEaPY9tJwvR+eQmV//R1ahLXuzHu6UOSAwngmPLrg2ObA/hme/LB/ whlPwkZ/OLfjhK3+zlksFlNM73f8gLFoB5TBCQShMs6d0MNYABHUTDc7PjUfyp5Fvlrc YxGw== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20230601; t=1711047811; x=1711652611; h=to:in-reply-to:references:message-id:content-transfer-encoding :mime-version:subject:date:from:x-gm-message-state:from:to:cc :subject:date:message-id:reply-to; bh=vlQ+VEDelG91pKGFzrDX4XGQi3DKFINdb7ElVDZR2o0=; b=VvOeKzrJ4GEy+2tIux+DNzihzv58VwoqRNmT3ycjNoJXtX2c4BPUjh4XYGNubOoqz6 dgzDJOy4Ytiqw0zZGGB9XVwQ+fSMsaZdqN9ZwiBxs35WaSU3RLjIU69+l2Skz7gKywWp kZHx7D+VT3ec6Wf157g/hG26xn7epxkDp+HMmVs7MeKaq4CV+4ne7A9dCMRhUyz+TVuj 3qX8fswNh8QnBscjc55pt5zsle7nDVDNCH8/t6SlOL0+kMseZsYreTKs5bveCUxoyT7Y 9K55gzmPH9T29YYY//hURSGPlgGnHOCromvS7G9YHdTg9yL5XpzCXYAOpVkYNoQ1kiNc ZTlg== X-Gm-Message-State: AOJu0Yy6hesYkR8aRWJU0rwgydtmnA+A1XOaGGlj+TljMHt+MtQ+lRkN eL2vP/EMXnuL5Szk2AWEfEQ20/5rD748snzQ4YQLy9PCQMU7LbtTzwXMU3hhTtHk2IWDSpU1uDo = X-Google-Smtp-Source: AGHT+IGJRDCksRAIknBnzIFdqK2doTWzzfzx/er4kIBBMGvQDTrErEBcjSItzHlNmS/lK8pSC+czBA== X-Received: by 2002:a05:6602:2981:b0:7d0:2b22:7221 with SMTP id o1-20020a056602298100b007d02b227221mr330040ior.20.1711047810670; Thu, 21 Mar 2024 12:03:30 -0700 (PDT) Received: from localhost.localdomain (97-122-82-115.hlrn.qwest.net. [97.122.82.115]) by smtp.gmail.com with ESMTPSA id dp10-20020a0566381c8a00b00476f2bfc3f8sm53358jab.87.2024.03.21.12.03.30 for (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Thu, 21 Mar 2024 12:03:30 -0700 (PDT) From: Tom Tromey Date: Thu, 21 Mar 2024 13:03:30 -0600 Subject: [PATCH 02/12] Implement Ada 2022 iterated assignment MIME-Version: 1.0 Message-Id: <20240321-ada-iterated-assign-v1-2-925cdd4f1f4a@adacore.com> References: <20240321-ada-iterated-assign-v1-0-925cdd4f1f4a@adacore.com> In-Reply-To: <20240321-ada-iterated-assign-v1-0-925cdd4f1f4a@adacore.com> To: gdb-patches@sourceware.org X-Mailer: b4 0.12.4 X-Spam-Status: No, score=-11.2 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 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 iterated assignment for array initialization. This patch implements a subset of this for gdb. In particular, only arrays with integer index types really work -- currently there's no decent way to get the index type in EVAL_AVOID_SIDE_EFFECTS mode during parsing. Fixing this probably requires the Ada parser to take a somewhat more sophisticated approach to type resolution; and while this would help fix another bug in this area, this patch is already useful without it. --- gdb/ada-exp.h | 77 ++++++++++++++++++++++++++ gdb/ada-exp.y | 52 +++++++++++++++-- gdb/ada-lang.c | 49 +++++++++++++++- gdb/ada-lex.l | 1 + gdb/testsuite/gdb.ada/iterated-assign.exp | 37 +++++++++++++ gdb/testsuite/gdb.ada/iterated-assign/main.adb | 24 ++++++++ gdb/testsuite/gdb.ada/iterated-assign/pck.adb | 23 ++++++++ gdb/testsuite/gdb.ada/iterated-assign/pck.ads | 26 +++++++++ 8 files changed, 284 insertions(+), 5 deletions(-) diff --git a/gdb/ada-exp.h b/gdb/ada-exp.h index 6122502dcdc..94e4ea0f47e 100644 --- a/gdb/ada-exp.h +++ b/gdb/ada-exp.h @@ -611,6 +611,15 @@ struct aggregate_assigner to. */ std::vector indices; +private: + + /* The current index value. This is only valid during the 'assign' + operation and is part of the implementation of iterated component + association. */ + LONGEST m_current_index = 0; + +public: + /* 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). */ @@ -620,6 +629,10 @@ struct aggregate_assigner [ INDICES[0] .. INDICES[1] ],... The resulting intervals do not overlap. */ void add_interval (LONGEST low, LONGEST high); + + /* Return the current index as a value, using the index type of + LHS. */ + value *current_value () const; }; /* This abstract class represents a single component in an Ada @@ -800,16 +813,80 @@ class ada_choices_component : public ada_component m_assocs = std::move (assoc); } + /* Set the underlying operation */ + void set_operation (operation_up op) + { m_op = std::move (op); } + + /* Set the index variable name for an iterated association. */ + void set_name (std::string &&name) + { m_name = std::move (name); } + + /* The name of this choice component. This is empty unless this is + an iterated association. */ + const std::string &name () const + { return m_name; } + void assign (aggregate_assigner &assigner) override; bool uses_objfile (struct objfile *objfile) override; void dump (ui_file *stream, int depth) override; + /* Return the current value of the index variable. This may only be + called underneath a call to 'assign'. */ + value *current_value () const + { return m_assigner->current_value (); } + private: std::vector m_assocs; operation_up m_op; + + /* Name of the variable used for iteration. This isn't needed for + evaluation, only for debug dumping. This is the empty string for + ordinary (non-iterated) choices. */ + std::string m_name; + + /* A pointer to the current assignment operation; only valid when in + a call to the 'assign' method. This is used to find the index + variable value during the evaluation of the RHS of the =>, via + ada_index_var_operation. */ + const aggregate_assigner *m_assigner = nullptr; +}; + +/* Implement the index variable for iterated component + association. */ +class ada_index_var_operation : public operation +{ +public: + + ada_index_var_operation () + { } + + /* Link this variable to the choices object. May only be called + once. */ + void set_choices (ada_choices_component *var) + { + gdb_assert (m_var == nullptr && var != nullptr); + m_var = var; + } + + value *evaluate (struct type *expect_type, + struct expression *exp, + enum noside noside) override; + + enum exp_opcode opcode () const override + { + /* It doesn't really matter. */ + return OP_VAR_VALUE; + } + + void dump (struct ui_file *stream, int depth) const override; + +private: + + /* The choices component that introduced the index variable. */ + ada_choices_component *m_var = nullptr; }; /* An association that uses a discrete range. */ diff --git a/gdb/ada-exp.y b/gdb/ada-exp.y index 2b205714d7a..c0a5b0534a6 100644 --- a/gdb/ada-exp.y +++ b/gdb/ada-exp.y @@ -422,6 +422,10 @@ typedef std::unique_ptr ada_assign_up; to implement '@', the target name symbol. */ static std::vector assignments; +/* Track currently active iterated assignment names. */ +static std::unordered_map> + iterated_associations; + %} %union @@ -488,7 +492,7 @@ static std::vector assignments; forces a.b.c, e.g., to be LEFT-associated. */ %right '.' '(' '[' DOT_ID DOT_COMPLETE -%token NEW OTHERS +%token NEW OTHERS FOR %% @@ -1098,6 +1102,33 @@ component_group : ada_choices_component *choices = choice_component (); choices->set_associations (pop_associations ($1)); } + | FOR NAME IN + { + std::string name = copy_name ($2); + + auto iter = iterated_associations.find (name); + if (iter != iterated_associations.end ()) + error (_("Nested use of index parameter '%s'"), + name.c_str ()); + + iterated_associations[name] = {}; + } + component_associations + { + std::string name = copy_name ($2); + + ada_choices_component *choices = choice_component (); + choices->set_associations (pop_associations ($5)); + + auto iter = iterated_associations.find (name); + gdb_assert (iter != iterated_associations.end ()); + for (ada_index_var_operation *var : iter->second) + var->set_choices (choices); + + iterated_associations.erase (name); + + choices->set_name (std::move (name)); + } ; /* We use this somewhat obscure definition in order to handle NAME => and @@ -1207,6 +1238,7 @@ ada_parse (struct parser_state *par_state) associations.clear (); int_storage.clear (); assignments.clear (); + iterated_associations.clear (); int result = yyparse (); if (!result) @@ -1652,10 +1684,22 @@ write_var_or_type (struct parser_state *par_state, char *encoded_name; int name_len; - if (block == NULL) - block = par_state->expression_context_block; - std::string name_storage = ada_encode (name0.ptr); + + if (block == nullptr) + { + auto iter = iterated_associations.find (name_storage); + if (iter != iterated_associations.end ()) + { + auto op = std::make_unique (); + iter->second.push_back (op.get ()); + par_state->push (std::move (op)); + return nullptr; + } + + block = par_state->expression_context_block; + } + name_len = name_storage.size (); encoded_name = obstack_strndup (&temp_parse_space, name_storage.c_str (), name_len); diff --git a/gdb/ada-lang.c b/gdb/ada-lang.c index c9cbeca40bc..d65ac70f251 100644 --- a/gdb/ada-lang.c +++ b/gdb/ada-lang.c @@ -9343,6 +9343,8 @@ aggregate_assigner::assign (LONGEST index, operation_up &arg) elt = ada_to_fixed_value (elt); } + scoped_restore save_index = make_scoped_restore (&m_current_index, index); + ada_aggregate_operation *ag_op = dynamic_cast (arg.get ()); if (ag_op != nullptr) @@ -9353,6 +9355,18 @@ aggregate_assigner::assign (LONGEST index, operation_up &arg) EVAL_NORMAL)); } +/* See ada-exp.h. */ + +value * +aggregate_assigner::current_value () const +{ + /* Note that using an integer type here is incorrect -- the type + should be the array's index type. Unfortunately, though, this + isn't currently available during parsing and type resolution. */ + struct type *index_type = builtin_type (exp->gdbarch)->builtin_int; + return value_from_longest (index_type, m_current_index); +} + bool ada_aggregate_component::uses_objfile (struct objfile *objfile) { @@ -9598,8 +9612,15 @@ ada_choices_component::uses_objfile (struct objfile *objfile) void ada_choices_component::dump (ui_file *stream, int depth) { - gdb_printf (stream, _("%*sChoices:\n"), depth, ""); + if (m_name.empty ()) + gdb_printf (stream, _("%*sChoices:\n"), depth, ""); + else + { + gdb_printf (stream, _("%*sIterated choices:\n"), depth, ""); + gdb_printf (stream, _("%*sName: %s\n"), depth + 1, "", m_name.c_str ()); + } m_op->dump (stream, depth + 1); + for (const auto &item : m_assocs) item->dump (stream, depth + 1); } @@ -9611,10 +9632,36 @@ ada_choices_component::dump (ui_file *stream, int depth) void ada_choices_component::assign (aggregate_assigner &assigner) { + scoped_restore save_index = make_scoped_restore (&m_assigner, &assigner); for (auto &item : m_assocs) item->assign (assigner, m_op); } +void +ada_index_var_operation::dump (struct ui_file *stream, int depth) const +{ + gdb_printf (stream, _("%*sIndex variable: %s\n"), depth, "", + m_var->name ().c_str ()); +} + +value * +ada_index_var_operation::evaluate (struct type *expect_type, + struct expression *exp, + enum noside noside) +{ + if (noside == EVAL_AVOID_SIDE_EFFECTS) + { + /* Note that using an integer type here is incorrect -- the type + should be the array's index type. Unfortunately, though, + this isn't currently available during parsing and type + resolution. */ + struct type *index_type = builtin_type (exp->gdbarch)->builtin_int; + return value::zero (index_type, not_lval); + } + + return m_var->current_value (); +} + bool ada_others_component::uses_objfile (struct objfile *objfile) { diff --git a/gdb/ada-lex.l b/gdb/ada-lex.l index c54cd5e452a..e1abf9adc25 100644 --- a/gdb/ada-lex.l +++ b/gdb/ada-lex.l @@ -227,6 +227,7 @@ abs { return ABS; } and { return _AND_; } delta { return DELTA; } else { return ELSE; } +for { return FOR; } in { return IN; } mod { return MOD; } new { return NEW; } diff --git a/gdb/testsuite/gdb.ada/iterated-assign.exp b/gdb/testsuite/gdb.ada/iterated-assign.exp new file mode 100644 index 00000000000..76b038fb45c --- /dev/null +++ b/gdb/testsuite/gdb.ada/iterated-assign.exp @@ -0,0 +1,37 @@ +# 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 a1 := (for i in 1..4 => 2 * i + 1)" \ + " = \\(3, 5, 7, 9\\)" \ + "simple iterated assignment" + +gdb_test "print a2 := (for i in 1..2 => (for j in 1..2 => 3 * i + j))" \ + " = \\(\\(4, 5\\), \\(7, 8\\)\\)" \ + "nested iterated assignment" diff --git a/gdb/testsuite/gdb.ada/iterated-assign/main.adb b/gdb/testsuite/gdb.ada/iterated-assign/main.adb new file mode 100644 index 00000000000..239c22cd8a8 --- /dev/null +++ b/gdb/testsuite/gdb.ada/iterated-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 + A1 : Other_Array_Type := (2, 4, 6, 8); + A2 : MD_Array_Type := ((1, 2), (3, 4)); +begin + Do_Nothing (A1'Address); -- STOP + Do_Nothing (A2'Address); +end Main; diff --git a/gdb/testsuite/gdb.ada/iterated-assign/pck.adb b/gdb/testsuite/gdb.ada/iterated-assign/pck.adb new file mode 100644 index 00000000000..14580e66be1 --- /dev/null +++ b/gdb/testsuite/gdb.ada/iterated-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/iterated-assign/pck.ads b/gdb/testsuite/gdb.ada/iterated-assign/pck.ads new file mode 100644 index 00000000000..b77af7264c4 --- /dev/null +++ b/gdb/testsuite/gdb.ada/iterated-assign/pck.ads @@ -0,0 +1,26 @@ +-- 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 Other_Array_Type is array (1 .. 4) of Integer; + + type MD_Array_Type is array (1 .. 2, 1 .. 2) of Integer; + + procedure Do_Nothing (A : System.Address); + +end Pck;