diff options
Diffstat (limited to 'gcc/ada/sem_ch8.adb')
| -rw-r--r-- | gcc/ada/sem_ch8.adb | 430 |
1 files changed, 241 insertions, 189 deletions
diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb index efff714..78d2426 100644 --- a/gcc/ada/sem_ch8.adb +++ b/gcc/ada/sem_ch8.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2020, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2021, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -23,55 +23,59 @@ -- -- ------------------------------------------------------------------------------ -with Atree; use Atree; -with Debug; use Debug; -with Einfo; use Einfo; -with Elists; use Elists; -with Errout; use Errout; -with Exp_Disp; use Exp_Disp; -with Exp_Tss; use Exp_Tss; -with Exp_Util; use Exp_Util; -with Freeze; use Freeze; -with Ghost; use Ghost; -with Impunit; use Impunit; -with Lib; use Lib; -with Lib.Load; use Lib.Load; -with Lib.Xref; use Lib.Xref; -with Namet; use Namet; -with Namet.Sp; use Namet.Sp; -with Nlists; use Nlists; -with Nmake; use Nmake; -with Opt; use Opt; -with Output; use Output; -with Restrict; use Restrict; -with Rident; use Rident; -with Rtsfind; use Rtsfind; -with Sem; use Sem; -with Sem_Aux; use Sem_Aux; -with Sem_Cat; use Sem_Cat; -with Sem_Ch3; use Sem_Ch3; -with Sem_Ch4; use Sem_Ch4; -with Sem_Ch6; use Sem_Ch6; -with Sem_Ch10; use Sem_Ch10; -with Sem_Ch12; use Sem_Ch12; -with Sem_Ch13; use Sem_Ch13; -with Sem_Dim; use Sem_Dim; -with Sem_Disp; use Sem_Disp; -with Sem_Dist; use Sem_Dist; -with Sem_Elab; use Sem_Elab; -with Sem_Eval; use Sem_Eval; -with Sem_Prag; use Sem_Prag; -with Sem_Res; use Sem_Res; -with Sem_Util; use Sem_Util; -with Sem_Type; use Sem_Type; -with Stand; use Stand; -with Sinfo; use Sinfo; -with Sinfo.CN; use Sinfo.CN; -with Snames; use Snames; +with Atree; use Atree; +with Debug; use Debug; +with Einfo; use Einfo; +with Einfo.Entities; use Einfo.Entities; +with Einfo.Utils; use Einfo.Utils; +with Elists; use Elists; +with Errout; use Errout; +with Exp_Disp; use Exp_Disp; +with Exp_Tss; use Exp_Tss; +with Exp_Util; use Exp_Util; +with Freeze; use Freeze; +with Ghost; use Ghost; +with Impunit; use Impunit; +with Lib; use Lib; +with Lib.Load; use Lib.Load; +with Lib.Xref; use Lib.Xref; +with Namet; use Namet; +with Namet.Sp; use Namet.Sp; +with Nlists; use Nlists; +with Nmake; use Nmake; +with Opt; use Opt; +with Output; use Output; +with Restrict; use Restrict; +with Rident; use Rident; +with Rtsfind; use Rtsfind; +with Sem; use Sem; +with Sem_Aux; use Sem_Aux; +with Sem_Cat; use Sem_Cat; +with Sem_Ch3; use Sem_Ch3; +with Sem_Ch4; use Sem_Ch4; +with Sem_Ch6; use Sem_Ch6; +with Sem_Ch10; use Sem_Ch10; +with Sem_Ch12; use Sem_Ch12; +with Sem_Ch13; use Sem_Ch13; +with Sem_Dim; use Sem_Dim; +with Sem_Disp; use Sem_Disp; +with Sem_Dist; use Sem_Dist; +with Sem_Elab; use Sem_Elab; +with Sem_Eval; use Sem_Eval; +with Sem_Prag; use Sem_Prag; +with Sem_Res; use Sem_Res; +with Sem_Util; use Sem_Util; +with Sem_Type; use Sem_Type; +with Stand; use Stand; +with Sinfo; use Sinfo; +with Sinfo.Nodes; use Sinfo.Nodes; +with Sinfo.Utils; use Sinfo.Utils; +with Sinfo.CN; use Sinfo.CN; +with Snames; use Snames; with Style; with Table; -with Tbuild; use Tbuild; -with Uintp; use Uintp; +with Tbuild; use Tbuild; +with Uintp; use Uintp; package body Sem_Ch8 is @@ -477,11 +481,10 @@ package body Sem_Ch8 is -- legality of selector given the scope denoted by prefix, and change node -- N into a expanded name with a properly set Entity field. - function Find_Most_Prev (Use_Clause : Node_Id) return Node_Id; + function Find_First_Use (Use_Clause : Node_Id) return Node_Id; -- Find the most previous use clause (that is, the first one to appear in -- the source) by traversing the previous clause chain that exists in both -- N_Use_Package_Clause nodes and N_Use_Type_Clause nodes. - -- ??? a better subprogram name is in order function Find_Renamed_Entity (N : Node_Id; @@ -525,7 +528,6 @@ package body Sem_Ch8 is Clause2 : Entity_Id) return Entity_Id; -- Determine which use clause parameter is the most descendant in terms of -- scope. - -- ??? a better subprogram name is in order procedure Premature_Usage (N : Node_Id); -- Diagnose usage of an entity before it is visible @@ -568,7 +570,7 @@ package body Sem_Ch8 is Enter_Name (Id); Analyze (Nam); - Set_Ekind (Id, E_Exception); + Mutate_Ekind (Id, E_Exception); Set_Etype (Id, Standard_Exception_Type); Set_Is_Pure (Id, Is_Pure (Current_Scope)); @@ -697,7 +699,7 @@ package body Sem_Ch8 is end if; Enter_Name (New_P); - Set_Ekind (New_P, K); + Mutate_Ekind (New_P, K); if Etype (Old_P) = Any_Type then null; @@ -759,6 +761,7 @@ package body Sem_Ch8 is Dec : Node_Id; T : Entity_Id; T2 : Entity_Id; + Q : Node_Id; procedure Check_Constrained_Object; -- If the nominal type is unconstrained but the renamed object is @@ -979,7 +982,7 @@ package body Sem_Ch8 is Error_Msg_N ("object name or value expected in renaming", Nam); - Set_Ekind (Id, E_Variable); + Mutate_Ekind (Id, E_Variable); Set_Etype (Id, Any_Type); return; @@ -1027,7 +1030,7 @@ package body Sem_Ch8 is Error_Msg_N ("object name or value expected in renaming", Nam); - Set_Ekind (Id, E_Variable); + Mutate_Ekind (Id, E_Variable); Set_Etype (Id, Any_Type); return; @@ -1074,17 +1077,55 @@ package body Sem_Ch8 is -- Check against AI12-0401 here before Resolve may rewrite Nam and -- potentially generate spurious warnings. + -- In the case where the object_name is a qualified_expression with + -- a nominal subtype T and whose expression is a name that denotes + -- an object Q: + -- * if T is an elementary subtype, then: + -- * Q shall be a constant other than a dereference of an access + -- type; or + -- * the nominal subtype of Q shall be statically compatible with + -- T; or + -- * T shall statically match the base subtype of its type if + -- scalar, or the first subtype of its type if an access type. + -- * if T is a composite subtype, then Q shall be known to be + -- constrained or T shall statically match the first subtype of + -- its type. + if Nkind (Nam) = N_Qualified_Expression - and then Is_Variable (Expression (Nam)) - and then not - (Subtypes_Statically_Match (T, Etype (Expression (Nam))) - or else - Subtypes_Statically_Match (Base_Type (T), Etype (Nam))) + and then Is_Object_Reference (Expression (Nam)) then - Error_Msg_N - ("subtype of renamed qualified expression does not " & - "statically match", N); - return; + Q := Expression (Nam); + + if (Is_Elementary_Type (T) + and then + not ((not Is_Variable (Q) + and then Nkind (Q) /= N_Explicit_Dereference) + or else Subtypes_Statically_Compatible (Etype (Q), T) + or else (Is_Scalar_Type (T) + and then Subtypes_Statically_Match + (T, Base_Type (T))) + or else (Is_Access_Type (T) + and then Subtypes_Statically_Match + (T, First_Subtype (T))))) + or else (Is_Composite_Type (T) + and then + + -- If Q is an aggregate, Is_Constrained may not be set + -- yet and its type may not be resolved yet. + -- This doesn't quite correspond to the complex notion + -- of "known to be constrained" but this is good enough + -- for a rule which is in any case too complex. + + not (Is_Constrained (Etype (Q)) + or else Nkind (Q) = N_Aggregate + or else Subtypes_Statically_Match + (T, First_Subtype (T)))) + then + Error_Msg_N + ("subtype of renamed qualified expression does not " & + "statically match", N); + return; + end if; end if; Resolve (Nam, T); @@ -1102,7 +1143,7 @@ package body Sem_Ch8 is and then Comes_From_Source (N) then Set_Etype (Id, T); - Set_Ekind (Id, E_Constant); + Mutate_Ekind (Id, E_Constant); Rewrite (N, Make_Object_Declaration (Loc, Defining_Identifier => Id, @@ -1125,7 +1166,9 @@ package body Sem_Ch8 is and then Is_Anonymous_Access_Type (Etype (Expression (Nam))) and then not Is_Anonymous_Access_Type (T) then - Wrong_Type (Expression (Nam), T); -- Should we give better error??? + Error_Msg_NE + ("cannot rename anonymous access object " + & "as a named access type", Expression (Nam), T); end if; -- Check that a class-wide object is not being renamed as an object @@ -1415,13 +1458,9 @@ package body Sem_Ch8 is -- want to change it to a variable. if Ekind (Id) /= E_Constant then - Set_Ekind (Id, E_Variable); + Mutate_Ekind (Id, E_Variable); end if; - -- Initialize the object size and alignment. Note that we used to call - -- Init_Size_Align here, but that's wrong for objects which have only - -- an Esize, not an RM_Size field. - Init_Object_Size_Align (Id); -- If N comes from source then check that the original node is an @@ -1491,13 +1530,13 @@ package body Sem_Ch8 is -- Ignore (accept) N_Raise_xxx_Error nodes in this context. elsif No_Raise_xxx_Error (Nam) = OK then - Error_Msg_Ada_2020_Feature ("value in renaming", Sloc (Nam)); + Error_Msg_Ada_2022_Feature ("value in renaming", Sloc (Nam)); end if; Set_Etype (Id, T2); if not Is_Variable (Nam) then - Set_Ekind (Id, E_Constant); + Mutate_Ekind (Id, E_Constant); Set_Never_Set_In_Source (Id, True); Set_Is_True_Constant (Id, True); end if; @@ -1506,10 +1545,11 @@ package body Sem_Ch8 is -- renamed object is atomic, independent, volatile or VFA. These flags -- are set on the renamed object in the RM legality sense. - Set_Is_Atomic (Id, Is_Atomic_Object (Nam)); - Set_Is_Independent (Id, Is_Independent_Object (Nam)); - Set_Is_Volatile (Id, Is_Volatile_Object (Nam)); - Set_Is_Volatile_Full_Access (Id, Is_Volatile_Full_Access_Object (Nam)); + Set_Is_Atomic (Id, Is_Atomic_Object (Nam)); + Set_Is_Independent (Id, Is_Independent_Object (Nam)); + Set_Is_Volatile (Id, Is_Volatile_Object_Ref (Nam)); + Set_Is_Volatile_Full_Access + (Id, Is_Volatile_Full_Access_Object_Ref (Nam)); -- Treat as volatile if we just set the Volatile flag @@ -1592,7 +1632,7 @@ package body Sem_Ch8 is -- Set basic attributes to minimize cascaded errors - Set_Ekind (New_P, E_Package); + Mutate_Ekind (New_P, E_Package); Set_Etype (New_P, Standard_Void_Type); elsif Present (Renamed_Entity (Old_P)) @@ -1607,7 +1647,7 @@ package body Sem_Ch8 is -- Set basic attributes to minimize cascaded errors - Set_Ekind (New_P, E_Package); + Mutate_Ekind (New_P, E_Package); Set_Etype (New_P, Standard_Void_Type); -- Here for OK package renaming @@ -1617,7 +1657,7 @@ package body Sem_Ch8 is -- entity. The simplest implementation is to have both packages share -- the entity list. - Set_Ekind (New_P, E_Package); + Mutate_Ekind (New_P, E_Package); Set_Etype (New_P, Standard_Void_Type); if Present (Renamed_Object (Old_P)) then @@ -1823,7 +1863,7 @@ package body Sem_Ch8 is Old_S := Find_Renamed_Entity (N, Selector_Name (Nam), New_S); if Old_S = Any_Id then - Error_Msg_N (" no subprogram or entry matches specification", N); + Error_Msg_N ("no subprogram or entry matches specification", N); else if Is_Body then Check_Subtype_Conformant (New_S, Old_S, N); @@ -3238,7 +3278,10 @@ package body Sem_Ch8 is -- constructed later at the freeze point, so indicate that the -- completion has not been seen yet. - Set_Ekind (New_S, E_Subprogram_Body); + Reinit_Field_To_Zero (New_S, F_Has_Out_Or_In_Out_Parameter); + Reinit_Field_To_Zero (New_S, F_Needs_No_Actuals, + Old_Ekind => (E_Function | E_Procedure => True, others => False)); + Mutate_Ekind (New_S, E_Subprogram_Body); New_S := Rename_Spec; Set_Has_Completion (Rename_Spec, False); @@ -3256,7 +3299,9 @@ package body Sem_Ch8 is Style.Missing_Overriding (N, Rename_Spec); end if; - elsif Must_Override (Specification (N)) then + elsif Must_Override (Specification (N)) + and then not Can_Override_Operator (Rename_Spec) + then Error_Msg_NE ("subprogram& is not overriding", N, Rename_Spec); end if; @@ -3538,7 +3583,7 @@ package body Sem_Ch8 is end if; if Original_Subprogram (Old_S) = Rename_Spec then - Error_Msg_N ("unfrozen subprogram cannot rename itself ", N); + Error_Msg_N ("unfrozen subprogram cannot rename itself", N); else Check_Formal_Subprogram_Conformance (New_S, Old_S, Spec); end if; @@ -3745,15 +3790,31 @@ package body Sem_Ch8 is Set_Has_Delayed_Freeze (New_S, False); Freeze_Before (N, New_S); - -- An abstract subprogram is only allowed as an actual in the case - -- where the formal subprogram is also abstract. - if (Ekind (Old_S) = E_Procedure or else Ekind (Old_S) = E_Function) - and then Is_Abstract_Subprogram (Old_S) and then not Is_Abstract_Subprogram (Formal_Spec) then - Error_Msg_N - ("abstract subprogram not allowed as generic actual", Nam); + -- An abstract subprogram is only allowed as an actual in the + -- case where the formal subprogram is also abstract. + + if Is_Abstract_Subprogram (Old_S) then + Error_Msg_N + ("abstract subprogram not allowed as generic actual", Nam); + end if; + + -- AI12-0412: A primitive of an abstract type with Pre'Class + -- or Post'Class aspects specified with nonstatic expressions + -- is not allowed as actual for a nonabstract formal subprogram + -- (see RM 6.1.1(18.2/5). + + if Is_Dispatching_Operation (Old_S) + and then + Is_Prim_Of_Abst_Type_With_Nonstatic_CW_Pre_Post (Old_S) + then + Error_Msg_N + ("primitive of abstract type with nonstatic class-wide " + & "pre/postconditions not allowed as actual", + Nam); + end if; end if; end if; @@ -4404,7 +4465,7 @@ package body Sem_Ch8 is if not Configurable_Run_Time_Mode and then not Present (Corresponding_Formal_Spec (N)) - and then Etype (Nam) /= RTE (RE_AST_Handler) + and then not Is_RTE (Etype (Nam), RE_AST_Handler) then declare P : constant Node_Id := Prefix (Nam); @@ -4819,7 +4880,7 @@ package body Sem_Ch8 is Pop_Scope; - while not (Is_List_Member (Decl)) + while not Is_List_Member (Decl) or else Nkind (Parent (Decl)) in N_Protected_Definition | N_Task_Definition loop @@ -5271,16 +5332,6 @@ package body Sem_Ch8 is elsif not Comes_From_Source (E) then return False; - - -- In gnat internal mode, we consider all entities known. The - -- historical reason behind this discrepancy is not known??? But the - -- only effect is to modify the error message given, so it is not - -- critical. Since it only affects the exact wording of error - -- messages in illegal programs, we do not mention this as an - -- effect of -gnatg, since it is not a language modification. - - elsif GNAT_Mode then - return True; end if; -- Here we have an entity that is not from package Standard, and @@ -6790,7 +6841,17 @@ package body Sem_Ch8 is end if; end if; - Change_Selected_Component_To_Expanded_Name (N); + case Nkind (N) is + when N_Selected_Component => + Reinit_Field_To_Zero (N, F_Is_Prefixed_Call); + Change_Selected_Component_To_Expanded_Name (N); + + when N_Expanded_Name => + null; + + when others => + pragma Assert (False); + end case; -- Preserve relevant elaboration-related attributes of the context which -- are no longer available or very expensive to recompute once analysis, @@ -6936,10 +6997,10 @@ package body Sem_Ch8 is end Find_Expanded_Name; -------------------- - -- Find_Most_Prev -- + -- Find_First_Use -- -------------------- - function Find_Most_Prev (Use_Clause : Node_Id) return Node_Id is + function Find_First_Use (Use_Clause : Node_Id) return Node_Id is Curr : Node_Id; begin @@ -6951,7 +7012,7 @@ package body Sem_Ch8 is end loop; return Curr; - end Find_Most_Prev; + end Find_First_Use; ------------------------- -- Find_Renamed_Entity -- @@ -7469,15 +7530,9 @@ package body Sem_Ch8 is -- dispatch table wrappers. Required to avoid generating -- elaboration code with HI runtimes. - elsif RTU_Loaded (Ada_Tags) - and then - ((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))) + elsif Is_RTE (Scope (Selector), RE_Dispatch_Table_Wrapper) + or else + Is_RTE (Scope (Selector), RE_No_Dispatch_Table_Wrapper) then C_Etype := Empty; else @@ -7549,10 +7604,16 @@ package body Sem_Ch8 is P_Type := Implicitly_Designated_Type (P_Type); end if; - -- First check for components of a record object (not the - -- result of a call, which is handled below). + -- First check for components of a record object (not the result of + -- a call, which is handled below). This also covers the case where + -- where the extension feature that supports the prefixed form of + -- calls for primitives of untagged types is enabled (excluding + -- concurrent cases, which are handled further below). - if Has_Components (P_Type) + if Is_Type (P_Type) + and then (Has_Components (P_Type) + or else (Extensions_Allowed + and then not Is_Concurrent_Type (P_Type))) and then not Is_Overloadable (P_Name) and then not Is_Type (P_Name) then @@ -7893,16 +7954,18 @@ package body Sem_Ch8 is Set_Entity (N, Any_Type); return; - -- ??? This test is temporarily disabled (always - -- False) because it causes an unwanted warning on - -- GNAT sources (built with -gnatg, which includes - -- Warn_On_Obsolescent_ Feature). Once this issue - -- is cleared in the sources, it can be enabled. + else + if Restriction_Check_Required (No_Obsolescent_Features) + then + Check_Restriction + (No_Obsolescent_Features, Prefix (N)); + end if; - 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); + if Warn_On_Obsolescent_Feature then + Error_Msg_N + ("applying ''Class to an untagged incomplete type" + & " is an obsolescent feature (RM J.11)?r?", N); + end if; end if; end if; @@ -8087,25 +8150,14 @@ package body Sem_Ch8 is if Ekind (Base_Type (T_Name)) = E_Task_Type then -- In Ada 2005, a task name can be used in an access - -- definition within its own body. It cannot be used - -- in the discriminant part of the task declaration, - -- nor anywhere else in the declaration because entries - -- cannot have access parameters. + -- definition within its own body. if Ada_Version >= Ada_2005 and then Nkind (Parent (N)) = N_Access_Definition then Set_Entity (N, T_Name); Set_Etype (N, T_Name); - - if Has_Completion (T_Name) then - return; - - else - Error_Msg_N - ("task type cannot be used as type mark " & - "within its own declaration", N); - end if; + return; else Error_Msg_N @@ -8959,6 +9011,28 @@ package body Sem_Ch8 is procedure Push_Scope (S : Entity_Id) is E : constant Entity_Id := Scope (S); + function Component_Alignment_Default return Component_Alignment_Kind; + -- Return Component_Alignment_Kind for the newly-pushed scope. + + function Component_Alignment_Default return Component_Alignment_Kind is + begin + -- Each new scope pushed onto the scope stack inherits the component + -- alignment of the previous scope. This emulates the "visibility" + -- semantics of pragma Component_Alignment. + + if Scope_Stack.Last > Scope_Stack.First then + return Scope_Stack.Table + (Scope_Stack.Last - 1).Component_Alignment_Default; + + -- Otherwise, this is the first scope being pushed on the scope + -- stack. Inherit the component alignment from the configuration + -- form of pragma Component_Alignment (if any). + + else + return Configuration_Component_Alignment; + end if; + end Component_Alignment_Default; + begin if Ekind (S) = E_Void then null; @@ -8987,49 +9061,27 @@ package body Sem_Ch8 is Scope_Stack.Increment_Last; - declare - SST : Scope_Stack_Entry renames Scope_Stack.Table (Scope_Stack.Last); - - begin - SST.Entity := S; - SST.Save_Scope_Suppress := Scope_Suppress; - SST.Save_Local_Suppress_Stack_Top := Local_Suppress_Stack_Top; - SST.Save_Check_Policy_List := Check_Policy_List; - SST.Save_Default_Storage_Pool := Default_Pool; - SST.Save_No_Tagged_Streams := No_Tagged_Streams; - SST.Save_SPARK_Mode := SPARK_Mode; - SST.Save_SPARK_Mode_Pragma := SPARK_Mode_Pragma; - SST.Save_Default_SSO := Default_SSO; - SST.Save_Uneval_Old := Uneval_Old; - - -- Each new scope pushed onto the scope stack inherits the component - -- alignment of the previous scope. This emulates the "visibility" - -- semantics of pragma Component_Alignment. - - if Scope_Stack.Last > Scope_Stack.First then - SST.Component_Alignment_Default := - Scope_Stack.Table - (Scope_Stack.Last - 1).Component_Alignment_Default; - - -- Otherwise, this is the first scope being pushed on the scope - -- stack. Inherit the component alignment from the configuration - -- form of pragma Component_Alignment (if any). - - else - SST.Component_Alignment_Default := - Configuration_Component_Alignment; - end if; - - SST.Last_Subprogram_Name := null; - SST.Is_Transient := False; - SST.Node_To_Be_Wrapped := Empty; - SST.Pending_Freeze_Actions := No_List; - SST.Actions_To_Be_Wrapped := (others => No_List); - SST.First_Use_Clause := Empty; - SST.Is_Active_Stack_Base := False; - SST.Previous_Visibility := False; - SST.Locked_Shared_Objects := No_Elist; - end; + Scope_Stack.Table (Scope_Stack.Last) := + (Entity => S, + Save_Scope_Suppress => Scope_Suppress, + Save_Local_Suppress_Stack_Top => Local_Suppress_Stack_Top, + Save_Check_Policy_List => Check_Policy_List, + Save_Default_Storage_Pool => Default_Pool, + Save_No_Tagged_Streams => No_Tagged_Streams, + Save_SPARK_Mode => SPARK_Mode, + Save_SPARK_Mode_Pragma => SPARK_Mode_Pragma, + Save_Default_SSO => Default_SSO, + Save_Uneval_Old => Uneval_Old, + Component_Alignment_Default => Component_Alignment_Default, + Last_Subprogram_Name => null, + Is_Transient => False, + Node_To_Be_Wrapped => Empty, + Pending_Freeze_Actions => No_List, + Actions_To_Be_Wrapped => (others => No_List), + First_Use_Clause => Empty, + Is_Active_Stack_Base => False, + Previous_Visibility => False, + Locked_Shared_Objects => No_Elist); if Debug_Flag_W then Write_Str ("--> new scope: "); @@ -9766,16 +9818,16 @@ package body Sem_Ch8 is if Present (Redundant) and then Parent (Redundant) /= Prev_Use then -- Make sure we are looking at most-descendant use_package_clause - -- by traversing the chain with Find_Most_Prev and then verifying + -- by traversing the chain with Find_First_Use and then verifying -- there is no scope manipulation via Most_Descendant_Use_Clause. if Nkind (Prev_Use) = N_Use_Package_Clause and then (Nkind (Parent (Prev_Use)) /= N_Compilation_Unit or else Most_Descendant_Use_Clause - (Prev_Use, Find_Most_Prev (Prev_Use)) /= Prev_Use) + (Prev_Use, Find_First_Use (Prev_Use)) /= Prev_Use) then - Prev_Use := Find_Most_Prev (Prev_Use); + Prev_Use := Find_First_Use (Prev_Use); end if; Error_Msg_Sloc := Sloc (Prev_Use); @@ -10329,7 +10381,7 @@ package body Sem_Ch8 is if Present (Current_Use_Clause (T)) then Use_Clause_Known : declare Clause1 : constant Node_Id := - Find_Most_Prev (Current_Use_Clause (T)); + Find_First_Use (Current_Use_Clause (T)); Clause2 : constant Node_Id := Parent (Id); Ent1 : Entity_Id; Ent2 : Entity_Id; @@ -10469,10 +10521,10 @@ package body Sem_Ch8 is -- a spurious warning - so verify there is a previous use clause. if Current_Use_Clause (Scope (T)) /= - Find_Most_Prev (Current_Use_Clause (Scope (T))) + Find_First_Use (Current_Use_Clause (Scope (T))) then Error_Msg_Sloc := - Sloc (Find_Most_Prev (Current_Use_Clause (Scope (T)))); + Sloc (Find_First_Use (Current_Use_Clause (Scope (T)))); Error_Msg_NE -- CODEFIX ("& is already use-visible through package use clause #??", Id, T); |