Skip to content

R
riscv-gcc-1
Commit ac7d724d by Ed Schonberg Committed by Arnaud Charlet
Options

sem_ch5.adb: remove spurious warning from non-empty loop. 

2013-04-11  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch5.adb: remove spurious warning from non-empty loop.
	* sem_ch8.adb (Enclosing_Instance): Make public to other routines
	in the package, in order to suppress redundant semantic checks
	on subprogram renamings in nested instantiations.

From-SVN: r197746
parent 8fde064e
Showing with 152 additions and 218 deletions
gcc/ada/ChangeLog
2013-04-11 Ed Schonberg <schonberg@adacore.com>
* sem_ch5.adb: remove spurious warning from non-empty loop.
* sem_ch8.adb (Enclosing_Instance): Make public to other routines
in the package, in order to suppress redundant semantic checks
on subprogram renamings in nested instantiations.
2013-04-11 Robert Dewar <dewar@adacore.com>
* errout.ads: Minor reformatting.
......
gcc/ada/sem_ch5.adb
......@@ -222,10 +222,9 @@ package body Sem_Ch5 is
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))) =
......@@ -607,9 +606,7 @@ package body Sem_Ch5 is
-- 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
......@@ -665,11 +662,9 @@ package body Sem_Ch5 is
-- assignment within the block.
elsif Is_Array_Type (T1)
and then
(Nkind (Rhs) /= N_Type_Conversion
and then (Nkind (Rhs) /= N_Type_Conversion
or else Is_Constrained (Etype (Rhs)))
and then
(Nkind (Rhs) /= N_Function_Call
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,
......@@ -1198,9 +1193,7 @@ package body Sem_Ch5 is
-- 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;
......@@ -1297,9 +1290,7 @@ package body Sem_Ch5 is
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;
......@@ -1423,9 +1414,7 @@ package body Sem_Ch5 is
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
......@@ -1447,9 +1436,9 @@ package body Sem_Ch5 is
-- 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.
......@@ -2161,15 +2150,11 @@ package body Sem_Ch5 is
-- 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;
......@@ -2238,8 +2223,7 @@ package body Sem_Ch5 is
-- new iterator form.
if Nkind (DS_Copy) = N_Function_Call
or else
(Is_Entity_Name (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
......@@ -2395,9 +2379,8 @@ package body Sem_Ch5 is
-- 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.
......@@ -2436,7 +2419,7 @@ package body Sem_Ch5 is
-- 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
......@@ -2449,11 +2432,24 @@ package body Sem_Ch5 is
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
-- 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;
end Analyze_Loop_Parameter_Specification;
......@@ -2839,9 +2835,7 @@ package body Sem_Ch5 is
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;
......@@ -2993,9 +2987,8 @@ package body Sem_Ch5 is
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.
......@@ -3037,9 +3030,7 @@ package body Sem_Ch5 is
-- 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
......
gcc/ada/sem_ch8.adb
......@@ -450,6 +450,25 @@ package body Sem_Ch8 is
-- 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.
......@@ -1076,9 +1095,7 @@ package body Sem_Ch8 is
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;
......@@ -1132,10 +1149,10 @@ package body Sem_Ch8 is
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` "
......@@ -1385,9 +1402,7 @@ package body Sem_Ch8 is
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
......@@ -1589,8 +1604,7 @@ package body Sem_Ch8 is
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);
......@@ -1982,9 +1996,7 @@ package body Sem_Ch8 is
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))
......@@ -2004,8 +2016,7 @@ package body Sem_Ch8 is
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))
and then not (Has_Null_Exclusion (Parent (Sub))
or else Can_Never_Be_Null (Etype (Sub)))
then
Error_Msg_N
......@@ -2081,9 +2092,7 @@ package body Sem_Ch8 is
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))
......@@ -2114,10 +2123,8 @@ package body Sem_Ch8 is
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
......@@ -2167,7 +2174,8 @@ package body Sem_Ch8 is
-- 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
......@@ -2490,8 +2498,7 @@ package body Sem_Ch8 is
(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
......@@ -2506,9 +2513,7 @@ package body Sem_Ch8 is
-- 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
......@@ -2607,9 +2612,7 @@ package body Sem_Ch8 is
-- 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));
......@@ -2710,13 +2713,11 @@ package body Sem_Ch8 is
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;
......@@ -2754,8 +2755,7 @@ package body Sem_Ch8 is
and then
(Chars (Old_S) /= Name_Op_Ne
or else Ekind (Old_S) = E_Operator
or else
Is_Intrinsic_Subprogram
or else Is_Intrinsic_Subprogram
(Corresponding_Equality (Old_S))));
if Ekind (Alias (New_S)) = E_Operator then
......@@ -2909,7 +2909,6 @@ package body Sem_Ch8 is
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);
......@@ -2980,8 +2979,7 @@ package body Sem_Ch8 is
if Comes_From_Source (N)
and then Present (Old_S)
and then
(Nkind (Old_S) = N_Defining_Operator_Symbol
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)
......@@ -3003,8 +3001,7 @@ package body Sem_Ch8 is
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)
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)
......@@ -3102,9 +3099,7 @@ package body Sem_Ch8 is
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",
......@@ -3224,14 +3219,12 @@ package body Sem_Ch8 is
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)
......@@ -3260,9 +3253,7 @@ package body Sem_Ch8 is
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;
......@@ -3572,9 +3563,7 @@ package body Sem_Ch8 is
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));
......@@ -3591,9 +3580,7 @@ package body Sem_Ch8 is
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));
......@@ -3629,7 +3616,6 @@ package body Sem_Ch8 is
-- 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,
......@@ -3670,10 +3656,7 @@ package body Sem_Ch8 is
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
......@@ -3766,6 +3749,30 @@ package body Sem_Ch8 is
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 --
---------------
......@@ -3952,8 +3959,7 @@ package body Sem_Ch8 is
if Nkind (Id) = N_Defining_Operator_Symbol
and then
(Is_Primitive_Operator_In_Use
(Id, First_Formal (Id))
(Is_Primitive_Operator_In_Use (Id, First_Formal (Id))
or else
(Present (Next_Formal (First_Formal (Id)))
and then
......@@ -3961,7 +3967,6 @@ package body Sem_Ch8 is
(Id, Next_Formal (First_Formal (Id)))))
then
null;
else
Set_Is_Potentially_Use_Visible (Id, False);
end if;
......@@ -4802,9 +4807,7 @@ package body Sem_Ch8 is
-- 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;
......@@ -5202,9 +5205,7 @@ package body Sem_Ch8 is
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.
......@@ -5463,9 +5464,7 @@ package body Sem_Ch8 is
-- 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
......@@ -5538,17 +5537,14 @@ package body Sem_Ch8 is
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)
and then (not Is_Hidden (H)
or else Is_Immediately_Visible (H))
then
Collect_Interps (N);
......@@ -5618,17 +5614,6 @@ package body Sem_Ch8 is
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
......@@ -5644,32 +5629,6 @@ package body Sem_Ch8 is
-- 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 --
--------------------------
......@@ -5683,8 +5642,7 @@ package body Sem_Ch8 is
if Ekind (Op) /= E_Operator
or else Scope (Op) /= Standard_Standard
or else (In_Instance
and then
(not Is_Actual
and then (not Is_Actual
or else Present (Enclosing_Instance)))
then
return True;
......@@ -5776,7 +5734,10 @@ package body Sem_Ch8 is
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
......@@ -5786,8 +5747,8 @@ package body Sem_Ch8 is
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;
......@@ -5851,8 +5812,8 @@ package body Sem_Ch8 is
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;
......@@ -6148,9 +6109,9 @@ package body Sem_Ch8 is
-- 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
......@@ -6327,9 +6288,7 @@ package body Sem_Ch8 is
-- 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);
......@@ -6596,9 +6555,7 @@ package body Sem_Ch8 is
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;
......@@ -6611,9 +6568,7 @@ package body Sem_Ch8 is
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
......@@ -6695,7 +6650,6 @@ package body Sem_Ch8 is
begin
Predef_Op := Current_Entity (Selector_Name (N));
while Present (Predef_Op)
and then Scope (Predef_Op) /= Standard_Standard
loop
......@@ -6760,9 +6714,7 @@ package body Sem_Ch8 is
-- 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;
......@@ -7202,9 +7154,7 @@ package body Sem_Ch8 is
-- 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
......@@ -7495,14 +7445,9 @@ package body Sem_Ch8 is
-- 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;
......@@ -7610,15 +7555,13 @@ package body Sem_Ch8 is
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))))
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);
......@@ -7736,7 +7679,8 @@ package body Sem_Ch8 is
pragma Assert
(Nkind (Parent (E)) = N_Defining_Program_Unit_Name
and then
Nkind (Parent (Parent (E))) = N_Package_Specification);
Nkind (Parent (Parent (E))) =
N_Package_Specification);
Set_Is_Immediately_Visible (E,
Limited_View_Installed (Parent (Parent (E))));
end if;
......@@ -7746,9 +7690,8 @@ package body Sem_Ch8 is
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);
......@@ -7798,8 +7741,7 @@ package body Sem_Ch8 is
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;
......@@ -8044,8 +7986,8 @@ package body Sem_Ch8 is
and then In_Open_Scopes
(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;
......@@ -8074,14 +8016,11 @@ package body Sem_Ch8 is
-- 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;
......@@ -8252,9 +8191,7 @@ package body Sem_Ch8 is
-- 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);
......@@ -8386,7 +8323,6 @@ package body Sem_Ch8 is
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.
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment