diff options
Diffstat (limited to 'gcc/ada/sem_ch8.adb')
| -rw-r--r-- | gcc/ada/sem_ch8.adb | 420 |
1 files changed, 179 insertions, 241 deletions
diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb index 32d49cc6932..12b37f447a4 100644 --- a/gcc/ada/sem_ch8.adb +++ b/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. @@ -773,6 +792,12 @@ package body Sem_Ch8 is Make_Subtype_From_Expr (Nam, Typ))); Rewrite (Subtype_Mark (N), New_Occurrence_Of (Subt, Loc)); Set_Etype (Nam, Subt); + + -- Freeze subtype at once, to prevent order of elaboration + -- issues in the backend. The renamed object exists, so its + -- type is already frozen in any case. + + Freeze_Before (N, Subt); end if; end if; end Check_Constrained_Object; @@ -1076,9 +1101,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; @@ -1103,7 +1126,7 @@ package body Sem_Ch8 is -- 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 @@ -1132,10 +1155,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` " @@ -1214,7 +1237,7 @@ package body Sem_Ch8 is 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; @@ -1385,9 +1408,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 +1610,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,13 +2002,11 @@ 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)) - 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 &", @@ -2004,9 +2022,8 @@ 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)) - 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`", @@ -2081,9 +2098,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 +2129,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 +2180,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 @@ -2382,8 +2396,8 @@ package body Sem_Ch8 is 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); @@ -2490,8 +2504,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 +2519,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 +2618,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 +2719,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; @@ -2750,13 +2757,12 @@ package body Sem_Ch8 is 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); @@ -2821,13 +2827,13 @@ package body Sem_Ch8 is and then Entity (Prefix (Nam)) = Current_Scope and then Chars (Selector_Name (Nam)) = Chars (New_S) then - if Overriding_Renamings then - null; + -- This is an error, but we overlook the error and accept the + -- renaming if the special Overriding_Renamings mode is in effect. - else + if not Overriding_Renamings then Error_Msg_NE - ("implicit operation& is not visible (RM 8.3 (15))", - Nam, Old_S); + ("implicit operation& is not visible (RM 8.3 (15))", + Nam, Old_S); end if; end if; @@ -2909,7 +2915,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,9 +2985,8 @@ package body Sem_Ch8 is 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 @@ -3003,9 +3007,8 @@ 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) - 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 @@ -3102,9 +3105,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 +3225,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 +3259,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; @@ -3365,13 +3362,9 @@ package body Sem_Ch8 is Error_Msg_N ("illegal expressions in attribute reference", Nam); elsif - Aname = Name_Compose or else - Aname = Name_Exponent or else - Aname = Name_Leading_Part or else - Aname = Name_Pos or else - Aname = Name_Round or else - Aname = Name_Scaling or else - Aname = Name_Val + Nam_In (Aname, Name_Compose, Name_Exponent, Name_Leading_Part, + Name_Pos, Name_Round, Name_Scaling, + Name_Val) then if Nkind (N) = N_Subprogram_Renaming_Declaration and then Present (Corresponding_Formal_Spec (N)) @@ -3572,9 +3565,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,12 +3582,10 @@ 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)); + Name (N)); end if; else @@ -3629,11 +3618,10 @@ 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, - N_Component_Declaration) + N_Component_Declaration) loop P := Parent (P); end loop; @@ -3670,13 +3658,10 @@ 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 + -- Protect the frontend against previous critical errors and then Nkind (Name (Item)) /= N_Selected_Component and then Entity (Name (Item)) = Pack @@ -3745,9 +3730,9 @@ package body Sem_Ch8 is ("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)); @@ -3766,6 +3751,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,16 +3961,14 @@ package body Sem_Ch8 is 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; @@ -4222,10 +4229,10 @@ package body Sem_Ch8 is 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; @@ -4558,7 +4565,7 @@ package body Sem_Ch8 is -- is put or put_line, then add a special error message (since -- this is a very common error for beginners to make). - if Chars (N) = Name_Put or else Chars (N) = Name_Put_Line then + if Nam_In (Chars (N), Name_Put, Name_Put_Line) then Error_Msg_N -- CODEFIX ("\\possible missing `WITH Ada.Text_'I'O; " & "USE Ada.Text_'I'O`!", N); @@ -4802,9 +4809,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 +5207,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 +5466,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 @@ -5481,11 +5482,11 @@ package body Sem_Ch8 is 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. @@ -5538,18 +5539,15 @@ 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) - or else Is_Immediately_Visible (H)) + and then (not Is_Hidden (H) + or else Is_Immediately_Visible (H)) then Collect_Interps (N); exit; @@ -5618,17 +5616,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 +5631,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,9 +5644,8 @@ 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 - or else Present (Enclosing_Instance))) + and then (not Is_Actual + or else Present (Enclosing_Instance))) then return True; @@ -5776,7 +5736,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 +5749,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 +5814,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; @@ -5964,10 +5927,10 @@ package body Sem_Ch8 is ((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; @@ -6071,7 +6034,7 @@ package body Sem_Ch8 is 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. @@ -6148,9 +6111,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 +6290,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 +6557,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 +6570,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 +6652,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 +6716,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 +7156,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 +7447,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; @@ -7609,16 +7556,14 @@ package body Sem_Ch8 is 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); @@ -7735,8 +7680,9 @@ package body Sem_Ch8 is 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; @@ -7746,9 +7692,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 +7743,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; @@ -7974,7 +7918,7 @@ package body Sem_Ch8 is 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 @@ -8042,10 +7986,10 @@ package body Sem_Ch8 is 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; @@ -8074,14 +8018,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,12 +8193,10 @@ 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); + & "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 @@ -8321,18 +8260,18 @@ package body Sem_Ch8 is 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 @@ -8386,7 +8325,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. |