From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: by sourceware.org (Postfix, from userid 1914) id 4CF34385843A; Mon, 4 Oct 2021 08:48:30 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 4CF34385843A MIME-Version: 1.0 Content-Transfer-Encoding: 7bit Content-Type: text/plain; charset="utf-8" From: Pierre-Marie de Rodat To: gcc-cvs@gcc.gnu.org Subject: [gcc r12-4123] [Ada] Fix resolution of Declare_Expressions involving transient scopes X-Act-Checkin: gcc X-Git-Author: Ed Schonberg X-Git-Refname: refs/heads/master X-Git-Oldrev: 8e1e74a162c751014b43d609207aaf75ed4dd428 X-Git-Newrev: f729943cf65ec9d475acccc5d04d7752680e19a3 Message-Id: <20211004084830.4CF34385843A@sourceware.org> Date: Mon, 4 Oct 2021 08:48:30 +0000 (GMT) X-BeenThere: gcc-cvs@gcc.gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: Gcc-cvs mailing list List-Unsubscribe: , List-Archive: List-Help: List-Subscribe: , X-List-Received-Date: Mon, 04 Oct 2021 08:48:30 -0000 https://gcc.gnu.org/g:f729943cf65ec9d475acccc5d04d7752680e19a3 commit r12-4123-gf729943cf65ec9d475acccc5d04d7752680e19a3 Author: Ed Schonberg Date: Mon Aug 30 17:41:29 2021 -0400 [Ada] Fix resolution of Declare_Expressions involving transient scopes gcc/ada/ * sem_res.adb (Resolve_Declare_Expression): Use tree traversals to perform name capture of local entities in the expression of the construct. * exp_util.adb (Possible_Side_Effects_In_SPARK): Do not apply to the prefix of an attribute reference Reduce when that prefix is an aggregate, because it will be expanded into a loop, and has no identifiable type. Diff: --- gcc/ada/exp_util.adb | 5 +++ gcc/ada/sem_res.adb | 108 ++++++++++++++++++++++++++++----------------------- 2 files changed, 64 insertions(+), 49 deletions(-) diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb index 4a301e20624..c0966fb0b96 100644 --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -11737,10 +11737,15 @@ package body Exp_Util is -- case and it is better not to make an additional one for the attribute -- itself, because the return type of many of them is universal integer, -- which is a very large type for a temporary. + -- The prefix of an attribute reference Reduce may be syntactically an + -- aggregate, but will be expanded into a loop, so no need to remove + -- side-effects. if Nkind (Exp) = N_Attribute_Reference and then Side_Effect_Free_Attribute (Attribute_Name (Exp)) and then Side_Effect_Free (Expressions (Exp), Name_Req, Variable_Ref) + and then (Attribute_Name (Exp) /= Name_Reduce + or else Nkind (Prefix (Exp)) /= N_Aggregate) and then not Is_Name_Reference (Prefix (Exp)) then Remove_Side_Effects (Prefix (Exp), Name_Req, Variable_Ref); diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index ec2d5ec353f..4dc3827acba 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -7487,66 +7487,76 @@ package body Sem_Res is (N : Node_Id; Typ : Entity_Id) is - Decl : Node_Id; - Need_Transient_Scope : Boolean := False; - begin - -- Install the scope created for local declarations, if - -- any. The syntax allows a Declare_Expression with no - -- declarations, in analogy with block statements. - -- Note that that scope has no explicit declaration, but - -- appears as the scope of all entities declared therein. + Expr : constant Node_Id := Expression (N); - Decl := First (Actions (N)); - while Present (Decl) loop - exit when Nkind (Decl) - in N_Object_Declaration | N_Object_Renaming_Declaration; - Next (Decl); - end loop; + Decl : Node_Id; + Local : Entity_Id := Empty; - if Present (Decl) then + function Replace_Local (N : Node_Id) return Traverse_Result; + -- Use a tree traversal to replace each ocurrence of the name of + -- a local object declared in the construct, with the corresponding + -- entity. This replaces the usual way to perform name capture by + -- visibility, because it is not possible to place on the scope + -- stack the fake scope created for the analysis of the local + -- declarations; such a scope conflicts with the transient scopes + -- that may be generated if the expression includes function calls + -- requiring finalization. - -- Need to establish a transient scope in case Expression (N) - -- requires actions to be wrapped. + ------------------- + -- Replace_Local -- + ------------------- - declare - Node : Node_Id; - begin - Node := First (Actions (N)); - while Present (Node) loop - if Nkind (Node) = N_Object_Declaration - and then Requires_Transient_Scope - (Etype (Defining_Identifier (Node))) - then - Need_Transient_Scope := True; - exit; - end if; + function Replace_Local (N : Node_Id) return Traverse_Result is + begin + -- The identifier may be the prefix of a selected component, + -- but not a selector name, because the local entities do not + -- have a scope that can be named: a selected component whose + -- selector is a homonym of a local entity must denote some + -- global entity. + + if Nkind (N) = N_Identifier + and then Chars (N) = Chars (Local) + and then No (Entity (N)) + and then + (Nkind (Parent (N)) /= N_Selected_Component + or else N = Prefix (Parent (N))) + then + Set_Entity (N, Local); + Set_Etype (N, Etype (Local)); + end if; - Next (Node); - end loop; - end; + return OK; + end Replace_Local; - if Need_Transient_Scope then - Establish_Transient_Scope (Decl, Manage_Sec_Stack => True); - else - Push_Scope (Scope (Defining_Identifier (Decl))); + procedure Replace_Local_Ref is new Traverse_Proc (Replace_Local); + + -- Start of processing for Resolve_Declare_Expression + + begin + + Decl := First (Actions (N)); + + while Present (Decl) loop + if Nkind (Decl) in + N_Object_Declaration | N_Object_Renaming_Declaration + and then Comes_From_Source (Defining_Identifier (Decl)) + then + Local := Defining_Identifier (Decl); + Replace_Local_Ref (Expr); end if; - declare - E : Entity_Id := First_Entity (Current_Scope); - begin - while Present (E) loop - Set_Current_Entity (E); - Set_Is_Immediately_Visible (E); - Next_Entity (E); - end loop; - end; + Next (Decl); + end loop; - Resolve (Expression (N), Typ); - End_Scope; + -- The end of the declarative list is a freeze point for the + -- local declarations. - else - Resolve (Expression (N), Typ); + if Present (Local) then + Decl := Parent (Local); + Freeze_All (First_Entity (Scope (Local)), Decl); end if; + + Resolve (Expr, Typ); end Resolve_Declare_Expression; -----------------------------------------