From: Eric Botcazou <[email protected]>
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.
Tested on x86_64-pc-linux-gnu, committed on master.
---
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 | 159 +++++++++-----------------------------------
5 files changed, 79 insertions(+), 182 deletions(-)
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index f434ae3e92a..1b4873f52b0 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -19156,9 +19156,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.
@@ -19167,53 +19164,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 0bb74729aae..400fa4f8869 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 6f53a8b01c3..c54ad85cf44 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 c01f2dcb029..03b210fe89d 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 54915607d68..61bc36e677c 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;
@@ -7752,145 +7753,49 @@ 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 Expander_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;
+ -- First push the scope of the EWA and install its declarations
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);
-
- -- Update the references to local in the name table and make them
- -- immediately visible to be available within the expression.
-
- Set_Current_Entity (Local);
- Set_Is_Immediately_Visible (Local);
- Set_Is_Not_Self_Hidden (Local);
- end if;
-
- Next (Decl);
- end loop;
-
- -- The end of the declarative list is a freeze point for the
+ -- The end of the declarative list is a freezing point for the
-- local declarations.
- if Present (Local) then
- Decl := Parent (Local);
- Freeze_All (First_Entity (Scope (Local)), Decl);
+ After := Last (Actions (N));
+ Freeze_All (First_Entity (Scope_Link (N)), After);
+
+ -- Now resolve the expression
+
+ Resolve (Expression (N), Typ);
+ Check_Unset_Reference (Expression (N));
+
+ -- If the resolution 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;
- 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;
-----------------------------------
--
2.53.0
