+2018-05-25 Hristian Kirtchev <kirtchev@adacore.com>
+
+ * einfo.adb, einfo.ads, exp_ch3.adb, exp_ch8.adb, exp_unst.adb,
+ pprint.adb, sem_ch12.adb, sem_ch3.adb, sem_prag.adb, sem_util.adb:
+ Minor reformatting.
+
2018-05-25 Ed Schonberg <schonberg@adacore.com>
* sem_ch12.adb (Instance_Exists): New function, subsidiary of
-- Entry_Max_Queue_Lengths_Array Node35
-- Import_Pragma Node35
- -- Prev_Entity Node36
-
-- Validated_Object Node38
-- Predicated_Parent Node38
-- Class_Wide_Clone Node38
-- Applies to all entities, true for access types and subtypes
-- Is_Activation_Record (Flag305)
--- Applies to In_Parameters generated in Exp_Unst for nested
+-- Applies to E_In_Parameters generated in Exp_Unst for nested
-- subprograms, to mark the added formal that carries the activation
-- record created in the enclosing subprogram.
Body_Id : Entity_Id;
Param_Specs : List_Id) return Node_Id
is
- Loc : constant Source_Ptr := Sloc (Typ);
- Def : constant Node_Id := Parent (Typ);
- Comps : constant Node_Id := Component_List (Type_Definition (Def));
- Left : constant Entity_Id := Defining_Identifier
- (First (Param_Specs));
- Right : constant Entity_Id := Defining_Identifier
- (Next (First (Param_Specs)));
- Decls : constant List_Id := New_List;
- Stmts : constant List_Id := New_List;
+ Loc : constant Source_Ptr := Sloc (Typ);
+ Def : constant Node_Id := Parent (Typ);
+ Comps : constant Node_Id := Component_List (Type_Definition (Def));
+ Left : constant Entity_Id := Defining_Identifier (First (Param_Specs));
+ Right : constant Entity_Id :=
+ Defining_Identifier (Next (First (Param_Specs)));
+ Decls : constant List_Id := New_List;
+ Stmts : constant List_Id := New_List;
+
Subp_Body : Node_Id;
begin
if Is_Unchecked_Union (Typ) then
declare
+ A : Entity_Id;
+ B : Entity_Id;
Discr : Entity_Id;
Discr_Type : Entity_Id;
- A, B : Entity_Id;
New_Discrs : Elist_Id;
begin
Discr := First_Discriminant (Typ);
while Present (Discr) loop
Discr_Type := Etype (Discr);
- A := Make_Defining_Identifier (Loc,
- Chars => New_External_Name (Chars (Discr), 'A'));
- B := Make_Defining_Identifier (Loc,
- Chars => New_External_Name (Chars (Discr), 'B'));
+ A :=
+ Make_Defining_Identifier (Loc,
+ Chars => New_External_Name (Chars (Discr), 'A'));
+
+ B :=
+ Make_Defining_Identifier (Loc,
+ Chars => New_External_Name (Chars (Discr), 'B'));
-- Add new parameters to the parameter list
end loop;
-- Generate component-by-component comparison. Note that we must
- -- propagate the inferred discriminants formals to act as
- -- the case statement switch. Their value is added when an
- -- equality call on unchecked unions is expanded.
+ -- propagate the inferred discriminants formals to act as the case
+ -- statement switch. Their value is added when an equality call on
+ -- unchecked unions is expanded.
Append_List_To (Stmts, Make_Eq_Case (Typ, Comps, New_Discrs));
end;
Subp_Body :=
Make_Subprogram_Body (Loc,
- Specification =>
+ Specification =>
Make_Function_Specification (Loc,
Defining_Unit_Name => Body_Id,
Parameter_Specifications => Param_Specs,
-- Create An Equality function for the untagged variant record Typ and
-- attach it to the TSS list.
+ -----------------------------------
+ -- Build_Variant_Record_Equality --
+ -----------------------------------
+
procedure Build_Variant_Record_Equality (Typ : Entity_Id) is
Loc : constant Source_Ptr := Sloc (Typ);
- F : constant Entity_Id :=
+ F : constant Entity_Id :=
Make_Defining_Identifier (Loc,
Chars => Make_TSS_Name (Typ, TSS_Composite_Equality));
begin
Body_Id => F,
Param_Specs => New_List (
Make_Parameter_Specification (Loc,
- Defining_Identifier => Make_Defining_Identifier (Loc,
- Name_X),
+ Defining_Identifier =>
+ Make_Defining_Identifier (Loc, Name_X),
Parameter_Type => New_Occurrence_Of (Typ, Loc)),
+
Make_Parameter_Specification (Loc,
- Defining_Identifier => Make_Defining_Identifier (Loc,
- Name_Y),
+ Defining_Identifier =>
+ Make_Defining_Identifier (Loc, Name_Y),
Parameter_Type => New_Occurrence_Of (Typ, Loc)))));
Set_TSS (Typ, F);
Body_Id => Body_Id,
Param_Specs => Copy_Parameter_List (Id));
- -- Build body for renamed equality, to capture its current
- -- meaning. It may be redefined later, but the renaming is
- -- elaborated where it occurs. This is technically known as
- -- Squirreling semantics. Renaming is rewritten as a subprogram
- -- declaration, and the generated body is inserted into the
- -- freeze actions for the subprogram.
+ -- Build body for renamed equality, to capture its current meaning.
+ -- It may be redefined later, but the renaming is elaborated where
+ -- it occurs. This is technically known as Squirreling semantics.
+ -- Renaming is rewritten as a subprogram declaration, and the
+ -- generated body is inserted into the freeze actions for the
+ -- subprogram.
else
Decl :=
procedure Note_Uplevel_Bound (N : Node_Id) is
begin
- -- Entity name case
- -- Make sure that that the entity is declared in a
- -- subprogram. THis may not be the case for an type
+ -- Entity name case. Make sure that the entity is declared
+ -- in a subprogram. This may not be the case for for a type
-- in a loop appearing in a precondition.
if Is_Entity_Name (N) then
if Present (Entity (N))
- and then Present (Enclosing_Subprogram (Entity (N)))
+ and then Present (Enclosing_Subprogram (Entity (N)))
then
Note_Uplevel_Ref
(E => Entity (N),
end if;
end if;
end if;
+
when Attribute_First
| Attribute_Last
| Attribute_Length
=>
- -- Special-case attributes of array objects
- -- whose bounds may be uplevel references.
- -- More complex prefixes are handled during
- -- full traversal. Note that if the nominal
- -- subtype of the prefix is unconstrained, the
- -- bound must be obtained from the object, not
- -- from the (possibly) uplevel reference,
+ -- Special-case attributes of array objects whose
+ -- bounds may be uplevel references. More complex
+ -- prefixes are handled during full traversal. Note
+ -- that if the nominal subtype of the prefix is
+ -- unconstrained, the bound must be obtained from
+ -- the object, not from the (possibly) uplevel
+ -- reference.
if Is_Entity_Name (Prefix (N))
and then Is_Constrained (Etype (Prefix (N)))
-- If argument does not already account for a closing
-- parenthesis, count one here.
- if not Nkind_In (Right, N_Quantified_Expression,
- N_Aggregate)
+ if not Nkind_In (Right, N_Aggregate,
+ N_Quantified_Expression)
then
Append_Paren := Append_Paren + 1;
end if;
end if;
when N_Quantified_Expression =>
- Right := Original_Node (Condition (Right));
+ Right := Original_Node (Condition (Right));
Append_Paren := Append_Paren + 1;
when N_Aggregate =>
declare
Aggr : constant Node_Id := Right;
Sub : Node_Id;
+
begin
Sub := First (Expressions (Aggr));
while Present (Sub) loop
if Sloc (Sub) > Sloc (Right) then
Right := Sub;
end if;
+
Next (Sub);
end loop;
if Sloc (Sub) > Sloc (Right) then
Right := Sub;
end if;
+
Next (Sub);
end loop;
end;
else
- return Buffer (1 .. Index) & Expr_Name (Right, False)
- & (1 .. Append_Paren => ')');
+ return
+ Buffer (1 .. Index)
+ & Expr_Name (Right, False)
+ & (1 .. Append_Paren => ')');
end if;
end;
end;
else
declare
+ Act_Iface_List : Elist_Id;
Iface : Node_Id;
Iface_Ent : Entity_Id;
- Act_Iface_List : Elist_Id;
function Instance_Exists (I : Entity_Id) return Boolean;
-- If the interface entity is declared in a generic unit,
while Present (Iface) loop
Iface_Ent := Get_Instance_Of (Entity (Iface));
- if Is_Ancestor (Iface_Ent, Act_T)
- or else Is_Progenitor (Iface_Ent, Act_T)
+ if Is_Ancestor (Iface_Ent, Act_T)
+ or else Is_Progenitor (Iface_Ent, Act_T)
then
null;
Error_Msg_Name_1 := Chars (Act_T);
Error_Msg_NE
("Actual% must implement interface&",
- Actual, Etype (Iface));
+ Actual, Etype (Iface));
end if;
Next (Iface);
-- (for example see the expansion of Deep_Adjust).
if Ekind (C) = E_Discriminant and then Present (N) then
- return not Comes_From_Source (N)
- or else not Is_Completely_Hidden (C);
+ return
+ not Comes_From_Source (N)
+ or else not Is_Completely_Hidden (C);
else
return True;
end if;
| Name_Off
=>
-- In CodePeer mode and GNATprove mode, we need to
- -- consider all assertions, unless they are
- -- disabled. Force Is_Checked on ignored assertions, in
- -- particular because transformations of the AST may
- -- depend on assertions being checked (e.g. the
- -- translation of attribute 'Loop_Entry).
+ -- consider all assertions, unless they are disabled.
+ -- Force Is_Checked on ignored assertions, in particular
+ -- because transformations of the AST may depend on
+ -- assertions being checked (e.g. the translation of
+ -- attribute 'Loop_Entry).
if CodePeer_Mode or GNATprove_Mode then
Set_Is_Checked (N, True);
Set_Is_Ignored (N, False);
else
- Set_Is_Ignored (N, True);
Set_Is_Checked (N, False);
+ Set_Is_Ignored (N, True);
end if;
when Name_Check
-- Follow subprogram renaming chain
if Is_Subprogram (Def_Id)
- and then
- Nkind (Parent (Declaration_Node (Def_Id))) =
- N_Subprogram_Renaming_Declaration
+ and then Nkind (Parent (Declaration_Node (Def_Id))) =
+ N_Subprogram_Renaming_Declaration
and then Present (Alias (Def_Id))
then
return Alias (Def_Id);
-----------------------------
procedure Iterate_Call_Parameters (Call : Node_Id) is
- Formal : Entity_Id := First_Formal (Get_Called_Entity (Call));
Actual : Node_Id := First_Actual (Call);
+ Formal : Entity_Id := First_Formal (Get_Called_Entity (Call));
begin
while Present (Formal) loop
projects / gcc.git / commitdiff