From patchwork Tue May 30 07:21:03 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: 70288 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 64F6638532C2 for ; Tue, 30 May 2023 07:25:11 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 64F6638532C2 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gcc.gnu.org; s=default; t=1685431511; bh=W6bcHjfPciiduUAfRkarIvD8yQDXN6k1MzjAYGTaIDo=; h=To:Cc:Subject:Date:List-Id:List-Unsubscribe:List-Archive: List-Post:List-Help:List-Subscribe:From:Reply-To:From; b=kqGM3rzx6teFqTPKZWi723vycERffBUCD7Q87gE9JIRvnHqUNbaKgztVbJxxHVuQr Tsc417ru1tzhPjMXavWIg40PnldoUsijhZMzj+ENliduFQBuOk0WsAaQjTz4JMBp+U SA8UBSdM112Thyih548cDm5Q/pYxBlgIWOX27a4o= X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from mail-wm1-x32d.google.com (mail-wm1-x32d.google.com [IPv6:2a00:1450:4864:20::32d]) by sourceware.org (Postfix) with ESMTPS id 76A2338532D8 for ; Tue, 30 May 2023 07:21:06 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org 76A2338532D8 Received: by mail-wm1-x32d.google.com with SMTP id 5b1f17b1804b1-3f6dbe3c230so42368425e9.3 for ; Tue, 30 May 2023 00:21:06 -0700 (PDT) X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20221208; t=1685431265; x=1688023265; 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=W6bcHjfPciiduUAfRkarIvD8yQDXN6k1MzjAYGTaIDo=; b=cZLxogFYB9Mkw4QYBIFLuXkzRmx7fPf6PLx8DMuXKF9lnjX1U0O0LX7yX3dg/RsStD ncNBPcUL4KtnKpeifZsKNfSi2S8RYg8blqh9ME3zmPX4LvCVaZw0LX50Wffmr4Rkv1hn tgUIXVusaq0rKAkQnwhjrubh/sBqsrqMOtA3bswfniBSSIolwqtRNEsAIafgFORxYqaW 8KoS9v3C3g0QVIl2Ci7miOjKh3X1QEV1sgSsQVZWc+aDy06/l7j7KdQJPho2pvIp9Ofh O5GVeELym5p7STNLrVmFPas6KE3RXlimIxc+v19eCTkt44HIisTN1NhM363ELqrA9e4Q lURQ== X-Gm-Message-State: AC+VfDyfLXcMnPf7K0rjxste5ZrvuGDPGj1RyhPxJnBhueA2AWgkYO0j RqpkdlcVcujyeM3QvjN5JPOwRKiR6XA2rn4up/S/2A== X-Google-Smtp-Source: ACHHUZ6C1aP5K5I2sti56Rv8f5O6Mq2A8guLOHnErIi88KhfX/7BZOhYWGWiPFi9yGfDNmobWAcemA== X-Received: by 2002:a7b:c048:0:b0:3f6:8c0:85b3 with SMTP id u8-20020a7bc048000000b003f608c085b3mr1336862wmc.12.1685431265338; Tue, 30 May 2023 00:21:05 -0700 (PDT) Received: from localhost.localdomain ([2001:861:3382:1a90:7733:a608:a415:6b2a]) by smtp.gmail.com with ESMTPSA id n14-20020a1c720e000000b003f4b6bcbd8bsm16538458wmc.31.2023.05.30.00.21.04 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Tue, 30 May 2023 00:21:04 -0700 (PDT) To: gcc-patches@gcc.gnu.org Cc: Eric Botcazou Subject: [COMMITTED] ada: Small cleanups and fixes in expansion of aggregates Date: Tue, 30 May 2023 09:21:03 +0200 Message-Id: <20230530072103.2500241-1-poulhies@adacore.com> X-Mailer: git-send-email 2.40.0 MIME-Version: 1.0 X-Spam-Status: No, score=-13.2 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 This streamlines the handling of qualified expressions in the expansion of aggregates and plugs a couple of loopholes that may cause memory leaks. gcc/ada/ * exp_aggr.adb (Build_Array_Aggr_Code): Move the declaration of Typ to the beginning. (Initialize_Array_Component): Test the unqualified version of the expression for the nested array case. (Initialize_Ctrl_Array_Component): Do not duplicate the expression here. Do the pattern matching of the unqualified version of it. (Gen_Assign): Call Unqualify to compute Expr_Q and use Expr_Q in subsequent pattern matching. (Initialize_Ctrl_Record_Component): Do the pattern matching of the unqualified version of the aggregate. (Build_Record_Aggr_Code): Call Unqualify. (Convert_Aggr_In_Assignment): Likewise. (Convert_Aggr_In_Object_Decl): Likewise. (Component_OK_For_Backend): Likewise. (Is_Delayed_Aggregate): Likewise. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/exp_aggr.adb | 90 ++++++++++++++------------------------------ 1 file changed, 28 insertions(+), 62 deletions(-) diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb index da31d2480f2..270d3bb8d66 100644 --- a/gcc/ada/exp_aggr.adb +++ b/gcc/ada/exp_aggr.adb @@ -1060,6 +1060,7 @@ package body Exp_Aggr is Indexes : List_Id := No_List) return List_Id is Loc : constant Source_Ptr := Sloc (N); + Typ : constant Entity_Id := Etype (N); Index_Base : constant Entity_Id := Base_Type (Etype (Index)); Index_Base_L : constant Node_Id := Type_Low_Bound (Index_Base); Index_Base_H : constant Node_Id := Type_High_Bound (Index_Base); @@ -1460,7 +1461,7 @@ package body Exp_Aggr is and then not (Is_Array_Type (Comp_Typ) and then Needs_Finalization (Component_Type (Comp_Typ)) - and then Nkind (Expr) = N_Aggregate) + and then Nkind (Unqualify (Init_Expr)) = N_Aggregate) then Adj_Call := Make_Adjust_Call @@ -1522,9 +1523,10 @@ package body Exp_Aggr is Init_Expr : Node_Id; Stmts : List_Id) is + Init_Expr_Q : constant Node_Id := Unqualify (Init_Expr); + Act_Aggr : Node_Id; Act_Stmts : List_Id; - Expr : Node_Id; Fin_Call : Node_Id; Hook_Clear : Node_Id; @@ -1533,29 +1535,20 @@ package body Exp_Aggr is -- in-place expansion. begin - -- Duplicate the initialization expression in case the context is - -- a multi choice list or an "others" choice which plugs various - -- holes in the aggregate. As a result the expression is no longer - -- shared between the various components and is reevaluated for - -- each such component. - - Expr := New_Copy_Tree (Init_Expr); - Set_Parent (Expr, Parent (Init_Expr)); - -- Perform a preliminary analysis and resolution to determine what -- the initialization expression denotes. An unanalyzed function -- call may appear as an identifier or an indexed component. - if Nkind (Expr) in N_Function_Call - | N_Identifier - | N_Indexed_Component - and then not Analyzed (Expr) + if Nkind (Init_Expr_Q) in N_Function_Call + | N_Identifier + | N_Indexed_Component + and then not Analyzed (Init_Expr) then - Preanalyze_And_Resolve (Expr, Comp_Typ); + Preanalyze_And_Resolve (Init_Expr, Comp_Typ); end if; In_Place_Expansion := - Nkind (Expr) = N_Function_Call + Nkind (Init_Expr_Q) = N_Function_Call and then not Is_Build_In_Place_Result_Type (Comp_Typ); -- The initialization expression is a controlled function call. @@ -1572,7 +1565,7 @@ package body Exp_Aggr is -- generation of a transient scope, which leads to out-of-order -- adjustment and finalization. - Set_No_Side_Effect_Removal (Expr); + Set_No_Side_Effect_Removal (Init_Expr); -- When the transient component initialization is related to a -- range or an "others", keep all generated statements within @@ -1598,7 +1591,7 @@ package body Exp_Aggr is Process_Transient_Component (Loc => Loc, Comp_Typ => Comp_Typ, - Init_Expr => Expr, + Init_Expr => Init_Expr, Fin_Call => Fin_Call, Hook_Clear => Hook_Clear, Aggr => Act_Aggr, @@ -1613,7 +1606,7 @@ package body Exp_Aggr is Initialize_Array_Component (Arr_Comp => Arr_Comp, Comp_Typ => Comp_Typ, - Init_Expr => Expr, + Init_Expr => Init_Expr, Stmts => Stmts); -- At this point the array element is fully initialized. Complete @@ -1676,13 +1669,7 @@ package body Exp_Aggr is -- Ada 2005 (AI-287): In case of default initialized component, Expr -- is not present (and therefore we also initialize Expr_Q to empty). - if No (Expr) then - Expr_Q := Empty; - elsif Nkind (Expr) = N_Qualified_Expression then - Expr_Q := Expression (Expr); - else - Expr_Q := Expr; - end if; + Expr_Q := Unqualify (Expr); if Present (Etype (N)) and then Etype (N) /= Any_Composite then Comp_Typ := Component_Type (Etype (N)); @@ -1815,7 +1802,7 @@ package body Exp_Aggr is if Present (Comp_Typ) and then Needs_Finalization (Comp_Typ) - and then Nkind (Expr) /= N_Aggregate + and then Nkind (Expr_Q) /= N_Aggregate then Initialize_Ctrl_Array_Component (Arr_Comp => Indexed_Comp, @@ -2298,7 +2285,6 @@ package body Exp_Aggr is Assoc : Node_Id; Choice : Node_Id; Expr : Node_Id; - Typ : constant Entity_Id := Etype (N); Bounds : Range_Nodes; Low : Node_Id renames Bounds.First; @@ -3143,6 +3129,8 @@ package body Exp_Aggr is Init_Expr : Node_Id; Stmts : List_Id) is + Init_Expr_Q : constant Node_Id := Unqualify (Init_Expr); + Fin_Call : Node_Id; Hook_Clear : Node_Id; @@ -3155,16 +3143,16 @@ package body Exp_Aggr is -- the initialization expression denotes. Unanalyzed function calls -- may appear as identifiers or indexed components. - if Nkind (Init_Expr) in N_Function_Call - | N_Identifier - | N_Indexed_Component + if Nkind (Init_Expr_Q) in N_Function_Call + | N_Identifier + | N_Indexed_Component and then not Analyzed (Init_Expr) then Preanalyze_And_Resolve (Init_Expr, Comp_Typ); end if; In_Place_Expansion := - Nkind (Init_Expr) = N_Function_Call + Nkind (Init_Expr_Q) = N_Function_Call and then not Is_Build_In_Place_Result_Type (Comp_Typ); -- The initialization expression is a controlled function call. @@ -3919,11 +3907,7 @@ package body Exp_Aggr is Prefix => New_Copy_Tree (Target), Selector_Name => New_Occurrence_Of (Selector, Loc)); - if Nkind (Expression (Comp)) = N_Qualified_Expression then - Expr_Q := Expression (Expression (Comp)); - else - Expr_Q := Expression (Comp); - end if; + Expr_Q := Unqualify (Expression (Comp)); -- Now either create the assignment or generate the code for the -- inner aggregate top-down. @@ -4319,15 +4303,11 @@ package body Exp_Aggr is -------------------------------- procedure Convert_Aggr_In_Assignment (N : Node_Id) is - Aggr : Node_Id := Expression (N); + Aggr : constant Node_Id := Unqualify (Expression (N)); Typ : constant Entity_Id := Etype (Aggr); Occ : constant Node_Id := New_Copy_Tree (Name (N)); begin - if Nkind (Aggr) = N_Qualified_Expression then - Aggr := Expression (Aggr); - end if; - Insert_Actions_After (N, Late_Expansion (Aggr, Typ, Occ)); end Convert_Aggr_In_Assignment; @@ -4337,7 +4317,7 @@ package body Exp_Aggr is procedure Convert_Aggr_In_Object_Decl (N : Node_Id) is Obj : constant Entity_Id := Defining_Identifier (N); - Aggr : Node_Id := Expression (N); + Aggr : constant Node_Id := Unqualify (Expression (N)); Loc : constant Source_Ptr := Sloc (Aggr); Typ : constant Entity_Id := Etype (Aggr); Occ : constant Node_Id := New_Occurrence_Of (Obj, Loc); @@ -4417,10 +4397,6 @@ package body Exp_Aggr is begin Set_Assignment_OK (Occ); - if Nkind (Aggr) = N_Qualified_Expression then - Aggr := Expression (Aggr); - end if; - if Has_Discriminants (Typ) and then Typ /= Etype (Obj) and then Is_Constrained (Etype (Obj)) @@ -8682,11 +8658,7 @@ package body Exp_Aggr is return False; end if; - if Nkind (Expression (C)) = N_Qualified_Expression then - Expr_Q := Expression (Expression (C)); - else - Expr_Q := Expression (C); - end if; + Expr_Q := Unqualify (Expression (C)); -- Return False for array components whose bounds raise -- constraint error. @@ -9085,17 +9057,11 @@ package body Exp_Aggr is -------------------------- function Is_Delayed_Aggregate (N : Node_Id) return Boolean is - Node : Node_Id := N; - Kind : Node_Kind := Nkind (Node); + Unqual_N : constant Node_Id := Unqualify (N); begin - if Kind = N_Qualified_Expression then - Node := Expression (Node); - Kind := Nkind (Node); - end if; - - return Kind in N_Aggregate | N_Extension_Aggregate - and then Expansion_Delayed (Node); + return Nkind (Unqual_N) in N_Aggregate | N_Extension_Aggregate + and then Expansion_Delayed (Unqual_N); end Is_Delayed_Aggregate; --------------------------------