https://gcc.gnu.org/g:9c0382624b302be3fda8a465dd37615344f7bef6
commit r15-6190-g9c0382624b302be3fda8a465dd37615344f7bef6
Author: Eric Botcazou <ebotca...@adacore.com>
Date: Thu Oct 24 17:09:39 2024 +0200
ada: Further work in semantic analysis of iterated component associations
This finishes up the transition to preanalysis of a copy of the expression
for iterated component associations in all contexts, thus voiding the need
to clean things up afterward.
However, this requires a larger cleanup in semantics analysis of aggregates,
in particular for others choices, which are currently skipped in Sem_Aggr,
with Exp_Aggr trying to patch things up afterward but leaving some legality
loopholes in the end. That's why this makes sure that all the expressions
appearing in aggregates are either analyzed or preanalyzed by Sem_Aggr, as
documented in the spec of Sem, modulo the copy in an iteration context.
gcc/ada/ChangeLog:
* exp_aggr.adb (Build_Array_Aggr_Code): Remove obsolete comment.
(Convert_To_Positional): Remove Ctyp local variable.
(Is_Static_Element): Remove Dims parameter and do not preanalyze the
expression there.
(Expand_Array_Aggregate): Make Ctyp a constant.
(Compute_Others_Present): Do not preanalyze the expression there.
* sem_aggr.adb (Resolve_Array_Aggregate): New Ctyp constant. Use it
throughout the procedure to denote the component type.
(Resolve_Aggr_Expr): Always preanalyze a copy of the expression in
an iteration context. Preanalyze it directly when the expander is
active and the choice may cover multiple components. Otherwise,
fully analyze it.
Do not reanalyze an iterated component association with an others
choice either when there are positional components.
(Resolve_Iterated_Component_Association): Do not remove references
from the expression after invoking Resolve_Aggr_Expr on it.
Diff:
---
gcc/ada/exp_aggr.adb | 54 ++++--------------
gcc/ada/sem_aggr.adb | 158 ++++++++++++++++++++++++---------------------------
2 files changed, 86 insertions(+), 126 deletions(-)
diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb
index c01011cc1fb5..c93554347ad2 100644
--- a/gcc/ada/exp_aggr.adb
+++ b/gcc/ada/exp_aggr.adb
@@ -1645,8 +1645,7 @@ package body Exp_Aggr is
if Is_Iterated_Component then
-- Create a new scope for the loop variable so that the
- -- following Gen_Assign (that ends up calling
- -- Preanalyze_And_Resolve) can correctly find it.
+ -- following Gen_Assign can correctly find it.
Ent := New_Internal_Entity (E_Loop,
Current_Scope, Loc, 'L');
@@ -4410,7 +4409,6 @@ package body Exp_Aggr is
Dims : constant Nat := Number_Dimensions (Typ);
Max_Others_Replicate : constant Nat := Max_Aggregate_Size (N);
- Ctyp : Entity_Id := Component_Type (Typ);
Static_Components : Boolean := True;
procedure Check_Static_Components;
@@ -4430,7 +4428,7 @@ package body Exp_Aggr is
-- Return True if the aggregate N is flat (which is not trivial in the
-- case of multidimensional aggregates).
- function Is_Static_Element (N : Node_Id; Dims : Nat) return Boolean;
+ function Is_Static_Element (N : Node_Id) return Boolean;
-- Return True if N, an element of a component association list, i.e.
-- N_Component_Association or N_Iterated_Component_Association, has a
-- compile-time known value and can be passed as is to the back-end
@@ -4474,7 +4472,7 @@ package body Exp_Aggr is
then
Assoc := First (Component_Associations (N));
while Present (Assoc) loop
- if not Is_Static_Element (Assoc, Dims) then
+ if not Is_Static_Element (Assoc) then
Static_Components := False;
exit;
end if;
@@ -4699,7 +4697,7 @@ package body Exp_Aggr is
-- only if either the element is static or is
-- an aggregate (we already know it is OK).
- elsif not Is_Static_Element (Elmt, Dims)
+ elsif not Is_Static_Element (Elmt)
and then Nkind (Expr) /= N_Aggregate
then
return False;
@@ -4856,7 +4854,7 @@ package body Exp_Aggr is
-- Is_Static_Element --
-----------------------
- function Is_Static_Element (N : Node_Id; Dims : Nat) return Boolean is
+ function Is_Static_Element (N : Node_Id) return Boolean is
Expr : constant Node_Id := Expression (N);
begin
@@ -4874,14 +4872,6 @@ package body Exp_Aggr is
then
return True;
- -- However, one may write static expressions that are syntactically
- -- ambiguous, so preanalyze the expression before checking it again,
- -- but only at the innermost level for a multidimensional array.
-
- elsif Dims = 1 then
- Preanalyze_And_Resolve (Expr, Ctyp);
- return Compile_Time_Known_Value (Expr);
-
else
return False;
end if;
@@ -4922,10 +4912,6 @@ package body Exp_Aggr is
return;
end if;
- -- Special handling for mutably taggeds
-
- Ctyp := Get_Corresponding_Mutably_Tagged_Type_If_Present (Ctyp);
-
Check_Static_Components;
-- If the size is known, or all the components are static, try to
@@ -5019,8 +5005,12 @@ package body Exp_Aggr is
Typ : constant Entity_Id := Etype (N);
-- Typ is the correct constrained array subtype of the aggregate
- Ctyp : Entity_Id := Component_Type (Typ);
- -- Ctyp is the corresponding component type.
+ Component_Typ : constant Entity_Id := Component_Type (Typ);
+ -- Component_Typ is the corresponding component type
+
+ Ctyp : constant Entity_Id :=
+ Get_Corresponding_Mutably_Tagged_Type_If_Present (Component_Typ);
+ -- Ctyp is the corresponding component type to be used
Aggr_Dimension : constant Pos := Number_Dimensions (Typ);
-- Number of aggregate index dimensions
@@ -5355,21 +5345,6 @@ package body Exp_Aggr is
and then Nkind (First (Choice_List (Assoc))) = N_Others_Choice
then
Others_Present (Dim) := True;
-
- -- An others_clause may be superfluous if previous components
- -- cover the full given range of a constrained array. In such
- -- a case an others_clause does not contribute any additional
- -- components and has not been analyzed. We analyze it now to
- -- detect type errors in the expression, even though no code
- -- will be generated for it.
-
- if Dim = Aggr_Dimension
- and then Nkind (Assoc) /= N_Iterated_Component_Association
- and then not Analyzed (Expression (Assoc))
- and then not Box_Present (Assoc)
- then
- Preanalyze_And_Resolve (Expression (Assoc), Ctyp);
- end if;
end if;
end if;
@@ -5392,8 +5367,7 @@ package body Exp_Aggr is
if Present (Component_Associations (Sub_Aggr)) then
Assoc := First (Component_Associations (Sub_Aggr));
while Present (Assoc) loop
- Expr := Expression (Assoc);
- Compute_Others_Present (Expr, Dim + 1);
+ Compute_Others_Present (Expression (Assoc), Dim + 1);
Next (Assoc);
end loop;
end if;
@@ -5966,10 +5940,6 @@ package body Exp_Aggr is
pragma Assert (not Raises_Constraint_Error (N));
- -- Special handling for mutably taggeds
-
- Ctyp := Get_Corresponding_Mutably_Tagged_Type_If_Present (Ctyp);
-
-- STEP 1a
-- Check that the index range defined by aggregate bounds is
diff --git a/gcc/ada/sem_aggr.adb b/gcc/ada/sem_aggr.adb
index e5bd4fd5e3f6..8cc00ad3b27a 100644
--- a/gcc/ada/sem_aggr.adb
+++ b/gcc/ada/sem_aggr.adb
@@ -1589,6 +1589,9 @@ package body Sem_Aggr is
Failure : constant Boolean := False;
Success : constant Boolean := True;
+ Ctyp : constant Entity_Id :=
+ Get_Corresponding_Mutably_Tagged_Type_If_Present (Component_Typ);
+
Index_Typ : constant Entity_Id := Etype (Index);
Index_Typ_Low : constant Node_Id := Type_Low_Bound (Index_Typ);
Index_Typ_High : constant Node_Id := Type_High_Bound (Index_Typ);
@@ -2005,7 +2008,7 @@ package body Sem_Aggr is
-- operator, it is still an operator symbol, which will be
-- transformed into a string when analyzed.
- if Is_Character_Type (Component_Typ)
+ if Is_Character_Type (Ctyp)
and then No (Next_Index (Nxt_Ind))
and then Nkind (Expr) in N_String_Literal | N_Operator_Symbol
then
@@ -2043,7 +2046,7 @@ package body Sem_Aggr is
Resolution_OK :=
Resolve_Array_Aggregate
- (Expr, Nxt_Ind, Nxt_Ind_Constr, Component_Typ,
+ (Expr, Nxt_Ind, Nxt_Ind_Constr, Ctyp,
Iterated => Iterated_Expr, Others_Allowed => Others_Allowed);
if Resolution_OK = Failure then
@@ -2051,38 +2054,60 @@ package body Sem_Aggr is
end if;
else
- -- Do not resolve the expressions of discrete or others choices
- -- unless the expression covers a single component, or else the
- -- expander is inactive or this is a spec expression.
-
- -- In SPARK mode, expressions that can perform side effects will
- -- be recognized by the gnat2why back-end, and the whole
- -- subprogram will be ignored. So semantic analysis can be
- -- performed safely.
-
- if (Single_Elmt and then not Iterated_Expr)
- or else not Expander_Active
- or else In_Spec_Expression
- then
- Analyze_And_Resolve (Expr, Component_Typ);
- Check_Expr_OK_In_Limited_Aggregate (Expr);
- Check_Non_Static_Context (Expr);
- Aggregate_Constraint_Checks (Expr, Component_Typ);
- Check_Unset_Reference (Expr);
+ -- In an iterated context, preanalyze a copy of the expression to
+ -- verify legality. We use a copy because the expression will be
+ -- analyzed anew when the enclosing aggregate is expanded and the
+ -- construct is rewritten as a loop with a new index variable.
- -- Analyze a copy of the expression, to verify legality. We use
- -- a copy because the expression will be analyzed anew when the
- -- enclosing aggregate is expanded, and the construct is rewritten
- -- as a loop with a new index variable.
+ -- If the parent is a component association, we also temporarily
+ -- point its Expression field to the copy, because analysis may
+ -- expect this invariant to hold.
- elsif Iterated_Expr then
+ if Iterated_Expr then
declare
+ In_Assoc : constant Boolean :=
+ Nkind (Parent (Expr)) in N_Component_Association
+ | N_Iterated_Component_Association;
New_Expr : constant Node_Id := Copy_Separate_Tree (Expr);
begin
Set_Parent (New_Expr, Parent (Expr));
- Preanalyze_And_Resolve (New_Expr, Component_Typ);
+ if In_Assoc then
+ Set_Expression (Parent (Expr), New_Expr);
+ end if;
+
+ Preanalyze_And_Resolve (New_Expr, Ctyp);
+ Check_Expr_OK_In_Limited_Aggregate (New_Expr);
+ Check_Expression_Dimensions (New_Expr, Ctyp);
+
+ if In_Assoc then
+ Set_Expression (Parent (Expr), Expr);
+ end if;
end;
+
+ -- If the expander is active and the choice may cover multiple
+ -- components, then we cannot expand (see the spec of Sem), so
+ -- we preanalyze the expression.
+
+ elsif Expander_Active and then not Single_Elmt then
+ Preanalyze_And_Resolve (Expr, Ctyp);
+ Check_Expr_OK_In_Limited_Aggregate (Expr);
+ Check_Expression_Dimensions (Expr, Ctyp);
+
+ -- The range given by the choice may be empty, in which case we
+ -- do not want spurious warnings about CE raised at run time.
+
+ Remove_Warning_Messages (Expr);
+
+ -- Otherwise, we perform a full analysis of the expression
+
+ else
+ Analyze_And_Resolve (Expr, Ctyp);
+ Check_Expr_OK_In_Limited_Aggregate (Expr);
+ Check_Expression_Dimensions (Expr, Ctyp);
+ Check_Non_Static_Context (Expr);
+ Check_Unset_Reference (Expr);
+ Aggregate_Constraint_Checks (Expr, Ctyp);
end if;
end if;
@@ -2092,10 +2117,10 @@ package body Sem_Aggr is
-- component assignments. If the expression covers several components
-- the analysis and the predicate check take place later.
- if Has_Predicates (Component_Typ)
+ if Has_Predicates (Ctyp)
and then Analyzed (Expr)
then
- Apply_Predicate_Check (Expr, Component_Typ);
+ Apply_Predicate_Check (Expr, Ctyp);
end if;
if Raises_Constraint_Error (Expr)
@@ -2112,7 +2137,7 @@ package body Sem_Aggr is
-- the expander is not active.
if Do_Range_Check (Expr) then
- Generate_Range_Check (Expr, Component_Typ, CE_Range_Check_Failed);
+ Generate_Range_Check (Expr, Ctyp, CE_Range_Check_Failed);
end if;
return Resolution_OK;
@@ -2130,29 +2155,6 @@ package body Sem_Aggr is
Id : constant Entity_Id := Defining_Identifier (N);
Expr : constant Node_Id := Expression (N);
- -----------------------
- -- Remove_References --
- -----------------------
-
- function Remove_Reference (N : Node_Id) return Traverse_Result;
- -- Remove reference to the entity Id after analysis, so it can be
- -- properly reanalyzed after construct is expanded into a loop.
-
- function Remove_Reference (N : Node_Id) return Traverse_Result is
- begin
- if Nkind (N) = N_Identifier
- and then Present (Entity (N))
- and then Entity (N) = Id
- then
- Set_Entity (N, Empty);
- Set_Etype (N, Empty);
- end if;
- Set_Analyzed (N, False);
- return OK;
- end Remove_Reference;
-
- procedure Remove_References is new Traverse_Proc (Remove_Reference);
-
-- Local variables
Choice : Node_Id;
@@ -2221,19 +2223,10 @@ package body Sem_Aggr is
Set_Scope (Id, Scop);
end if;
- -- Analyze expression without expansion, to verify legality.
- -- When generating code, we then remove references to the index
- -- variable, because the expression will be analyzed anew when the
- -- enclosing aggregate is expanded, and the construct is rewritten
- -- as a loop with a new index variable; when not generating code we
- -- leave the analyzed expression as it is.
+ -- Analyze expression without expansion, to verify legality
Resolution_OK := Resolve_Aggr_Expr (Expr, Iterated_Elmt => True);
- if Operating_Mode /= Check_Semantics then
- Remove_References (Expr);
- end if;
-
End_Scope;
return Resolution_OK;
@@ -2346,8 +2339,6 @@ package body Sem_Aggr is
----------------------------------------
procedure Warn_On_Null_Component_Association (Expr : Node_Id) is
- Comp_Typ : constant Entity_Id := Component_Type (Etype (N));
-
procedure Check_Case_Expr (N : Node_Id);
-- Check if a case expression may initialize some component with a
-- null value.
@@ -2445,14 +2436,14 @@ package body Sem_Aggr is
Make_Raise_Constraint_Error (Sloc (Null_Expr),
Reason => CE_Access_Check_Failed));
- Set_Etype (Null_Expr, Comp_Typ);
+ Set_Etype (Null_Expr, Ctyp);
Set_Analyzed (Null_Expr);
end Warn_On_Null_Expression_And_Rewrite;
-- Start of processing for Warn_On_Null_Component_Association
begin
- pragma Assert (Can_Never_Be_Null (Comp_Typ));
+ pragma Assert (Can_Never_Be_Null (Ctyp));
case Nkind (Expr) is
when N_If_Expression =>
@@ -3063,7 +3054,7 @@ package body Sem_Aggr is
-- (if Func (J) = 0 then A(J)'Access else Null)];
elsif Ada_Version >= Ada_2022
- and then Can_Never_Be_Null (Component_Type (Etype (N)))
+ and then Can_Never_Be_Null (Ctyp)
and then Nkind (Assoc) = N_Iterated_Component_Association
and then Nkind (Expression (Assoc)) in N_If_Expression
| N_Case_Expression
@@ -3125,13 +3116,6 @@ package body Sem_Aggr is
Set_Parent (Expr, Parent (Expression (Assoc)));
Analyze (Expr);
- -- Compute its dimensions now, rather than at the end of
- -- resolution, because in the case of multidimensional
- -- aggregates subsequent expansion may lead to spurious
- -- errors.
-
- Check_Expression_Dimensions (Expr, Component_Typ);
-
-- If the expression is a literal, propagate this info
-- to the expression in the association, to enable some
-- optimizations downstream.
@@ -3140,8 +3124,7 @@ package body Sem_Aggr is
and then Present (Entity (Expr))
and then Ekind (Entity (Expr)) = E_Enumeration_Literal
then
- Analyze_And_Resolve
- (Expression (Assoc), Component_Typ);
+ Analyze_And_Resolve (Expression (Assoc), Ctyp);
end if;
Full_Analysis := Save_Analysis;
@@ -3151,8 +3134,7 @@ package body Sem_Aggr is
-- types.
if Is_Tagged_Type (Etype (Expr))
- and then Is_Class_Wide_Equivalent_Type
- (Component_Type (Etype (N)))
+ and then Is_Class_Wide_Equivalent_Type (Ctyp)
then
null;
@@ -3161,7 +3143,7 @@ package body Sem_Aggr is
elsif Is_Tagged_Type (Etype (Expr)) then
Check_Dynamically_Tagged_Expression
(Expr => Expr,
- Typ => Component_Type (Etype (N)),
+ Typ => Ctyp,
Related_Nod => N);
end if;
end;
@@ -3169,7 +3151,7 @@ package body Sem_Aggr is
elsif Is_Tagged_Type (Etype (Expression (Assoc))) then
Check_Dynamically_Tagged_Expression
(Expr => Expression (Assoc),
- Typ => Component_Type (Etype (N)),
+ Typ => Ctyp,
Related_Nod => N);
end if;
@@ -3593,7 +3575,7 @@ package body Sem_Aggr is
if Is_Tagged_Type (Etype (Expr)) then
Check_Dynamically_Tagged_Expression
(Expr => Expr,
- Typ => Component_Type (Etype (N)),
+ Typ => Ctyp,
Related_Nod => N);
end if;
end if;
@@ -3625,6 +3607,14 @@ package body Sem_Aggr is
return Failure;
end if;
+ -- ??? Checks for dynamically tagged expressions below will
+ -- be only applied to iterated_component_association after
+ -- expansion; in particular, errors might not be reported when
+ -- -gnatc switch is used.
+
+ elsif Nkind (Assoc) = N_Iterated_Component_Association then
+ null; -- handled above, in a loop context
+
elsif not Resolve_Aggr_Expr (Expression (Assoc),
Single_Elmt => False)
then
@@ -3635,7 +3625,7 @@ package body Sem_Aggr is
-- In order to diagnose the semantic error we create a duplicate
-- tree to analyze it and perform the check.
- elsif Nkind (Assoc) /= N_Iterated_Component_Association then
+ else
declare
Save_Analysis : constant Boolean := Full_Analysis;
Expr : constant Node_Id :=
@@ -3651,7 +3641,7 @@ package body Sem_Aggr is
if Is_Tagged_Type (Etype (Expr)) then
Check_Dynamically_Tagged_Expression
(Expr => Expr,
- Typ => Component_Type (Etype (N)),
+ Typ => Ctyp,
Related_Nod => N);
end if;
end;
@@ -3778,7 +3768,7 @@ package body Sem_Aggr is
-- Check the dimensions of each component in the array aggregate
- Analyze_Dimension_Array_Aggregate (N, Component_Typ);
+ Analyze_Dimension_Array_Aggregate (N, Ctyp);
if Serious_Errors_Detected /= Saved_SED then
return Failure;
