-- --
-- B o d y --
-- --
--- Copyright (C) 1998-2013, Free Software Foundation, Inc. --
+-- Copyright (C) 1998-2020, 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- --
with Csets; use Csets;
with Elists; use Elists;
with Errout; use Errout;
+with Lib.Util; use Lib.Util;
with Nlists; use Nlists;
with Opt; use Opt;
with Restrict; use Restrict;
-- Declarations --
------------------
+ package Deferred_References is new Table.Table (
+ Table_Component_Type => Deferred_Reference_Entry,
+ Table_Index_Type => Int,
+ Table_Low_Bound => 0,
+ Table_Initial => 512,
+ Table_Increment => 200,
+ Table_Name => "Name_Deferred_References");
+
-- The Xref table is used to record references. The Loc field is set
-- to No_Location for a definition entry.
Loc : Source_Ptr;
-- Location of reference (Original_Location (Sloc field of N parameter
- -- to Generate_Reference). Set to No_Location for the case of a
+ -- to Generate_Reference)). Set to No_Location for the case of a
-- defining occurrence.
Typ : Character;
Set_Has_Xref_Entry (Key.Ent);
- -- It was already in Xref_Set, so throw away the tentatively-added
- -- entry
+ -- It was already in Xref_Set, so throw away the tentatively-added entry
else
Xrefs.Decrement_Last;
end if;
end Add_Entry;
+ ---------------------
+ -- Defer_Reference --
+ ---------------------
+
+ procedure Defer_Reference (Deferred_Reference : Deferred_Reference_Entry) is
+ begin
+ -- If Get_Ignore_Errors, then we are in Preanalyze_Without_Errors, and
+ -- we should not record cross references, because that will cause
+ -- duplicates when we call Analyze.
+
+ if not Get_Ignore_Errors then
+ Deferred_References.Append (Deferred_Reference);
+ end if;
+ end Defer_Reference;
+
-----------
-- Equal --
-----------
Set_Ref : Boolean := True;
Force : Boolean := False)
is
- Actual_Typ : Character := Typ;
- Call : Node_Id;
- Def : Source_Ptr;
- Ent : Entity_Id;
- Ent_Scope : Entity_Id;
- Formal : Entity_Id;
- Kind : Entity_Kind;
- Nod : Node_Id;
- Ref : Source_Ptr;
- Ref_Scope : Entity_Id;
+ Actual_Typ : Character := Typ;
+ Call : Node_Id;
+ Def : Source_Ptr;
+ Ent : Entity_Id;
+ Ent_Scope : Entity_Id;
+ Formal : Entity_Id;
+ Kind : Entity_Kind;
+ Nod : Node_Id;
+ Ref : Source_Ptr;
+ Ref_Scope : Entity_Id;
function Get_Through_Renamings (E : Entity_Id) return Entity_Id;
-- Get the enclosing entity through renamings, which may come from
---------------------------
function Get_Through_Renamings (E : Entity_Id) return Entity_Id is
- Result : Entity_Id := E;
begin
- while Present (Result)
- and then Is_Object (Result)
- and then Present (Renamed_Object (Result))
- loop
- Result := Get_Enclosing_Object (Renamed_Object (Result));
- end loop;
- return Result;
+ case Ekind (E) is
+
+ -- For subprograms we just need to check once if they are have a
+ -- Renamed_Entity, because Renamed_Entity is set transitively.
+
+ when Subprogram_Kind =>
+ declare
+ Renamed : constant Entity_Id := Renamed_Entity (E);
+
+ begin
+ if Present (Renamed) then
+ return Renamed;
+ else
+ return E;
+ end if;
+ end;
+
+ -- For objects we need to repeatedly call Renamed_Object, because
+ -- it is not transitive.
+
+ when Object_Kind =>
+ declare
+ Obj : Entity_Id := E;
+
+ begin
+ loop
+ pragma Assert (Present (Obj));
+
+ declare
+ Renamed : constant Entity_Id := Renamed_Object (Obj);
+
+ begin
+ if Present (Renamed) then
+ Obj := Get_Enclosing_Object (Renamed);
+
+ -- The renamed expression denotes a non-object,
+ -- e.g. function call, slicing of a function call,
+ -- pointer dereference, etc.
+
+ if No (Obj) then
+ return Empty;
+ end if;
+ else
+ return Obj;
+ end if;
+ end;
+ end loop;
+ end;
+
+ when others =>
+ return E;
+
+ end case;
end Get_Through_Renamings;
---------------
-- ??? There are several routines here and there that perform a similar
-- (but subtly different) computation, which should be factored:
+ -- Sem_Util.Is_LHS
-- Sem_Util.May_Be_Lvalue
-- Sem_Util.Known_To_Be_Assigned
-- Exp_Ch2.Expand_Entry_Parameter.In_Assignment_Context
-- ??? case of a slice assignment?
- -- ??? Note that in some cases this is called too early
- -- (see comments in Sem_Ch8.Find_Direct_Name), at a point where
- -- the tree is not fully typed yet. In that case we may lack
- -- an Etype for N, and we must disable the check for an implicit
- -- dereference. If the dereference is on an LHS, this causes a
- -- false positive.
-
elsif (K = N_Selected_Component or else K = N_Indexed_Component)
and then Prefix (P) = N
- and then not (Present (Etype (N))
- and then
- Is_Access_Type (Etype (N)))
then
- N := P;
+ -- Check for access type. First a special test, In some cases
+ -- this is called too early (see comments in Find_Direct_Name),
+ -- at a point where the tree is not fully typed yet. In that
+ -- case we may lack an Etype for N, and we can't check the
+ -- Etype. For now, we always return False in such a case,
+ -- but this is clearly not right in all cases ???
+
+ if No (Etype (N)) then
+ return False;
+
+ elsif Is_Access_Type (Etype (N)) then
+ return False;
+
+ -- Access type case dealt with, keep going
+
+ else
+ N := P;
+ end if;
-- All other cases, definitely not on left side
P := Parent (P);
if Nkind (P) = N_Pragma then
- if Nam_In (Pragma_Name (P), Name_Warnings,
- Name_Unmodified,
- Name_Unreferenced)
+ if Pragma_Name_Unmapped (P) in Name_Warnings
+ | Name_Unmodified
+ | Name_Unreferenced
then
return False;
end if;
-- Start of processing for Generate_Reference
begin
- pragma Assert (Nkind (E) in N_Entity);
+ -- If Get_Ignore_Errors, then we are in Preanalyze_Without_Errors, and
+ -- we should not record cross references, because that will cause
+ -- duplicates when we call Analyze.
+
+ if Get_Ignore_Errors then
+ return;
+ end if;
+
+ -- May happen in case of severe errors
+
+ if Nkind (E) not in N_Entity then
+ return;
+ end if;
+
Find_Actual (N, Formal, Call);
if Present (Formal) then
-- Do not generate references if we are within a postcondition sub-
-- program, because the reference does not comes from source, and the
- -- pre-analysis of the aspect has already created an entry for the ali
+ -- preanalysis of the aspect has already created an entry for the ALI
-- file at the proper source location.
if Chars (Current_Scope) = Name_uPostconditions then
-- For the same reason we accept an implicit reference generated for
-- a default in an instance.
+ -- We also set the referenced flag in a generic package that is not in
+ -- then main source unit, when the variable is of a formal private type,
+ -- to warn in the instance if the corresponding type is not a fully
+ -- initialized type.
+
if not In_Extended_Main_Source_Unit (N) then
- if Typ = 'e'
- or else Typ = 'I'
- or else Typ = 'p'
- or else Typ = 'i'
- or else Typ = 'k'
+ if Typ = 'e' or else
+ Typ = 'I' or else
+ Typ = 'p' or else
+ Typ = 'i' or else
+ Typ = 'k'
or else (Typ = 'b' and then Is_Generic_Instance (E))
-- Allow the generation of references to reads, writes and calls
and then (Typ = 'm' or else Typ = 'r' or else Typ = 's'))
then
null;
+
+ elsif In_Instance_Body
+ and then In_Extended_Main_Code_Unit (N)
+ and then Is_Generic_Type (Etype (E))
+ then
+ Set_Referenced (E);
+ return;
+
+ elsif Inside_A_Generic
+ and then Is_Generic_Type (Etype (E))
+ then
+ Set_Referenced (E);
+ return;
+
else
return;
end if;
-- Check for pragma Unreferenced given and reference is within
-- this source unit (occasion for possible warning to be issued).
+ -- Note that the entity may be marked as unreferenced by pragma
+ -- Unused.
if Has_Unreferenced (E)
and then In_Same_Extended_Unit (E, N)
then
- -- A reference as a named parameter in a call does not count
- -- as a violation of pragma Unreferenced for this purpose...
+ -- A reference as a named parameter in a call does not count as a
+ -- violation of pragma Unreferenced for this purpose...
if Nkind (N) = N_Identifier
and then Nkind (Parent (N)) = N_Parameter_Association
then
null;
- -- ... Neither does a reference to a variable on the left side
- -- of an assignment.
+ -- ... Neither does a reference to a variable on the left side of
+ -- an assignment.
elsif Is_On_LHS (N) then
null;
+ -- Do not consider F'Result as a violation of pragma Unreferenced
+ -- since the attribute acts as an anonymous alias of the function
+ -- result and not as a real reference to the function.
+
+ elsif Ekind (E) in E_Function | E_Generic_Function
+ and then Is_Entity_Name (N)
+ and then Is_Attribute_Result (Parent (N))
+ then
+ null;
+
+ -- No warning if the reference is in a call that does not come
+ -- from source (e.g. a call to a controlled type primitive).
+
+ elsif not Comes_From_Source (Parent (N))
+ and then Nkind (Parent (N)) = N_Procedure_Call_Statement
+ then
+ null;
+
-- For entry formals, we want to place the warning message on the
-- corresponding entity in the accept statement. The current scope
-- is the body of the accept, so we find the formal whose name
BE := First_Entity (Current_Scope);
while Present (BE) loop
if Chars (BE) = Chars (E) then
- Error_Msg_NE -- CODEFIX
- ("??pragma Unreferenced given for&!", N, BE);
+ if Has_Pragma_Unused (E) then
+ Error_Msg_NE -- CODEFIX
+ ("??pragma Unused given for&!", N, BE);
+ else
+ Error_Msg_NE -- CODEFIX
+ ("??pragma Unreferenced given for&!", N, BE);
+ end if;
exit;
end if;
-- Here we issue the warning, since this is a real reference
+ elsif Has_Pragma_Unused (E) then
+ Error_Msg_NE -- CODEFIX
+ ("??pragma Unused given for&!", N, E);
else
Error_Msg_NE -- CODEFIX
- ("?pragma Unreferenced given for&!", N, E);
+ ("??pragma Unreferenced given for&!", N, E);
end if;
end if;
and then Typ /= ' '
then
- if Nkind_In (N, N_Identifier,
- N_Defining_Identifier,
- N_Defining_Operator_Symbol,
- N_Operator_Symbol,
- N_Defining_Character_Literal)
- or else Nkind (N) in N_Op
+ if Nkind (N) in N_Identifier
+ | N_Defining_Identifier
+ | N_Defining_Operator_Symbol
+ | N_Operator_Symbol
+ | N_Defining_Character_Literal
+ | N_Op
or else (Nkind (N) = N_Character_Literal
and then Sloc (Entity (N)) /= Standard_Location)
then
Nod := N;
- elsif Nkind_In (N, N_Expanded_Name, N_Selected_Component) then
+ elsif Nkind (N) in N_Expanded_Name | N_Selected_Component then
Nod := Selector_Name (N);
else
if Comes_From_Source (E) then
Ent := E;
+ -- Because a declaration may be generated for a subprogram body
+ -- without declaration in GNATprove mode, for inlining, some
+ -- parameters may end up being marked as not coming from source
+ -- although they are. Take these into account specially.
+
+ elsif GNATprove_Mode and then Is_Formal (E) then
+ Ent := E;
+
-- Entity does not come from source, but is a derived subprogram and
-- the derived subprogram comes from source (after one or more
-- derivations) in which case the reference is to parent subprogram.
-- original discriminant, which gets the reference.
elsif Ekind (E) = E_In_Parameter
- and then Present (Discriminal_Link (E))
+ and then Present (Discriminal_Link (E))
then
Ent := Discriminal_Link (E);
Set_Referenced (Ent);
-- Comment needed here for special SPARK code ???
if GNATprove_Mode then
+
+ -- Ignore references to an entity which is a Part_Of single
+ -- concurrent object. Ideally we would prefer to add it as a
+ -- reference to the corresponding concurrent type, but it is quite
+ -- difficult (as such references are not currently added even for)
+ -- reads/writes of private protected components) and not worth the
+ -- effort.
+
+ if Ekind (Ent) in E_Abstract_State | E_Constant | E_Variable
+ and then Present (Encapsulating_State (Ent))
+ and then Is_Single_Concurrent_Object (Encapsulating_State (Ent))
+ then
+ return;
+ end if;
+
Ref := Sloc (Nod);
Def := Sloc (Ent);
- Ref_Scope := SPARK_Specific.Enclosing_Subprogram_Or_Package (Nod);
- Ent_Scope := SPARK_Specific.Enclosing_Subprogram_Or_Package (Ent);
+ Ref_Scope :=
+ SPARK_Specific.Enclosing_Subprogram_Or_Library_Package (Nod);
+ Ent_Scope :=
+ SPARK_Specific.Enclosing_Subprogram_Or_Library_Package (Ent);
-- Since we are reaching through renamings in SPARK mode, we may
-- end up with standard constants. Ignore those.
end if;
Add_Entry
- ((Ent => Ent,
+ ((Ent => Ent,
Loc => Ref,
Typ => Actual_Typ,
- Eun => Get_Code_Unit (Def),
- Lun => Get_Code_Unit (Ref),
+ Eun => Get_Top_Level_Code_Unit (Def),
+ Lun => Get_Top_Level_Code_Unit (Ref),
Ref_Scope => Ref_Scope,
Ent_Scope => Ent_Scope),
- Ent_Scope_File => Get_Code_Unit (Ent));
+ Ent_Scope_File => Get_Top_Level_Code_Unit (Ent));
else
Ref := Original_Location (Sloc (Nod));
end if;
Add_Entry
- ((Ent => Ent,
+ ((Ent => Ent,
Loc => Ref,
Typ => Actual_Typ,
Eun => Get_Source_Unit (Def),
Ref_Scope => Empty,
Ent_Scope => Empty),
Ent_Scope_File => No_Unit);
+
+ -- Generate reference to the first private entity
+
+ if Typ = 'e'
+ and then Comes_From_Source (E)
+ and then Nkind (Ent) = N_Defining_Identifier
+ and then (Is_Package_Or_Generic_Package (Ent)
+ or else Is_Concurrent_Type (Ent))
+ and then Present (First_Private_Entity (E))
+ and then In_Extended_Main_Source_Unit (N)
+ then
+ -- Handle case in which the full-view and partial-view of the
+ -- first private entity are swapped.
+
+ declare
+ First_Private : Entity_Id := First_Private_Entity (E);
+
+ begin
+ if Is_Private_Type (First_Private)
+ and then Present (Full_View (First_Private))
+ then
+ First_Private := Full_View (First_Private);
+ end if;
+
+ Add_Entry
+ ((Ent => Ent,
+ Loc => Sloc (First_Private),
+ Typ => 'E',
+ Eun => Get_Source_Unit (Def),
+ Lun => Get_Source_Unit (Ref),
+ Ref_Scope => Empty,
+ Ent_Scope => Empty),
+ Ent_Scope_File => No_Unit);
+ end;
+ end if;
end if;
end if;
end Generate_Reference;
while Present (Formal) loop
if Ekind (Formal) = E_In_Parameter then
- if Nkind (Parameter_Type (Parent (Formal)))
- = N_Access_Definition
+ if Nkind (Parameter_Type (Parent (Formal))) = N_Access_Definition
then
Generate_Reference (E, Formal, '^', False);
else
return E;
end Get_Key;
+ ----------------------------
+ -- Has_Deferred_Reference --
+ ----------------------------
+
+ function Has_Deferred_Reference (Ent : Entity_Id) return Boolean is
+ begin
+ for J in Deferred_References.First .. Deferred_References.Last loop
+ if Deferred_References.Table (J).E = Ent then
+ return True;
+ end if;
+ end loop;
+
+ return False;
+ end Has_Deferred_Reference;
+
----------
-- Hash --
----------
-- initialized with a tag-indeterminate call gets a subtype
-- of the classwide type during expansion. See if the original
-- type in the declaration is named, and return it instead
- -- of going to the root type.
+ -- of going to the root type. The expression may be a class-
+ -- wide function call whose result is on the secondary stack,
+ -- which forces the declaration to be rewritten as a renaming,
+ -- so examine the source declaration.
- if Ekind (Tref) = E_Class_Wide_Subtype
- and then Nkind (Parent (Ent)) = N_Object_Declaration
- and then
- Nkind (Original_Node (Object_Definition (Parent (Ent))))
- = N_Identifier
+ if Ekind (Tref) = E_Class_Wide_Subtype then
+ declare
+ Decl : constant Node_Id := Original_Node (Parent (Ent));
+ begin
+ if Nkind (Decl) = N_Object_Declaration
+ and then Is_Entity_Name
+ (Original_Node (Object_Definition (Decl)))
+ then
+ Tref :=
+ Entity (Original_Node (Object_Definition (Decl)));
+ end if;
+ end;
+
+ -- For a function that returns a class-wide type, Tref is
+ -- already correct.
+
+ elsif Is_Overloadable (Ent)
+ and then Is_Class_Wide_Type (Tref)
then
- Tref :=
- Entity
- (Original_Node ((Object_Definition (Parent (Ent)))));
+ return;
end if;
-- For anything else, exit
begin
-- Generate language name from convention
- if Conv = Convention_C then
+ if Conv = Convention_C or else Conv in Convention_C_Variadic then
Language_Name := Name_C;
elsif Conv = Convention_CPP then
and then Sloc (E) > No_Location
then
Add_Entry
- ((Ent => E,
- Loc => No_Location,
- Typ => Character'First,
- Eun => Get_Source_Unit (Original_Location (Sloc (E))),
- Lun => No_Unit,
+ ((Ent => E,
+ Loc => No_Location,
+ Typ => Character'First,
+ Eun => Get_Source_Unit (Original_Location (Sloc (E))),
+ Lun => No_Unit,
Ref_Scope => Empty,
Ent_Scope => Empty),
Ent_Scope_File => No_Unit);
J := 1;
while J <= Xrefs.Last loop
Ent := Xrefs.Table (J).Key.Ent;
+
+ -- Do not generate reference information for an ignored Ghost
+ -- entity because neither the entity nor its references will
+ -- appear in the final tree.
+
+ if Is_Ignored_Ghost_Entity (Ent) then
+ goto Orphan_Continue;
+ end if;
+
Get_Type_Reference (Ent, Tref, L, R);
if Present (Tref)
if Present (Prim) then
Add_Entry
- ((Ent => Prim,
- Loc => No_Location,
- Typ => Character'First,
- Eun => Get_Source_Unit (Sloc (Prim)),
- Lun => No_Unit,
+ ((Ent => Prim,
+ Loc => No_Location,
+ Typ => Character'First,
+ Eun => Get_Source_Unit (Sloc (Prim)),
+ Lun => No_Unit,
Ref_Scope => Empty,
Ent_Scope => Empty),
Ent_Scope_File => No_Unit);
end;
end if;
+ <<Orphan_Continue>>
J := J + 1;
end loop;
end Handle_Orphan_Type_References;
- -- Now we have all the references, including those for any embedded
- -- type references, so we can sort them, and output them.
+ -- Now we have all the references, including those for any embedded type
+ -- references, so we can sort them, and output them.
Output_Refs : declare
-
Nrefs : constant Nat := Xrefs.Last;
-- Number of references in table
procedure Check_Type_Reference
(Ent : Entity_Id;
- List_Interface : Boolean);
+ List_Interface : Boolean;
+ Is_Component : Boolean := False);
-- Find whether there is a meaningful type reference for
-- Ent, and display it accordingly. If List_Interface is
-- true, then Ent is a progenitor interface of the current
-- type entity being listed. In that case list it as is,
- -- without looking for a type reference for it.
+ -- without looking for a type reference for it. Flag is also
+ -- used for index types of an array type, where the caller
+ -- supplies the intended type reference. Is_Component serves
+ -- the same purpose, to display the component type of a
+ -- derived array type, for which only the parent type has
+ -- ben displayed so far.
procedure Output_Instantiation_Refs (Loc : Source_Ptr);
-- Recursive procedure to output instantiation references for
procedure Check_Type_Reference
(Ent : Entity_Id;
- List_Interface : Boolean)
+ List_Interface : Boolean;
+ Is_Component : Boolean := False)
is
begin
if List_Interface then
Left := '<';
Right := '>';
+ -- The following is not documented in lib-xref.ads ???
+
+ elsif Is_Component then
+ Tref := Ent;
+ Left := '(';
+ Right := ')';
+
else
Get_Type_Reference (Ent, Tref, Left, Right);
end if;
begin
Ent := XE.Key.Ent;
+
+ -- Do not generate reference information for an ignored Ghost
+ -- entity because neither the entity nor its references will
+ -- appear in the final tree.
+
+ if Is_Ignored_Ghost_Entity (Ent) then
+ goto Continue;
+ end if;
+
Ctyp := Xref_Entity_Letters (Ekind (Ent));
-- Skip reference if it is the only reference to an entity,
-- Special handling for access parameters and objects and
-- components of an anonymous access type.
- if Ekind_In (Etype (XE.Key.Ent),
- E_Anonymous_Access_Type,
- E_Anonymous_Access_Subprogram_Type,
- E_Anonymous_Access_Protected_Subprogram_Type)
+ if Ekind (Etype (XE.Key.Ent)) in
+ E_Anonymous_Access_Type
+ | E_Anonymous_Access_Subprogram_Type
+ | E_Anonymous_Access_Protected_Subprogram_Type
then
if Is_Formal (XE.Key.Ent)
or else
- Ekind_In
- (XE.Key.Ent, E_Variable, E_Constant, E_Component)
+ Ekind (XE.Key.Ent) in
+ E_Variable | E_Constant | E_Component
then
Ctyp := 'p';
end if;
-- Write out information about generic parent, if entity
-- is an instance.
- if Is_Generic_Instance (XE.Key.Ent) then
+ if Is_Generic_Instance (XE.Key.Ent) then
declare
Gen_Par : constant Entity_Id :=
Generic_Parent
Check_Type_Reference (XE.Key.Ent, False);
- -- Additional information for types with progenitors
+ -- Additional information for types with progenitors,
+ -- including synchronized tagged types.
- if Is_Record_Type (XE.Key.Ent)
- and then Present (Interfaces (XE.Key.Ent))
- then
- declare
- Elmt : Elmt_Id :=
- First_Elmt (Interfaces (XE.Key.Ent));
- begin
- while Present (Elmt) loop
- Check_Type_Reference (Node (Elmt), True);
- Next_Elmt (Elmt);
- end loop;
- end;
+ declare
+ Typ : constant Entity_Id := XE.Key.Ent;
+ Elmt : Elmt_Id;
+
+ begin
+ if Is_Record_Type (Typ)
+ and then Present (Interfaces (Typ))
+ then
+ Elmt := First_Elmt (Interfaces (Typ));
+
+ elsif Is_Concurrent_Type (Typ)
+ and then Present (Corresponding_Record_Type (Typ))
+ and then Present (
+ Interfaces (Corresponding_Record_Type (Typ)))
+ then
+ Elmt :=
+ First_Elmt (
+ Interfaces (Corresponding_Record_Type (Typ)));
+
+ else
+ Elmt := No_Elmt;
+ end if;
+
+ while Present (Elmt) loop
+ Check_Type_Reference (Node (Elmt), True);
+ Next_Elmt (Elmt);
+ end loop;
+ end;
-- For array types, list index types as well. (This is
-- not C, indexes have distinct types).
- elsif Is_Array_Type (XE.Key.Ent) then
+ if Is_Array_Type (XE.Key.Ent) then
declare
+ A_Typ : constant Entity_Id := XE.Key.Ent;
Indx : Node_Id;
+
begin
+ -- If this is a derived array type, we have
+ -- output the parent type, so add the component
+ -- type now.
+
+ if Is_Derived_Type (A_Typ) then
+ Check_Type_Reference
+ (Component_Type (A_Typ), False, True);
+ end if;
+
+ -- Add references to index types.
+
Indx := First_Index (XE.Key.Ent);
while Present (Indx) loop
Check_Type_Reference
if XE.Key.Loc /= No_Location
and then
(XE.Key.Loc /= Crloc
- or else (Prevt = 'm' and then XE.Key.Typ = 'r'))
+ or else (Prevt = 'm' and then XE.Key.Typ = 'r'))
then
Crloc := XE.Key.Loc;
Prevt := XE.Key.Typ;
end Output_Refs;
end Output_References;
+ ---------------------------------
+ -- Process_Deferred_References --
+ ---------------------------------
+
+ procedure Process_Deferred_References is
+ begin
+ for J in Deferred_References.First .. Deferred_References.Last loop
+ declare
+ D : Deferred_Reference_Entry renames Deferred_References.Table (J);
+
+ begin
+ case Is_LHS (D.N) is
+ when Yes =>
+ Generate_Reference (D.E, D.N, 'm');
+
+ when No =>
+ Generate_Reference (D.E, D.N, 'r');
+
+ -- Not clear if Unknown can occur at this stage, but if it
+ -- does we will treat it as a normal reference.
+
+ when Unknown =>
+ Generate_Reference (D.E, D.N, 'r');
+ end case;
+ end;
+ end loop;
+
+ -- Clear processed entries from table
+
+ Deferred_References.Init;
+ end Process_Deferred_References;
+
-- Start of elaboration for Lib.Xref
begin
projects / gcc.git / blobdiff