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');
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;
-- 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
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;
-- 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;
-- 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
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;
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
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
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;
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;
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
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);
-- 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
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
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;
-- 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)
-- 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;
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;
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;
----------------------------------------
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.
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 =>
-- (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
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.
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;
-- 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;
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;
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;
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;
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
-- 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 :=
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;
-- 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;
projects / thirdparty / gcc.git / commitdiff
