-- --
-- $Revision$
-- --
--- Copyright (C) 1992-2001, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2002, 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- --
-- Verify that the actuals of the actual instance match the actuals of
-- the template for a formal package that is not declared with a box.
- procedure Check_Forward_Instantiation (N : Node_Id; Decl : Node_Id);
+ procedure Check_Forward_Instantiation (Decl : Node_Id);
-- If the generic is a local entity and the corresponding body has not
-- been seen yet, flag enclosing packages to indicate that it will be
-- elaborated after the generic body. Subprograms declared in the same
-- information from the associated node is placed on the new copy, so
-- that name resolution is not repeated.
- -- Three kinds of nodes have associated nodes:
+ -- Three kinds of source nodes have associated nodes:
- -- a) those that contain entities, that is to say identifiers,
- -- expanded_names, and operators (N_Has_Entity)
+ -- a) those that can reference (denote) entities, that is identifiers,
+ -- character literals, expanded_names, operator symbols, operators,
+ -- and attribute reference nodes. These nodes have an Entity field
+ -- and are the set of nodes that are in N_Has_Entity.
-- b) aggregates (N_Aggregate and N_Extension_Aggregate)
-- some of the ancestor types, if their view is private at the point of
-- instantiation.
- -- Query??? why selected components. What about N_Freeze_Nodes, I assume
- -- that the answer is no, which means that the comment above for a) is
- -- confusing ???
+ -- Nodes that are selected components in the parse tree may be rewritten
+ -- as expanded names after resolution, and must be treated as potential
+ -- entity holders. which is why they also have an Associated_Node.
+
+ -- Nodes that do not come from source, such as freeze nodes, do not appear
+ -- in the generic tree, and need not have an associated node.
-- The associated node is stored in the Associated_Node field. Note that
-- this field overlaps Entity, which is fine, because the whole point is
Set_Small_Value (T, Delta_Val);
Set_Scalar_Range (T, Scalar_Range (Base));
+ Check_Restriction (No_Fixed_Point, Def);
end Analyze_Formal_Decimal_Fixed_Point_Type;
---------------------------------
Set_Digits_Value (Base, Digits_Value (Standard_Float));
Set_Scalar_Range (Base, Scalar_Range (Standard_Float));
Set_Parent (Base, Parent (Def));
+
+ Check_Restriction (No_Floating_Point, Def);
end Analyze_Formal_Floating_Type;
---------------------------------
Set_Delta_Value (Base, Ureal_1);
Set_Scalar_Range (Base, Scalar_Range (T));
Set_Parent (Base, Parent (Def));
+
+ Check_Restriction (No_Fixed_Point, Def);
end Analyze_Formal_Ordinary_Fixed_Point_Type;
----------------------------
Subp : Entity_Id;
begin
+ if Nam = Error then
+ return;
+ end if;
+
if Nkind (Nam) = N_Defining_Program_Unit_Name then
Error_Msg_N ("name of formal subprogram must be a direct name", Nam);
return;
-- Enter the new name, and branch to specific routine.
case Nkind (Def) is
- when N_Formal_Private_Type_Definition
- => Analyze_Formal_Private_Type (N, T, Def);
+ when N_Formal_Private_Type_Definition =>
+ Analyze_Formal_Private_Type (N, T, Def);
- when N_Formal_Derived_Type_Definition
- => Analyze_Formal_Derived_Type (N, T, Def);
+ when N_Formal_Derived_Type_Definition =>
+ Analyze_Formal_Derived_Type (N, T, Def);
- when N_Formal_Discrete_Type_Definition
- => Analyze_Formal_Discrete_Type (T, Def);
+ when N_Formal_Discrete_Type_Definition =>
+ Analyze_Formal_Discrete_Type (T, Def);
- when N_Formal_Signed_Integer_Type_Definition
- => Analyze_Formal_Signed_Integer_Type (T, Def);
+ when N_Formal_Signed_Integer_Type_Definition =>
+ Analyze_Formal_Signed_Integer_Type (T, Def);
- when N_Formal_Modular_Type_Definition
- => Analyze_Formal_Modular_Type (T, Def);
+ when N_Formal_Modular_Type_Definition =>
+ Analyze_Formal_Modular_Type (T, Def);
- when N_Formal_Floating_Point_Definition
- => Analyze_Formal_Floating_Type (T, Def);
+ when N_Formal_Floating_Point_Definition =>
+ Analyze_Formal_Floating_Type (T, Def);
+
+ when N_Formal_Ordinary_Fixed_Point_Definition =>
+ Analyze_Formal_Ordinary_Fixed_Point_Type (T, Def);
- when N_Formal_Ordinary_Fixed_Point_Definition
- => Analyze_Formal_Ordinary_Fixed_Point_Type (T, Def);
+ when N_Formal_Decimal_Fixed_Point_Definition =>
+ Analyze_Formal_Decimal_Fixed_Point_Type (T, Def);
- when N_Formal_Decimal_Fixed_Point_Definition
- => Analyze_Formal_Decimal_Fixed_Point_Type (T, Def);
+ when N_Array_Type_Definition =>
+ Analyze_Formal_Array_Type (T, Def);
- when N_Array_Type_Definition
- => Analyze_Formal_Array_Type (T, Def);
+ when N_Access_To_Object_Definition |
+ N_Access_Function_Definition |
+ N_Access_Procedure_Definition =>
+ Analyze_Generic_Access_Type (T, Def);
- when N_Access_To_Object_Definition |
- N_Access_Function_Definition |
- N_Access_Procedure_Definition
- => Analyze_Generic_Access_Type (T, Def);
+ when N_Error =>
+ null;
- when others =>
+ when others =>
raise Program_Error;
end case;
Set_Is_Generic_Type (T);
-
end Analyze_Formal_Type_Declaration;
------------------------------------
Enter_Name (Id);
+ Set_Scope_Depth_Value (Id, Scope_Depth (Current_Scope) + 1);
New_Scope (Id);
+ Enter_Generic_Scope (Id);
Set_Inner_Instances (Id, New_Elmt_List);
Set_Is_Pure (Id, Is_Pure (Current_Scope));
Formals := Parameter_Specifications (Spec);
if Present (Formals) then
- Process_Formals (Id, Formals, Spec);
+ Process_Formals (Formals, Spec);
end if;
if Nkind (Spec) = N_Function_Specification then
End_Generic;
End_Scope;
+ Exit_Generic_Scope (Id);
end Analyze_Generic_Subprogram_Declaration;
("& is hidden within declaration of instance ", Prefix (Gen_Id));
end if;
- -- If renaming, indicate this is an instantiation of renamed unit.
+ Set_Entity (Gen_Id, Gen_Unit);
+
+ -- If generic is a renaming, get original generic unit.
if Present (Renamed_Object (Gen_Unit))
and then Ekind (Renamed_Object (Gen_Unit)) = E_Generic_Package
then
Gen_Unit := Renamed_Object (Gen_Unit);
- Set_Entity (Gen_Id, Gen_Unit);
end if;
-- Verify that there are no circular instantiations.
-- and that cleanup actions should be delayed until after the
-- instance body is expanded.
- Check_Forward_Instantiation (N, Gen_Decl);
+ Check_Forward_Instantiation (Gen_Decl);
if Nkind (N) = N_Package_Instantiation then
declare
Enclosing_Master : Entity_Id := Current_Scope;
Set_Instance_Spec (N, Act_Decl);
- -- Case of not a compilation unit
+ -- If not a compilation unit, insert the package declaration
+ -- after the instantiation node.
if Nkind (Parent (N)) /= N_Compilation_Unit then
Mark_Rewrite_Insertion (Act_Decl);
Insert_Before (N, Act_Decl);
Analyze (Act_Decl);
- -- Case of compilation unit that is generic instantiation
-
- -- Place declaration on current node so context is complete
- -- for analysis (including nested instantiations).
+ -- For an instantiation that is a compilation unit, place
+ -- declaration on current node so context is complete
+ -- for analysis (including nested instantiations). It this
+ -- is the main unit, the declaration eventually replaces the
+ -- instantiation node. If the instance body is later created, it
+ -- replaces the instance node, and the declation is attached to
+ -- it (see Build_Instance_Compilation_Unit_Nodes).
else
if Cunit_Entity (Current_Sem_Unit) = Defining_Entity (N) then
First_Private_Entity (Act_Decl_Id));
if Nkind (Parent (N)) = N_Compilation_Unit
- and then not Needs_Body
+ and then not Needs_Body
then
Rewrite (N, Act_Decl);
end if;
S := Scope (S);
end loop;
- -- Find and save all enclosing instances.
+ -- Find and save all enclosing instances
S := Current_Scope;
-- Remove context of current compilation unit, unless we
-- are within a nested package instantiation, in which case
-- the context has been removed previously.
+
-- If current scope is the body of a child unit, remove context
-- of spec as well.
and then S /= Standard_Standard
loop
exit when Is_Generic_Instance (S)
- and then In_Package_Body (S);
+ and then (In_Package_Body (S)
+ or else Ekind (S) = E_Procedure
+ or else Ekind (S) = E_Function);
if S = Curr_Unit
or else (Ekind (Curr_Unit) = E_Package_Body
then
Removed := True;
+ -- Remove entities in current scopes from visibility, so
+ -- than instance body is compiled in a clean environment.
+
+ Save_Scope_Stack;
+
if Is_Child_Unit (S) then
+
-- Remove child unit from stack, as well as inner scopes.
- -- Removing its context of child unit will remove parent
+ -- Removing the context of a child unit removes parent
-- units as well.
while Current_Scope /= S loop
S := Scope (S);
end loop;
+ New_Scope (Standard_Standard);
Instantiate_Package_Body
((N, Act_Decl, Expander_Active, Current_Sem_Unit));
+ Pop_Scope;
- -- Restore context.
+ -- Restore context
Set_Is_Immediately_Visible (Gen_Comp, Vis);
end loop;
if Removed then
- -- Make local entities not visible, so that when the context of
- -- unit is restored, there are not spurious hidings of use-
- -- visible entities (which appear in the environment before the
- -- current scope).
-
- if Current_Scope /= Standard_Standard then
- S := First_Entity (Current_Scope);
-
- while Present (S) loop
- if Is_Overloadable (S) then
- Set_Is_Immediately_Visible (S, False);
- end if;
-
- Next_Entity (S);
- end loop;
- end if;
-
Install_Context (Curr_Comp);
- if Current_Scope /= Standard_Standard then
- S := First_Entity (Current_Scope);
-
- while Present (S) loop
- if Is_Overloadable (S) then
- Set_Is_Immediately_Visible (S);
- end if;
-
- Next_Entity (S);
- end loop;
- end if;
-
if Present (Curr_Scope)
and then Is_Child_Unit (Curr_Scope)
then
New_Scope (Inner_Scopes (J));
end loop;
end if;
+
+ Restore_Scope_Stack;
end if;
for J in reverse 1 .. Num_Scopes loop
+ Scope_Stack.Table (Scope_Stack.Last - J + 1).First_Use_Clause :=
+ Use_Clauses (J);
Install_Use_Clauses (Use_Clauses (J));
end loop;
elsif In_Open_Scopes (Gen_Unit) then
Error_Msg_NE ("instantiation of & within itself", N, Gen_Unit);
- elsif Contains_Instance_Of (Gen_Unit, Current_Scope, Gen_Id) then
- Error_Msg_Node_2 := Current_Scope;
- Error_Msg_NE
- ("circular Instantiation: & instantiated in &!", N, Gen_Unit);
- Circularity_Detected := True;
-
elsif K = E_Procedure
and then Ekind (Gen_Unit) /= E_Generic_Procedure
then
end if;
else
- -- If renaming, indicate that this is instantiation of renamed unit
+ Set_Entity (Gen_Id, Gen_Unit);
+
+ -- If renaming, get original unit.
if Present (Renamed_Object (Gen_Unit))
and then (Ekind (Renamed_Object (Gen_Unit)) = E_Generic_Procedure
Ekind (Renamed_Object (Gen_Unit)) = E_Generic_Function)
then
Gen_Unit := Renamed_Object (Gen_Unit);
- Set_Entity (Gen_Id, Gen_Unit);
+ end if;
+
+ if Contains_Instance_Of (Gen_Unit, Current_Scope, Gen_Id) then
+ Error_Msg_Node_2 := Current_Scope;
+ Error_Msg_NE
+ ("circular Instantiation: & instantiated in &!", N, Gen_Unit);
+ Circularity_Detected := True;
+ return;
end if;
if In_Extended_Main_Source_Unit (N) then
Pending_Instantiations.Increment_Last;
Pending_Instantiations.Table (Pending_Instantiations.Last) :=
(N, Act_Decl, Expander_Active, Current_Sem_Unit);
- Check_Forward_Instantiation (N, Gen_Decl);
+ Check_Forward_Instantiation (Gen_Decl);
-- The wrapper package is always delayed, because it does
-- not constitute a freeze point, but to insure that the
if Parent_Installed then
Remove_Parent;
end if;
-
end Analyze_Subprogram_Instantiation;
-------------------------
Set_Library_Unit (Decl_Cunit, Body_Cunit);
Set_Library_Unit (Body_Cunit, Decl_Cunit);
+ -- If the instance is not the main unit, its context, categorization,
+ -- and elaboration entity are not relevant to the compilation.
+
+ if Parent (N) /= Cunit (Main_Unit) then
+ return;
+ end if;
+
-- The context clause items on the instantiation, which are now
-- attached to the body compilation unit (since the body overwrote
-- the original instantiation node), semantically belong on the spec,
-- Check_Forward_Instantiation --
---------------------------------
- procedure Check_Forward_Instantiation (N : Node_Id; Decl : Node_Id) is
+ procedure Check_Forward_Instantiation (Decl : Node_Id) is
S : Entity_Id;
Gen_Comp : Entity_Id := Cunit_Entity (Get_Source_Unit (Decl));
return List_Id;
-- Apply Copy_Node recursively to the members of a node list.
+ function In_Defining_Unit_Name (Nam : Node_Id) return Boolean;
+ -- True if an identifier is part of the defining program unit name
+ -- of a child unit. The entity of such an identifier must be kept
+ -- (for ASIS use) even though as the name of an enclosing generic
+ -- it would otherwise not be preserved in the generic tree.
+
-----------------------
-- Copy_Descendants --
-----------------------
end if;
end Copy_Generic_List;
+ ---------------------------
+ -- In_Defining_Unit_Name --
+ ---------------------------
+
+ function In_Defining_Unit_Name (Nam : Node_Id) return Boolean is
+ begin
+ return Present (Parent (Nam))
+ and then (Nkind (Parent (Nam)) = N_Defining_Program_Unit_Name
+ or else
+ (Nkind (Parent (Nam)) = N_Expanded_Name
+ and then In_Defining_Unit_Name (Parent (Nam))));
+ end In_Defining_Unit_Name;
+
-- Start of processing for Copy_Generic_Node
begin
if No (Current_Instantiated_Parent.Gen_Id) then
if No (Ent)
or else Nkind (Ent) /= N_Defining_Identifier
- or else Nkind (Parent (N)) /= N_Defining_Program_Unit_Name
+ or else not In_Defining_Unit_Name (N)
then
Set_Associated_Node (New_N, Empty);
end if;
elsif Nkind (N) = N_Allocator
and then Nkind (Expression (N)) = N_Qualified_Expression
+ and then Is_Entity_Name (Subtype_Mark (Expression (N)))
and then Instantiating
then
declare
Pack_Id : Entity_Id)
is
F_Node : Node_Id;
- Gen_Unit : constant Entity_Id := Entity (Name (Inst_Node));
+ Gen_Unit : constant Entity_Id := Get_Generic_Entity (Inst_Node);
Par : constant Entity_Id := Scope (Gen_Unit);
Enc_G : Entity_Id;
Enc_I : Node_Id;
begin
-- If the instance and the generic body appear within the same
- -- unit, and the instance preceeds the generic, the freeze node for
+ -- unit, and the instance precedes the generic, the freeze node for
-- the instance must appear after that of the generic. If the generic
-- is nested within another instance I2, then current instance must
-- be frozen after I2. In both cases, the freeze nodes are those of
and then
In_Same_Declarative_Part (Freeze_Node (Par), Inst_Node)
then
- Insert_After (Freeze_Node (Par), F_Node);
+ if ABE_Is_Certain (Get_Package_Instantiation_Node (Par)) then
+ -- The parent was a premature instantiation. Insert freeze
+ -- node at the end the current declarative part.
+
+ Insert_After_Last_Decl (Inst_Node, F_Node);
+
+ else
+ Insert_After (Freeze_Node (Par), F_Node);
+ end if;
-- The body enclosing the instance should be frozen after the body
-- that includes the generic, because the body of the instance may
-- If the instantiation is a compilation unit that does not need a
-- body then the instantiation node has been rewritten as a package
-- declaration for the instance, and we return the original node.
+
-- If it is a compilation unit and the instance node has not been
- -- rewritten, then it is still the unit of the compilation.
+ -- rewritten, then it is still the unit of the compilation. Finally,
+ -- if a body is present, this is a parent of the main unit whose body
+ -- has been compiled for inlining purposes, and the instantiation node
+ -- has been rewritten with the instance body.
+
-- Otherwise the instantiation node appears after the declaration.
-- If the entity is a formal package, the declaration may have been
-- rewritten as a generic declaration (in the case of a formal with a
-- is found with a forward search.
if Nkind (Parent (Decl)) = N_Compilation_Unit then
+ if Nkind (Decl) = N_Package_Declaration
+ and then Present (Corresponding_Body (Decl))
+ then
+ Decl := Unit_Declaration_Node (Corresponding_Body (Decl));
+ end if;
+
if Nkind (Original_Node (Decl)) = N_Package_Instantiation then
return Original_Node (Decl);
else
-- The inherited context is attached to the enclosing compilation
-- unit. This is either the main unit, or the declaration for the
- -- main unit (in case the instantation appears within the package
+ -- main unit (in case the instantiation appears within the package
-- declaration and the main unit is its body).
Current_Unit := Parent (Inst);
Loc : constant Source_Ptr := Sloc (Inst_Node);
Gen_Id : constant Node_Id := Name (Inst_Node);
- Gen_Unit : constant Entity_Id := Entity (Name (Inst_Node));
+ Gen_Unit : constant Entity_Id := Get_Generic_Entity (Inst_Node);
Gen_Decl : constant Node_Id := Unit_Declaration_Node (Gen_Unit);
Act_Spec : constant Node_Id := Specification (Act_Decl);
Act_Decl_Id : constant Entity_Id := Defining_Entity (Act_Spec);
begin
Gen_Body_Id := Corresponding_Body (Gen_Decl);
+
+ -- The instance body may already have been processed, as the parent
+ -- of another instance that is inlined. (Load_Parent_Of_Generic).
+
+ if Present (Corresponding_Body (Instance_Spec (Inst_Node))) then
+ return;
+ end if;
+
Expander_Mode_Save_And_Set (Body_Info.Expander_Status);
if No (Gen_Body_Id) then
if Nkind (Parent (Inst_Node)) = N_Compilation_Unit then
+ -- Replace instance node with body of instance, and create
+ -- new node for corresponding instance declaration.
+
+ Build_Instance_Compilation_Unit_Nodes
+ (Inst_Node, Act_Body, Act_Decl);
+ Analyze (Inst_Node);
+
if Parent (Inst_Node) = Cunit (Main_Unit) then
- Build_Instance_Compilation_Unit_Nodes
- (Inst_Node, Act_Body, Act_Decl);
- Analyze (Inst_Node);
-- If the instance is a child unit itself, then set the
-- scope of the expanded body to be the parent of the
Set_Scope
(Defining_Entity (Inst_Node), Scope (Act_Decl_Id));
end if;
-
- else
- Set_Parent (Act_Body, Parent (Inst_Node));
- Analyze (Act_Body);
end if;
-- Case where instantiation is not a library unit
Inherit_Context (Gen_Body, Inst_Node);
end if;
+ -- Remove the parent instances if they have been placed on the
+ -- scope stack to compile the body.
+
+ if Parent_Installed then
+ Remove_Parent (In_Body => True);
+ end if;
+
Restore_Private_Views (Act_Decl_Id);
Restore_Env;
Style_Check := Save_Style_Check;
-- (since a common reason for missing the body is that it had errors).
elsif Unit_Requires_Body (Gen_Unit) then
- if Errors_Detected = 0 then
+ if Serious_Errors_Detected = 0 then
Error_Msg_NE
("cannot find body of generic package &", Inst_Node, Gen_Unit);
end if;
Expander_Mode_Restore;
-
- -- Remove the parent instances if they have been placed on the
- -- scope stack to compile the body.
-
- if Parent_Installed then
- Remove_Parent (In_Body => True);
- end if;
end Instantiate_Package_Body;
---------------------------------
Decls : List_Id;
Gen_Id : constant Node_Id := Name (Inst_Node);
- Gen_Unit : constant Entity_Id := Entity (Name (Inst_Node));
+ Gen_Unit : constant Entity_Id := Get_Generic_Entity (Inst_Node);
Gen_Decl : constant Node_Id := Unit_Declaration_Node (Gen_Unit);
Anon_Id : constant Entity_Id :=
Defining_Unit_Name (Specification (Act_Decl));
-- raise program error if executed. We generate a subprogram body for
-- this purpose. See DEC ac30vso.
- elsif Errors_Detected = 0
+ elsif Serious_Errors_Detected = 0
and then Nkind (Parent (Inst_Node)) /= N_Compilation_Unit
then
if Ekind (Anon_Id) = E_Procedure then
Handled_Statement_Sequence =>
Make_Handled_Sequence_Of_Statements (Loc,
Statements =>
- New_List (Make_Raise_Program_Error (Loc))));
+ New_List (
+ Make_Raise_Program_Error (Loc,
+ Reason =>
+ PE_Access_Before_Elaboration))));
+
else
Act_Body :=
Make_Subprogram_Body (Loc,
Make_Handled_Sequence_Of_Statements (Loc,
Statements => New_List (
Make_Return_Statement (Loc,
- Expression => Make_Raise_Program_Error (Loc)))));
+ Expression =>
+ Make_Raise_Program_Error (Loc,
+ Reason =>
+ PE_Access_Before_Elaboration)))));
end if;
Pack_Body := Make_Package_Body (Loc,
Ancestor :=
Get_Instance_Of (Base_Type (Etype (A_Gen_T)));
- elsif Is_Derived_Type (Get_Instance_Of (A_Gen_T)) then
+ -- The type may be a local derivation, or a type extension of
+ -- a previous formal, or of a formal of a parent package.
+
+ elsif Is_Derived_Type (Get_Instance_Of (A_Gen_T))
+ or else
+ Ekind (Get_Instance_Of (A_Gen_T)) = E_Record_Type_With_Private
+ then
Ancestor :=
Get_Instance_Of (Base_Type (Get_Instance_Of (A_Gen_T)));
else
Act_T := Entity (Actual);
+ -- Deal with fixed/floating restrictions
+
+ if Is_Floating_Point_Type (Act_T) then
+ Check_Restriction (No_Floating_Point, Actual);
+ elsif Is_Fixed_Point_Type (Act_T) then
+ Check_Restriction (No_Fixed_Point, Actual);
+ end if;
+
+ -- Deal with error of using incomplete type as generic actual
+
if Ekind (Act_T) = E_Incomplete_Type then
if No (Underlying_Type (Act_T)) then
Error_Msg_N ("premature use of incomplete type", Actual);
end if;
end if;
+ -- Deal with error of premature use of private type as generic actual
+
elsif Is_Private_Type (Act_T)
and then Is_Private_Type (Base_Type (Act_T))
and then not Is_Generic_Type (Act_T)
procedure Pre_Analyze_Actuals (N : Node_Id) is
Assoc : Node_Id;
Act : Node_Id;
- Errs : Int := Errors_Detected;
+ Errs : Int := Serious_Errors_Detected;
begin
Assoc := First (Generic_Associations (N));
Analyze (Act);
end if;
- if Errs /= Errors_Detected then
+ if Errs /= Serious_Errors_Detected then
Abandon_Instantiation (Act);
end if;
Next_Entity (E);
end loop;
+ if Is_Generic_Instance (Current_Scope)
+ and then P /= Current_Scope
+ then
+ -- We are within an instance of some sibling. Retain
+ -- visibility of parent, for proper subsequent cleanup.
+
+ Set_In_Private_Part (P);
+ end if;
+
elsif not In_Open_Scopes (Scope (P)) then
Set_Is_Immediately_Visible (P, False);
end if;
-- package itself. If the instance is a subprogram, all entities
-- in the corresponding package are renamings. If this entity is
-- a formal package, make its own formals private as well. The
- -- actual in this case is itself the renaming of an instantation.
+ -- actual in this case is itself the renaming of an instantiation.
-- If the entity is not a package renaming, it is the entity
-- created to validate formal package actuals: ignore.
-- Save semantic information on global entity, so that it is not
-- resolved again at instantiation time.
+ procedure Save_Entity_Descendants (N : Node_Id);
+ -- Apply Save_Global_References to the two syntactic descendants of
+ -- non-terminal nodes that carry an Associated_Node and are processed
+ -- through Reset_Entity. Once the global entity (if any) has been
+ -- captured together with its type, only two syntactic descendants
+ -- need to be traversed to complete the processing of the tree rooted
+ -- at N. This applies to Selected_Components, Expanded_Names, and to
+ -- Operator nodes. N can also be a character literal, identifier, or
+ -- operator symbol node, but the call has no effect in these cases.
+
procedure Save_Global_Defaults (N1, N2 : Node_Id);
-- Default actuals in nested instances must be handled specially
-- because there is no link to them from the original tree. When an
-- context of the parent, we must preserve the identifier of the parent
-- so that it can be properly resolved in a subsequent instantiation.
- procedure Save_Global_Operand_Descendants (N : Node_Id);
- -- Apply Save_Global_Descendant to the possible operand fields
- -- of the node N (Field2 = Left_Opnd, Field3 = Right_Opnd).
- --
- -- It is uncomfortable for Sem_Ch12 to have this knowledge ???
-
procedure Save_Global_Descendant (D : Union_Id);
-- Apply Save_Global_References recursively to the descendents of
-- current node.
Change_Selected_Component_To_Expanded_Name (Parent (N));
Set_Associated_Node (Parent (N), Parent (N2));
Set_Global_Type (Parent (N), Parent (N2));
- Save_Global_Operand_Descendants (N);
+ Save_Entity_Descendants (N);
-- If this is a reference to the current generic entity,
-- replace it with a simple name. This is to avoid anomalies
Change_Selected_Component_To_Expanded_Name (Parent (N));
Set_Associated_Node (Parent (N), Name (Parent (N2)));
Set_Global_Type (Parent (N), Name (Parent (N2)));
- Save_Global_Operand_Descendants (N);
+ Save_Entity_Descendants (N);
else
-- Entity is local. Reset in generic unit, so that node
end if;
end Reset_Entity;
+ -----------------------------
+ -- Save_Entity_Descendants --
+ -----------------------------
+
+ procedure Save_Entity_Descendants (N : Node_Id) is
+ begin
+ case Nkind (N) is
+ when N_Binary_Op =>
+ Save_Global_Descendant (Union_Id (Left_Opnd (N)));
+ Save_Global_Descendant (Union_Id (Right_Opnd (N)));
+
+ when N_Unary_Op =>
+ Save_Global_Descendant (Union_Id (Right_Opnd (N)));
+
+ when N_Expanded_Name | N_Selected_Component =>
+ Save_Global_Descendant (Union_Id (Prefix (N)));
+ Save_Global_Descendant (Union_Id (Selector_Name (N)));
+
+ when N_Identifier | N_Character_Literal | N_Operator_Symbol =>
+ null;
+
+ when others =>
+ raise Program_Error;
+ end case;
+ end Save_Entity_Descendants;
+
--------------------------
-- Save_Global_Defaults --
--------------------------
Act1 : Node_Id;
Act2 : Node_Id;
Def : Node_Id;
- Gen_Id : Entity_Id := Entity (Name (N2));
+ Gen_Id : Entity_Id := Get_Generic_Entity (N2);
Ndec : Node_Id;
Subp : Entity_Id;
Actual : Entity_Id;
end if;
end Save_Global_Descendant;
- -------------------------------------
- -- Save_Global_Operand_Descendants --
- -------------------------------------
-
- procedure Save_Global_Operand_Descendants (N : Node_Id) is
-
- use Atree.Unchecked_Access;
- -- This code section is part of the implementation of an untyped
- -- tree traversal, so it needs direct access to node fields.
-
- begin
- Save_Global_Descendant (Field2 (N));
- Save_Global_Descendant (Field3 (N));
- end Save_Global_Operand_Descendants;
-
---------------------
-- Save_References --
---------------------
end if;
end if;
- -- Complete the check on operands
+ -- Complete the check on operands, if node has not been
+ -- constant-folded.
- Save_Global_Operand_Descendants (N);
+ if Nkind (N) in N_Op then
+ Save_Entity_Descendants (N);
+ end if;
elsif Nkind (N) = N_Identifier then
if Nkind (N) = Nkind (Get_Associated_Node (N)) then
OSDN Git Service
