https://gcc.gnu.org/g:77af29573a1fdb1c7d6256a786807f34fdfc1702
commit r16-9191-g77af29573a1fdb1c7d6256a786807f34fdfc1702 Author: Eric Botcazou <[email protected]> Date: Wed Jun 10 19:40:37 2026 +0200 ada: Fix spurious conflict introduced by Ada 2022 declare expression This streamlines the resolution of declare expressions in Ada 2022, which started as a manual name resolution to avoid scope management issues, then added local visibility support, and eventually added scope management with a kludge for transient scopes. Transient scopes are not really scopes but placeholders and, therefore, may traverse regular scopes when the node they service is higher up. This also has uncovered a loophole in Find_Type_Of_Object in the preanalysis case. gcc/ada/ChangeLog: * sem_ch3.adb (Find_Type_Of_Object): In the subtype indication case for a stand-alone object, invoke Process_Subtype during preanalysis instead of partially reimplementing it. * sem_ch5.ads (Has_Sec_Stack_Call): Move back declaration to... * sem_ch5.adb (Has_Sec_Stack_Call): ...here. * sem_ch4.adb (Analyze_Expression_With_Actions): Deal with transient scopes created during analysis. * sem_res.adb: Add clauses for Sem_Ch9 package. (Resolve_Declare_Expression): Streamline and deal with transient scopes created during resolution. Diff: --- gcc/ada/sem_ch3.adb | 58 ++++++-------------- gcc/ada/sem_ch4.adb | 21 ++++++++ gcc/ada/sem_ch5.adb | 11 ++++ gcc/ada/sem_ch5.ads | 12 ----- gcc/ada/sem_res.adb | 153 ++++++++++------------------------------------------ 5 files changed, 75 insertions(+), 180 deletions(-) diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index d935248b1695..594de4d65145 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -19138,9 +19138,6 @@ package body Sem_Ch3 is elsif Nkind (P) /= N_Component_Declaration and then Def_Kind = N_Subtype_Indication then - -- Base name of subtype on object name, which will be unique in - -- the current scope. - -- If this is a duplicate declaration, return base type, to avoid -- generating duplicate anonymous types. @@ -19149,53 +19146,28 @@ package body Sem_Ch3 is return Entity (Subtype_Mark (Obj_Def)); end if; + -- During preanalysis, for example within a pre/postcondition, + -- provide just enough information to use the subtype. + + if Preanalysis_Active then + return + Process_Subtype + (Obj_Def, + Related_Nod, + Excludes_Null => Null_Exclusion_Present (P)); + end if; + + -- Base name of subtype on object name, which will be unique in + -- the current scope. + Nam := New_External_Name (Chars (Defining_Identifier (Related_Nod)), 'S', 0, 'T'); T := Make_Defining_Identifier (Sloc (P), Nam); - -- If In_Spec_Expression, for example within a pre/postcondition, - -- provide enough information for use of the subtype without - -- depending on full analysis and freezing, which will happen when - -- building the corresponding subprogram. - - if In_Spec_Expression then - Analyze (Subtype_Mark (Obj_Def)); - - declare - Base_T : constant Entity_Id := Entity (Subtype_Mark (Obj_Def)); - New_Def : constant Node_Id := New_Copy_Tree (Obj_Def); - Decl : constant Node_Id := - Make_Subtype_Declaration (Sloc (P), - Defining_Identifier => T, - Subtype_Indication => New_Def); - - begin - Set_Etype (T, Base_T); - Mutate_Ekind (T, Subtype_Kind (Ekind (Base_T))); - Set_Parent (T, Decl); - Set_Scope (T, Current_Scope); - - if Ekind (T) = E_Array_Subtype then - Constrain_Array (T, New_Def, Related_Nod, T, 'P'); - - elsif Ekind (T) = E_Record_Subtype then - Set_First_Entity (T, First_Entity (Base_T)); - Set_Has_Discriminants (T, Has_Discriminants (Base_T)); - Set_Is_Constrained (T); - end if; - - Insert_Before (Related_Nod, Decl); - end; - - return T; - end if; - -- When generating code, insert subtype declaration ahead of - -- declaration that generated it. Similar behavior required under - -- preanalysis (including strict preanalysis) to perform the - -- minimum decoration, and avoid reporting spurious errors. + -- declaration that generated it. Insert_Action (Obj_Def, Make_Subtype_Declaration (Sloc (P), diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index ec62624a59e8..ae27440b5ad6 100644 --- a/gcc/ada/sem_ch4.adb +++ b/gcc/ada/sem_ch4.adb @@ -2486,6 +2486,7 @@ package body Sem_Ch4 is A : Node_Id; EWA_Scop : Entity_Id; + SE : Scope_Stack_Entry; -- Start of processing for Analyze_Expression_With_Actions @@ -2523,8 +2524,28 @@ package body Sem_Ch4 is In_Declare_Expr := In_Declare_Expr - 1; end if; + -- If the analysis of the expression has created a transient + -- scope, we first need to save the transient scope and pop it. + + if Scope_Is_Transient then + SE := Scope_Stack.Table (Scope_Stack.Last); + Scope_Stack.Decrement_Last; + else + SE.Is_Transient := False; + end if; + + -- Remove the scope and its declarations from visibility. Note that + -- the scope is purely static and the EWA is not a master construct + -- (see AI22-0017) so the lifetime of the objects does not end here. + pragma Assert (Current_Scope = Scope_Link (N)); End_Scope; + + -- Push again the transient scope, if any + + if SE.Is_Transient then + Scope_Stack.Append (SE); + end if; end Analyze_Expression_With_Actions; --------------------------- diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb index 018a25616ccd..30cdaeb4a7e0 100644 --- a/gcc/ada/sem_ch5.adb +++ b/gcc/ada/sem_ch5.adb @@ -94,6 +94,17 @@ package body Sem_Ch5 is -- statements. On success, the return value is the entity of the loop -- referenced by the statement. + function Has_Sec_Stack_Call (N : Node_Id) return Boolean; + -- N is the node for an arbitrary construct. This function searches the + -- construct N to see if it contains a function call that returns on the + -- secondary stack, returning True if any such call is found, and False + -- otherwise. + + -- ??? The implementation invokes Sem_Util.Requires_Transient_Scope so it + -- will return True if N contains a function call that needs finalization, + -- in addition to the above specification. See Analyze_Loop_Statement for + -- a similar comment about this entanglement. + procedure Preanalyze_Range (R_Copy : Node_Id); -- Determine expected type of range or domain of iteration of Ada 2012 -- loop by analyzing separate copy. Do the analysis and resolution of the diff --git a/gcc/ada/sem_ch5.ads b/gcc/ada/sem_ch5.ads index c01f2dcb0292..03b210fe89df 100644 --- a/gcc/ada/sem_ch5.ads +++ b/gcc/ada/sem_ch5.ads @@ -51,16 +51,4 @@ package Sem_Ch5 is -- an unconditional transfer of control or an apparent infinite loop. It -- checks to see if the statement is followed by some other statement, and -- if so generates an appropriate warning for unreachable code. - - function Has_Sec_Stack_Call (N : Node_Id) return Boolean; - -- N is the node for an arbitrary construct. This function searches the - -- construct N to see if it contains a function call that returns on the - -- secondary stack, returning True if any such call is found, and False - -- otherwise. - - -- ??? The implementation invokes Sem_Util.Requires_Transient_Scope so it - -- will return True if N contains a function call that needs finalization, - -- in addition to the above specification. See Analyze_Loop_Statement for - -- a similar comment about this entanglement. - end Sem_Ch5; diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index 65734d1cf00b..d11e18a099dc 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -67,6 +67,7 @@ with Sem_Ch4; use Sem_Ch4; with Sem_Ch5; use Sem_Ch5; with Sem_Ch6; use Sem_Ch6; with Sem_Ch8; use Sem_Ch8; +with Sem_Ch9; use Sem_Ch9; with Sem_Ch13; use Sem_Ch13; with Sem_Dim; use Sem_Dim; with Sem_Disp; use Sem_Disp; @@ -7741,145 +7742,47 @@ package body Sem_Res is -- Resolve_Declare_Expression -- -------------------------------- - procedure Resolve_Declare_Expression - (N : Node_Id; - Typ : Entity_Id) - is - Expr : constant Node_Id := Expression (N); - - Decl : Node_Id; - Local : Entity_Id := Empty; - - Save_Hidden_Map : constant Elist_Id := New_Elmt_List; - -- Stores the map of identifiers, and corresponding entities, that - -- temporarily loose visibility due to homonym declarations in the - -- current declare expression. - - function Replace_Local (N : Node_Id) return Traverse_Result; - -- Use a tree traversal to replace each occurrence 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. - - ------------------- - -- Replace_Local -- - ------------------- - - 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)); - Generate_Reference (Local, N); - end if; - - return OK; - end Replace_Local; - - procedure Replace_Local_Ref is new Traverse_Proc (Replace_Local); - - -- Start of processing for Resolve_Declare_Expression + procedure Resolve_Declare_Expression (N : Node_Id; Typ : Entity_Id) is + After : Node_Id; + SE : Scope_Stack_Entry; begin - -- Create a transient scope if the type of this declare-expression - -- or its expression requires it; this must be done before we push - -- in the scope stack the scope of this declare expression (in order - -- to properly remove it from the stack on exit from this routine). - -- Given that we don't know yet if secondary stack management will - -- be needed, we assume the worst case. - - if not Preanalysis_Active - and then (Requires_Transient_Scope (Typ) - or else Has_Sec_Stack_Call (Expr)) - then - Establish_Transient_Scope (N, Manage_Sec_Stack => True); - end if; - Push_Scope (Scope_Link (N)); + Install_Declarations (Scope_Link (N)); - 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); - - -- Traverse the expression to replace references to local - -- variables that occur within declarations of the - -- declare_expression. - - declare - D : Node_Id := Next (Decl); - begin - while Present (D) loop - Replace_Local_Ref (D); - Next (D); - end loop; - end; - - -- Homonyms of the new local declaration are saved to be restored - -- after the resolution of the declare block's expression. - - Append_Elmt (Local, Save_Hidden_Map); - Append_Elmt (Get_Name_Entity_Id (Chars (Local)), Save_Hidden_Map); + -- The end of the declarative list is a freezing point for the + -- local declarations. - -- Update the references to local in the name table and make them - -- immediately visible to be available within the expression. + After := Last (Actions (N)); + Freeze_All (First_Entity (Scope_Link (N)), After); - Set_Current_Entity (Local); - Set_Is_Immediately_Visible (Local); - Set_Is_Not_Self_Hidden (Local); - end if; + -- Now resolve the expression - Next (Decl); - end loop; + Resolve (Expression (N), Typ); + Check_Unset_Reference (Expression (N)); - -- The end of the declarative list is a freeze point for the - -- local declarations. + -- If the resolution of the expression has created a transient + -- scope, we first need to save the transient scope and pop it. - if Present (Local) then - Decl := Parent (Local); - Freeze_All (First_Entity (Scope (Local)), Decl); + if Scope_Is_Transient then + SE := Scope_Stack.Table (Scope_Stack.Last); + Scope_Stack.Decrement_Last; + else + SE.Is_Transient := False; end if; - Resolve (Expr, Typ); - Check_Unset_Reference (Expr); - - -- Restore any hidden entity homonyms to a local one - - declare - Cursor : Elmt_Id := First_Elmt (Save_Hidden_Map); - Name : Name_Id; - begin - while Present (Cursor) loop - Name := Chars (Node (Cursor)); - Next_Elmt (Cursor); - Set_Name_Entity_Id (Name, Node (Cursor)); - Next_Elmt (Cursor); - end loop; - end; + -- Remove the scope and its declarations from visibility. Note that + -- the scope is purely static and the EWA is not a master construct + -- (see AI22-0017) so the lifetime of the objects does not end here. pragma Assert (Current_Scope = Scope_Link (N)); End_Scope; + + -- Push again the transient scope, if any + + if SE.Is_Transient then + Scope_Stack.Append (SE); + end if; end Resolve_Declare_Expression; -----------------------------------
