From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from rock.gnat.com (rock.gnat.com [IPv6:2620:20:4000:0:a9e:1ff:fe9b:1d1]) by sourceware.org (Postfix) with ESMTP id 1DD6A39888A3 for ; Wed, 5 May 2021 08:20:14 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.3.2 sourceware.org 1DD6A39888A3 Authentication-Results: sourceware.org; dmarc=none (p=none dis=none) header.from=adacore.com Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=derodat@adacore.com Received: from localhost (localhost.localdomain [127.0.0.1]) by filtered-rock.gnat.com (Postfix) with ESMTP id BCBF8561F1; Wed, 5 May 2021 04:20:05 -0400 (EDT) X-Virus-Scanned: Debian amavisd-new at gnat.com Received: from rock.gnat.com ([127.0.0.1]) by localhost (rock.gnat.com [127.0.0.1]) (amavisd-new, port 10024) with LMTP id MkGaPvrQbSiA; Wed, 5 May 2021 04:20:05 -0400 (EDT) Received: from tron.gnat.com (tron.gnat.com [IPv6:2620:20:4000:0:46a8:42ff:fe0e:e294]) by rock.gnat.com (Postfix) with ESMTP id 9795A561EE; Wed, 5 May 2021 04:20:05 -0400 (EDT) Received: by tron.gnat.com (Postfix, from userid 4862) id 967B8103; Wed, 5 May 2021 04:20:05 -0400 (EDT) Date: Wed, 5 May 2021 04:20:05 -0400 From: Pierre-Marie de Rodat To: gcc-patches@gcc.gnu.org Cc: Justin Squirek Subject: [Ada] Incorrect accessibility level on actual in procedure call Message-ID: <20210505082005.GA31418@adacore.com> MIME-Version: 1.0 Content-Type: multipart/mixed; boundary="2fHTh5uZTiUOsy+g" Content-Disposition: inline User-Agent: Mutt/1.5.23 (2014-03-12) X-Spam-Status: No, score=-12.4 required=5.0 tests=BAYES_00, GIT_PATCH_0, KAM_DMARC_STATUS, SPF_HELO_NONE, SPF_PASS, TXREP autolearn=ham autolearn_force=no version=3.4.2 X-Spam-Checker-Version: SpamAssassin 3.4.2 (2018-09-13) 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-List-Received-Date: Wed, 05 May 2021 08:20:16 -0000 --2fHTh5uZTiUOsy+g Content-Type: text/plain; charset=us-ascii Content-Disposition: inline This patch fixes an error in the compiler whereby dispatching calls to subprograms featuring anonymous access formals may get incorrectly expanded in such a way so as to lead to spurious runtime accessibility check failures within the callee. Tested on x86_64-pc-linux-gnu, committed on trunk gcc/ada/ * exp_ch6.adb (Expand_Call_Helper): Add condition to check for expanded actuals and remove dead code. --2fHTh5uZTiUOsy+g Content-Type: text/x-diff; charset=us-ascii Content-Disposition: attachment; filename="patch.diff" diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -3473,12 +3473,6 @@ package body Exp_Ch6 is Scop : Entity_Id; Subp : Entity_Id; - Prev_Orig : Node_Id; - -- Original node for an actual, which may have been rewritten. If the - -- actual is a function call that has been transformed from a selected - -- component, the original node is unanalyzed. Otherwise, it carries - -- semantic information used to generate additional actuals. - CW_Interface_Formals_Present : Boolean := False; -- Start of processing for Expand_Call_Helper @@ -3739,7 +3733,6 @@ package body Exp_Ch6 is -- Prepare to examine current entry Prev := Actual; - Prev_Orig := Original_Node (Prev); -- Ada 2005 (AI-251): Check if any formal is a class-wide interface -- to expand it in a further round. @@ -3828,63 +3821,6 @@ package body Exp_Ch6 is -- Create possible extra actual for accessibility level if Present (Extra_Accessibility (Formal)) then - - -- Ada 2005 (AI-252): If the actual was rewritten as an Access - -- attribute, then the original actual may be an aliased object - -- occurring as the prefix in a call using "Object.Operation" - -- notation. In that case we must pass the level of the object, - -- so Prev_Orig is reset to Prev and the attribute will be - -- processed by the code for Access attributes further below. - - if Prev_Orig /= Prev - and then Nkind (Prev) = N_Attribute_Reference - and then Get_Attribute_Id (Attribute_Name (Prev)) = - Attribute_Access - and then Is_Aliased_View (Prev_Orig) - then - Prev_Orig := Prev; - - -- A class-wide precondition generates a test in which formals of - -- the subprogram are replaced by actuals that came from source. - -- In that case as well, the accessiblity comes from the actual. - -- This is the one case in which there are references to formals - -- outside of their subprogram. - - elsif Prev_Orig /= Prev - and then Is_Entity_Name (Prev_Orig) - and then Present (Entity (Prev_Orig)) - and then Is_Formal (Entity (Prev_Orig)) - and then not In_Open_Scopes (Scope (Entity (Prev_Orig))) - then - Prev_Orig := Prev; - - -- If the actual is a formal of an enclosing subprogram it is - -- the right entity, even if it is a rewriting. This happens - -- when the call is within an inherited condition or predicate. - - elsif Is_Entity_Name (Actual) - and then Is_Formal (Entity (Actual)) - and then In_Open_Scopes (Scope (Entity (Actual))) - then - Prev_Orig := Prev; - - -- If the actual is an attribute reference that was expanded - -- into a reference to an entity, then get accessibility level - -- from that entity. AARM 6.1.1(27.d) says "... the implicit - -- constant declaration defines the accessibility level of X'Old". - - elsif Nkind (Prev_Orig) = N_Attribute_Reference - and then Attribute_Name (Prev_Orig) in Name_Old | Name_Loop_Entry - and then Is_Entity_Name (Prev) - and then Present (Entity (Prev)) - and then Is_Object (Entity (Prev)) - then - Prev_Orig := Prev; - - elsif Nkind (Prev_Orig) = N_Type_Conversion then - Prev_Orig := Expression (Prev_Orig); - end if; - -- Ada 2005 (AI-251): Thunks must propagate the extra actuals of -- accessibility levels. @@ -3929,6 +3865,29 @@ package body Exp_Ch6 is then Add_Cond_Expression_Extra_Actual (Formal); + -- Internal constant generated to remove side effects (normally + -- from the expansion of dispatching calls). + + -- First verify the actual is internal + + elsif not Comes_From_Source (Prev) + and then Original_Node (Prev) = Prev + + -- Next check that the actual is a constant + + and then Nkind (Prev) = N_Identifier + and then Ekind (Entity (Prev)) = E_Constant + and then Nkind (Parent (Entity (Prev))) = N_Object_Declaration + then + -- Generate the accessibility level based on the expression in + -- the constant's declaration. + + Add_Extra_Actual + (Expr => Accessibility_Level + (Expr => Expression (Parent (Entity (Prev))), + Level => Dynamic_Level), + EF => Extra_Accessibility (Formal)); + -- Normal case else --2fHTh5uZTiUOsy+g--