function Analyze_Associations
(I_Node : Node_Id;
Formals : List_Id;
- F_Copy : List_Id)
- return List_Id;
+ F_Copy : List_Id) return List_Id;
-- At instantiation time, build the list of associations between formals
-- and actuals. Each association becomes a renaming declaration for the
-- formal entity. F_Copy is the analyzed list of formals in the generic
function Contains_Instance_Of
(Inner : Entity_Id;
Outer : Entity_Id;
- N : Node_Id)
- return Boolean;
+ N : Node_Id) return Boolean;
-- Inner is instantiated within the generic Outer. Check whether Inner
-- directly or indirectly contains an instance of Outer or of one of its
-- parents, in the case of a subunit. Each generic unit holds a list of
-- determines whether the set of such lists contains a cycle, i.e. an
-- illegal circular instantiation.
- function Denotes_Formal_Package (Pack : Entity_Id) return Boolean;
+ function Denotes_Formal_Package
+ (Pack : Entity_Id;
+ On_Exit : Boolean := False) return Boolean;
-- Returns True if E is a formal package of an enclosing generic, or
- -- the actual for such a formal in an enclosing instantiation. Used in
- -- Restore_Private_Views, to keep the formals of such a package visible
- -- on exit from an inner instantiation.
+ -- the actual for such a formal in an enclosing instantiation. If such
+ -- a package is used as a formal in an nested generic, or as an actual
+ -- in a nested instantiation, the visibility of ITS formals should not
+ -- be modified. When called from within Restore_Private_Views, the flag
+ -- On_Exit is true, to indicate that the search for a possible enclosing
+ -- instance should ignore the current one.
function Find_Actual_Type
(Typ : Entity_Id;
- Gen_Scope : Entity_Id)
- return Entity_Id;
+ Gen_Scope : Entity_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
function In_Same_Declarative_Part
(F_Node : Node_Id;
- Inst : Node_Id)
- return Boolean;
+ Inst : Node_Id) return Boolean;
-- True if the instantiation Inst and the given freeze_node F_Node appear
-- within the same declarative part, ignoring subunits, but with no inter-
-- vening suprograms or concurrent units. If true, the freeze node
function Instantiate_Object
(Formal : Node_Id;
Actual : Node_Id;
- Analyzed_Formal : Node_Id)
- return List_Id;
+ Analyzed_Formal : Node_Id) return List_Id;
function Instantiate_Type
(Formal : Node_Id;
Actual : Node_Id;
Analyzed_Formal : Node_Id;
- Actual_Decls : List_Id)
- return Node_Id;
+ Actual_Decls : List_Id) return Node_Id;
function Instantiate_Formal_Subprogram
(Formal : Node_Id;
Actual : Node_Id;
- Analyzed_Formal : Node_Id)
- return Node_Id;
+ Analyzed_Formal : Node_Id) return Node_Id;
function Instantiate_Formal_Package
(Formal : Node_Id;
Actual : Node_Id;
- Analyzed_Formal : Node_Id)
- return List_Id;
+ Analyzed_Formal : Node_Id) return List_Id;
-- If the formal package is declared with a box, special visibility rules
-- apply to its formals: they are in the visible part of the package. This
-- is true in the declarative region of the formal package, that is to say
procedure Set_Next_Assoc (E : Assoc_Ptr; Next : Assoc_Ptr);
function Next_Assoc (E : Assoc_Ptr) return Assoc_Ptr;
function Get_Gen_Id (E : Assoc_Ptr) return Entity_Id;
- function Hash (F : Entity_Id) return HTable_Range;
+ function Hash (F : Entity_Id) return HTable_Range;
package Generic_Renamings_HTable is new GNAT.HTable.Static_HTable (
Header_Num => HTable_Range,
function Analyze_Associations
(I_Node : Node_Id;
Formals : List_Id;
- F_Copy : List_Id)
- return List_Id
+ F_Copy : List_Id) return List_Id
is
- Actual_Types : constant Elist_Id := New_Elmt_List;
- Assoc : constant List_Id := New_List;
- Defaults : constant Elist_Id := New_Elmt_List;
- Gen_Unit : constant Entity_Id := Defining_Entity
- (Parent (F_Copy));
+ Actual_Types : constant Elist_Id := New_Elmt_List;
+ Assoc : constant List_Id := New_List;
+ Defaults : constant Elist_Id := New_Elmt_List;
+ Gen_Unit : constant Entity_Id := Defining_Entity (Parent (F_Copy));
Actuals : List_Id;
Actual : Node_Id;
Formal : Node_Id;
Num_Actuals : Int := 0;
function Matching_Actual
- (F : Entity_Id;
- A_F : Entity_Id)
- return Node_Id;
+ (F : Entity_Id;
+ A_F : Entity_Id) return Node_Id;
-- Find actual that corresponds to a given a formal parameter. If the
-- actuals are positional, return the next one, if any. If the actuals
-- are named, scan the parameter associations to find the right one.
---------------------
function Matching_Actual
- (F : Entity_Id;
- A_F : Entity_Id)
- return Node_Id
+ (F : Entity_Id;
+ A_F : Entity_Id) return Node_Id
is
Found : Node_Id;
Prev : Node_Id;
else
E := First_Entity (Gen_Unit);
-
while Present (E) loop
-
if Is_Subprogram (E)
and then Is_Inlined (E)
then
-- If front_end_inlining is enabled, do not instantiate a
-- body if within a generic context.
- if Front_End_Inlining
- and then not Expander_Active
+ if (Front_End_Inlining
+ and then not Expander_Active)
+ or else Is_Generic_Unit (Cunit_Entity (Main_Unit))
then
Needs_Body := False;
end if;
or else Nkind (Assoc) = N_Extension_Aggregate
then
return Assoc;
+
else
-- If the node is part of an inner generic, it may itself have been
-- remapped into a further generic copy. Associated_Node is otherwise
E : Entity_Id;
Astype : Entity_Id;
+ function Denotes_Previous_Actual (Typ : Entity_Id) return Boolean;
+ -- For a formal that is an array type, the component type is often
+ -- a previous formal in the same unit. The privacy status of the
+ -- component type will have been examined earlier in the traversal
+ -- of the corresponding actuals, and this status should not be
+ -- modified for the array type itself.
+ -- To detect this case we have to rescan the list of formals, which
+ -- is usually short enough to ignore the resulting inefficiency.
+
+ function Denotes_Previous_Actual (Typ : Entity_Id) return Boolean is
+ Prev : Entity_Id;
+ begin
+ Prev := First_Entity (Instance);
+ while Present (Prev) loop
+ if Is_Type (Prev)
+ and then Nkind (Parent (Prev)) = N_Subtype_Declaration
+ and then Is_Entity_Name (Subtype_Indication (Parent (Prev)))
+ and then Entity (Subtype_Indication (Parent (Prev))) = Typ
+ then
+ return True;
+ elsif Prev = E then
+ return False;
+ else
+ Next_Entity (Prev);
+ end if;
+ end loop;
+ return False;
+ end Denotes_Previous_Actual;
+
+ -- Start of processing for Check_Generic_Actuals
+
begin
E := First_Entity (Instance);
while Present (E) loop
and then Scope (Etype (E)) /= Instance
and then Is_Entity_Name (Subtype_Indication (Parent (E)))
then
- Check_Private_View (Subtype_Indication (Parent (E)));
+ if Is_Array_Type (E)
+ and then Denotes_Previous_Actual (Component_Type (E))
+ then
+ null;
+ else
+ Check_Private_View (Subtype_Indication (Parent (E)));
+ end if;
Set_Is_Generic_Actual_Type (E, True);
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
elsif Denotes_Formal_Package (E) then
null;
- elsif Present (Associated_Formal_Package (E))
- and then Box_Present (Parent (Associated_Formal_Package (E)))
- then
- Check_Generic_Actuals (Renamed_Object (E), True);
+ elsif Present (Associated_Formal_Package (E)) then
+ if Box_Present (Parent (Associated_Formal_Package (E))) then
+ Check_Generic_Actuals (Renamed_Object (E), True);
+ end if;
+
Set_Is_Hidden (E, False);
end if;
function Find_Generic_Child
(Scop : Entity_Id;
- Id : Node_Id)
- return Entity_Id;
+ Id : Node_Id) return Entity_Id;
-- Search generic parent for possible child unit with the given name.
function In_Enclosing_Instance return Boolean;
function Find_Generic_Child
(Scop : Entity_Id;
- Id : Node_Id)
- return Entity_Id
+ Id : Node_Id) return Entity_Id
is
E : Entity_Id;
function Contains_Instance_Of
(Inner : Entity_Id;
Outer : Entity_Id;
- N : Node_Id)
- return Boolean
+ N : Node_Id) return Boolean
is
Elmt : Elmt_Id;
Scop : Entity_Id;
function Copy_Generic_Node
(N : Node_Id;
Parent_Id : Node_Id;
- Instantiating : Boolean)
- return Node_Id
+ Instantiating : Boolean) return Node_Id
is
Ent : Entity_Id;
New_N : Node_Id;
function Copy_Generic_List
(L : List_Id;
- Parent_Id : Node_Id)
- return List_Id;
+ Parent_Id : Node_Id) return List_Id;
-- Apply Copy_Node recursively to the members of a node list.
function In_Defining_Unit_Name (Nam : Node_Id) return Boolean;
function Copy_Generic_List
(L : List_Id;
- Parent_Id : Node_Id)
- return List_Id
+ Parent_Id : Node_Id) return List_Id
is
N : Node_Id;
New_L : List_Id;
-- Denotes_Formal_Package --
----------------------------
- function Denotes_Formal_Package (Pack : Entity_Id) return Boolean is
- Par : constant Entity_Id := Current_Instantiated_Parent.Act_Id;
+ function Denotes_Formal_Package
+ (Pack : Entity_Id;
+ On_Exit : Boolean := False) return Boolean
+ is
+ Par : Entity_Id;
Scop : constant Entity_Id := Scope (Pack);
E : Entity_Id;
begin
+ if On_Exit then
+ Par :=
+ Instance_Envs.Table
+ (Instance_Envs.Last).Instantiated_Parent.Act_Id;
+ else
+ Par := Current_Instantiated_Parent.Act_Id;
+ end if;
+
if Ekind (Scop) = E_Generic_Package
or else Nkind (Unit_Declaration_Node (Scop)) =
N_Generic_Subprogram_Declaration
function Find_Actual_Type
(Typ : Entity_Id;
- Gen_Scope : Entity_Id)
- return Entity_Id
+ Gen_Scope : Entity_Id) return Entity_Id
is
T : Entity_Id;
function In_Same_Declarative_Part
(F_Node : Node_Id;
- Inst : Node_Id)
- return Boolean
+ Inst : Node_Id) return Boolean
is
Decls : constant Node_Id := Parent (F_Node);
Nod : Node_Id := Parent (Inst);
-- origin of a node by finding the maximum sloc of any ancestor node.
-- Why is this not equivalent fo Top_Level_Location ???
+ --------------------
+ -- Enclosing_Subp --
+ --------------------
+
function Enclosing_Subp (Id : Entity_Id) return Entity_Id is
Scop : Entity_Id := Scope (Id);
return Scop;
end Enclosing_Subp;
+ ---------------
+ -- True_Sloc --
+ ---------------
+
function True_Sloc (N : Node_Id) return Source_Ptr is
Res : Source_Ptr;
N1 : Node_Id;
function Instantiate_Formal_Package
(Formal : Node_Id;
Actual : Node_Id;
- Analyzed_Formal : Node_Id)
- return List_Id
+ Analyzed_Formal : Node_Id) return List_Id
is
Loc : constant Source_Ptr := Sloc (Actual);
Actual_Pack : Entity_Id;
function Formal_Entity
(F : Node_Id;
- Act_Ent : Entity_Id)
- return Entity_Id;
+ Act_Ent : Entity_Id) return Entity_Id;
-- Returns the entity associated with the given formal F. In the
-- case where F is a formal package, this function will iterate
-- through all of F's formals and enter map associations from the
function Is_Instance_Of
(Act_Spec : Entity_Id;
- Gen_Anc : Entity_Id)
- return Boolean;
+ Gen_Anc : Entity_Id) return Boolean;
-- The actual can be an instantiation of a generic within another
-- instance, in which case there is no direct link from it to the
-- original generic ancestor. In that case, we recognize that the
-- that the entities in P2 are mapped into those of P3. The mapping of
-- entities has to be done recursively for nested packages.
+ procedure Process_Nested_Formal (Formal : Entity_Id);
+ -- If the current formal is declared with a box, its own formals are
+ -- visible in the instance, as they were in the generic, and their
+ -- Hidden flag must be reset. If some of these formals are themselves
+ -- packages declared with a box, the processing must be recursive.
+
--------------------------
-- Find_Matching_Actual --
--------------------------
function Formal_Entity
(F : Node_Id;
- Act_Ent : Entity_Id)
- return Entity_Id
+ Act_Ent : Entity_Id) return Entity_Id
is
Orig_Node : Node_Id := F;
Act_Pkg : Entity_Id;
function Is_Instance_Of
(Act_Spec : Entity_Id;
- Gen_Anc : Entity_Id)
- return Boolean
+ Gen_Anc : Entity_Id) return Boolean
is
Gen_Par : constant Entity_Id := Generic_Parent (Act_Spec);
end loop;
end Map_Entities;
+ ---------------------------
+ -- Process_Nested_Formal --
+ ---------------------------
+
+ procedure Process_Nested_Formal (Formal : Entity_Id) is
+ Ent : Entity_Id;
+
+ begin
+ if Present (Associated_Formal_Package (Formal))
+ and then Box_Present (Parent (Associated_Formal_Package (Formal)))
+ then
+ Ent := First_Entity (Formal);
+ while Present (Ent) loop
+ Set_Is_Hidden (Ent, False);
+ Set_Is_Potentially_Use_Visible
+ (Ent, Is_Potentially_Use_Visible (Formal));
+
+ if Ekind (Ent) = E_Package then
+ exit when Renamed_Entity (Ent) = Renamed_Entity (Formal);
+ Process_Nested_Formal (Ent);
+ end if;
+
+ Next_Entity (Ent);
+ end loop;
+ end if;
+ end Process_Nested_Formal;
+
-- Start of processing for Instantiate_Formal_Package
begin
Set_Is_Potentially_Use_Visible
(Actual_Ent, In_Use (Actual_Pack));
+ if Ekind (Actual_Ent) = E_Package then
+ Process_Nested_Formal (Actual_Ent);
+ end if;
+
if Present (Formal_Node) then
Formal_Ent := Formal_Entity (Formal_Node, Actual_Ent);
function Instantiate_Formal_Subprogram
(Formal : Node_Id;
Actual : Node_Id;
- Analyzed_Formal : Node_Id)
- return Node_Id
+ Analyzed_Formal : Node_Id) return Node_Id
is
Loc : Source_Ptr := Sloc (Instantiation_Node);
Formal_Sub : constant Entity_Id :=
function Instantiate_Object
(Formal : Node_Id;
Actual : Node_Id;
- Analyzed_Formal : Node_Id)
- return List_Id
+ Analyzed_Formal : Node_Id) return List_Id
is
Formal_Id : constant Entity_Id := Defining_Identifier (Formal);
Type_Id : constant Node_Id := Subtype_Mark (Formal);
(Formal : Node_Id;
Actual : Node_Id;
Analyzed_Formal : Node_Id;
- Actual_Decls : List_Id)
- return Node_Id
+ Actual_Decls : List_Id) return Node_Id
is
Loc : constant Source_Ptr := Sloc (Actual);
Gen_T : constant Entity_Id := Defining_Identifier (Formal);
function Formal_Dimensions return Int;
-- Count number of dimensions in array type formal
+ -----------------------
+ -- Formal_Dimensions --
+ -----------------------
+
function Formal_Dimensions return Int is
Num : Int := 0;
Index : Node_Id;
---------------------
function Is_In_Main_Unit (N : Node_Id) return Boolean is
- Unum : constant Unit_Number_Type := Get_Source_Unit (N);
-
+ Unum : constant Unit_Number_Type := Get_Source_Unit (N);
Current_Unit : Node_Id;
begin
Dep_Elmt : Elmt_Id;
Dep_Typ : Node_Id;
+ procedure Restore_Nested_Formal (Formal : Entity_Id);
+ -- Hide the generic formals of formal packages declared with box
+ -- which were reachable in the current instantiation.
+
+ procedure Restore_Nested_Formal (Formal : Entity_Id) is
+ Ent : Entity_Id;
+ begin
+ if Present (Renamed_Object (Formal))
+ and then Denotes_Formal_Package (Renamed_Object (Formal), True)
+ then
+ return;
+
+ elsif Present (Associated_Formal_Package (Formal))
+ and then Box_Present (Parent (Associated_Formal_Package (Formal)))
+ then
+ Ent := First_Entity (Formal);
+
+ while Present (Ent) loop
+ exit when Ekind (Ent) = E_Package
+ and then Renamed_Entity (Ent) = Renamed_Entity (Formal);
+
+ Set_Is_Hidden (Ent);
+ Set_Is_Potentially_Use_Visible (Ent, False);
+
+ if Ekind (Ent) = E_Package then
+ -- Recurse.
+ Restore_Nested_Formal (Ent);
+ end if;
+
+ Next_Entity (Ent);
+ end loop;
+ end if;
+ end Restore_Nested_Formal;
+
begin
M := First_Elmt (Exchanged_Views);
while Present (M) loop
-- If the actual is itself a formal package for the enclosing
-- generic, or the actual for such a formal package, it remains
- -- visible after the current instance, and therefore nothing
+ -- visible on exit from the instance, and therefore nothing
-- needs to be done either, except to keep it accessible.
if Is_Package
elsif Nkind (Parent (E)) /= N_Package_Renaming_Declaration then
null;
- elsif Denotes_Formal_Package (Renamed_Object (E)) then
+ elsif Denotes_Formal_Package (Renamed_Object (E), True) then
Set_Is_Hidden (E, False);
else
while Present (Id)
and then Id /= First_Private_Entity (Act_P)
loop
- Set_Is_Hidden (Id, True);
- Set_Is_Potentially_Use_Visible (Id, In_Use (Act_P));
exit when Ekind (Id) = E_Package
and then Renamed_Object (Id) = Act_P;
+ Set_Is_Hidden (Id, True);
+ Set_Is_Potentially_Use_Visible (Id, In_Use (Act_P));
+
+ if Ekind (Id) = E_Package then
+ Restore_Nested_Formal (Id);
+ end if;
+
Next_Entity (Id);
end loop;
end;
- null;
end if;
end if;
-- the current scope (e.g. when the instance appears within the body
-- of an ancestor).
+ ----------------------
+ -- Is_Instance_Node --
+ ----------------------
+
function Is_Instance_Node (Decl : Node_Id) return Boolean is
begin
return (Nkind (Decl) in N_Generic_Instantiation
projects / gcc.git / commitdiff