diff options
Diffstat (limited to 'gcc/ada/sem_ch12.adb')
| -rw-r--r-- | gcc/ada/sem_ch12.adb | 376 |
1 files changed, 174 insertions, 202 deletions
diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index deb19ee..750c2c1 100644 --- a/gcc/ada/sem_ch12.adb +++ b/gcc/ada/sem_ch12.adb @@ -599,8 +599,8 @@ package body Sem_Ch12 is -- whose views can change between the point of instantiation and the point -- of instantiation of the body. In addition, mark the generic renamings -- as generic actuals, so that they are not compatible with other actuals. - -- Recurse on an actual that is a formal package whose declaration has - -- a box. + -- For an instantiation of a formal package that is declared with a box or + -- contains defaulted parameters, make the corresponding actuals visible. function Component_Type_For_Private_View (T : Entity_Id) return Entity_Id; -- Return the component type of array type T, with the following addition: @@ -642,8 +642,9 @@ package body Sem_Ch12 is -- of freeze nodes for instance bodies that may depend on other instances. function Find_Actual_Type - (Typ : Entity_Id; - Gen_Type : Entity_Id) return Entity_Id; + (Typ : Entity_Id; + Gen_Type : Entity_Id; + Typ_Ref : Node_Id) return Entity_Id; -- When validating the actual types of a child instance, check whether -- the formal is a formal type of the parent unit, and retrieve the current -- actual for it. Typ is the entity in the analyzed formal type declaration @@ -653,7 +654,8 @@ package body Sem_Ch12 is -- be declared in a formal package of a parent. In both cases it is a -- generic actual type because it appears within a visible instance. -- Finally, it may be declared in a parent unit without being a formal - -- of that unit, in which case it must be retrieved by visibility. + -- of that unit, in which case it must be retrieved by visibility and + -- Typ_Ref is the unanalyzed subtype mark in the instance to be used. -- Ambiguities may still arise if two homonyms are declared in two formal -- packages, and the prefix of the formal type may be needed to resolve -- the ambiguity in the instance ??? @@ -810,11 +812,11 @@ package body Sem_Ch12 is -- the suffix is removed is added to Prims_List to restore them later. procedure Install_Parent (P : Entity_Id; In_Body : Boolean := False); - -- When compiling an instance of a child unit the parent (which is - -- itself an instance) is an enclosing scope that must be made - -- immediately visible. This procedure is also used to install the non- - -- generic parent of a generic child unit when compiling its body, so - -- that full views of types in the parent are made visible. + -- When compiling an instance of a child unit, the parent P is an enclosing + -- scope that must be made immediately visible. In_Body is True if this is + -- done for an instance body and False for an instance spec. Note that the + -- procedure does not insert P on the scope stack above the current scope, + -- but instead pushes P and then pushes an extra copy of the current scope. -- The functions Instantiate_... perform various legality checks and build -- the declarations for instantiated generic parameters. In all of these @@ -930,7 +932,7 @@ package body Sem_Ch12 is -- subprogram declaration N. procedure Remove_Parent (In_Body : Boolean := False); - -- Reverse effect after instantiation of child is complete + -- Reverse Install_Parent's effect after instantiation of child is complete function Renames_Standard_Subprogram (Subp : Entity_Id) return Boolean; -- Determine whether Subp renames one of the subprograms defined in the @@ -944,6 +946,13 @@ package body Sem_Ch12 is -- Restore suffix 'P' to primitives of Prims_List and leave Prims_List -- set to No_Elist. + procedure Restore_Private_Views (Pack_Id : Entity_Id; Is_Package : Boolean); + -- Restore the private views of external types, and unmark the generic + -- renamings of actuals, so that they become compatible subtypes again. + -- Reset the visibility of the actuals (some of them may have been made + -- visible by Check_Generic_Actuals). For subprograms, Pack_Id is the + -- wrapper package built to hold the renamings and Is_Package is False. + procedure Set_Instance_Env (Gen_Unit : Entity_Id; Act_Unit : Entity_Id); @@ -958,6 +967,10 @@ package body Sem_Ch12 is -- Associate analyzed generic parameter with corresponding instance. Used -- for semantic checks at instantiation time. + procedure Switch_View (T : Entity_Id); + -- Switch the partial and full views of a type, as well as those of its + -- private dependents (i.e. its subtypes and derived types). + function True_Parent (N : Node_Id) return Node_Id; -- For a subunit, return parent of corresponding stub, else return -- parent of node. @@ -1080,18 +1093,6 @@ package body Sem_Ch12 is Table_Increment => 100, Table_Name => "Instance_Envs"); - procedure Restore_Private_Views - (Pack_Id : Entity_Id; - Is_Package : Boolean := True); - -- Restore the private views of external types, and unmark the generic - -- renamings of actuals, so that they become compatible subtypes again. - -- For subprograms, Pack_Id is the package constructed to hold the - -- renamings. - - procedure Switch_View (T : Entity_Id); - -- Switch the partial and full views of a type and its private - -- dependents (i.e. its subtypes and derived types). - ------------------------------------ -- Structures for Error Reporting -- ------------------------------------ @@ -1607,8 +1608,8 @@ package body Sem_Ch12 is return Result : Actual_Rec do case Nkind (Un_Formal) is when N_Formal_Object_Declaration => - if Present (Default_Expression (Un_Formal)) then - Result := (Name_Exp, Default_Expression (Un_Formal)); + if Present (Expression (Un_Formal)) then + Result := (Name_Exp, Expression (Un_Formal)); end if; when N_Formal_Type_Declaration => if Present (Default_Subtype_Mark (Un_Formal)) then @@ -1663,18 +1664,14 @@ package body Sem_Ch12 is if Box_Present (Src_Assoc) then Assoc.Actual := (Kind => Box_Actual); - if False then -- ??? - -- Disable this for now, because we have various - -- code that needs to be updated. - Error_Msg_N - ("box requires named notation", Src_Assoc); - end if; + Error_Msg_N ("box requires named notation", Src_Assoc); else Assoc.Actual := (Name_Exp, Explicit_Generic_Actual_Parameter (Src_Assoc)); pragma Assert (Present (Assoc.Actual.Name_Exp)); end if; + Assoc.Actual_Origin := From_Explicit_Actual; Next (Src_Assoc); @@ -2557,7 +2554,7 @@ package body Sem_Ch12 is (Defining_Identifier (Assoc.Un_Formal), Sloc (N)), Explicit_Generic_Actual_Parameter => - New_Copy_Tree (Default_Expression (Assoc.Un_Formal)))); + New_Copy_Tree (Expression (Assoc.Un_Formal)))); end if; end if; @@ -3361,7 +3358,7 @@ package body Sem_Ch12 is --------------------------------------- procedure Analyze_Formal_Object_Declaration (N : Node_Id) is - E : constant Node_Id := Default_Expression (N); + E : constant Node_Id := Expression (N); Id : constant Node_Id := Defining_Identifier (N); K : Entity_Kind; @@ -4885,25 +4882,38 @@ package body Sem_Ch12 is ------------------------------- function Needs_Body_Instantiated (Gen_Unit : Entity_Id) return Boolean is + S : constant Entity_Id := Scope (Gen_Unit); + begin + -- If the generic package being instantiated is declared within + -- a formal package, and we are in the context of the enclosing + -- generic unit of the formal package, then there is no body to + -- instantiate until the enclosing generic unit is instantiated + -- with an actual for the formal package. + + if Is_Generic_Instance (S) + and then + Nkind (Original_Node (Unit_Declaration_Node (S))) = + N_Formal_Package_Declaration + and then In_Open_Scopes (Scope (S)) + then + return False; + -- If the instantiation is in the auxiliary declarations of the main -- unit, then the body is needed, even if the main unit is generic. - if Parent (N) = Aux_Decls_Node (Cunit (Main_Unit)) then + elsif Parent (N) = Aux_Decls_Node (Cunit (Main_Unit)) then return True; - end if; -- No need to instantiate bodies in generic units - if Is_Generic_Unit (Cunit_Entity (Main_Unit)) then + elsif Is_Generic_Unit (Cunit_Entity (Main_Unit)) then return False; - end if; -- If the instantiation is in the main unit, then the body is needed - if Is_In_Main_Unit (N) then + elsif Is_In_Main_Unit (N) then return True; - end if; -- In GNATprove mode, never instantiate bodies outside of the main -- unit, as it does not use frontend/backend inlining in the way that @@ -4911,15 +4921,13 @@ package body Sem_Ch12 is -- contrary, such instantiations may bring artificial constraints, -- as for example such bodies may require preprocessing. - if GNATprove_Mode then + elsif GNATprove_Mode then return False; - end if; -- If not, then again no need to instantiate bodies in generic units - if Is_Generic_Unit (Cunit_Entity (Get_Code_Unit (N))) then + elsif Is_Generic_Unit (Cunit_Entity (Get_Code_Unit (N))) then return False; - end if; -- Here we have a special handling for back-end inlining: if inline -- processing is required, then we unconditionally want to have the @@ -4929,14 +4937,15 @@ package body Sem_Ch12 is -- these instantiations are only performed on demand when back-end -- inlining is enabled, so this causes very little extra work. - if Inline_Processing_Required and then Back_End_Inlining then + elsif Inline_Processing_Required and then Back_End_Inlining then return True; - end if; -- We want to have the bodies instantiated in non-main units if -- they might contribute inlined subprograms. - return Might_Inline_Subp (Gen_Unit); + else + return Might_Inline_Subp (Gen_Unit); + end if; end Needs_Body_Instantiated; -- Local declarations @@ -5417,43 +5426,6 @@ package body Sem_Ch12 is and then (Operating_Mode = Generate_Code or else (Operating_Mode = Check_Semantics and then GNATprove_Mode)); - - -- If front-end inlining is enabled or there are any subprograms - -- marked with Inline_Always, do not instantiate body when within - -- a generic context. - - if not Back_End_Inlining - and then (Front_End_Inlining or else Has_Inline_Always) - and then not Expander_Active - then - Needs_Body := False; - end if; - - -- If the current context is generic, and the package being - -- instantiated is declared within a formal package, there is no - -- body to instantiate until the enclosing generic is instantiated - -- and there is an actual for the formal package. If the formal - -- package has parameters, we build a regular package instance for - -- it, that precedes the original formal package declaration. - - if In_Open_Scopes (Scope (Scope (Gen_Unit))) then - declare - Decl : constant Node_Id := - Original_Node - (Unit_Declaration_Node (Scope (Gen_Unit))); - begin - if Nkind (Decl) = N_Formal_Package_Declaration - or else (Nkind (Decl) = N_Package_Declaration - and then Is_List_Member (Decl) - and then Present (Next (Decl)) - and then - Nkind (Next (Decl)) = - N_Formal_Package_Declaration) - then - Needs_Body := False; - end if; - end; - end if; end; -- For RCI unit calling stubs, we omit the instance body if the @@ -5696,7 +5668,7 @@ package body Sem_Ch12 is Check_Formal_Packages (Act_Decl_Id); Restore_Hidden_Primitives (Vis_Prims_List); - Restore_Private_Views (Act_Decl_Id); + Restore_Private_Views (Act_Decl_Id, Is_Package => True); Inherit_Context (Gen_Decl, N); @@ -7218,7 +7190,7 @@ package body Sem_Ch12 is if not Is_Intrinsic_Subprogram (Act_Decl_Id) then Inherit_Context (Gen_Decl, N); - Restore_Private_Views (Pack_Id, False); + Restore_Private_Views (Pack_Id, Is_Package => False); -- If the context requires a full instantiation, mark node for -- subsequent construction of the body. @@ -8571,9 +8543,6 @@ package body Sem_Ch12 is Set_Is_Generic_Actual_Type (Full_View (E)); end if; - Set_Is_Hidden (E, False); - Set_Is_Potentially_Use_Visible (E, In_Use (Instance)); - -- We constructed the generic actual type as a subtype of the -- supplied type. This means that it normally would not inherit -- subtype specific attributes of the actual, which is wrong for @@ -8627,21 +8596,15 @@ package body Sem_Ch12 is (Renamed_Entity (E), Is_Formal_Box => Box_Present (Parent (Associated_Formal_Package (E)))); - - Set_Is_Hidden (E, False); end if; - - -- If this is a subprogram instance (in a wrapper package) the - -- actual is fully visible. - - elsif Is_Wrapper_Package (Instance) then - Set_Is_Hidden (E, False); + end if; -- If the formal package is declared with a box, or if the formal - -- parameter is defaulted, it is visible in the body. + -- parameter is defaulted, the actual is visible in the instance. - elsif Is_Formal_Box or else Is_Visible_Formal (E) then + if Is_Formal_Box or else Is_Visible_Formal (E) then Set_Is_Hidden (E, False); + Set_Is_Potentially_Use_Visible (E, In_Use (Instance)); end if; -- Check directly the type of the actual objects, including the @@ -10479,10 +10442,10 @@ package body Sem_Ch12 is function Find_Actual_Type (Typ : Entity_Id; - Gen_Type : Entity_Id) return Entity_Id + Gen_Type : Entity_Id; + Typ_Ref : Node_Id) return Entity_Id is Gen_Scope : constant Entity_Id := Scope (Gen_Type); - T : Entity_Id; begin -- Special processing only applies to child units @@ -10496,6 +10459,12 @@ package body Sem_Ch12 is elsif Scope (Typ) = Gen_Scope then return Get_Instance_Of (Typ); + -- If designated or component type is declared in a formal of the child + -- unit, its instance is available. + + elsif Scope (Scope (Typ)) = Gen_Scope then + return Get_Instance_Of (Typ); + -- If the array or access type is not declared in the parent unit, -- no special processing needed. @@ -10507,18 +10476,8 @@ package body Sem_Ch12 is -- Otherwise, retrieve designated or component type by visibility else - T := Current_Entity (Typ); - while Present (T) loop - if In_Open_Scopes (Scope (T)) then - return T; - elsif Is_Generic_Actual_Type (T) then - return T; - end if; - - T := Homonym (T); - end loop; - - return Typ; + Analyze (Typ_Ref); + return Entity (Typ_Ref); end if; end Find_Actual_Type; @@ -11182,10 +11141,20 @@ package body Sem_Ch12 is ------------------------ procedure Hide_Current_Scope is - C : constant Entity_Id := Current_Scope; + C : Entity_Id; E : Entity_Id; begin + C := Current_Scope; + + -- The analysis of the actual parameters may have created a transient + -- scope after the extra copy of the current scope was pushed onto the + -- stack, so we need to skip it. + + if Scope_Is_Transient then + C := Scope (C); + end if; + Set_Is_Hidden_Open_Scope (C); E := First_Entity (C); @@ -11208,7 +11177,6 @@ package body Sem_Ch12 is Set_Is_Immediately_Visible (C, False); Append_Elmt (C, Hidden_Entities); end if; - end Hide_Current_Scope; -------------- @@ -11660,8 +11628,10 @@ package body Sem_Ch12 is null; elsif Present (Associated_Formal_Package (E)) then - Check_Generic_Actuals (Renamed_Entity (E), True); - Set_Is_Hidden (E, False); + Check_Generic_Actuals + (Renamed_Entity (E), + Is_Formal_Box => + Box_Present (Parent (Associated_Formal_Package (E)))); -- Find formal package in generic unit that corresponds to -- (instance of) formal package in instance. @@ -12450,7 +12420,7 @@ package body Sem_Ch12 is (Nkind (Actual_Of_Formal) = N_Package_Instantiation); end if; - Next (Actual_Of_Formal); + Next_Non_Pragma (Actual_Of_Formal); -- A formal subprogram may be overloaded, so advance in -- the list of actuals to make sure we do not match two @@ -13236,7 +13206,7 @@ package body Sem_Ch12 is end if; end; - elsif Present (Default_Expression (Formal)) then + elsif Present (Expression (Formal)) then -- Use default to construct declaration @@ -13254,7 +13224,7 @@ package body Sem_Ch12 is Null_Exclusion_Present => Null_Exclusion_Present (Formal), Object_Definition => Def, Expression => New_Copy_Tree - (Default_Expression (Formal))); + (Expression (Formal))); Copy_Ghost_Aspect (Formal, To => Decl_Node); Set_Corresponding_Generic_Association @@ -13679,7 +13649,7 @@ package body Sem_Ch12 is Set_Defining_Unit_Name (Act_Body, Act_Body_Name); Set_Corresponding_Spec (Act_Body, Act_Decl_Id); - Check_Generic_Actuals (Act_Decl_Id, False); + Check_Generic_Actuals (Act_Decl_Id, Is_Formal_Box => False); Check_Initialized_Types; -- Install primitives hidden at the point of the instantiation but @@ -13927,7 +13897,7 @@ package body Sem_Ch12 is -- the two mechanisms swap exactly the same entities, in particular -- the private entities dependent on the primary private entities. - Restore_Private_Views (Act_Decl_Id); + Restore_Private_Views (Act_Decl_Id, Is_Package => True); -- Remove the current unit from visibility if this is an instance -- that is not elaborated on the fly for inlining purposes. @@ -14174,7 +14144,7 @@ package body Sem_Ch12 is Set_Corresponding_Spec (Act_Body, Act_Decl_Id); Set_Has_Completion (Act_Decl_Id); - Check_Generic_Actuals (Pack_Id, False); + Check_Generic_Actuals (Pack_Id, Is_Formal_Box => False); -- Generate a reference to link the visible subprogram instance to -- the generic body, which for navigation purposes is the only @@ -14245,7 +14215,7 @@ package body Sem_Ch12 is Inherit_Context (Gen_Body, Inst_Node); - Restore_Private_Views (Pack_Id, False); + Restore_Private_Views (Pack_Id, Is_Package => False); if Par_Installed then Remove_Parent (In_Body => True); @@ -14599,7 +14569,8 @@ package body Sem_Ch12 is procedure Validate_Access_Type_Instance is Desig_Type : constant Entity_Id := - Find_Actual_Type (Designated_Type (A_Gen_T), A_Gen_T); + Find_Actual_Type + (Designated_Type (A_Gen_T), A_Gen_T, Subtype_Indication (Def)); Desig_Act : Entity_Id; begin @@ -14688,31 +14659,15 @@ package body Sem_Ch12 is ---------------------------------- procedure Validate_Array_Type_Instance is - I1 : Node_Id; - I2 : Node_Id; - T2 : Entity_Id; - - function Formal_Dimensions return Nat; - -- Count number of dimensions in array type formal - - ----------------------- - -- Formal_Dimensions -- - ----------------------- + Dims : constant List_Id + := (if Nkind (Def) = N_Constrained_Array_Definition + then Discrete_Subtype_Definitions (Def) + else Subtype_Marks (Def)); - function Formal_Dimensions return Nat is - Dims : List_Id; - - begin - if Nkind (Def) = N_Constrained_Array_Definition then - Dims := Discrete_Subtype_Definitions (Def); - else - Dims := Subtype_Marks (Def); - end if; - - return List_Length (Dims); - end Formal_Dimensions; - - -- Start of processing for Validate_Array_Type_Instance + Dim : Node_Id; + I1 : Node_Id; + I2 : Node_Id; + T2 : Entity_Id; begin if not Is_Array_Type (Act_T) then @@ -14737,15 +14692,16 @@ package body Sem_Ch12 is end if; end if; - if Formal_Dimensions /= Number_Dimensions (Act_T) then + if List_Length (Dims) /= Number_Dimensions (Act_T) then Error_Msg_NE ("dimensions of actual do not match formal &", Actual, Gen_T); Abandon_Instantiation (Actual); end if; - I1 := First_Index (A_Gen_T); - I2 := First_Index (Act_T); - for J in 1 .. Formal_Dimensions loop + Dim := First (Dims); + I1 := First_Index (A_Gen_T); + I2 := First_Index (Act_T); + for J in 1 .. List_Length (Dims) loop -- If the indexes of the actual were given by a subtype_mark, -- the index was transformed into a range attribute. Retrieve @@ -14768,7 +14724,13 @@ package body Sem_Ch12 is end if; if not Subtypes_Match - (Find_Actual_Type (Etype (I1), A_Gen_T), T2) + (Find_Actual_Type + (Etype (I1), + A_Gen_T, + (if Nkind (Dim) = N_Subtype_Indication + then Subtype_Mark (Dim) + else Dim)), + T2) then Error_Msg_NE ("index types of actual do not match those of formal &", @@ -14776,34 +14738,20 @@ package body Sem_Ch12 is Abandon_Instantiation (Actual); end if; + Next (Dim); Next_Index (I1); Next_Index (I2); end loop; - -- Check matching subtypes. Note that there are complex visibility - -- issues when the generic is a child unit and some aspect of the - -- generic type is declared in a parent unit of the generic. We do - -- the test to handle this special case only after a direct check - -- for static matching has failed. The case where both the component - -- type and the array type are separate formals, and the component - -- type is a private view may also require special checking in - -- Subtypes_Match. Finally, we assume that a child instance where - -- the component type comes from a formal of a parent instance is - -- correct because the generic was correct. A more precise check - -- seems too complex to install??? - - if Subtypes_Match - (Component_Type (A_Gen_T), Component_Type (Act_T)) - or else - Subtypes_Match - (Find_Actual_Type (Component_Type (A_Gen_T), A_Gen_T), - Component_Type (Act_T)) - or else - (not Inside_A_Generic - and then Is_Child_Unit (Scope (Component_Type (A_Gen_T)))) + -- Check matching component subtypes + + if not Subtypes_Match + (Find_Actual_Type + (Component_Type (A_Gen_T), + A_Gen_T, + Subtype_Indication (Component_Definition (Def))), + Component_Type (Act_T)) then - null; - else Error_Msg_NE ("component subtype of actual does not match that of formal &", Actual, Gen_T); @@ -15846,7 +15794,7 @@ package body Sem_Ch12 is Diagnose_Predicated_Actual; when N_Formal_Signed_Integer_Type_Definition => - if not Is_Signed_Integer_Type (Act_T) then + if not Has_Overflow_Operations (Act_T) then Error_Msg_NE ("expect signed integer type in instantiation of&", Actual, Gen_T); @@ -15856,7 +15804,7 @@ package body Sem_Ch12 is Diagnose_Predicated_Actual; when N_Formal_Modular_Type_Definition => - if not Is_Modular_Integer_Type (Act_T) then + if not Has_Modular_Operations (Act_T) then Error_Msg_NE ("expect modular type in instantiation of &", Actual, Gen_T); @@ -16960,20 +16908,33 @@ package body Sem_Ch12 is procedure Remove_Parent (In_Body : Boolean := False) is S : Entity_Id := Current_Scope; - -- S is the scope containing the instantiation just completed. The scope - -- stack contains the parent instances of the instantiation, followed by - -- the original S. + -- S is the extra copy of the current scope that has been pushed by + -- Install_Parent. The scope stack next contains the parents of the + -- instance followed by the original S. Cur_P : Entity_Id; E : Entity_Id; - P : Entity_Id; Hidden : Elmt_Id; + P : Entity_Id; + SE : Scope_Stack_Entry; begin - -- After child instantiation is complete, remove from scope stack the - -- extra copy of the current scope, and then remove parent instances. - if not In_Body then + -- If the analysis of the actual parameters has created a transient + -- scope after the extra copy of the current scope was pushed onto + -- the stack, we first need to save this transient scope and pop it. + + if Scope_Is_Transient then + SE := Scope_Stack.Table (Scope_Stack.Last); + Scope_Stack.Decrement_Last; + S := Current_Scope; + else + SE.Is_Transient := False; + end if; + + -- After child instantiation is complete, remove from scope stack the + -- extra copy of the current scope, and then remove the parents. + Pop_Scope; while Current_Scope /= S loop @@ -17057,6 +17018,12 @@ package body Sem_Ch12 is Next_Elmt (Hidden); end loop; + -- Restore the transient scope that was popped on entry, if any + + if SE.Is_Transient then + Scope_Stack.Append (SE); + end if; + else -- Each body is analyzed separately, and there is no context that -- needs preserving from one body instance to the next, so remove all @@ -17093,10 +17060,18 @@ package body Sem_Ch12 is Saved : Instance_Env renames Instance_Envs.Table (Instance_Envs.Last); begin - if No (Current_Instantiated_Parent.Act_Id) then - -- Restore environment after subprogram inlining + -- Restore environment after subprogram inlining - Restore_Private_Views (Empty); + if No (Current_Instantiated_Parent.Act_Id) then + declare + M : Elmt_Id; + begin + M := First_Elmt (Exchanged_Views); + while Present (M) loop + Exchange_Declarations (Node (M)); + Next_Elmt (M); + end loop; + end; end if; Current_Instantiated_Parent := Saved.Instantiated_Parent; @@ -17115,9 +17090,7 @@ package body Sem_Ch12 is -- Restore_Private_Views -- --------------------------- - procedure Restore_Private_Views - (Pack_Id : Entity_Id; - Is_Package : Boolean := True) + procedure Restore_Private_Views (Pack_Id : Entity_Id; Is_Package : Boolean) is M : Elmt_Id; E : Entity_Id; @@ -17136,6 +17109,7 @@ package body Sem_Ch12 is procedure Restore_Nested_Formal (Formal : Entity_Id) is pragma Assert (Ekind (Formal) = E_Package); Ent : Entity_Id; + begin if Present (Renamed_Entity (Formal)) and then Denotes_Formal_Package (Renamed_Entity (Formal), True) @@ -17198,16 +17172,13 @@ package body Sem_Ch12 is Next_Elmt (M); end loop; - if No (Pack_Id) then - return; - end if; - -- Make the generic formal parameters private, and make the formal types -- into subtypes of the actuals again. E := First_Entity (Pack_Id); while Present (E) loop - Set_Is_Hidden (E, True); + Set_Is_Hidden (E); + Set_Is_Potentially_Use_Visible (E, False); if Is_Type (E) and then Nkind (Parent (E)) = N_Subtype_Declaration @@ -17231,6 +17202,7 @@ package body Sem_Ch12 is (Entity (Subtype_Indication (Parent (E)))) then null; + else Set_Is_Generic_Actual_Type (E, False); @@ -17275,7 +17247,7 @@ package body Sem_Ch12 is -- If the actual is itself a formal package for the enclosing -- generic, or the actual for such a formal package, it remains -- visible on exit from the instance, and therefore nothing needs - -- to be done either, except to keep it accessible. + -- to be done either. if Is_Package and then Renamed_Entity (E) = Pack_Id then exit; @@ -17286,7 +17258,7 @@ package body Sem_Ch12 is elsif Denotes_Formal_Package (Renamed_Entity (E), True, Pack_Id) then - Set_Is_Hidden (E, False); + null; else declare @@ -17301,8 +17273,8 @@ package body Sem_Ch12 is exit when Ekind (Id) = E_Package and then Renamed_Entity (Id) = Act_P; - Set_Is_Hidden (Id, True); - Set_Is_Potentially_Use_Visible (Id, In_Use (Act_P)); + Set_Is_Hidden (Id); + Set_Is_Potentially_Use_Visible (Id, False); if Ekind (Id) = E_Package then Restore_Nested_Formal (Id); @@ -19258,13 +19230,13 @@ package body Sem_Ch12 is end if; when N_Formal_Signed_Integer_Type_Definition => - if not Is_Integer_Type (Def_Sub) then + if not Has_Overflow_Operations (Def_Sub) then Error_Msg_NE ("default for& must be a discrete type", Default, Formal); end if; when N_Formal_Modular_Type_Definition => - if not Is_Modular_Integer_Type (Def_Sub) then + if not Has_Modular_Operations (Def_Sub) then Error_Msg_NE ("default for& must be a modular_integer Type", Default, Formal); end if; |