From patchwork Thu Jan 6 17:12:50 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: 1576191 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Authentication-Results: bilbo.ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.a=rsa-sha256 header.s=default header.b=mhoJ9iWC; dkim-atps=neutral Authentication-Results: ozlabs.org; spf=pass (sender SPF authorized) smtp.mailfrom=gcc.gnu.org (client-ip=8.43.85.97; helo=sourceware.org; envelope-from=gcc-patches-bounces+incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=) Received: from sourceware.org (ip-8-43-85-97.sourceware.org [8.43.85.97]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits) key-exchange X25519 server-signature RSA-PSS (4096 bits) server-digest SHA256) (No client certificate requested) by bilbo.ozlabs.org (Postfix) with ESMTPS id 4JVCht6tQPz9t0k for ; Fri, 7 Jan 2022 04:17:34 +1100 (AEDT) Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id DB1003858421 for ; Thu, 6 Jan 2022 17:17:31 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org DB1003858421 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gcc.gnu.org; s=default; t=1641489451; bh=SVuj30p58s0QZ9v7BChDeSGbA2+Af81qCsDB2OMfC2k=; h=Date:To:Subject:List-Id:List-Unsubscribe:List-Archive:List-Post: List-Help:List-Subscribe:From:Reply-To:Cc:From; b=mhoJ9iWCFtUcAmfq6TG2dCGbDPixxNBJiXGZkgNKmpg6Ha82qKz51jQ8k0QhAzIvy q5XmSJL0JxKCCXgL06vcNk3LRzioee196a8740LEsUCMjWalBNsOiz6phdhBlqyzoo DvwdLgxB+DVRAjnrSvp1OkPUSchutk0qwaxCbzNQ= X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from mail-wr1-x436.google.com (mail-wr1-x436.google.com [IPv6:2a00:1450:4864:20::436]) by sourceware.org (Postfix) with ESMTPS id 200183858002 for ; Thu, 6 Jan 2022 17:12:53 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.1 sourceware.org 200183858002 Received: by mail-wr1-x436.google.com with SMTP id l10so6101234wrh.7 for ; Thu, 06 Jan 2022 09:12:53 -0800 (PST) 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=SVuj30p58s0QZ9v7BChDeSGbA2+Af81qCsDB2OMfC2k=; b=nasFT2ZxDe/xgtOsGgH1JIdOYiHH/6yBvO82oJzWx3S8X2414s0bKXy1Qek5VVW1sx Eyuat+W+g2RdR4bVrq446nlwFikr7fgsKvsHe3TWdgi7qGOdDKLu4Jzqh8GeNsxoQvV/ +VoejgJXyNfNwOv3Vk/YKiK+TGkBJ8bnjDgGFzjkrE3kM5U03QtdlqKoWmagzKFczjO+ 8RqLiBS+SJ66kFQQWLie8j5d2JafvV0NsoojlDSiGpgnUGxsN5xYpuhR2hgOov/mXfTH WTFtXcVbGxPmOQpmwVOOOsWI9B1zT2r5VLQlwW3Xzgcgbm+gNTd298utxtRrxAHSlFCh NMzQ== X-Gm-Message-State: AOAM532e3nEYupAOBPXH4PKrwv6NdrgRnkur0oXhOd0wDPKoQIL92owM noXZh0AMFBjpCVZsJLTFZQzcgUx8BkULvA== X-Google-Smtp-Source: ABdhPJy2tMUXzRCOnzJQZZl+Q/8PCodrQuqJsDDuuIJRLMg34alTx0dFAIz/g8LnHs4EUD4u+bztZA== X-Received: by 2002:a05:6000:15c2:: with SMTP id y2mr52618959wry.202.1641489172092; Thu, 06 Jan 2022 09:12:52 -0800 (PST) Received: from adacore.com ([45.147.211.82]) by smtp.gmail.com with ESMTPSA id k31sm2346922wms.21.2022.01.06.09.12.51 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Thu, 06 Jan 2022 09:12:51 -0800 (PST) Date: Thu, 6 Jan 2022 17:12:50 +0000 To: gcc-patches@gcc.gnu.org Subject: [Ada] Crash in class-wide pre/postconditions Message-ID: <20220106171250.GA2921406@adacore.com> MIME-Version: 1.0 Content-Disposition: inline X-Spam-Status: No, score=-12.7 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 autolearn=ham autolearn_force=no version=3.4.4 X-Spam-Checker-Version: SpamAssassin 3.4.4 (2020-01-24) 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: Javier Miranda Errors-To: gcc-patches-bounces+incoming=patchwork.ozlabs.org@gcc.gnu.org Sender: "Gcc-patches" The compiler may crash processing a class-wide pre/postcondition that has dispatching calls using the Object.Operation notation. Tested on x86_64-pc-linux-gnu, committed on trunk gcc/ada/ * contracts.adb (Restore_Original_Selected_Component): New subprogram that traverses a preanalyzed expression searching for dispatching calls to functions whose original node was a selected component, and replacing them with their original node. This functionality is required because the preanalyis of dispatching calls using the Object.Operation notation transforms such calls, and we need the original condition to properly inherit and extend the condition expression on tagged type derivations. This functionality was previously provided by the routine Install_Original_Selected_Component (as part of inheriting conditions); now it is performed as part of the preanalysis of the condition, thus avoiding repeatedly installing and restoring such nodes. (Install_Original_Selected_Component): Removed. (Restore_Dispatching_Calls): Removed. diff --git a/gcc/ada/contracts.adb b/gcc/ada/contracts.adb --- a/gcc/ada/contracts.adb +++ b/gcc/ada/contracts.adb @@ -4254,6 +4254,11 @@ package body Contracts is procedure Remove_Formals (Id : Entity_Id); -- Remove formals from homonym chains and make them not visible + procedure Restore_Original_Selected_Component; + -- Traverse Expr searching for dispatching calls to functions whose + -- original node was a selected component, and replace them with + -- their original node. + ---------------------------- -- Clear_Unset_References -- ---------------------------- @@ -4313,6 +4318,46 @@ package body Contracts is end loop; end Remove_Formals; + ----------------------------------------- + -- Restore_Original_Selected_Component -- + ----------------------------------------- + + procedure Restore_Original_Selected_Component is + + function Restore_Node (N : Node_Id) return Traverse_Result; + -- Process a single node + + ------------------ + -- Restore_Node -- + ------------------ + + function Restore_Node (N : Node_Id) return Traverse_Result is + begin + if Nkind (N) = N_Function_Call + and then Nkind (Original_Node (N)) = N_Selected_Component + and then Is_Dispatching_Operation (Entity (Name (N))) + then + Rewrite (N, Original_Node (N)); + Set_Original_Node (N, N); + + -- Restore decoration of its child nodes; required to ensure + -- proper copies of this subtree (if required) by subsequent + -- calls to New_Copy_Tree (since otherwise these child nodes + -- are not duplicated). + + Set_Parent (Prefix (N), N); + Set_Parent (Selector_Name (N), N); + end if; + + return OK; + end Restore_Node; + + procedure Restore_Nodes is new Traverse_Proc (Restore_Node); + + begin + Restore_Nodes (Expr); + end Restore_Original_Selected_Component; + -- Start of processing for Preanalyze_Condition begin @@ -4329,6 +4374,16 @@ package body Contracts is Remove_Formals (Subp); Pop_Scope; + -- If this preanalyzed condition has occurrences of dispatching calls + -- using the Object.Operation notation, during preanalysis such calls + -- are rewritten as dispatching function calls; if at later stages + -- this condition is inherited we must have restored the original + -- selected-component node to ensure that the preanalysis of the + -- inherited condition rewrites these dispatching calls in the + -- correct context to avoid reporting spurious errors. + + Restore_Original_Selected_Component; + -- Traverse Expr and clear the Controlling_Argument of calls to -- nonabstract functions. Required since the preanalyzed condition -- is not yet installed on its definite context and will be cloned @@ -4373,103 +4428,9 @@ package body Contracts is (Par_Subp : Entity_Id; Subp : Entity_Id) return Node_Id is - Installed_Calls : constant Elist_Id := New_Elmt_List; - - procedure Install_Original_Selected_Component (Expr : Node_Id); - -- Traverse the given expression searching for dispatching calls - -- to functions whose original nodes was a selected component, - -- and replacing them temporarily by a copy of their original - -- node. Modified calls are stored in the list Installed_Calls - -- (to undo this work later). - - procedure Restore_Dispatching_Calls (Expr : Node_Id); - -- Undo the work done by Install_Original_Selected_Component. - - ----------------------------------------- - -- Install_Original_Selected_Component -- - ----------------------------------------- - - procedure Install_Original_Selected_Component (Expr : Node_Id) is - function Install_Node (N : Node_Id) return Traverse_Result; - -- Process a single node - - ------------------ - -- Install_Node -- - ------------------ - - function Install_Node (N : Node_Id) return Traverse_Result is - New_N : Node_Id; - Orig_Nod : Node_Id; - - begin - if Nkind (N) = N_Function_Call - and then Nkind (Original_Node (N)) = N_Selected_Component - and then Is_Dispatching_Operation (Entity (Name (N))) - then - Orig_Nod := Original_Node (N); - - -- Temporarily use the original node field to keep the - -- reference to this node (to undo this work later!). - - New_N := New_Copy (N); - Set_Original_Node (New_N, Orig_Nod); - Append_Elmt (New_N, Installed_Calls); - - Rewrite (N, Orig_Nod); - Set_Original_Node (N, New_N); - end if; - - return OK; - end Install_Node; - - procedure Install_Nodes is new Traverse_Proc (Install_Node); - - begin - Install_Nodes (Expr); - end Install_Original_Selected_Component; - - ------------------------------- - -- Restore_Dispatching_Calls -- - ------------------------------- - - procedure Restore_Dispatching_Calls (Expr : Node_Id) is - function Restore_Node (N : Node_Id) return Traverse_Result; - -- Process a single node - - ------------------ - -- Restore_Node -- - ------------------ - - function Restore_Node (N : Node_Id) return Traverse_Result is - Orig_Sel_N : Node_Id; - - begin - if Nkind (N) = N_Selected_Component - and then Nkind (Original_Node (N)) = N_Function_Call - and then Contains (Installed_Calls, Original_Node (N)) - then - Orig_Sel_N := Original_Node (Original_Node (N)); - pragma Assert (Nkind (Orig_Sel_N) = N_Selected_Component); - Rewrite (N, Original_Node (N)); - Set_Original_Node (N, Orig_Sel_N); - end if; - - return OK; - end Restore_Node; - - procedure Restore_Nodes is new Traverse_Proc (Restore_Node); - - begin - Restore_Nodes (Expr); - end Restore_Dispatching_Calls; - - -- Local variables - Assoc_List : constant Elist_Id := New_Elmt_List; Par_Formal_Id : Entity_Id := First_Formal (Par_Subp); Subp_Formal_Id : Entity_Id := First_Formal (Subp); - New_Expr : Node_Id; - Class_Cond : Node_Id; -- Start of processing for Inherit_Condition @@ -4482,18 +4443,9 @@ package body Contracts is Next_Formal (Subp_Formal_Id); end loop; - -- In order to properly preanalyze an inherited preanalyzed - -- condition that has occurrences of the Object.Operation - -- notation we must restore the original node; otherwise we - -- would report spurious errors. - - Class_Cond := Class_Condition (Kind, Par_Subp); - - Install_Original_Selected_Component (Class_Cond); - New_Expr := New_Copy_Tree (Class_Cond); - Restore_Dispatching_Calls (Class_Cond); - - return New_Copy_Tree (New_Expr, Map => Assoc_List); + return New_Copy_Tree + (Source => Class_Condition (Kind, Par_Subp), + Map => Assoc_List); end Inherit_Condition; ----------------------