From patchwork Mon May 16 08:43:04 2022 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Pierre-Marie de Rodat X-Patchwork-Id: 54007 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 31E7C385780C for ; Mon, 16 May 2022 08:51:44 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 31E7C385780C DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gcc.gnu.org; s=default; t=1652691104; bh=qlpWj9poVwFKE57WB27jqJo3JKHJXjFJBlF1jOSWiv0=; h=Date:To:Subject:List-Id:List-Unsubscribe:List-Archive:List-Post: List-Help:List-Subscribe:From:Reply-To:Cc:From; b=gFJMexjs3xTTcjomfJapjeu91MaPTM7KGZXFSi/lbixdr19byazZP67Ejqjob0ASD LZCbG3jS9KB39OprsyL67MePxdjcfYRoaHKSIo+FR9IwhieTBMrETd833CtyhcMbHk u9ctThXH7SEgMrz7nZzbw9xm41kKvKm1fUSRy31k= X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from mail-wr1-x432.google.com (mail-wr1-x432.google.com [IPv6:2a00:1450:4864:20::432]) by sourceware.org (Postfix) with ESMTPS id A68D13857823 for ; Mon, 16 May 2022 08:43:05 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.1 sourceware.org A68D13857823 Received: by mail-wr1-x432.google.com with SMTP id m1so19472270wrb.8 for ; Mon, 16 May 2022 01:43:05 -0700 (PDT) X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20210112; h=x-gm-message-state:date:from:to:cc:subject:message-id:mime-version :content-disposition; bh=qlpWj9poVwFKE57WB27jqJo3JKHJXjFJBlF1jOSWiv0=; b=09DJxmAOHu8S4GJ1i48umTQTrw01smcq849uW6kT4Ri71+rqz6x/ShVfkTyYt+4tFG Ym3wZ1/l/JN15Ll4oJ2DAB/GppnKAelLFfrh7l6+l4XZqS+prBQvp1Ne9Rf9bVgwDkdf jsrbvFZi9GhrDUvf1FPKASrXUzFipmXh8sjIcHLYqJndpsz4P+hkWjCeV/8+HhtFIXQl K8XQ8cw6c0Nu1Bo+Kgx+dfpF3KoLgeDcWkiGjxArJo8G4oIck/n56TbuUKNePuxecQkk XYYGjaG0ThpCY3S8WMwijDrAQxZCGkLsY+RBQHVT47st092RJI/oJhAXRH4RKey2WGer iJfw== X-Gm-Message-State: AOAM532TbS8GmjNFh64sNZyAN8QXbqrnxVccrALdMjkiFMbgFZJJpIqN nlBnZmZjahNzKznp774QcmRP6VYXumvWHQ== X-Google-Smtp-Source: ABdhPJwNHEP+IKtPpLw3JzveCwVpmj5KCo15A0SeW4pN/movS4pC63L5iqBL6gx1R3F21IVeFGX57g== X-Received: by 2002:a05:6000:178d:b0:20c:b1fb:abe9 with SMTP id e13-20020a056000178d00b0020cb1fbabe9mr13196684wrg.452.1652690585278; Mon, 16 May 2022 01:43:05 -0700 (PDT) Received: from adacore.com ([45.147.211.82]) by smtp.gmail.com with ESMTPSA id e17-20020adf9bd1000000b0020c5253d8bdsm10769315wrc.9.2022.05.16.01.43.04 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Mon, 16 May 2022 01:43:04 -0700 (PDT) Date: Mon, 16 May 2022 08:43:04 +0000 To: gcc-patches@gcc.gnu.org Subject: [Ada] Implement component finalization ordering rules for type extensions Message-ID: <20220516084304.GA3843504@adacore.com> MIME-Version: 1.0 Content-Disposition: inline X-Spam-Status: No, score=-12.8 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: Pierre-Marie de Rodat via Gcc-patches From: Pierre-Marie de Rodat Reply-To: Pierre-Marie de Rodat Cc: Steve Baird Errors-To: gcc-patches-bounces+patchwork=sourceware.org@gcc.gnu.org Sender: "Gcc-patches" Finalization of a record object is required to finalize any components that have an access discriminant constrained by a per-object expression before other components. This includes the case of a type extension; "early finalization" components of the parent type are required to be finalized before non-early-finalization extension components. This is implemented in the extension type's finalization procedure by placing the call to the parent type's finalization procedure between the finalization of the "early finalization" extension components and the finalization of the other extension components. Previously that call was executed after finalizing all of the extension conponents. Tested on x86_64-pc-linux-gnu, committed on trunk gcc/ada/ * exp_ch7.adb (Build_Finalize_Statements): Add Last_POC_Call variable to keep track of the last "early finalization" call generated for type extension's finalization procedure. If non-empty, then this will indicate the point at which to insert the call to the parent type's finalization procedure. Modify nested function Process_Component_List_For_Finalize to set this variable (and avoid setting it during a recursive call). If Last_POC_Call is empty, then insert the parent finalization call before, rather than after, the finalization code for the extension components. diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb --- a/gcc/ada/exp_ch7.adb +++ b/gcc/ada/exp_ch7.adb @@ -8273,19 +8273,23 @@ package body Exp_Ch7 is Counter : Nat := 0; Finalizer_Data : Finalization_Exception_Data; + Last_POC_Call : Node_Id := Empty; function Process_Component_List_For_Finalize - (Comps : Node_Id) return List_Id; + (Comps : Node_Id; + In_Variant_Part : Boolean := False) return List_Id; -- Build all necessary finalization statements for a single component -- list. The statements may include a jump circuitry if flag Is_Local - -- is enabled. + -- is enabled. In_Variant_Part indicates whether this is a recursive + -- call. ----------------------------------------- -- Process_Component_List_For_Finalize -- ----------------------------------------- function Process_Component_List_For_Finalize - (Comps : Node_Id) return List_Id + (Comps : Node_Id; + In_Variant_Part : Boolean := False) return List_Id is procedure Process_Component_For_Finalize (Decl : Node_Id; @@ -8467,7 +8471,8 @@ package body Exp_Ch7 is New_Copy_List (Discrete_Choices (Var)), Statements => Process_Component_List_For_Finalize ( - Component_List (Var)))); + Component_List (Var), + In_Variant_Part => True))); Next_Non_Pragma (Var); end loop; @@ -8534,6 +8539,12 @@ package body Exp_Ch7 is end loop; end if; + if not In_Variant_Part then + Last_POC_Call := Last (Stmts); + -- In the case of a type extension, the deep-finalize call + -- for the _Parent component will be inserted here. + end if; + -- Process the rest of the components in reverse order Decl := Last_Non_Pragma (Component_Items (Comps)); @@ -8749,7 +8760,38 @@ package body Exp_Ch7 is (Finalizer_Data)))); end if; - Append_To (Bod_Stmts, Fin_Stmt); + -- The intended component finalization order is + -- 1) POC components of extension + -- 2) _Parent component + -- 3) non-POC components of extension. + -- + -- With this "finalize the parent part in the middle" + -- ordering, we can avoid the need for making two + -- calls to the parent's subprogram in the way that + -- is necessary for Init_Procs. This does have the + -- peculiar (but legal) consequence that the parent's + -- non-POC components are finalized before the + -- non-POC extension components. This violates the + -- usual "finalize in reverse declaration order" + -- principle, but that's ok (see Ada RM 7.6.1(9)). + -- + -- Last_POC_Call should be non-empty if the extension + -- has at least one POC. Interactions with variant + -- parts are incorrectly ignored. + + if Present (Last_POC_Call) then + Insert_After (Last_POC_Call, Fin_Stmt); + else + -- At this point, we could look for the common case + -- where there are no POC components anywhere in + -- sight (inherited or not) and, in that common case, + -- call Append_To instead of Prepend_To. That would + -- result in finalizing the parent part after, rather + -- than before, the extension components. That might + -- be more intuitive (as discussed in preceding + -- comment), but it is not required. + Prepend_To (Bod_Stmts, Fin_Stmt); + end if; end if; end if; end;