From patchwork Mon May 29 08:29:51 2023 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: =?utf-8?q?Marc_Poulhi=C3=A8s?= X-Patchwork-Id: 70233 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 2C6A9392AC07 for ; Mon, 29 May 2023 08:38:23 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 2C6A9392AC07 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gcc.gnu.org; s=default; t=1685349503; bh=BwypghwfTNm42PLsVS3KcJKAsO5iEpNjthEuBxnoMMo=; h=To:Cc:Subject:Date:List-Id:List-Unsubscribe:List-Archive: List-Post:List-Help:List-Subscribe:From:Reply-To:From; b=ZTWBpR9IbBpYXi2muk3c9XeBBpVMG0XrjudMe9EcKqLzaKJdmjpqeVGXTBJf5fasr YugPCwb+9xDjc/xNCBTUBeGsu1oik6bcY1f2CVS3pXdyPv6PnjWr2GYUT1Y015qoQU TWn7/fE8ja9pB103saOVU1za5UYfBfhSXgO11PxU= X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from mail-wr1-x42c.google.com (mail-wr1-x42c.google.com [IPv6:2a00:1450:4864:20::42c]) by sourceware.org (Postfix) with ESMTPS id 4469D385700F for ; Mon, 29 May 2023 08:29:54 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org 4469D385700F Received: by mail-wr1-x42c.google.com with SMTP id ffacd0b85a97d-30789a4c537so1707944f8f.0 for ; Mon, 29 May 2023 01:29:54 -0700 (PDT) X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20221208; t=1685348993; x=1687940993; 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=BwypghwfTNm42PLsVS3KcJKAsO5iEpNjthEuBxnoMMo=; b=doTFXbYJROkMzxEdVMt/67AXH4rPR0yKdHvX7i8geUJHc4RiW828qWDK3bp/AP67G8 qQAswKKT1aucb27Ff5AQ7FU82hnY5VgcjwvlROhRAfAtc8Wm6N+n2BxJ92hcXXtY2zIj 4M0PahxU8uF9sFjQ6+jk/X4g0r/2VUPtGK1lJvBUVU7qsAdDbVoKqhoLMe/ck4cod6PA CtlMVO6DYPPChVVHpKO/3IF/3AN/paFKJGnpFNqkTVM+1u4tkF5tgy4qwPgcaHgGM3pB wg/Lf2Z4whSWFTCH083nfow1oVd/SJstzSLUDRe3QIQpVRLlE8VDpO/iWFpPlsOk2u0g 6h6g== X-Gm-Message-State: AC+VfDxLCveR2ZDmGDPdceRmuYzbYRJONGhHnWOil/ujAMFNe2ZksPH9 p6mMXFnwbzB4iLTgBtBFdgBh+zurEdXW400cqA2yCw== X-Google-Smtp-Source: ACHHUZ4XpiQIp6CppP0qv3gc5whg5iwHIiZnnPH2MA75yiwxLAkvNhJ79lIfbnoAUxDqrBit+ii4MA== X-Received: by 2002:a5d:6a4c:0:b0:307:9a49:da8a with SMTP id t12-20020a5d6a4c000000b003079a49da8amr8035696wrw.26.1685348993091; Mon, 29 May 2023 01:29:53 -0700 (PDT) Received: from poulhies-Precision-5550.telnowedge.local (lmontsouris-659-1-24-67.w81-250.abo.wanadoo.fr. [81.250.175.67]) by smtp.gmail.com with ESMTPSA id t14-20020a5d6a4e000000b0030add836194sm8501721wrw.65.2023.05.29.01.29.52 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Mon, 29 May 2023 01:29:52 -0700 (PDT) To: gcc-patches@gcc.gnu.org Cc: Eric Botcazou Subject: [COMMITTED] ada: Fix wrong finalization for loop on indexed container Date: Mon, 29 May 2023 10:29:51 +0200 Message-Id: <20230529082951.2411129-1-poulhies@adacore.com> X-Mailer: git-send-email 2.40.0 MIME-Version: 1.0 X-Spam-Status: No, score=-13.3 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, DKIM_VALID_AU, DKIM_VALID_EF, GIT_PATCH_0, KAM_ASCII_DIVIDERS, 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: gcc-patches@gcc.gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: Gcc-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , X-Patchwork-Original-From: =?utf-8?q?Marc_Poulhi=C3=A8s_via_Gcc-patches?= From: =?utf-8?q?Marc_Poulhi=C3=A8s?= Reply-To: =?utf-8?q?Marc_Poulhi=C3=A8s?= Errors-To: gcc-patches-bounces+patchwork=sourceware.org@gcc.gnu.org Sender: "Gcc-patches" From: Eric Botcazou The problem is that a transient temporary created for the constant indexing of the container is finalized almost immediately after its creation. gcc/ada/ * exp_util.adb (Is_Finalizable_Transient.Is_Indexed_Container): New predicate to detect a temporary created to hold the result of a constant indexing on a container. (Is_Finalizable_Transient.Is_Iterated_Container): Adjust a couple of obsolete comments. (Is_Finalizable_Transient): Return False if Is_Indexed_Container returns True on the object. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/exp_util.adb | 102 +++++++++++++++++++++++++++++++++++++++++-- 1 file changed, 99 insertions(+), 3 deletions(-) diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb index f010dac4978..2582524b1dd 100644 --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -8323,6 +8323,13 @@ package body Exp_Util is function Is_Allocated (Trans_Id : Entity_Id) return Boolean; -- Determine whether transient object Trans_Id is allocated on the heap + function Is_Indexed_Container + (Trans_Id : Entity_Id; + First_Stmt : Node_Id) return Boolean; + -- Determine whether transient object Trans_Id denotes a container which + -- is in the process of being indexed in the statement list starting + -- from First_Stmt. + function Is_Iterated_Container (Trans_Id : Entity_Id; First_Stmt : Node_Id) return Boolean; @@ -8597,6 +8604,91 @@ package body Exp_Util is and then Nkind (Expr) = N_Allocator; end Is_Allocated; + -------------------------- + -- Is_Indexed_Container -- + -------------------------- + + function Is_Indexed_Container + (Trans_Id : Entity_Id; + First_Stmt : Node_Id) return Boolean + is + Aspect : Node_Id; + Call : Node_Id; + Index : Entity_Id; + Param : Node_Id; + Stmt : Node_Id; + Typ : Entity_Id; + + begin + -- It is not possible to iterate over containers in non-Ada 2012 code + + if Ada_Version < Ada_2012 then + return False; + end if; + + Typ := Etype (Trans_Id); + + -- Handle access type created for the reference below + + if Is_Access_Type (Typ) then + Typ := Designated_Type (Typ); + end if; + + -- Look for aspect Constant_Indexing. It may be part of a type + -- declaration for a container, or inherited from a base type + -- or parent type. + + Aspect := Find_Value_Of_Aspect (Typ, Aspect_Constant_Indexing); + + if Present (Aspect) then + Index := Entity (Aspect); + + -- Examine the statements following the container object and + -- look for a call to the default indexing routine where the + -- first parameter is the transient. Such a call appears as: + + -- It : Access_To_Constant_Reference_Type := + -- Constant_Indexing (Tran_Id.all, ...)'reference; + + Stmt := First_Stmt; + while Present (Stmt) loop + + -- Detect an object declaration which is initialized by a + -- controlled function call. + + if Nkind (Stmt) = N_Object_Declaration + and then Present (Expression (Stmt)) + and then Nkind (Expression (Stmt)) = N_Reference + and then Nkind (Prefix (Expression (Stmt))) = N_Function_Call + then + Call := Prefix (Expression (Stmt)); + + -- The call must invoke the default indexing routine of + -- the container and the transient object must appear as + -- the first actual parameter. Skip any calls whose names + -- are not entities. + + if Is_Entity_Name (Name (Call)) + and then Entity (Name (Call)) = Index + and then Present (Parameter_Associations (Call)) + then + Param := First (Parameter_Associations (Call)); + + if Nkind (Param) = N_Explicit_Dereference + and then Entity (Prefix (Param)) = Trans_Id + then + return True; + end if; + end if; + end if; + + Next (Stmt); + end loop; + end if; + + return False; + end Is_Indexed_Container; + --------------------------- -- Is_Iterated_Container -- --------------------------- @@ -8621,7 +8713,7 @@ package body Exp_Util is Typ := Etype (Trans_Id); - -- Handle access type created for secondary stack use + -- Handle access type created for the reference below if Is_Access_Type (Typ) then Typ := Designated_Type (Typ); @@ -8647,7 +8739,7 @@ package body Exp_Util is while Present (Stmt) loop -- Detect an object declaration which is initialized by a - -- secondary stack function call. + -- controlled function call. if Nkind (Stmt) = N_Object_Declaration and then Present (Expression (Stmt)) @@ -8766,7 +8858,11 @@ package body Exp_Util is -- transient objects must exist for as long as the loop is around, -- otherwise any operation carried out by the iterator will fail. - and then not Is_Iterated_Container (Obj_Id, Decl); + and then not Is_Iterated_Container (Obj_Id, Decl) + + -- Likewise for indexed containers in the context of iterator loops + + and then not Is_Indexed_Container (Obj_Id, Decl); end Is_Finalizable_Transient; ---------------------------------