This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
[Ada] Fix to no longer use Node4 directly from sem-ch12
- To: gcc-patches at gcc dot gnu dot org
- Subject: [Ada] Fix to no longer use Node4 directly from sem-ch12
- From: bosch at gnat dot com
- Date: Fri, 26 Oct 2001 12:44:37 -0400 (EDT)
2001-10-26 Robert Dewar <dewar@gnat.com>
* sinfo.ads: Define Associated_Node to overlap Entity field. Cleanup.
* sinfo.ads: Clarify use of Associated_Node (documentation only).
* sem_ch12.adb: Change Node4 to Associated_Node. Change
Associated_Node to Get_Associated_Node. Put use of Unchecked_Access
much more narrowly in places where needed. These are cleanups.
*** sinfo.ads 2001/09/20 01:22:29 1.430
--- sinfo.ads 2001/10/06 19:43:06 1.431
***************
*** 404,409 ****
--- 404,410 ----
-- Left_Opnd (Node2) left operand expression
-- Right_Opnd (Node3) right operand expression
-- Entity (Node4-Sem) defining entity for operator
+ -- Associated_Node (Node4-Sem) for generic processing
-- Do_Overflow_Check (Flag17-Sem) set if overflow check needed
-- Has_Private_View (Flag11-Sem) set in generic units.
***************
*** 411,416 ****
--- 412,418 ----
-- Chars (Name1) Name_Id for the operator
-- Right_Opnd (Node3) right operand expression
-- Entity (Node4-Sem) defining entity for operator
+ -- Associated_Node (Node4-Sem) for generic processing
-- Do_Overflow_Check (Flag17-Sem) set if overflow check needed
-- Has_Private_View (Flag11-Sem) set in generic units.
***************
*** 566,571 ****
--- 568,580 ----
-- expression is valid, even where it would normally not be allowed
-- (e.g. where the type involved is limited).
+ -- Associated_Node (Node4-Sem)
+ -- Present in all nodes that have an Entity field, and also in
+ -- N_Aggregate, N_Selected_Component, and N_Extension_Aggregate nodes.
+ -- This field is used during generic processing to relate nodes in the
+ -- template to nodes in the instantiation. It overlaps the Entity field,
+ -- see description in Sem_Ch12 for further details on this usage.
+
-- At_End_Proc (Node1)
-- This field is present in an N_Handled_Sequence_Of_Statements node.
-- It contains an identifier reference for the cleanup procedure to
***************
*** 849,858 ****
-- defining occurrence is in a separately compiled file, and this
-- pointer must be set using the library Load procedure. Note that
-- during name resolution, the value in Entity may be temporarily
! -- incorrect (e.g. during overload resolution, Entity is
! -- initially set to the first possible correct interpretation, and
! -- then later modified if necessary to contain the correct value
! -- after resolution).
-- Etype (Node5-Sem)
-- Appears in all expression nodes, all direct names, and all
--- 858,868 ----
-- defining occurrence is in a separately compiled file, and this
-- pointer must be set using the library Load procedure. Note that
-- during name resolution, the value in Entity may be temporarily
! -- incorrect (e.g. during overload resolution, Entity is initially
! -- set to the first possible correct interpretation, and then later
! -- modified if necessary to contain the correct value after resolution).
! -- Note that Associated_Node overlays this field during the processing
! -- of generics. See Sem_Ch12 for further details.
-- Etype (Node5-Sem)
-- Appears in all expression nodes, all direct names, and all
***************
*** 1538,1543 ****
--- 1548,1554 ----
-- Sloc points to identifier
-- Chars (Name1) contains the Name_Id for the identifier
-- Entity (Node4-Sem)
+ -- Associated_Node (Node4-Sem)
-- Original_Discriminant (Node2-Sem)
-- Redundant_Use (Flag13-Sem)
-- Has_Private_View (Flag11-Sem) (set in generic units)
***************
*** 1610,1615 ****
--- 1621,1627 ----
-- Chars (Name1) contains the Name_Id for the identifier
-- Char_Literal_Value (Char_Code2) contains the literal value
-- Entity (Node4-Sem)
+ -- Associated_Node (Node4-Sem)
-- Has_Private_View (Flag11-Sem) set in generic units.
-- plus fields for expression
***************
*** 2721,2726 ****
--- 2733,2739 ----
-- Sloc points to period
-- Prefix (Node3)
-- Selector_Name (Node2)
+ -- Associated_Node (Node4-Sem)
-- Do_Access_Check (Flag11-Sem)
-- Do_Discriminant_Check (Flag13-Sem)
-- plus fields for expression
***************
*** 2791,2796 ****
--- 2804,2810 ----
-- Attribute_Name (Name2) identifier name from attribute designator
-- Expressions (List1) (set to No_List if no associated expressions)
-- Entity (Node4-Sem) used if the attribute yields a type
+ -- Associated_Node (Node4-Sem)
-- Do_Access_Check (Flag11-Sem)
-- Do_Overflow_Check (Flag17-Sem)
-- Redundant_Use (Flag13-Sem)
***************
*** 2850,2855 ****
--- 2864,2870 ----
-- Component_Associations (List2) (set to No_List if none)
-- Null_Record_Present (Flag17)
-- Aggregate_Bounds (Node3-Sem)
+ -- Associated_Node (Node4-Sem)
-- Static_Processing_OK (Flag4-Sem)
-- Compile_Time_Known_Aggregate (Flag18-Sem)
-- Expansion_Delayed (Flag11-Sem)
***************
*** 2932,2937 ****
--- 2947,2953 ----
-- N_Extension_Aggregate
-- Sloc points to left parenthesis
-- Ancestor_Part (Node3)
+ -- Associated_Node (Node4-Sem)
-- Expressions (List1) (set to No_List if none or null record case)
-- Component_Associations (List2) (set to No_List if none)
-- Null_Record_Present (Flag17)
***************
*** 3779,3784 ****
--- 3795,3801 ----
-- Strval (Str3) Id of string value. This is used if the operator
-- symbol turns out to be a normal string after all.
-- Entity (Node4-Sem)
+ -- Associated_Node (Node4-Sem)
-- Has_Private_View (Flag11-Sem) set in generic units.
-- Etype (Node5-Sem)
***************
*** 5887,5892 ****
--- 5904,5910 ----
-- Prefix (Node3)
-- Selector_Name (Node2)
-- Entity (Node4-Sem)
+ -- Associated_Node (Node4-Sem)
-- Redundant_Use (Flag13-Sem)
-- Has_Private_View (Flag11-Sem) set in generic units.
-- plus fields for expression
***************
*** 5942,5947 ****
--- 5960,5966 ----
-- N_Freeze_Entity
-- Sloc points near freeze point (see above special note)
-- Entity (Node4-Sem)
+ -- Associated_Node (Node4-Sem)
-- Access_Types_To_Process (Elist2-Sem) (set to No_Elist if none)
-- TSS_Elist (Elist3-Sem) (set to No_Elist if no associated TSS's)
-- Actions (List1) (set to No_List if no freeze actions)
***************
*** 6732,6737 ****
--- 6751,6759 ----
function Assignment_OK
(N : Node_Id) return Boolean; -- Flag15
+ function Associated_Node
+ (N : Node_Id) return Node_Id; -- Node4
+
function At_End_Proc
(N : Node_Id) return Node_Id; -- Node1
***************
*** 7479,7484 ****
--- 7501,7509 ----
procedure Set_Assignment_OK
(N : Node_Id; Val : Boolean := True); -- Flag15
+ procedure Set_Associated_Node
+ (N : Node_Id; Val : Node_Id); -- Node4
+
procedure Set_Attribute_Name
(N : Node_Id; Val : Name_Id); -- Name2
***************
*** 8208,8213 ****
--- 8233,8239 ----
pragma Inline (Ancestor_Part);
pragma Inline (Array_Aggregate);
pragma Inline (Assignment_OK);
+ pragma Inline (Associated_Node);
pragma Inline (At_End_Proc);
pragma Inline (Attribute_Name);
pragma Inline (Aux_Decls_Node);
***************
*** 8454,8459 ****
--- 8480,8486 ----
pragma Inline (Set_Ancestor_Part);
pragma Inline (Set_Array_Aggregate);
pragma Inline (Set_Assignment_OK);
+ pragma Inline (Set_Associated_Node);
pragma Inline (Set_At_End_Proc);
pragma Inline (Set_Attribute_Name);
pragma Inline (Set_Aux_Decls_Node);
*** sinfo.ads 2001/10/07 15:19:42 1.432
--- sinfo.ads 2001/10/08 13:28:35 1.433
***************
*** 569,578 ****
-- (e.g. where the type involved is limited).
-- Associated_Node (Node4-Sem)
! -- Present in all nodes that have an Entity field, and also in
! -- N_Aggregate, N_Selected_Component, and N_Extension_Aggregate nodes.
! -- This field is used during generic processing to relate nodes in the
! -- template to nodes in the instantiation. It overlaps the Entity field,
-- see description in Sem_Ch12 for further details on this usage.
-- At_End_Proc (Node1)
--- 569,581 ----
-- (e.g. where the type involved is limited).
-- Associated_Node (Node4-Sem)
! -- Present in nodes that can denote an entity: identifiers, character
! -- literals and expanded names, operator nodes that carry an entity
! -- reference, and also in N_Aggregate, N_Selected_Component, and
! -- N_Extension_Aggregate nodes. This field is used during generic
! -- processing to relate nodes in the original template to nodes in the
! -- generic copy. It overlaps the Entity field, and is used to capture
! -- global references in the analyzed copy and place them in the template.
-- see description in Sem_Ch12 for further details on this usage.
-- At_End_Proc (Node1)
*** sem_ch12.adb 2001/10/04 14:13:22 1.783
--- sem_ch12.adb 2001/10/06 19:42:45 1.784
***************
*** 75,84 ****
package body Sem_Ch12 is
- use Atree.Unchecked_Access;
- -- This package performs untyped traversals of the tree, therefore it
- -- needs direct access to the fields of a node.
-
----------------------------------------------------------
-- Implementation of Generic Analysis and Instantiation --
-----------------------------------------------------------
--- 75,80 ----
***************
*** 526,547 ****
-- Add the context clause of the unit containing a generic unit to
-- an instantiation that is a compilation unit.
! function Associated_Node (N : Node_Id) return Node_Id;
-- In order to propagate semantic information back from the analyzed
-- copy to the original generic, we maintain links between selected nodes
-- in the generic and their corresponding copies. At the end of generic
-- analysis, the routine Save_Global_References traverses the generic
-- tree, examines the semantic information, and preserves the links to
-- those nodes that contain global information. At instantiation, the
! -- information from the associated node is placed on the new copy, so that
! -- name resolution is not repeated.
! -- Two kinds of nodes have associated nodes:
! -- a) those that contain entities, that is to say identifiers, expanded_
! -- names, and operators.
! -- b) aggregates.
-- For the first class, the associated node preserves the entity if it is
-- global. If the generic contains nested instantiations, the associated_
-- node itself has been recopied, and a chain of them must be followed.
--- 522,546 ----
-- Add the context clause of the unit containing a generic unit to
-- an instantiation that is a compilation unit.
! function Get_Associated_Node (N : Node_Id) return Node_Id;
-- In order to propagate semantic information back from the analyzed
-- copy to the original generic, we maintain links between selected nodes
-- in the generic and their corresponding copies. At the end of generic
-- analysis, the routine Save_Global_References traverses the generic
-- tree, examines the semantic information, and preserves the links to
-- those nodes that contain global information. At instantiation, the
! -- 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:
! -- a) those that contain entities, that is to say identifiers,
! -- expanded_names, and operators (N_Has_Entity)
! -- b) aggregates (N_Aggregate and N_Extension_Aggregate)
+ -- c) selected components (N_Selected_Component)
+
-- For the first class, the associated node preserves the entity if it is
-- global. If the generic contains nested instantiations, the associated_
-- node itself has been recopied, and a chain of them must be followed.
***************
*** 554,561 ****
-- some of the ancestor types, if their view is private at the point of
-- instantiation.
! -- The associated node is stored in Node4, using this field as a free
! -- union in a fashion that should clearly be under control of sinfo ???
procedure Move_Freeze_Nodes
(Out_Of : Entity_Id;
--- 553,565 ----
-- 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 ???
!
! -- The associated node is stored in the Associated_Node field. Note that
! -- this field overlaps Entity, which is fine, because the whole point is
! -- that we don't need or want the normal Entity field in this situation.
procedure Move_Freeze_Nodes
(Out_Of : Entity_Id;
***************
*** 573,584 ****
-- before installing parents of generics, that are not visible for the
-- actuals themselves.
- procedure Set_Associated_Node
- (Gen_Node : Node_Id;
- Copy_Node : Node_Id);
- -- Establish the link between an identifier in the generic unit, and the
- -- corresponding node in the semantic copy.
-
procedure Valid_Default_Attribute (Nam : Entity_Id; Def : Node_Id);
-- Verify that an attribute that appears as the default for a formal
-- subprogram is a function or procedure with the correct profile.
--- 577,582 ----
***************
*** 3224,3236 ****
end if;
end Analyze_Subprogram_Instantiation;
! ---------------------
! -- Associated_Node --
! ---------------------
! function Associated_Node (N : Node_Id) return Node_Id is
! Assoc : Node_Id := Node4 (N);
! -- ??? what is Node4 being used for here?
begin
if Nkind (Assoc) /= Nkind (N) then
--- 3222,3233 ----
end if;
end Analyze_Subprogram_Instantiation;
! -------------------------
! -- Get_Associated_Node --
! -------------------------
! function Get_Associated_Node (N : Node_Id) return Node_Id is
! Assoc : Node_Id := Associated_Node (N);
begin
if Nkind (Assoc) /= Nkind (N) then
***************
*** 3242,3274 ****
return Assoc;
else
-- If the node is part of an inner generic, it may itself have been
! -- remapped into a further generic copy. Node4 is otherwise used for
! -- the entity of the node, and will be of a different node kind, or
! -- else N has been rewritten as a literal or function call.
! while Present (Node4 (Assoc))
! and then Nkind (Node4 (Assoc)) = Nkind (Assoc)
loop
! Assoc := Node4 (Assoc);
end loop;
-- Follow and additional link in case the final node was rewritten.
-- This can only happen with nested generic units.
if (Nkind (Assoc) = N_Identifier or else Nkind (Assoc) in N_Op)
! and then Present (Node4 (Assoc))
! and then (Nkind (Node4 (Assoc)) = N_Function_Call
! or else Nkind (Node4 (Assoc)) = N_Explicit_Dereference
! or else Nkind (Node4 (Assoc)) = N_Integer_Literal
! or else Nkind (Node4 (Assoc)) = N_Real_Literal
! or else Nkind (Node4 (Assoc)) = N_String_Literal)
then
! Assoc := Node4 (Assoc);
end if;
return Assoc;
end if;
! end Associated_Node;
-------------------------------------------
-- Build_Instance_Compilation_Unit_Nodes --
--- 3239,3275 ----
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
! -- used for the entity of the node, and will be of a different node
! -- kind, or else N has been rewritten as a literal or function call.
! while Present (Associated_Node (Assoc))
! and then Nkind (Associated_Node (Assoc)) = Nkind (Assoc)
loop
! Assoc := Associated_Node (Assoc);
end loop;
-- Follow and additional link in case the final node was rewritten.
-- This can only happen with nested generic units.
if (Nkind (Assoc) = N_Identifier or else Nkind (Assoc) in N_Op)
! and then Present (Associated_Node (Assoc))
! and then (Nkind (Associated_Node (Assoc)) = N_Function_Call
! or else
! Nkind (Associated_Node (Assoc)) = N_Explicit_Dereference
! or else
! Nkind (Associated_Node (Assoc)) = N_Integer_Literal
! or else
! Nkind (Associated_Node (Assoc)) = N_Real_Literal
! or else
! Nkind (Associated_Node (Assoc)) = N_String_Literal)
then
! Assoc := Associated_Node (Assoc);
end if;
return Assoc;
end if;
! end Get_Associated_Node;
-------------------------------------------
-- Build_Instance_Compilation_Unit_Nodes --
***************
*** 4027,4033 ****
elsif Has_Private_View (N)
and then not Is_Private_Type (T)
and then not Has_Been_Exchanged (T)
! and then Etype (Associated_Node (N)) /= T
then
-- Only the private declaration was visible in the generic. If
-- the type appears in a subtype declaration, the subtype in the
--- 4028,4034 ----
elsif Has_Private_View (N)
and then not Is_Private_Type (T)
and then not Has_Been_Exchanged (T)
! and then Etype (Get_Associated_Node (N)) /= T
then
-- Only the private declaration was visible in the generic. If
-- the type appears in a subtype declaration, the subtype in the
***************
*** 4046,4052 ****
or else not In_Private_Part (Scope (Base_Type (T)))
then
Append_Elmt (T, Exchanged_Views);
! Exchange_Declarations (Etype (Associated_Node (N)));
end if;
-- For composite types with inconsistent representation
--- 4047,4053 ----
or else not In_Private_Part (Scope (Base_Type (T)))
then
Append_Elmt (T, Exchanged_Views);
! Exchange_Declarations (Etype (Get_Associated_Node (N)));
end if;
-- For composite types with inconsistent representation
***************
*** 4200,4205 ****
--- 4201,4211 ----
-----------------------
procedure Copy_Descendants 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
Set_Field1 (New_N, Copy_Generic_Descendant (Field1 (N)));
Set_Field2 (New_N, Copy_Generic_Descendant (Field2 (N)));
***************
*** 4381,4393 ****
-- If the associated node is still defined, the entity in
-- it is global, and must be copied to the instance.
! if Present (Associated_Node (N)) then
! if Nkind (Associated_Node (N)) = Nkind (N) then
! Set_Entity (New_N, Entity (Associated_Node (N)));
Check_Private_View (N);
! elsif Nkind (Associated_Node (N)) = N_Function_Call then
! Set_Entity (New_N, Entity (Name (Associated_Node (N))));
else
Set_Entity (New_N, Empty);
--- 4387,4399 ----
-- If the associated node is still defined, the entity in
-- it is global, and must be copied to the instance.
! if Present (Get_Associated_Node (N)) then
! if Nkind (Get_Associated_Node (N)) = Nkind (N) then
! Set_Entity (New_N, Entity (Get_Associated_Node (N)));
Check_Private_View (N);
! elsif Nkind (Get_Associated_Node (N)) = N_Function_Call then
! Set_Entity (New_N, Entity (Name (Get_Associated_Node (N))));
else
Set_Entity (New_N, Empty);
***************
*** 4570,4577 ****
Set_Associated_Node (N, New_N);
else
! if Present (Associated_Node (N))
! and then Nkind (Associated_Node (N)) = Nkind (N)
then
-- In the generic the aggregate has some composite type.
-- If at the point of instantiation the type has a private
--- 4576,4583 ----
Set_Associated_Node (N, New_N);
else
! if Present (Get_Associated_Node (N))
! and then Nkind (Get_Associated_Node (N)) = Nkind (N)
then
-- In the generic the aggregate has some composite type.
-- If at the point of instantiation the type has a private
***************
*** 4579,4585 ****
-- if any).
declare
! T : Entity_Id := (Etype (Associated_Node (New_N)));
Rt : Entity_Id;
begin
--- 4585,4591 ----
-- if any).
declare
! T : Entity_Id := (Etype (Get_Associated_Node (New_N)));
Rt : Entity_Id;
begin
***************
*** 4612,4622 ****
-- Do not copy the associated node, which points to
-- the generic copy of the aggregate.
! Set_Field1 (New_N, Copy_Generic_Descendant (Field1 (N)));
! Set_Field2 (New_N, Copy_Generic_Descendant (Field2 (N)));
! Set_Field3 (New_N, Copy_Generic_Descendant (Field3 (N)));
! Set_Field5 (New_N, Copy_Generic_Descendant (Field5 (N)));
-- Allocators do not have an identifier denoting the access type,
-- so we must locate it through the expression to check whether
-- the views are consistent.
--- 4618,4635 ----
-- Do not copy the associated node, which points to
-- the generic copy of the aggregate.
! declare
! 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
+ Set_Field1 (New_N, Copy_Generic_Descendant (Field1 (N)));
+ Set_Field2 (New_N, Copy_Generic_Descendant (Field2 (N)));
+ Set_Field3 (New_N, Copy_Generic_Descendant (Field3 (N)));
+ Set_Field5 (New_N, Copy_Generic_Descendant (Field5 (N)));
+ end;
+
-- Allocators do not have an identifier denoting the access type,
-- so we must locate it through the expression to check whether
-- the views are consistent.
***************
*** 4626,4633 ****
and then Instantiating
then
declare
! T : Node_Id := Associated_Node (Subtype_Mark (Expression (N)));
! Acc_T : Entity_Id;
begin
if Present (T) then
--- 4639,4646 ----
and then Instantiating
then
declare
! T : Node_Id := Get_Associated_Node (Subtype_Mark (Expression (N)));
! Acc_T : Entity_Id;
begin
if Present (T) then
***************
*** 8180,8185 ****
--- 8193,8204 ----
-- 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.
***************
*** 8249,8254 ****
--- 8268,8277 ----
-- The type of N2 is global to the generic unit. Save the
-- type in the generic node.
+ ---------------------
+ -- Set_Global_Type --
+ ---------------------
+
procedure Set_Global_Type (N : Node_Id; N2 : Node_Id) is
Typ : constant Entity_Id := Etype (N2);
***************
*** 8296,8302 ****
-- Start of processing for Reset_Entity
begin
! N2 := Associated_Node (N);
E := Entity (N2);
if Present (E) then
--- 8319,8325 ----
-- Start of processing for Reset_Entity
begin
! N2 := Get_Associated_Node (N);
E := Entity (N2);
if Present (E) then
***************
*** 8336,8345 ****
Change_Selected_Component_To_Expanded_Name (Parent (N));
Set_Associated_Node (Parent (N), Parent (N2));
Set_Global_Type (Parent (N), Parent (N2));
- Save_Global_Descendant (Field2 (N));
- Save_Global_Descendant (Field3 (N));
-
-- If this is a reference to the current generic entity,
-- replace it with a simple name. This is to avoid anomalies
-- when the enclosing scope is also a generic unit, in which
--- 8359,8366 ----
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);
-- If this is a reference to the current generic entity,
-- replace it with a simple name. This is to avoid anomalies
-- when the enclosing scope is also a generic unit, in which
***************
*** 8377,8383 ****
New_Copy (Parent (N2)));
Set_Analyzed (Parent (N), False);
! -- a selected component may be transformed into a parameterless
-- function call. If the called entity is global, rewrite the
-- node appropriately, i.e. as an extended name for the global
-- entity.
--- 8398,8404 ----
New_Copy (Parent (N2)));
Set_Analyzed (Parent (N), False);
! -- A selected component may be transformed into a parameterless
-- function call. If the called entity is global, rewrite the
-- node appropriately, i.e. as an extended name for the global
-- entity.
***************
*** 8389,8397 ****
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_Descendant (Field2 (N));
! Save_Global_Descendant (Field3 (N));
else
-- Entity is local. Reset in generic unit, so that node
--- 8410,8416 ----
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);
else
-- Entity is local. Reset in generic unit, so that node
***************
*** 8570,8575 ****
--- 8589,8609 ----
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 --
---------------------
***************
*** 8590,8621 ****
elsif (Nkind (N) = N_Character_Literal
or else Nkind (N) = N_Operator_Symbol)
then
! if Nkind (N) = Nkind (Associated_Node (N)) then
Reset_Entity (N);
elsif Nkind (N) = N_Operator_Symbol
! and then Nkind (Associated_Node (N)) = N_String_Literal
then
Change_Operator_Symbol_To_String_Literal (N);
end if;
elsif Nkind (N) in N_Op then
! if Nkind (N) = Nkind (Associated_Node (N)) then
if Nkind (N) = N_Op_Concat then
Set_Is_Component_Left_Opnd (N,
! Is_Component_Left_Opnd (Associated_Node (N)));
Set_Is_Component_Right_Opnd (N,
! Is_Component_Right_Opnd (Associated_Node (N)));
end if;
Reset_Entity (N);
else
-- Node may be transformed into call to a user-defined operator
! N2 := Associated_Node (N);
if Nkind (N2) = N_Function_Call then
E := Entity (Name (N2));
--- 8624,8655 ----
elsif (Nkind (N) = N_Character_Literal
or else Nkind (N) = N_Operator_Symbol)
then
! if Nkind (N) = Nkind (Get_Associated_Node (N)) then
Reset_Entity (N);
elsif Nkind (N) = N_Operator_Symbol
! and then Nkind (Get_Associated_Node (N)) = N_String_Literal
then
Change_Operator_Symbol_To_String_Literal (N);
end if;
elsif Nkind (N) in N_Op then
! if Nkind (N) = Nkind (Get_Associated_Node (N)) then
if Nkind (N) = N_Op_Concat then
Set_Is_Component_Left_Opnd (N,
! Is_Component_Left_Opnd (Get_Associated_Node (N)));
Set_Is_Component_Right_Opnd (N,
! Is_Component_Right_Opnd (Get_Associated_Node (N)));
end if;
Reset_Entity (N);
else
-- Node may be transformed into call to a user-defined operator
! N2 := Get_Associated_Node (N);
if Nkind (N2) = N_Function_Call then
E := Entity (Name (N2));
***************
*** 8658,8681 ****
end if;
end if;
! -- Complete the check on operands.
! Save_Global_Descendant (Field2 (N));
! Save_Global_Descendant (Field3 (N));
elsif Nkind (N) = N_Identifier then
! if Nkind (N) = Nkind (Associated_Node (N)) then
-- If this is a discriminant reference, always save it.
-- It is used in the instance to find the corresponding
-- discriminant positionally rather than by name.
Set_Original_Discriminant
! (N, Original_Discriminant (Associated_Node (N)));
Reset_Entity (N);
else
! N2 := Associated_Node (N);
if Nkind (N2) = N_Function_Call then
E := Entity (Name (N2));
--- 8692,8714 ----
end if;
end if;
! -- Complete the check on operands
! Save_Global_Operand_Descendants (N);
elsif Nkind (N) = N_Identifier then
! if Nkind (N) = Nkind (Get_Associated_Node (N)) then
-- If this is a discriminant reference, always save it.
-- It is used in the instance to find the corresponding
-- discriminant positionally rather than by name.
Set_Original_Discriminant
! (N, Original_Discriminant (Get_Associated_Node (N)));
Reset_Entity (N);
else
! N2 := Get_Associated_Node (N);
if Nkind (N2) = N_Function_Call then
E := Entity (Name (N2));
***************
*** 8759,8787 ****
elsif Nkind (N) in N_Entity then
null;
! elsif Nkind (N) = N_Aggregate
! or else Nkind (N) = N_Extension_Aggregate
! then
! N2 := Associated_Node (N);
! if No (N2)
! or else No (Etype (N2))
! or else not Is_Global (Etype (N2))
! then
! Set_Associated_Node (N, Empty);
! end if;
! Save_Global_Descendant (Field1 (N));
! Save_Global_Descendant (Field2 (N));
! Save_Global_Descendant (Field3 (N));
! Save_Global_Descendant (Field5 (N));
! else
! Save_Global_Descendant (Field1 (N));
! Save_Global_Descendant (Field2 (N));
! Save_Global_Descendant (Field3 (N));
! Save_Global_Descendant (Field4 (N));
! Save_Global_Descendant (Field5 (N));
end if;
end Save_References;
--- 8792,8832 ----
elsif Nkind (N) in N_Entity then
null;
! else
! declare
! use Atree.Unchecked_Access;
! -- This code section is part of implementing an untyped tree
! -- traversal, so it needs direct access to node fields.
! begin
! if Nkind (N) = N_Aggregate
! or else
! Nkind (N) = N_Extension_Aggregate
! then
! N2 := Get_Associated_Node (N);
! if No (N2)
! or else No (Etype (N2))
! or else not Is_Global (Etype (N2))
! then
! Set_Associated_Node (N, Empty);
! end if;
!
! Save_Global_Descendant (Field1 (N));
! Save_Global_Descendant (Field2 (N));
! Save_Global_Descendant (Field3 (N));
! Save_Global_Descendant (Field5 (N));
+ -- All other cases than aggregates
+
+ else
+ Save_Global_Descendant (Field1 (N));
+ Save_Global_Descendant (Field2 (N));
+ Save_Global_Descendant (Field3 (N));
+ Save_Global_Descendant (Field4 (N));
+ Save_Global_Descendant (Field5 (N));
+ end if;
+ end;
end if;
end Save_References;
***************
*** 8802,8821 ****
Save_References (N);
end Save_Global_References;
-
- -------------------------
- -- Set_Associated_Node --
- -------------------------
-
- -- Note from RBKD: the uncommented use of Set_Node4 below is ugly ???
-
- procedure Set_Associated_Node
- (Gen_Node : Node_Id;
- Copy_Node : Node_Id)
- is
- begin
- Set_Node4 (Gen_Node, Copy_Node);
- end Set_Associated_Node;
---------------------
-- Set_Copied_Sloc --
--- 8847,8852 ----