-- directly.
elsif (Is_Prival (Ent)
- and then
- (Ekind (Current_Scope) = E_Function
- or else Ekind (Enclosing_Dynamic_Scope
- (Current_Scope)) = E_Function))
+ and then
+ (Ekind (Current_Scope) = E_Function
+ or else Ekind (Enclosing_Dynamic_Scope
+ (Current_Scope)) = E_Function))
or else
(Ekind (Ent) = E_Component
- and then Is_Protected_Type (Scope (Ent)))
+ and then Is_Protected_Type (Scope (Ent)))
then
Error_Msg_N
("protected function cannot modify protected object", N);
if Is_Entity_Name (Opnd)
and then (Ekind (Entity (Opnd)) = E_Out_Parameter
- or else Ekind (Entity (Opnd)) =
- E_In_Out_Parameter
- or else Ekind (Entity (Opnd)) =
- E_Generic_In_Out_Parameter
+ or else Ekind_In (Entity (Opnd),
+ E_In_Out_Parameter,
+ E_Generic_In_Out_Parameter)
or else
(Ekind (Entity (Opnd)) = E_Variable
and then Nkind (Parent (Entity (Opnd))) =
- N_Object_Renaming_Declaration
+ N_Object_Renaming_Declaration
and then Nkind (Parent (Parent (Entity (Opnd)))) =
- N_Accept_Statement))
+ N_Accept_Statement))
then
Opnd_Type := Get_Actual_Subtype (Opnd);
end loop;
if (Nkind (Ent) = N_Attribute_Reference
- and then Attribute_Name (Ent) = Name_Priority)
+ and then Attribute_Name (Ent) = Name_Priority)
-- Renamings of the attribute Priority applied to protected
-- objects have been previously expanded into calls to the
or else
(Nkind (Ent) = N_Function_Call
- and then (Entity (Name (Ent)) = RTE (RE_Get_Ceiling)
- or else
- Entity (Name (Ent)) = RTE (RO_PE_Get_Ceiling)))
+ and then (Entity (Name (Ent)) = RTE (RE_Get_Ceiling)
+ or else
+ Entity (Name (Ent)) = RTE (RO_PE_Get_Ceiling)))
then
-- The enclosing subprogram cannot be a protected function
S := Current_Scope;
while not (Is_Subprogram (S)
- and then Convention (S) = Convention_Protected)
+ and then Convention (S) = Convention_Protected)
and then S /= Standard_Standard
loop
S := Scope (S);
Propagate_Tag (Lhs, Rhs);
elsif Nkind (Rhs) = N_Function_Call
- and then Is_Entity_Name (Name (Rhs))
- and then Is_Abstract_Subprogram (Entity (Name (Rhs)))
+ and then Is_Entity_Name (Name (Rhs))
+ and then Is_Abstract_Subprogram (Entity (Name (Rhs)))
then
Error_Msg_N
("call to abstract function must be dispatching", Name (Rhs));
-- as well to anonymous access-to-subprogram types that are component
-- subtypes or formal parameters.
- if Ada_Version >= Ada_2005
- and then Is_Access_Type (T1)
- then
+ if Ada_Version >= Ada_2005 and then Is_Access_Type (T1) then
if Is_Local_Anonymous_Access (T1)
or else Ekind (T2) = E_Anonymous_Access_Subprogram_Type
-- assignment within the block.
elsif Is_Array_Type (T1)
- and then
- (Nkind (Rhs) /= N_Type_Conversion
- or else Is_Constrained (Etype (Rhs)))
- and then
- (Nkind (Rhs) /= N_Function_Call
- or else Nkind (N) /= N_Block_Statement)
+ and then (Nkind (Rhs) /= N_Type_Conversion
+ or else Is_Constrained (Etype (Rhs)))
+ and then (Nkind (Rhs) /= N_Function_Call
+ or else Nkind (N) /= N_Block_Statement)
then
-- Assignment verifies that the length of the Lsh and Rhs are equal,
-- but of course the indexes do not have to match. If the right-hand
elsif Ada_Version = Ada_83
and then (Is_Generic_Type (Exp_Btype)
- or else Is_Generic_Type (Root_Type (Exp_Btype)))
+ or else Is_Generic_Type (Root_Type (Exp_Btype)))
then
Error_Msg_N
("(Ada 83) case expression cannot be of a generic type", Exp);
-- A case statement with a single OTHERS alternative is not allowed
-- in SPARK.
- if Others_Present
- and then List_Length (Alternatives (N)) = 1
- then
+ if Others_Present and then List_Length (Alternatives (N)) = 1 then
Check_SPARK_Restriction
("OTHERS as unique case alternative is not allowed", N);
end if;
Scope_Id := Scope_Stack.Table (J).Entity;
Kind := Ekind (Scope_Id);
- if Kind = E_Loop
- and then (No (Target) or else Scope_Id = U_Name)
- then
+ if Kind = E_Loop and then (No (Target) or else Scope_Id = U_Name) then
Set_Has_Exit (Scope_Id);
exit;
Scope_Id := Scope_Stack.Table (J).Entity;
if Label_Scope = Scope_Id
- or else (Ekind (Scope_Id) /= E_Block
- and then Ekind (Scope_Id) /= E_Loop
- and then Ekind (Scope_Id) /= E_Return_Statement)
+ or else not Ekind_In (Scope_Id, E_Block, E_Loop, E_Return_Statement)
then
if Scope_Id /= Label_Scope then
Error_Msg_N
-- The expander has circuitry to completely delete code that it can tell
-- will not be executed (as a result of compile time known conditions). In
- -- the analyzer, we ensure that code that will be deleted in this manner is
- -- analyzed but not expanded. This is obviously more efficient, but more
- -- significantly, difficulties arise if code is expanded and then
+ -- the analyzer, we ensure that code that will be deleted in this manner
+ -- is analyzed but not expanded. This is obviously more efficient, but
+ -- more significantly, difficulties arise if code is expanded and then
-- eliminated (e.g. exception table entries disappear). Similarly, itypes
-- generated in deleted code must be frozen from start, because the nodes
-- on which they depend will not be available at the freeze point.
-- Propagate staticness to loop range itself, in case the
-- corresponding subtype is static.
- if New_Lo /= Lo
- and then Is_Static_Expression (New_Lo)
- then
+ if New_Lo /= Lo and then Is_Static_Expression (New_Lo) then
Rewrite (Low_Bound (R), New_Copy (New_Lo));
end if;
- if New_Hi /= Hi
- and then Is_Static_Expression (New_Hi)
- then
+ if New_Hi /= Hi and then Is_Static_Expression (New_Hi) then
Rewrite (High_Bound (R), New_Copy (New_Hi));
end if;
end Process_Bounds;
-- new iterator form.
if Nkind (DS_Copy) = N_Function_Call
- or else
- (Is_Entity_Name (DS_Copy)
- and then not Is_Type (Entity (DS_Copy)))
+ or else (Is_Entity_Name (DS_Copy)
+ and then not Is_Type (Entity (DS_Copy)))
then
-- This is an iterator specification. Rewrite it as such and
-- analyze it to capture function calls that may require
and then Is_Itype (Etype (Id))
and then Nkind (Parent (Loop_Nod)) = N_Expression_With_Actions
and then Nkind (Original_Node (Parent (Loop_Nod))) =
- N_Quantified_Expression)
+ N_Quantified_Expression)
then
Set_Etype (Id, Etype (DS));
end if;
-- instance, since in practice they tend to be dubious in these
-- cases since they can result from intended parametrization.
- if not Inside_A_Generic
- and then not In_Instance
- then
+ if not Inside_A_Generic and then not In_Instance then
+
-- Specialize msg if invalid values could make the loop
-- non-null after all.
-- The other case for a warning is a reverse loop where the
-- upper bound is the integer literal zero or one, and the
- -- lower bound can be positive.
+ -- lower bound may exceed this value.
-- For example, we have
and then Nkind (Original_Node (H)) = N_Integer_Literal
and then
(Intval (Original_Node (H)) = Uint_0
- or else Intval (Original_Node (H)) = Uint_1)
+ or else
+ Intval (Original_Node (H)) = Uint_1)
then
- Error_Msg_N ("??loop range may be null", DS);
- Error_Msg_N ("\??bounds may be wrong way round", DS);
+ -- Lower bound may in fact be known and known not to exceed
+ -- upper bound (e.g. reverse 0 .. 1) and that's OK.
+
+ if Compile_Time_Known_Value (L)
+ and then Expr_Value (L) <= Expr_Value (H)
+ then
+ null;
+
+ -- Otherwise warning is warranted
+
+ else
+ Error_Msg_N ("??loop range may be null", DS);
+ Error_Msg_N ("\??bounds may be wrong way round", DS);
+ end if;
end if;
end;
end if;
P : Node_Id;
begin
- if Is_List_Member (N)
- and then Comes_From_Source (N)
- then
+ if Is_List_Member (N) and then Comes_From_Source (N) then
declare
Nxt : Node_Id;
Analyze (R_Copy);
- if Nkind (R_Copy) in N_Subexpr
- and then Is_Overloaded (R_Copy)
- then
+ if Nkind (R_Copy) in N_Subexpr and then Is_Overloaded (R_Copy) then
+
-- Apply preference rules for range of predefined integer types, or
-- diagnose true ambiguity.
-- Subtype mark in iteration scheme
- if Is_Entity_Name (R_Copy)
- and then Is_Type (Entity (R_Copy))
- then
+ if Is_Entity_Name (R_Copy) and then Is_Type (Entity (R_Copy)) then
null;
-- Expression in range, or Ada 2012 iterator
-- when compiling a subunit or instantiating a generic body on the fly,
-- when it is necessary to save and restore full environments.
+ function Enclosing_Instance return Entity_Id;
+ -- In an instance nested within another one, several semantic checks are
+ -- unnecessary because the legality of the nested instance has been checked
+ -- in the enclosing generic unit. This applies in particular to legality
+ -- checks on actuals for formal subprograms of the inner instance, which
+ -- are checked as subprogram renamings, and may be complicated by confusion
+ -- in private/full views. This function returns the instance enclosing the
+ -- current one if there is such, else it returns Empty.
+ --
+ -- If the renaming determines the entity for the default of a formal
+ -- subprogram nested within another instance, choose the innermost
+ -- candidate. This is because if the formal has a box, and we are within
+ -- an enclosing instance where some candidate interpretations are local
+ -- to this enclosing instance, we know that the default was properly
+ -- resolved when analyzing the generic, so we prefer the local
+ -- candidates to those that are external. This is not always the case
+ -- but is a reasonable heuristic on the use of nested generics. The
+ -- proper solution requires a full renaming model.
+
function Has_Implicit_Character_Literal (N : Node_Id) return Boolean;
-- Find a type derived from Character or Wide_Character in the prefix of N.
-- Used to resolved qualified names whose selector is a character literal.
then
null;
- elsif Ada_Version >= Ada_2005
- and then Nkind (Nam) in N_Has_Entity
- then
+ elsif Ada_Version >= Ada_2005 and then Nkind (Nam) in N_Has_Entity then
declare
Nam_Decl : Node_Id;
Nam_Ent : Entity_Id;
-- have a null exclusion or a null-excluding subtype.
if Is_Formal_Object (Nam_Ent)
- and then In_Generic_Scope (Id)
+ and then In_Generic_Scope (Id)
then
if not Can_Never_Be_Null (Etype (Nam_Ent)) then
Error_Msg_N
elsif Nkind (Nam_Decl) = N_Object_Declaration
and then In_Instance
- and then Present
- (Corresponding_Generic_Association (Nam_Decl))
- and then Nkind (Expression (Nam_Decl))
- = N_Raise_Constraint_Error
+ and then
+ Present (Corresponding_Generic_Association (Nam_Decl))
+ and then Nkind (Expression (Nam_Decl)) =
+ N_Raise_Constraint_Error
then
Error_Msg_N
("renamed actual does not exclude `NULL` "
Nkind (Original_Node (Nam)) /= N_Attribute_Reference)
or else (Nkind (Nam) = N_Type_Conversion
- and then Is_Tagged_Type (Entity (Subtype_Mark (Nam))))
+ and then Is_Tagged_Type (Entity (Subtype_Mark (Nam))))
then
null;
begin
E := First_Entity (Old_P);
- while Present (E)
- and then E /= New_P
- loop
+ while Present (E) and then E /= New_P loop
if Is_Type (E)
and then Nkind (Parent (E)) = N_Subtype_Declaration
then
begin
if (Is_Entity_Name (P) and then Ekind (Entity (P)) = E_Entry_Family)
or else (Nkind (P) = N_Selected_Component
- and then
- Ekind (Entity (Selector_Name (P))) = E_Entry_Family)
+ and then Ekind (Entity (Selector_Name (P))) = E_Entry_Family)
then
if Is_Entity_Name (P) then
Old_S := Entity (P);
Ren_Formal := First_Formal (Ren);
Sub_Formal := First_Formal (Sub);
- while Present (Ren_Formal)
- and then Present (Sub_Formal)
- loop
+ while Present (Ren_Formal) and then Present (Sub_Formal) loop
if Has_Null_Exclusion (Parent (Ren_Formal))
and then
not (Has_Null_Exclusion (Parent (Sub_Formal))
- or else Can_Never_Be_Null (Etype (Sub_Formal)))
+ or else Can_Never_Be_Null (Etype (Sub_Formal)))
then
Error_Msg_NE
("`NOT NULL` required for parameter &",
if Nkind (Parent (Ren)) = N_Function_Specification
and then Nkind (Parent (Sub)) = N_Function_Specification
and then Has_Null_Exclusion (Parent (Ren))
- and then
- not (Has_Null_Exclusion (Parent (Sub))
- or else Can_Never_Be_Null (Etype (Sub)))
+ and then not (Has_Null_Exclusion (Parent (Sub))
+ or else Can_Never_Be_Null (Etype (Sub)))
then
Error_Msg_N
("return must specify `NOT NULL`",
then
F_Nam := First_Entity (Entity (Nam));
F_Spec := First_Formal (Formal_Spec);
- while Present (F_Nam)
- and then Present (F_Spec)
- loop
+ while Present (F_Nam) and then Present (F_Spec) loop
if Is_Controlling_Formal (F_Nam)
and then Has_Unknown_Discriminants (Etype (F_Spec))
and then not Is_Class_Wide_Type (Etype (F_Spec))
if Present (Alias (Subp)) then
return Alias (Subp);
- elsif
- Nkind (Unit_Declaration_Node (Subp)) = N_Subprogram_Declaration
- and then Present
- (Corresponding_Body (Unit_Declaration_Node (Subp)))
+ elsif Nkind (Unit_Declaration_Node (Subp)) = N_Subprogram_Declaration
+ and then Present (Corresponding_Body (Unit_Declaration_Node (Subp)))
then
-- Check if renamed entity is a renaming_as_body
-- this must be treated as a normal attribute reference, to be
-- expanded in subsequent instantiations.
- if Is_Actual and then Is_Abstract_Subprogram (Formal_Spec)
+ if Is_Actual
+ and then Is_Abstract_Subprogram (Formal_Spec)
and then Full_Expander_Active
then
declare
pragma Assert
(Is_Primitive (Entity (Nam))
- and then
- Is_Abstract_Type (Find_Dispatching_Type (Entity (Nam))));
+ and then
+ Is_Abstract_Type (Find_Dispatching_Type (Entity (Nam))));
declare
Old_Decl : constant Node_Id :=
Unit_Declaration_Node (Rename_Spec);
(Is_Tagged_Type (T)
or else
(Is_Access_Type (T)
- and then
- Is_Tagged_Type (Designated_Type (T))))
+ and then Is_Tagged_Type (Designated_Type (T))))
and then Scope (Entity (Selector_Name (Nam))) /= T
then
Analyze_Renamed_Primitive_Operation
-- This is not allowed for renaming as body if the renamed
-- spec is already frozen (see RM 8.5.4(5) for details).
- if Present (Rename_Spec)
- and then Is_Frozen (Rename_Spec)
- then
+ if Present (Rename_Spec) and then Is_Frozen (Rename_Spec) then
Error_Msg_N
("renaming-as-body cannot rename entry as subprogram", N);
Error_Msg_NE
-- when performing a null exclusion check between a renaming and a
-- renamed subprogram that has been found to be illegal.
- if Ada_Version >= Ada_2005
- and then Entity (Nam) /= Any_Id
- then
+ if Ada_Version >= Ada_2005 and then Entity (Nam) /= Any_Id then
Check_Null_Exclusion
(Ren => New_S,
Sub => Entity (Nam));
if CW_Actual then
null;
- else
+ elsif not Is_Actual or else No (Enclosing_Instance) then
Check_Mode_Conformant (New_S, Old_S);
end if;
- if Is_Actual
- and then Error_Posted (New_S)
- then
+ if Is_Actual and then Error_Posted (New_S) then
Error_Msg_NE ("invalid actual subprogram: & #!", N, Old_S);
end if;
end if;
Set_Is_Intrinsic_Subprogram
(New_S,
- Is_Intrinsic_Subprogram (Old_S)
- and then
- (Chars (Old_S) /= Name_Op_Ne
- or else Ekind (Old_S) = E_Operator
- or else
- Is_Intrinsic_Subprogram
- (Corresponding_Equality (Old_S))));
+ Is_Intrinsic_Subprogram (Old_S)
+ and then
+ (Chars (Old_S) /= Name_Op_Ne
+ or else Ekind (Old_S) = E_Operator
+ or else Is_Intrinsic_Subprogram
+ (Corresponding_Equality (Old_S))));
if Ekind (Alias (New_S)) = E_Operator then
Set_Has_Delayed_Freeze (New_S, False);
F1 := First_Formal (Candidate_Renaming);
F2 := First_Formal (New_S);
T1 := First_Subtype (Etype (F1));
-
while Present (F1) and then Present (F2) loop
Next_Formal (F1);
Next_Formal (F2);
if Comes_From_Source (N)
and then Present (Old_S)
- and then
- (Nkind (Old_S) = N_Defining_Operator_Symbol
- or else Ekind (Old_S) = E_Operator)
+ and then (Nkind (Old_S) = N_Defining_Operator_Symbol
+ or else Ekind (Old_S) = E_Operator)
and then Nkind (New_S) = N_Defining_Operator_Symbol
and then Chars (Old_S) /= Chars (New_S)
then
and then Comes_From_Source (N)
and then Scope (Old_S) /= Standard_Standard
and then Warn_On_Redundant_Constructs
- and then
- (Is_Immediately_Visible (Old_S)
- or else Is_Potentially_Use_Visible (Old_S))
+ and then (Is_Immediately_Visible (Old_S)
+ or else Is_Potentially_Use_Visible (Old_S))
and then Is_Overloadable (Current_Scope)
and then Chars (Current_Scope) /= Chars (Old_S)
then
if Is_Entity_Name (Pack_Name) then
Pack := Entity (Pack_Name);
- if Ekind (Pack) /= E_Package
- and then Etype (Pack) /= Any_Type
- then
+ if Ekind (Pack) /= E_Package and then Etype (Pack) /= Any_Type then
if Ekind (Pack) = E_Generic_Package then
Error_Msg_N -- CODEFIX
("a generic package is not allowed in a use clause",
function Mentioned (Nam : Node_Id) return Boolean is
begin
return Nkind (Name (Item)) = N_Selected_Component
- and then
- Chars (Prefix (Name (Item))) = Chars (Nam);
+ and then Chars (Prefix (Name (Item))) = Chars (Nam);
end Mentioned;
begin
Pref := Prefix (Id);
Item := First (Context_Items (Parent (N)));
-
while Present (Item) and then Item /= N loop
if Nkind (Item) = N_With_Clause
and then Limited_Present (Item)
begin
if In_Open_Scopes (Pack) then
- if Warn_On_Redundant_Constructs
- and then Pack = Current_Scope
- then
+ if Warn_On_Redundant_Constructs and then Pack = Current_Scope then
Error_Msg_NE -- CODEFIX
("& is already use-visible within itself?r?", Pack_Name, Pack);
end if;
Old_S : Entity_Id;
begin
- if Is_Frozen (Subp)
- and then not Has_Completion (Subp)
- then
+ if Is_Frozen (Subp) and then not Has_Completion (Subp) then
B_Node :=
Build_Renamed_Body
(Parent (Declaration_Node (Subp)), Defining_Entity (N));
Analyze (B_Node);
end if;
- if Is_Intrinsic_Subprogram (Old_S)
- and then not In_Instance
- then
+ if Is_Intrinsic_Subprogram (Old_S) and then not In_Instance then
Error_Msg_N
("subprogram used in renaming_as_body cannot be intrinsic",
- Name (N));
+ Name (N));
end if;
else
-- for details on their handling.
elsif Is_Concurrent_Type (Scope (E)) then
-
P := Parent (N);
while Present (P)
and then not Nkind_In (P, N_Parameter_Specification,
- N_Component_Declaration)
+ N_Component_Declaration)
loop
P := Parent (P);
end loop;
begin
Item := First (Context_Items (Parent (N)));
-
- while Present (Item)
- and then Item /= N
- loop
+ while Present (Item) and then Item /= N loop
if Nkind (Item) = N_With_Clause
- -- Protect the frontend against previous critical errors
+ -- Protect the frontend against previous critical errors
and then Nkind (Name (Item)) /= N_Selected_Component
and then Entity (Name (Item)) = Pack
("renamed unit must be a child unit of generic parent", Name (N));
elsif Nkind (N) in N_Generic_Renaming_Declaration
- and then Nkind (Name (N)) = N_Expanded_Name
- and then Is_Generic_Instance (Entity (Prefix (Name (N))))
- and then Is_Generic_Unit (Old_E)
+ and then Nkind (Name (N)) = N_Expanded_Name
+ and then Is_Generic_Instance (Entity (Prefix (Name (N))))
+ and then Is_Generic_Unit (Old_E)
then
Error_Msg_N
("renamed generic unit must be a library unit", Name (N));
end if;
end Check_Library_Unit_Renaming;
+ ------------------------
+ -- Enclosing_Instance --
+ ------------------------
+
+ function Enclosing_Instance return Entity_Id is
+ S : Entity_Id;
+
+ begin
+ if not Is_Generic_Instance (Current_Scope) then
+ return Empty;
+ end if;
+
+ S := Scope (Current_Scope);
+ while S /= Standard_Standard loop
+ if Is_Generic_Instance (S) then
+ return S;
+ end if;
+
+ S := Scope (S);
+ end loop;
+
+ return Empty;
+ end Enclosing_Instance;
+
---------------
-- End_Scope --
---------------
if Nkind (Id) = N_Defining_Operator_Symbol
and then
- (Is_Primitive_Operator_In_Use
- (Id, First_Formal (Id))
- or else
- (Present (Next_Formal (First_Formal (Id)))
- and then
- Is_Primitive_Operator_In_Use
- (Id, Next_Formal (First_Formal (Id)))))
+ (Is_Primitive_Operator_In_Use (Id, First_Formal (Id))
+ or else
+ (Present (Next_Formal (First_Formal (Id)))
+ and then
+ Is_Primitive_Operator_In_Use
+ (Id, Next_Formal (First_Formal (Id)))))
then
null;
-
else
Set_Is_Potentially_Use_Visible (Id, False);
end if;
Nkind (N) = N_Identifier
and then
(Nkind (Parent (N)) = N_Procedure_Call_Statement
- or else
- (Nkind (Parent (N)) = N_Parameter_Association
- and then N = Explicit_Actual_Parameter (Parent (N))
- and then Nkind (Parent (Parent (N))) =
+ or else
+ (Nkind (Parent (N)) = N_Parameter_Association
+ and then N = Explicit_Actual_Parameter (Parent (N))
+ and then Nkind (Parent (Parent (N))) =
N_Procedure_Call_Statement));
end Is_Actual_Parameter;
-- Find current instance
Inst := Current_Scope;
- while Present (Inst)
- and then Inst /= Standard_Standard
- loop
+ while Present (Inst) and then Inst /= Standard_Standard loop
if Is_Generic_Instance (Inst) then
exit;
end if;
end;
if No (Id)
- and then (Ekind (P_Name) = E_Procedure
- or else
- Ekind (P_Name) = E_Function)
+ and then Ekind_In (P_Name, E_Procedure, E_Function)
and then Is_Generic_Instance (P_Name)
then
-- Expanded name denotes entity in (instance of) generic subprogram.
-- Ada 2005 (AI-50217): Check usage of entities in limited withed units
- if Ekind (P_Name) = E_Package
- and then From_With_Type (P_Name)
- then
+ if Ekind (P_Name) = E_Package and then From_With_Type (P_Name) then
if From_With_Type (Id)
or else Is_Type (Id)
or else Ekind (Id) = E_Package
if Is_Task_Type (P_Name)
and then ((Ekind (Id) = E_Entry
- and then Nkind (Parent (N)) /= N_Attribute_Reference)
+ and then Nkind (Parent (N)) /= N_Attribute_Reference)
or else
- (Ekind (Id) = E_Entry_Family
- and then
- Nkind (Parent (Parent (N))) /= N_Attribute_Reference))
+ (Ekind (Id) = E_Entry_Family
+ and then
+ Nkind (Parent (Parent (N))) /= N_Attribute_Reference))
then
-- If both the task type and the entry are in scope, this may still
-- be the expanded name of an entry formal.
if Ekind (Id) = E_Void then
Premature_Usage (N);
- elsif Is_Overloadable (Id)
- and then Present (Homonym (Id))
- then
+ elsif Is_Overloadable (Id) and then Present (Homonym (Id)) then
declare
H : Entity_Id := Homonym (Id);
begin
while Present (H) loop
if Scope (H) = Scope (Id)
- and then
- (not Is_Hidden (H)
- or else Is_Immediately_Visible (H))
+ and then (not Is_Hidden (H)
+ or else Is_Immediately_Visible (H))
then
Collect_Interps (N);
exit;
Old_S : Entity_Id;
Inst : Entity_Id;
- function Enclosing_Instance return Entity_Id;
- -- If the renaming determines the entity for the default of a formal
- -- subprogram nested within another instance, choose the innermost
- -- candidate. This is because if the formal has a box, and we are within
- -- an enclosing instance where some candidate interpretations are local
- -- to this enclosing instance, we know that the default was properly
- -- resolved when analyzing the generic, so we prefer the local
- -- candidates to those that are external. This is not always the case
- -- but is a reasonable heuristic on the use of nested generics. The
- -- proper solution requires a full renaming model.
-
function Is_Visible_Operation (Op : Entity_Id) return Boolean;
-- If the renamed entity is an implicit operator, check whether it is
-- visible because its operand type is properly visible. This check
-- Determine whether a candidate subprogram is defined within the
-- enclosing instance. If yes, it has precedence over outer candidates.
- ------------------------
- -- Enclosing_Instance --
- ------------------------
-
- function Enclosing_Instance return Entity_Id is
- S : Entity_Id;
-
- begin
- if not Is_Generic_Instance (Current_Scope)
- and then not Is_Actual
- then
- return Empty;
- end if;
-
- S := Scope (Current_Scope);
- while S /= Standard_Standard loop
- if Is_Generic_Instance (S) then
- return S;
- end if;
-
- S := Scope (S);
- end loop;
-
- return Empty;
- end Enclosing_Instance;
-
--------------------------
-- Is_Visible_Operation --
--------------------------
if Ekind (Op) /= E_Operator
or else Scope (Op) /= Standard_Standard
or else (In_Instance
- and then
- (not Is_Actual
- or else Present (Enclosing_Instance)))
+ and then (not Is_Actual
+ or else Present (Enclosing_Instance)))
then
return True;
Candidate_Renaming := Empty;
if not Is_Overloaded (Nam) then
- if Entity_Matches_Spec (Entity (Nam), New_S) then
+ if Is_Actual and then Present (Enclosing_Instance) then
+ Old_S := Entity (Nam);
+
+ elsif Entity_Matches_Spec (Entity (Nam), New_S) then
Candidate_Renaming := New_S;
if Is_Visible_Operation (Entity (Nam)) then
elsif
Present (First_Formal (Entity (Nam)))
and then Present (First_Formal (New_S))
- and then (Base_Type (Etype (First_Formal (Entity (Nam))))
- = Base_Type (Etype (First_Formal (New_S))))
+ and then (Base_Type (Etype (First_Formal (Entity (Nam)))) =
+ Base_Type (Etype (First_Formal (New_S))))
then
Candidate_Renaming := Entity (Nam);
end if;
elsif
Present (First_Formal (It.Nam))
and then Present (First_Formal (New_S))
- and then (Base_Type (Etype (First_Formal (It.Nam)))
- = Base_Type (Etype (First_Formal (New_S))))
+ and then (Base_Type (Etype (First_Formal (It.Nam))) =
+ Base_Type (Etype (First_Formal (New_S))))
then
Candidate_Renaming := It.Nam;
end if;
((RTE_Available (RE_Dispatch_Table_Wrapper)
and then Scope (Selector) =
RTE (RE_Dispatch_Table_Wrapper))
- or else
- (RTE_Available (RE_No_Dispatch_Table_Wrapper)
- and then Scope (Selector) =
- RTE (RE_No_Dispatch_Table_Wrapper)))
+ or else
+ (RTE_Available (RE_No_Dispatch_Table_Wrapper)
+ and then Scope (Selector) =
+ RTE (RE_No_Dispatch_Table_Wrapper)))
then
C_Etype := Empty;
elsif Is_Appropriate_For_Entry_Prefix (P_Type)
and then not In_Open_Scopes (P_Name)
and then (not Is_Concurrent_Type (Etype (P_Name))
- or else not In_Open_Scopes (Etype (P_Name)))
+ or else not In_Open_Scopes (Etype (P_Name)))
then
-- Call to protected operation or entry. Type checking is
-- needed on the prefix.
-- entry, as is P.X; this is an error.
if Ekind (P_Name) /= E_Function
- and then (not Is_Overloaded (P)
- or else
- Nkind (Parent (N)) = N_Procedure_Call_Statement)
+ and then
+ (not Is_Overloaded (P)
+ or else Nkind (Parent (N)) = N_Procedure_Call_Statement)
then
-- Prefix may mention a package that is hidden by a local
-- declaration: let the user know. Scan the full homonym
-- Warn_On_Obsolescent_ Feature). Once this issue
-- is cleared in the sources, it can be enabled.
- elsif Warn_On_Obsolescent_Feature
- and then False
- then
+ elsif Warn_On_Obsolescent_Feature and then False then
Error_Msg_N
("applying 'Class to an untagged incomplete type"
& " is an obsolescent feature (RM J.11)?r?", N);
Priv_Id : Entity_Id := Empty;
begin
- if Ekind (P) = E_Package
- and then not In_Open_Scopes (P)
- then
+ if Ekind (P) = E_Package and then not In_Open_Scopes (P) then
Priv_Id := First_Private_Entity (P);
end if;
end if;
Id := First_Entity (P);
- while Present (Id)
- and then Id /= Priv_Id
- loop
+ while Present (Id) and then Id /= Priv_Id loop
if Is_Standard_Character_Type (Id) and then Is_Base_Type (Id) then
-- We replace the node with the literal itself, resolve as a
begin
Predef_Op := Current_Entity (Selector_Name (N));
-
while Present (Predef_Op)
and then Scope (Predef_Op) /= Standard_Standard
loop
-- Start of processing for Has_Implicit_Operator
begin
- if Ekind (P) = E_Package
- and then not In_Open_Scopes (P)
- then
+ if Ekind (P) = E_Package and then not In_Open_Scopes (P) then
Priv_Id := First_Private_Entity (P);
end if;
-- of the stack is related to the current compilation.
Scop := Current_Scope;
- while Present (Scop)
- and then Scop /= Standard_Standard
- loop
+ while Present (Scop) and then Scop /= Standard_Standard loop
if Is_Compilation_Unit (Scop)
and then not Is_Child_Unit (Scop)
then
-- name resolution on component associations. (see 4717-008). In such a
-- case, look for the visible homonym on the chain.
- if In_Instance
- and then Present (Homonym (E))
- then
+ if In_Instance and then Present (Homonym (E)) then
E := Homonym (E);
-
- while Present (E)
- and then not In_Open_Scopes (Scope (E))
- loop
+ while Present (E) and then not In_Open_Scopes (Scope (E)) loop
E := Homonym (E);
end loop;
if No (With_Sys)
and then
(Nkind (The_Unit) = N_Package_Body
- or else (Nkind (The_Unit) = N_Subprogram_Body
- and then
- not Acts_As_Spec (Cunit (Current_Sem_Unit))))
+ or else (Nkind (The_Unit) = N_Subprogram_Body
+ and then not Acts_As_Spec (Cunit (Current_Sem_Unit))))
then
With_Sys := Find_System (Library_Unit (Cunit (Current_Sem_Unit)));
end if;
- if No (With_Sys)
- and then Present (N)
- then
+ if No (With_Sys) and then Present (N) then
+
-- If we are compiling a subunit, we need to examine its
-- context as well (Current_Sem_Unit is the parent unit);
else
pragma Assert
(Nkind (Parent (E)) = N_Defining_Program_Unit_Name
- and then
- Nkind (Parent (Parent (E))) = N_Package_Specification);
+ and then
+ Nkind (Parent (Parent (E))) =
+ N_Package_Specification);
Set_Is_Immediately_Visible (E,
Limited_View_Installed (Parent (Parent (E))));
end if;
Next_Entity (E);
- if not Full_Vis
- and then Is_Package_Or_Generic_Package (S)
- then
+ if not Full_Vis and then Is_Package_Or_Generic_Package (S) then
+
-- We are in the visible part of the package scope
exit when E = First_Private_Entity (S);
elsif Is_Hidden_Open_Scope (S) then
null;
- elsif (Ekind (S) = E_Procedure
- or else Ekind (S) = E_Function)
+ elsif Ekind_In (S, E_Procedure, E_Function)
and then Has_Completion (S)
then
Full_Vis := True;
Id := First_Entity (P);
while Present (Id)
and then (Id /= First_Private_Entity (P)
- or else Private_With_OK) -- Ada 2005 (AI-262)
+ or else Private_With_OK) -- Ada 2005 (AI-262)
loop
Prev := Current_Entity (Id);
while Present (Prev) loop
elsif Ekind (Prev) = E_Operator
and then Operator_Matches_Spec (Prev, Id)
and then In_Open_Scopes
- (Scope (Base_Type (Etype (First_Formal (Id)))))
+ (Scope (Base_Type (Etype (First_Formal (Id)))))
and then (No (Next_Formal (First_Formal (Id)))
- or else Etype (First_Formal (Id))
- = Etype (Next_Formal (First_Formal (Id)))
+ or else Etype (First_Formal (Id)) =
+ Etype (Next_Formal (First_Formal (Id)))
or else Chars (Prev) = Name_Op_Expon)
then
goto Next_Usable_Entity;
-- On exit, we know entity is not hidden, unless it is private
if not Is_Hidden (Id)
- and then ((not Is_Child_Unit (Id))
- or else Is_Visible_Lib_Unit (Id))
+ and then ((not Is_Child_Unit (Id)) or else Is_Visible_Lib_Unit (Id))
then
Set_Is_Potentially_Use_Visible (Id);
- if Is_Private_Type (Id)
- and then Present (Full_View (Id))
- then
+ if Is_Private_Type (Id) and then Present (Full_View (Id)) then
Set_Is_Potentially_Use_Visible (Full_View (Id));
end if;
end if;
-- a limited view unless we only have a limited view of its enclosing
-- package.
- elsif From_With_Type (T)
- and then From_With_Type (Scope (T))
- then
+ elsif From_With_Type (T) and then From_With_Type (Scope (T)) then
Error_Msg_N
("incomplete type from limited view "
- & "cannot appear in use clause", Id);
+ & "cannot appear in use clause", Id);
-- If the subtype mark designates a subtype in a different package,
-- we have to check that the parent type is visible, otherwise the
if Warn_On_Redundant_Constructs
and then Is_Known_Used
- -- with P; with P; use P;
- -- package P is package X is package body X is
- -- type T ... use P.T;
+ -- with P; with P; use P;
+ -- package P is package X is package body X is
+ -- type T ... use P.T;
- -- The compilation unit is the body of X. GNAT first compiles the
- -- spec of X, then proceeds to the body. At that point P is marked
- -- as use visible. The analysis then reinstalls the spec along with
- -- its context. The use clause P.T is now recognized as redundant,
- -- but in the wrong context. Do not emit a warning in such cases.
- -- Do not emit a warning either if we are in an instance, there is
- -- no redundancy between an outer use_clause and one that appears
- -- within the generic.
+ -- The compilation unit is the body of X. GNAT first compiles the
+ -- spec of X, then proceeds to the body. At that point P is marked
+ -- as use visible. The analysis then reinstalls the spec along with
+ -- its context. The use clause P.T is now recognized as redundant,
+ -- but in the wrong context. Do not emit a warning in such cases.
+ -- Do not emit a warning either if we are in an instance, there is
+ -- no redundancy between an outer use_clause and one that appears
+ -- within the generic.
and then not Spec_Reloaded_For_Body
and then not In_Instance
and then
Nkind (Parent (Clause2)) = N_Compilation_Unit
then
-
-- If the unit is a subprogram body that acts as spec,
-- the context clause is shared with the constructed
-- subprogram spec. Clearly there is no redundancy.
projects / gcc.git / commitdiff