--------------------------------
procedure Expand_Container_Aggregate (N : Node_Id) is
- Loc : constant Source_Ptr := Sloc (N);
- Typ : constant Entity_Id := Etype (N);
- Asp : constant Node_Id := Find_Value_Of_Aspect (Typ, Aspect_Aggregate);
+ Loc : constant Source_Ptr := Sloc (N);
+ Typ : constant Entity_Id := Etype (N);
+ Asp : constant Node_Id := Find_Value_Of_Aspect (Typ, Aspect_Aggregate);
Empty_Subp : Node_Id := Empty;
Add_Named_Subp : Node_Id := Empty;
New_Indexed_Subp : Node_Id := Empty;
Assign_Indexed_Subp : Node_Id := Empty;
- Aggr_Code : constant List_Id := New_List;
- Temp : constant Entity_Id := Make_Temporary (Loc, 'C', N);
+ Aggr_Code : constant List_Id := New_List;
+ Temp : constant Entity_Id := Make_Temporary (Loc, 'C', N);
Decl : Node_Id;
- Init_Stat : Node_Id;
+ Init_Stat : Node_Id;
+
begin
Parse_Aspect_Aggregate (Asp,
Empty_Subp, Add_Named_Subp, Add_Unnamed_Subp,
Defining_Identifier => Temp,
Object_Definition => New_Occurrence_Of (Typ, Loc));
- Insert_Action (N, Decl);
- if Ekind (Entity (Empty_Subp)) = E_Constant then
- Init_Stat := Make_Assignment_Statement (Loc,
- Name => New_Occurrence_Of (Temp, Loc),
- Expression => Make_Function_Call (Loc,
- Name => New_Occurrence_Of (Entity (Empty_Subp), Loc)));
- else
- Init_Stat := Make_Assignment_Statement (Loc,
- Name => New_Occurrence_Of (Temp, Loc),
- Expression => New_Occurrence_Of (Entity (Empty_Subp), Loc));
- end if;
- Append (Init_Stat, Aggr_Code);
+ Insert_Action (N, Decl);
+ if Ekind (Entity (Empty_Subp)) = E_Constant then
+ Init_Stat := Make_Assignment_Statement (Loc,
+ Name => New_Occurrence_Of (Temp, Loc),
+ Expression => Make_Function_Call (Loc,
+ Name => New_Occurrence_Of (Entity (Empty_Subp), Loc)));
+ else
+ Init_Stat := Make_Assignment_Statement (Loc,
+ Name => New_Occurrence_Of (Temp, Loc),
+ Expression => New_Occurrence_Of (Entity (Empty_Subp), Loc));
+ end if;
+ Append (Init_Stat, Aggr_Code);
- -- First case : positional aggregate.
+ -- First case: positional aggregate
- if Present (Expressions (N)) then
- declare
- Insert : constant Entity_Id := Entity (Add_Unnamed_Subp);
- Comp : Node_Id;
- Stat : Node_Id;
- begin
- Comp := First (Expressions (N));
- while Present (Comp) loop
- Stat := Make_Procedure_Call_Statement (Loc,
- Name => New_Occurrence_Of (Insert, Loc),
- Parameter_Associations =>
- New_List (New_Occurrence_Of (Temp, Loc),
- New_Copy_Tree (Comp)));
- Append (Stat, Aggr_Code);
- Next (Comp);
- end loop;
- end;
- end if;
- Insert_Actions (N, Aggr_Code);
- Rewrite (N, New_Occurrence_Of (Temp, Loc));
- Analyze_And_Resolve (N, Typ);
+ if Present (Expressions (N)) then
+ declare
+ Insert : constant Entity_Id := Entity (Add_Unnamed_Subp);
+ Comp : Node_Id;
+ Stat : Node_Id;
+ begin
+ Comp := First (Expressions (N));
+ while Present (Comp) loop
+ Stat := Make_Procedure_Call_Statement (Loc,
+ Name => New_Occurrence_Of (Insert, Loc),
+ Parameter_Associations =>
+ New_List (New_Occurrence_Of (Temp, Loc),
+ New_Copy_Tree (Comp)));
+ Append (Stat, Aggr_Code);
+ Next (Comp);
+ end loop;
+ end;
+ end if;
+ Insert_Actions (N, Aggr_Code);
+ Rewrite (N, New_Occurrence_Of (Temp, Loc));
+ Analyze_And_Resolve (N, Typ);
end Expand_Container_Aggregate;
------------------------------
-- Rewrite operator /= based on operator = when defined explicitly
procedure Expand_SPARK_Delta_Or_Update (Typ : Entity_Id; Aggr : Node_Id);
- -- Common expansion of attribute Update and delta_aggregate
+ -- Common expansion for attribute Update and delta aggregates
------------------
-- Expand_SPARK --
if Is_Array_Type (Typ) then
- -- Multi-dimensional array
+ -- Multidimensional arrays
if Present (Next_Index (First_Index (Typ))) then
Assoc := First (Component_Associations (Aggr));
Next (Assoc);
end loop;
- -- One-dimensional array
+ -- One-dimensional arrays
else
Assoc := First (Component_Associations (Aggr));
Apply_Scalar_Range_Check
(High_Bound (Index), Etype (Index_Typ));
- -- Otherwise the index denotes a single element
+ -- Otherwise the index denotes a single element
else
Apply_Scalar_Range_Check (Index, Etype (Index_Typ));
else pragma Assert (Is_Record_Type (Typ));
- -- If the aggregate has multiple component choices, e.g.
+ -- If the aggregate has multiple component choices, e.g.:
--
-- X'Update (A | B | C => 123)
--
- -- then each component might be of a different type and might
- -- or might not require a range check. We first rewrite
- -- associations into single-component choices, e.g.:
+ -- then each component might be of a different type and might or
+ -- might not require a range check. We first rewrite associations
+ -- into single-component choices, e.g.:
--
-- X'Update (A => 123, B => 123, C => 123)
--
-- are in keeping with the components of Address_Clause_Check_Record below.
procedure Validate_Aspect_Aggregate (N : Node_Id);
- -- Check legality of operations given in the Ada_2020 Aggregate aspect
- -- for containers.
+ -- Check legality of operations given in the Ada 202x Aggregate aspect for
+ -- containers.
procedure Resolve_Aspect_Aggregate
(Typ : Entity_Id;
Indexing_Found : Boolean := False;
procedure Check_Inherited_Indexing;
- -- For a derived type, check tha for a derived type a specification
- -- of an indexing aspect can only be confirming, i.e. uses the
- -- the same name as in the parent type.
- -- AI12-0160: verify that an indexing cannot be specified for
+ -- For a derived type, check that for a derived type, a specification
+ -- of an indexing aspect can only be confirming, i.e. uses the same
+ -- name as in the parent type.
+ -- AI12-0160: Verify that an indexing cannot be specified for
-- a derived type unless it is specified for the parent.
procedure Check_One_Function (Subp : Entity_Id);
(Typ : Entity_Id;
Expr : Node_Id)
is
- -- Predicates that establish the legality of each possible
- -- operation in an Aggregate aspect.
+ -- Predicates that establish the legality of each possible operation in
+ -- an Aggregate aspect.
function Valid_Empty (E : Entity_Id) return Boolean;
function Valid_Add_Named (E : Entity_Id) return Boolean;
function Valid_Add_Unnamed (E : Entity_Id) return Boolean;
function Valid_New_Indexed (E : Entity_Id) return Boolean;
- -- Note : the leglity rules for Assign_Indexed are the same
- -- as for Add_Named.
+ -- Note: The legality rules for Assign_Indexed are the same as for
+ -- Add_Named.
generic
with function Pred (Id : Node_Id) return Boolean;
elsif Ekind (E) = E_Function then
return No (First_Formal (E))
or else
- (Is_Integer_Type (Etype (First_Formal (E)))
+ (Is_Integer_Type (Etype (First_Formal (E)))
and then No (Next_Formal (First_Formal (E))));
else
return False;
and then Etype (First_Formal (E)) = Typ
and then Ekind (First_Formal (E)) = E_In_Out_Parameter
and then
- not Is_Limited_Type (Etype (Next_Formal (First_Formal (E))));
+ not Is_Limited_Type (Etype (Next_Formal (First_Formal (E))));
end Valid_Add_Unnamed;
-----------------------
while Present (Assoc) loop
Op_Name := Chars (First (Choices (Assoc)));
- -- When verifying the consistency of aspects between
- -- the freeze point and the end of declarqtions, we
- -- use a copy which is not analyzed yet, so do it now.
+ -- When verifying the consistency of aspects between the freeze point
+ -- and the end of declarqtions, we use a copy which is not analyzed
+ -- yet, so do it now.
Subp_Id := Expression (Assoc);
if No (Etype (Subp_Id)) then
Add_Unnamed_Subp : in out Node_Id;
New_Indexed_Subp : in out Node_Id;
Assign_Indexed_Subp : in out Node_Id);
- -- Utility to unpack the subprogramz in an occurrence of asoect Aggregate,
- -- used to verify the structure of the asoect, and resolve and expand an
- -- aggregate for a container type that carries the asoect.
+ -- Utility to unpack the subprograms in an occurrence of aspect Aggregate;
+ -- used to verify the structure of the aspect, and resolve and expand an
+ -- aggregate for a container type that carries the aspect.
function Rep_Item_Too_Early (T : Entity_Id; N : Node_Id) return Boolean;
-- Called at start of processing a representation clause/pragma. Used to
Name_Reference_Control_Type : constant Name_Id := N + $;
Name_Get_Element_Access : constant Name_Id := N + $;
- -- Names for Ada2020 Aggregate aspect. Nmme_Aggregate is already
+ -- Names for Ada 202x Aggregate aspect. Name_Aggregate is already
-- present for gprbuild.
Name_Empty : constant Name_Id := N + $;