+2018-07-16 Hristian Kirtchev <kirtchev@adacore.com>
+
+ * einfo.adb, exp_ch7.adb, exp_ch9.adb, exp_unst.adb, inline.adb,
+ sem.adb, sem_ch12.adb, sem_ch13.adb, sem_ch3.adb, sem_eval.adb,
+ sem_util.adb: Minor reformatting.
+
2018-07-16 Arnaud Charlet <charlet@adacore.com>
* frontend.adb: Only unnest subprograms if no previous errors were
procedure Set_Is_Uplevel_Referenced_Entity (Id : E; V : B := True) is
begin
pragma Assert
- (Ekind_In (Id, E_Constant, E_Variable, E_Loop_Parameter)
+ (Ekind_In (Id, E_Constant, E_Loop_Parameter, E_Variable)
or else Is_Formal (Id)
or else Is_Type (Id));
Set_Flag283 (Id, V);
end if;
end Cleanup_Task;
- -----------------------------------
+ --------------------------------------
-- Check_Unnesting_Elaboration_Code --
- -----------------------------------
+ --------------------------------------
procedure Check_Unnesting_Elaboration_Code (N : Node_Id) is
Loc : constant Source_Ptr := Sloc (N);
-- <actualN> := P.<formalN>;
procedure Reset_Scopes_To (Proc_Body : Node_Id; E : Entity_Id);
- -- Reset the scope of declarations and blocks at the top level of
- -- Proc_Body to be E. Used after expanding entry bodies into their
- -- corresponding procedures.
+ -- Reset the scope of declarations and blocks at the top level of Proc_Body
+ -- to be E. Used after expanding entry bodies into their corresponding
+ -- procedures.
function Trivial_Accept_OK return Boolean;
-- If there is no DO-END block for an accept, or if the DO-END block has
Eloc : constant Source_Ptr := Sloc (Ename);
Eent : constant Entity_Id := Entity (Ename);
Index : constant Node_Id := Entry_Index (Acc_Stm);
+
+ Call : Node_Id;
+ Expr : Node_Id;
Null_Body : Node_Id;
- Proc_Body : Node_Id;
PB_Ent : Entity_Id;
- Expr : Node_Id;
- Call : Node_Id;
+ Proc_Body : Node_Id;
- -- Start of processing for Add_Accept
+ -- Start of processing for Add_Accept
begin
if No (Ann) then
Entry_Index_Expression (Eloc, Eent, Index, Scope (Eent)),
New_Occurrence_Of (RTE (RE_Null_Task_Entry), Eloc)));
else
- Expr :=
- Entry_Index_Expression
- (Eloc, Eent, Index, Scope (Eent));
+ Expr := Entry_Index_Expression (Eloc, Eent, Index, Scope (Eent));
end if;
if Present (Handled_Statement_Sequence (Accept_Statement (Alt))) then
Make_Defining_Identifier (Eloc,
New_External_Name (Chars (Ename), 'A', Num_Accept));
- -- Link the acceptor to the original receiving entry.
+ -- Link the acceptor to the original receiving entry
Set_Ekind (PB_Ent, E_Procedure);
Set_Receiving_Entry (PB_Ent, Eent);
---------------------
procedure Reset_Scopes_To (Proc_Body : Node_Id; E : Entity_Id) is
-
function Reset_Scope (N : Node_Id) return Traverse_Result;
- -- Temporaries may have been declared during expansion of the
- -- procedure alternative. Indicate that their scope is the new
- -- body, to prevent generation of spurious uplevel references
- -- for these entities.
+ -- Temporaries may have been declared during expansion of the procedure
+ -- alternative. Indicate that their scope is the new body, to prevent
+ -- generation of spurious uplevel references for these entities.
procedure Reset_Scopes is new Traverse_Proc (Reset_Scope);
Decl : Node_Id;
begin
- -- If this is a block statement with an Identifier, it forms
- -- a scope, so we want to reset its scope but not look inside.
+ -- If this is a block statement with an Identifier, it forms a scope,
+ -- so we want to reset its scope but not look inside.
- if Nkind (N) = N_Block_Statement and then Present (Identifier (N))
+ if Nkind (N) = N_Block_Statement
+ and then Present (Identifier (N))
then
Set_Scope (Entity (Identifier (N)), E);
return Skip;
return OK;
end Reset_Scope;
+ -- Start of processing for Reset_Scopes_To
+
begin
Reset_Scopes (Proc_Body);
end Reset_Scopes_To;
end loop;
end;
- -- Binary operator cases. These can apply
- -- to arrays for which we may need bounds.
+ -- Binary operator cases. These can apply to arrays for
+ -- which we may need bounds.
elsif Nkind (N) in N_Binary_Op then
Note_Uplevel_Bound (Left_Opnd (N), Ref);
-- and if the lower bound (or an inner bound for a multi-
-- dimensional array) is uplevel.
- when N_Indexed_Component | N_Slice =>
+ when N_Indexed_Component
+ | N_Slice
+ =>
if Is_Constrained (Etype (Prefix (N))) then
declare
DT : Boolean := False;
-- in order to do the comparison, which means we need the
-- bounds.
- when N_Op_Eq | N_Op_Ne =>
+ when N_Op_Eq
+ | N_Op_Ne
+ =>
declare
DT : Boolean := False;
begin
return Skip;
end if;
- -- Pragmas and component declarations can be ignored.
+ -- Pragmas and component declarations can be ignored
- when N_Pragma | N_Component_Declaration =>
+ when N_Component_Declaration
+ | N_Pragma
+ =>
return Skip;
- -- Otherwise record an uplevel reference in a local
- -- identifier.
+ -- Otherwise record an uplevel reference in a local identifier
when others =>
if Nkind (N) in N_Has_Entity
-- references to global declarations.
and then
- (Ekind_In
- (Ent, E_Constant, E_Variable, E_Loop_Parameter)
+ (Ekind_In (Ent, E_Constant,
+ E_Loop_Parameter,
+ E_Variable)
- -- Formals are interesting, but not if being used as
- -- mere names of parameters for name notation calls.
+ -- Formals are interesting, but not if being used
+ -- as mere names of parameters for name notation
+ -- calls.
- or else
- (Is_Formal (Ent)
- and then not
- (Nkind (Parent (N)) = N_Parameter_Association
- and then Selector_Name (Parent (N)) = N))
+ or else
+ (Is_Formal (Ent)
+ and then not
+ (Nkind (Parent (N)) = N_Parameter_Association
+ and then Selector_Name (Parent (N)) = N))
- -- Types other than known Is_Static types are
- -- potentially interesting.
+ -- Types other than known Is_Static types are
+ -- potentially interesting.
- or else (Is_Type (Ent)
- and then not Is_Static_Type (Ent)))
+ or else
+ (Is_Type (Ent) and then not Is_Static_Type (Ent)))
then
-- Here we have a potentially interesting uplevel
-- reference to examine.
loop
S := Enclosing_Subprogram (S);
- -- if we are at the top level, as can happen with
+ -- If we are at the top level, as can happen with
-- references to formals in aspects of nested subprogram
- -- declarations, there are no further subprograms to
- -- mark as requiring activation records.
+ -- declarations, there are no further subprograms to mark
+ -- as requiring activation records.
exit when No (S);
-- If this entity was marked reachable because it is
-- in a task or protected type, there may not appear
- -- to be any calls to it, which would normally
- -- adjust the levels of the parent subprograms.
- -- So we need to be sure that the uplevel reference
- -- of that entity takes into account possible calls.
+ -- to be any calls to it, which would normally adjust
+ -- the levels of the parent subprograms. So we need to
+ -- be sure that the uplevel reference of that entity
+ -- takes into account possible calls.
if In_Synchronized_Unit (SUBF.Ent)
and then SUBT.Lev < SUBI.Uplevel_Ref
begin
-- For parameters, we insert the assignment
-- right after the declaration of ARECnP.
- -- For all other entities, we insert
- -- the assignment immediately after the
- -- declaration of the entity or after
- -- the freeze node if present.
+ -- For all other entities, we insert the
+ -- assignment immediately after the
+ -- declaration of the entity or after the
+ -- freeze node if present.
-- Note: we don't need to mark the entity
-- as being aliased, because the address
-- N_Loop_Parametrer_Specification.
if Ekind (Ent) = E_Loop_Parameter then
- Ins := First (Statements
- (Parent (Parent (Ins))));
+ Ins :=
+ First
+ (Statements (Parent (Parent (Ins))));
Insert_Before (Ins, Asn);
else
end if;
end if;
- -- A return statement within an extended return is a noop
- -- after inlining.
+ -- A return statement within an extended return is a noop after
+ -- inlining.
elsif No (Expression (N))
- and then
- Nkind (Parent (Parent (N))) = N_Extended_Return_Statement
+ and then Nkind (Parent (Parent (N))) =
+ N_Extended_Return_Statement
then
return OK;
return True;
else
- return Present (Declarations (N))
- and then Present (First (Declarations (N)))
- and then Entity (Expression (Return_Statement)) =
- Defining_Identifier (First (Declarations (N)));
+ return
+ Present (Declarations (N))
+ and then Present (First (Declarations (N)))
+ and then Entity (Expression (Return_Statement)) =
+ Defining_Identifier (First (Declarations (N)));
end if;
end Has_Single_Return;
function Is_Subunit_Of_Main (U : Node_Id) return Boolean is
Lib : Node_Id;
+
begin
if Present (U) and then Nkind (Unit (U)) = N_Subunit then
Lib := Library_Unit (U);
else
declare
- ASN1, ASN2 : Node_Id;
Inherited_Aspects : constant List_Id :=
- New_Copy_List_Tree (Aspect_Specifications (Gen_Spec));
+ New_Copy_List_Tree
+ (Aspect_Specifications (Gen_Spec));
+
+ ASN1 : Node_Id;
+ ASN2 : Node_Id;
Pool_Present : Boolean := False;
begin
ASN1 := First (Aspect_Specifications (N));
while Present (ASN1) loop
- if Chars (Identifier (ASN1)) = Name_Default_Storage_Pool
+ if Chars (Identifier (ASN1)) =
+ Name_Default_Storage_Pool
then
Pool_Present := True;
exit;
end loop;
if Pool_Present then
- -- If generic carries a default storage pool, remove
- -- it in favor of the instance one.
+
+ -- If generic carries a default storage pool, remove it
+ -- in favor of the instance one.
ASN2 := First (Inherited_Aspects);
while Present (ASN2) loop
if Chars (Identifier (ASN2)) =
- Name_Default_Storage_Pool
+ Name_Default_Storage_Pool
then
Remove (ASN2);
exit;
Error_Msg_N
("Bit_Order can only be defined for record type", Nam);
- elsif Is_Tagged_Type (U_Ent)
- and then Is_Derived_Type (U_Ent)
- then
+ elsif Is_Tagged_Type (U_Ent) and then Is_Derived_Type (U_Ent) then
Error_Msg_N
("Bit_Order cannot be defined for record extensions", Nam);
Flag_Non_Static_Expr
("Bit_Order requires static expression!", Expr);
- else
- if (Expr_Value (Expr) = 0) /= Bytes_Big_Endian then
- Set_Reverse_Bit_Order (Base_Type (U_Ent), True);
- end if;
+ elsif (Expr_Value (Expr) = 0) /= Bytes_Big_Endian then
+ Set_Reverse_Bit_Order (Base_Type (U_Ent), True);
end if;
end if;
if Is_Itype (Subt) and then Present (Predicate_Function (Par)) then
Set_Subprograms_For_Type (Subt, Subprograms_For_Type (Par));
- if Has_Static_Predicate (Par)
- and then Is_Discrete_Type (Par)
- then
+ if Has_Static_Predicate (Par) and then Is_Discrete_Type (Par) then
Set_Static_Discrete_Predicate
(Subt, Static_Discrete_Predicate (Par));
end if;
-- the expander that do not correspond to static expressions.
procedure Eval_Integer_Literal (N : Node_Id) is
- T : constant Entity_Id := Etype (N);
-
- function In_Any_Integer_Context return Boolean;
+ function In_Any_Integer_Context (Context : Node_Id) return Boolean;
-- If the literal is resolved with a specific type in a context where
-- the expected type is Any_Integer, there are no range checks on the
-- literal. By the time the literal is evaluated, it carries the type
-- In_Any_Integer_Context --
----------------------------
- function In_Any_Integer_Context return Boolean is
- Par : constant Node_Id := Parent (N);
- K : constant Node_Kind := Nkind (Par);
-
+ function In_Any_Integer_Context (Context : Node_Id) return Boolean is
begin
-- Any_Integer also appears in digits specifications for real types,
-- but those have bounds smaller that those of any integer base type,
-- so we can safely ignore these cases.
- return Nkind_In (K, N_Number_Declaration,
- N_Attribute_Reference,
- N_Attribute_Definition_Clause,
- N_Modular_Type_Definition,
- N_Signed_Integer_Type_Definition);
+ return
+ Nkind_In (Context, N_Attribute_Definition_Clause,
+ N_Attribute_Reference,
+ N_Modular_Type_Definition,
+ N_Number_Declaration,
+ N_Signed_Integer_Type_Definition);
end In_Any_Integer_Context;
+ -- Local variables
+
+ Par : constant Node_Id := Parent (N);
+ Typ : constant Entity_Id := Etype (N);
+
-- Start of processing for Eval_Integer_Literal
begin
-- Check_Non_Static_Context on an expanded literal may lead to spurious
-- and misleading warnings.
- if (Nkind_In (Parent (N), N_If_Expression, N_Case_Expression_Alternative)
+ if (Nkind_In (Par, N_If_Expression, N_Case_Expression_Alternative)
or else Nkind (Parent (N)) not in N_Subexpr)
- and then (not Nkind_In (Parent (N), N_If_Expression,
- N_Case_Expression_Alternative)
+ and then (not Nkind_In (Par, N_Case_Expression_Alternative,
+ N_If_Expression)
or else Comes_From_Source (N))
- and then not In_Any_Integer_Context
+ and then not In_Any_Integer_Context (Par)
then
Check_Non_Static_Context (N);
end if;
-- Modular integer literals must be in their base range
- if Is_Modular_Integer_Type (T)
- and then Is_Out_Of_Range (N, Base_Type (T), Assume_Valid => True)
+ if Is_Modular_Integer_Type (Typ)
+ and then Is_Out_Of_Range (N, Base_Type (Typ), Assume_Valid => True)
then
Out_Of_Range (N);
end if;
-------------------------
function Denotes_Same_Object (A1, A2 : Node_Id) return Boolean is
- Obj1 : Node_Id := A1;
- Obj2 : Node_Id := A2;
-
function Is_Renaming (N : Node_Id) return Boolean;
-- Return true if N names a renaming entity
function Is_Renaming (N : Node_Id) return Boolean is
begin
- return Is_Entity_Name (N)
- and then Present (Renamed_Entity (Entity (N)));
+ return
+ Is_Entity_Name (N) and then Present (Renamed_Entity (Entity (N)));
end Is_Renaming;
-----------------------
-----------------------
function Is_Valid_Renaming (N : Node_Id) return Boolean is
-
function Check_Renaming (N : Node_Id) return Boolean;
-- Recursive function used to traverse all the prefixes of N
+ --------------------
+ -- Check_Renaming --
+ --------------------
+
function Check_Renaming (N : Node_Id) return Boolean is
begin
if Is_Renaming (N)
return Check_Renaming (N);
end Is_Valid_Renaming;
+ -- Local variables
+
+ Obj1 : Node_Id := A1;
+ Obj2 : Node_Id := A2;
+
-- Start of processing for Denotes_Same_Object
begin
function Has_Prefix (N : Node_Id) return Boolean is
begin
return
- Nkind_In (N,
- N_Attribute_Reference,
- N_Expanded_Name,
- N_Explicit_Dereference,
- N_Indexed_Component,
- N_Reference,
- N_Selected_Component,
- N_Slice);
+ Nkind_In (N, N_Attribute_Reference,
+ N_Expanded_Name,
+ N_Explicit_Dereference,
+ N_Indexed_Component,
+ N_Reference,
+ N_Selected_Component,
+ N_Slice);
end Has_Prefix;
---------------------------
projects / gcc.git / commitdiff