with Atree; use Atree;
with Csets; use Csets;
with Elists; use Elists;
with Errout; use Errout;
with Lib.Util; use Lib.Util;
with Namet; use Namet;
with Nlists; use Nlists;
with Opt; use Opt;
with Restrict; use Restrict;
with Rident; use Rident;
with Sem_Prag; use Sem_Prag;
with Sem_Util; use Sem_Util;
with Sinfo; use Sinfo;
with Sinput; use Sinput;
with Snames; use Snames;
with Stringt; use Stringt;
with Stand; use Stand;
with Table; use Table;
with Widechar; use Widechar;
with GNAT.Heap_Sort_A;
package body Lib.Xref is
subtype Xref_Entry_Number is Int;
type Xref_Entry is record
Ent : Entity_Id;
Def : Source_Ptr;
Loc : Source_Ptr;
Typ : Character;
Eun : Unit_Number_Type;
Lun : Unit_Number_Type;
end record;
package Xrefs is new Table.Table (
Table_Component_Type => Xref_Entry,
Table_Index_Type => Xref_Entry_Number,
Table_Low_Bound => 1,
Table_Initial => Alloc.Xrefs_Initial,
Table_Increment => Alloc.Xrefs_Increment,
Table_Name => "Xrefs");
procedure Generate_Definition (E : Entity_Id) is
Loc : Source_Ptr;
Indx : Nat;
begin
pragma Assert (Nkind (E) in N_Entity);
if Opt.Xref_Active
and then Comes_From_Source (E)
and then Sloc (E) > No_Location
and then Instantiation_Location (Sloc (E)) = No_Location
and then In_Extended_Main_Source_Unit (E)
and then not Is_Internal_Name (Chars (E))
then
Xrefs.Increment_Last;
Indx := Xrefs.Last;
Loc := Original_Location (Sloc (E));
Xrefs.Table (Indx).Ent := E;
Xrefs.Table (Indx).Loc := No_Location;
Xrefs.Table (Indx).Eun := Get_Source_Unit (Loc);
Xrefs.Table (Indx).Lun := No_Unit;
Set_Has_Xref_Entry (E);
end if;
end Generate_Definition;
procedure Generate_Operator_Reference
(N : Node_Id;
T : Entity_Id)
is
begin
if not In_Extended_Main_Source_Unit (N) then
return;
end if;
if Sloc (Entity (N)) /= Standard_Location then
Generate_Reference (Entity (N), N);
if Nkind (N) = N_Op_Ne
and then not Comes_From_Source (Entity (N))
and then Present (Corresponding_Equality (Entity (N)))
then
Generate_Reference (Corresponding_Equality (Entity (N)), N);
end if;
elsif Comes_From_Source (N) then
Set_Referenced (First_Subtype (T));
end if;
end Generate_Operator_Reference;
procedure Generate_Reference
(E : Entity_Id;
N : Node_Id;
Typ : Character := 'r';
Set_Ref : Boolean := True;
Force : Boolean := False)
is
Indx : Nat;
Nod : Node_Id;
Ref : Source_Ptr;
Def : Source_Ptr;
Ent : Entity_Id;
function Is_On_LHS (Node : Node_Id) return Boolean;
function Is_On_LHS (Node : Node_Id) return Boolean is
N : Node_Id := Node;
begin
if Nkind (N) /= N_Identifier then
return False;
end if;
while Nkind (Parent (N)) /= N_Assignment_Statement loop
if (Nkind (Parent (N)) = N_Selected_Component
or else
Nkind (Parent (N)) = N_Indexed_Component)
and then Prefix (Parent (N)) = N
then
N := Parent (N);
else
return False;
end if;
end loop;
return Name (Parent (N)) = N;
end Is_On_LHS;
begin
pragma Assert (Nkind (E) in N_Entity);
if E = Standard_ASCII then
Check_Restriction (No_Obsolescent_Features, N);
end if;
if Is_Ada_2005 (E) and then Ada_Version < Ada_05 then
Error_Msg_NE ("& is only defined in Ada 2005?", N, E);
end if;
if not In_Extended_Main_Source_Unit (N)
and then Typ /= 'e'
and then Typ /= 'p'
and then Typ /= 'k'
then
return;
end if;
if Typ = 'p' and then not In_Extended_Main_Source_Unit (E) then
return;
end if;
if not Force and then not Comes_From_Source (N) then
return;
end if;
if Set_Ref then
if Ekind (E) = E_Variable
and then Is_On_LHS (N)
then
Set_Referenced_As_LHS (E);
elsif Is_Non_Significant_Pragma_Reference (N) then
null;
elsif Nkind (Parent (N)) = N_Attribute_Definition_Clause
and then Chars (Parent (N)) /= Name_Address
and then N = Name (Parent (N))
then
null;
elsif Typ = 'c'
and then Ekind (E) = E_Constant
then
null;
elsif Nkind (N) = N_Identifier
and then Nkind (Parent (N)) = N_Record_Representation_Clause
then
null;
elsif Typ = 'd'
and then Nkind (Parent (N)) = N_Discriminant_Specification
then
null;
else
Set_Referenced (E);
end if;
if Has_Pragma_Unreferenced (E)
and then In_Same_Extended_Unit (E, N)
then
if Nkind (N) = N_Identifier
and then Nkind (Parent (N)) = N_Parameter_Association
and then Selector_Name (Parent (N)) = N
then
null;
elsif Ekind (E) = E_Variable
and then Nkind (Parent (N)) = N_Assignment_Statement
and then Name (Parent (N)) = N
then
null;
elsif Ekind (Scope (E)) = E_Entry then
declare
BE : Entity_Id;
begin
BE := First_Entity (Current_Scope);
while Present (BE) loop
if Chars (BE) = Chars (E) then
Error_Msg_NE
("?pragma Unreferenced given for&", N, BE);
exit;
end if;
Next_Entity (BE);
end loop;
end;
else
Error_Msg_NE ("?pragma Unreferenced given for&", N, E);
end if;
end if;
if Is_Overloadable (E)
and then Is_Generic_Instance (E)
and then Present (Alias (E))
then
Set_Referenced (Alias (E));
end if;
end if;
if
Opt.Xref_Active
and then Xref_Entity_Letters (Ekind (E)) /= ' '
and then Sloc (E) > No_Location
and then Sloc (N) > No_Location
and then Instantiation_Location (Sloc (N)) = No_Location
and then Typ /= ' '
then
if Nkind (N) = N_Identifier
or else
Nkind (N) = N_Defining_Identifier
or else
Nkind (N) in N_Op
or else
Nkind (N) = N_Defining_Operator_Symbol
or else
Nkind (N) = N_Operator_Symbol
or else
(Nkind (N) = N_Character_Literal
and then Sloc (Entity (N)) /= Standard_Location)
or else
Nkind (N) = N_Defining_Character_Literal
then
Nod := N;
elsif Nkind (N) = N_Expanded_Name
or else
Nkind (N) = N_Selected_Component
then
Nod := Selector_Name (N);
else
return;
end if;
if Comes_From_Source (E) then
Ent := E;
elsif Is_Overloadable (E)
and then Present (Alias (E))
then
Ent := Alias (E);
loop
if Comes_From_Source (Ent) then
exit;
elsif No (Alias (Ent)) then
return;
else
Ent := Alias (Ent);
end if;
end loop;
elsif Ekind (E) = E_Component
and then Comes_From_Source (Original_Record_Component (E))
then
Ent := Original_Record_Component (E);
else
return;
end if;
Ref := Original_Location (Sloc (Nod));
Def := Original_Location (Sloc (Ent));
Xrefs.Increment_Last;
Indx := Xrefs.Last;
Xrefs.Table (Indx).Loc := Ref;
if Typ = 'p'
and then Is_Subprogram (N)
and then Is_Overriding_Operation (N)
then
Xrefs.Table (Indx).Typ := 'P';
else
Xrefs.Table (Indx).Typ := Typ;
end if;
Xrefs.Table (Indx).Eun := Get_Source_Unit (Def);
Xrefs.Table (Indx).Lun := Get_Source_Unit (Ref);
Xrefs.Table (Indx).Ent := Ent;
Set_Has_Xref_Entry (Ent);
end if;
end Generate_Reference;
procedure Generate_Reference_To_Formals (E : Entity_Id) is
Formal : Entity_Id;
begin
if Is_Generic_Subprogram (E) then
Formal := First_Entity (E);
while Present (Formal)
and then not Is_Formal (Formal)
loop
Next_Entity (Formal);
end loop;
else
Formal := First_Formal (E);
end if;
while Present (Formal) loop
if Ekind (Formal) = E_In_Parameter then
if Nkind (Parameter_Type (Parent (Formal)))
= N_Access_Definition
then
Generate_Reference (E, Formal, '^', False);
else
Generate_Reference (E, Formal, '>', False);
end if;
elsif Ekind (Formal) = E_In_Out_Parameter then
Generate_Reference (E, Formal, '=', False);
else
Generate_Reference (E, Formal, '<', False);
end if;
Next_Formal (Formal);
end loop;
end Generate_Reference_To_Formals;
procedure Generate_Reference_To_Generic_Formals (E : Entity_Id) is
Formal : Entity_Id;
begin
Formal := First_Entity (E);
while Present (Formal) loop
if Comes_From_Source (Formal) then
Generate_Reference (E, Formal, 'z', False);
end if;
Next_Entity (Formal);
end loop;
end Generate_Reference_To_Generic_Formals;
procedure Initialize is
begin
Xrefs.Init;
end Initialize;
procedure Output_References is
procedure Get_Type_Reference
(Ent : Entity_Id;
Tref : out Entity_Id;
Left : out Character;
Right : out Character);
procedure Output_Import_Export_Info (Ent : Entity_Id);
procedure Get_Type_Reference
(Ent : Entity_Id;
Tref : out Entity_Id;
Left : out Character;
Right : out Character)
is
Sav : Entity_Id;
begin
Tref := Ent;
Left := '{';
Right := '}';
loop
Sav := Tref;
if Is_Type (Tref) then
if Base_Type (Tref) = Tref then
if Tref /= Etype (Tref) then
Tref := First_Subtype (Etype (Tref));
if Left /= '(' then
Left := '<';
Right := '>';
end if;
elsif Is_Access_Type (Tref) then
Tref := Directly_Designated_Type (Tref);
Left := '(';
Right := ')';
elsif Is_Private_Type (Tref)
and then Present (Full_View (Tref))
and then Is_Access_Type (Full_View (Tref))
then
Tref := Directly_Designated_Type (Full_View (Tref));
Left := '(';
Right := ')';
elsif Is_Array_Type (Tref)
and then Tref /= Standard_String
and then Tref /= Standard_Wide_String
then
Tref := Component_Type (Tref);
Left := '(';
Right := ')';
else
exit;
end if;
else
Tref := Ancestor_Subtype (Tref);
if No (Tref) then
Tref := Base_Type (Sav);
end if;
end if;
elsif Is_Object (Tref)
or else Ekind (Tref) = E_Enumeration_Literal
or else Ekind (Tref) = E_Function
or else Ekind (Tref) = E_Operator
then
Tref := Etype (Tref);
else
exit;
end if;
exit when No (Tref)
or else Tref = Sav
or else Tref = Standard_Void_Type;
if Sloc (Tref) = Standard_Location
or else Comes_From_Source (Tref)
then
if Nkind (Parent (Tref)) = N_Subtype_Declaration
and then not Comes_From_Source (Parent (Tref))
and then
(Is_Wrapper_Package (Scope (Tref))
or else Is_Generic_Instance (Scope (Tref)))
then
Tref := Base_Type (Tref);
end if;
return;
end if;
end loop;
Tref := Empty;
Left := ' ';
Right := ' ';
end Get_Type_Reference;
procedure Output_Import_Export_Info (Ent : Entity_Id) is
Language_Name : Name_Id;
Conv : constant Convention_Id := Convention (Ent);
begin
if Conv = Convention_C then
Language_Name := Name_C;
elsif Conv = Convention_CPP then
Language_Name := Name_CPP;
elsif Conv = Convention_Ada then
Language_Name := Name_Ada;
else
return;
end if;
Write_Info_Char ('<');
Get_Unqualified_Name_String (Language_Name);
for J in 1 .. Name_Len loop
Write_Info_Char (Name_Buffer (J));
end loop;
if Present (Interface_Name (Ent)) then
Write_Info_Char (',');
String_To_Name_Buffer (Strval (Interface_Name (Ent)));
for J in 1 .. Name_Len loop
Write_Info_Char (Name_Buffer (J));
end loop;
end if;
Write_Info_Char ('>');
end Output_Import_Export_Info;
begin
if not Opt.Xref_Active then
return;
end if;
declare
J : Nat;
Tref : Entity_Id;
L, R : Character;
Indx : Nat;
Ent : Entity_Id;
Loc : Source_Ptr;
begin
J := 1;
while J <= Xrefs.Last loop
Ent := Xrefs.Table (J).Ent;
Get_Type_Reference (Ent, Tref, L, R);
if Present (Tref)
and then not Has_Xref_Entry (Tref)
and then Sloc (Tref) > No_Location
then
Xrefs.Increment_Last;
Indx := Xrefs.Last;
Loc := Original_Location (Sloc (Tref));
Xrefs.Table (Indx).Ent := Tref;
Xrefs.Table (Indx).Loc := No_Location;
Xrefs.Table (Indx).Eun := Get_Source_Unit (Loc);
Xrefs.Table (Indx).Lun := No_Unit;
Set_Has_Xref_Entry (Tref);
end if;
if Is_Type (Ent)
and then Is_Tagged_Type (Ent)
and then Is_Derived_Type (Ent)
and then Ent = Base_Type (Ent)
and then In_Extended_Main_Source_Unit (Ent)
then
declare
Op_List : constant Elist_Id := Primitive_Operations (Ent);
Op : Elmt_Id;
Prim : Entity_Id;
function Parent_Op (E : Entity_Id) return Entity_Id;
function Parent_Op (E : Entity_Id) return Entity_Id is
Orig_Op : constant Entity_Id := Alias (E);
begin
if No (Orig_Op) then
return Empty;
elsif not Comes_From_Source (E)
and then not Has_Xref_Entry (Orig_Op)
and then Comes_From_Source (Orig_Op)
then
return Orig_Op;
else
return Parent_Op (Orig_Op);
end if;
end Parent_Op;
begin
Op := First_Elmt (Op_List);
while Present (Op) loop
Prim := Parent_Op (Node (Op));
if Present (Prim) then
Xrefs.Increment_Last;
Indx := Xrefs.Last;
Loc := Original_Location (Sloc (Prim));
Xrefs.Table (Indx).Ent := Prim;
Xrefs.Table (Indx).Loc := No_Location;
Xrefs.Table (Indx).Eun :=
Get_Source_Unit (Sloc (Prim));
Xrefs.Table (Indx).Lun := No_Unit;
Set_Has_Xref_Entry (Prim);
end if;
Next_Elmt (Op);
end loop;
end;
end if;
J := J + 1;
end loop;
end;
Output_Refs : declare
Nrefs : Nat := Xrefs.Last;
Rnums : array (0 .. Nrefs) of Nat;
Curxu : Unit_Number_Type;
Curru : Unit_Number_Type;
Cursrc : Source_Buffer_Ptr;
Curent : Entity_Id;
Curnam : String (1 .. Name_Buffer'Length);
Curlen : Natural;
Curdef : Source_Ptr;
Crloc : Source_Ptr;
Ctyp : Character;
Tref : Entity_Id;
Rref : Node_Id;
Trunit : Unit_Number_Type;
function Lt (Op1, Op2 : Natural) return Boolean;
function Name_Change (X : Entity_Id) return Boolean;
procedure Move (From : Natural; To : Natural);
function Lt (Op1, Op2 : Natural) return Boolean is
T1 : Xref_Entry renames Xrefs.Table (Rnums (Nat (Op1)));
T2 : Xref_Entry renames Xrefs.Table (Rnums (Nat (Op2)));
begin
if T1.Eun /= T2.Eun then
return Dependency_Num (T1.Eun) < Dependency_Num (T2.Eun);
elsif T1.Def /= T2.Def then
return T1.Def < T2.Def;
elsif T1.Loc = No_Location then
return True;
elsif T2.Loc = No_Location then
return False;
elsif T1.Lun /= T2.Lun then
return Dependency_Num (T1.Lun) < Dependency_Num (T2.Lun);
elsif T1.Loc /= T2.Loc then
return T1.Loc < T2.Loc;
else
return T2.Typ = 'r';
end if;
end Lt;
procedure Move (From : Natural; To : Natural) is
begin
Rnums (Nat (To)) := Rnums (Nat (From));
end Move;
function Name_Change (X : Entity_Id) return Boolean is
begin
Get_Unqualified_Name_String (Chars (X));
if Name_Len /= Curlen then
return True;
else
return Name_Buffer (1 .. Curlen) /= Curnam (1 .. Curlen);
end if;
end Name_Change;
begin
for J in 1 .. Nrefs loop
Rnums (J) := J;
Xrefs.Table (J).Def :=
Original_Location (Sloc (Xrefs.Table (J).Ent));
end loop;
GNAT.Heap_Sort_A.Sort
(Integer (Nrefs),
Move'Unrestricted_Access,
Lt'Unrestricted_Access);
declare
NR : constant Nat := Nrefs;
begin
if NR >= 2 then
Nrefs := 1;
for J in 2 .. NR loop
if Xrefs.Table (Rnums (J)) /=
Xrefs.Table (Rnums (Nrefs))
then
Nrefs := Nrefs + 1;
Rnums (Nrefs) := Rnums (J);
end if;
end loop;
end if;
end;
Curxu := No_Unit;
Curent := Empty;
Curdef := No_Location;
Curru := No_Unit;
Crloc := No_Location;
for Refno in 1 .. Nrefs loop
Output_One_Ref : declare
P2 : Source_Ptr;
WC : Char_Code;
Err : Boolean;
Ent : Entity_Id;
XE : Xref_Entry renames Xrefs.Table (Rnums (Refno));
P : Source_Ptr;
Left : Character;
Right : Character;
procedure Output_Instantiation_Refs (Loc : Source_Ptr);
procedure Output_Instantiation_Refs (Loc : Source_Ptr) is
Iloc : constant Source_Ptr := Instantiation_Location (Loc);
Lun : Unit_Number_Type;
Cu : constant Unit_Number_Type := Curru;
begin
if Iloc = No_Location then
return;
end if;
Write_Info_Char ('[');
Lun := Get_Source_Unit (Iloc);
if Lun /= Curru then
Curru := Lun;
Write_Info_Nat (Dependency_Num (Curru));
Write_Info_Char ('|');
end if;
Write_Info_Nat (Int (Get_Logical_Line_Number (Iloc)));
Output_Instantiation_Refs (Iloc);
Write_Info_Char (']');
Curru := Cu;
return;
end Output_Instantiation_Refs;
begin
Ent := XE.Ent;
Ctyp := Xref_Entity_Letters (Ekind (Ent));
if XE.Typ = 'e'
and then Ent /= Curent
and then (Refno = Nrefs or else
Ent /= Xrefs.Table (Rnums (Refno + 1)).Ent)
and then
not In_Extended_Main_Source_Unit (Ent)
then
goto Continue;
end if;
if Ctyp = '+'
and then Present (Full_View (XE.Ent))
then
Ent := Underlying_Type (Ent);
if Present (Ent) then
Ctyp := Xref_Entity_Letters (Ekind (Ent));
end if;
end if;
if Ctyp = 'E' and then Is_Boolean_Type (Ent) then
Ctyp := 'B';
end if;
if Ctyp = '*' then
Ent := Etype (XE.Ent);
Ctyp := Fold_Lower (Xref_Entity_Letters (Ekind (Ent)));
if Ctyp = '+'
and then Present (Full_View (Etype (XE.Ent)))
then
Ent := Underlying_Type (Etype (XE.Ent));
if Present (Ent) then
Ctyp := Fold_Lower (Xref_Entity_Letters (Ekind (Ent)));
end if;
end if;
declare
K : constant Entity_Kind := Ekind (Etype (XE.Ent));
begin
if (K = E_Anonymous_Access_Type
or else
K = E_Anonymous_Access_Subprogram_Type
or else K =
E_Anonymous_Access_Protected_Subprogram_Type)
and then Is_Formal (XE.Ent)
then
Ctyp := 'p';
elsif Ctyp = 'e' and then Is_Boolean_Type (Ent) then
Ctyp := 'b';
end if;
end;
end if;
if Is_Abstract (XE.Ent) then
if Ctyp = 'U' then
Ctyp := 'x';
elsif Ctyp = 'V' then
Ctyp := 'y';
elsif Ctyp = 'R' then
Ctyp := 'H'; end if;
end if;
if Ctyp = ' '
or else (XE.Loc = XE.Def
and then
(XE.Typ /= 'b'
or else not Is_Subprogram (XE.Ent)))
or else (Is_Formal (XE.Ent)
and then Present (Spec_Entity (XE.Ent)))
then
null;
else
if XE.Eun /= Curxu then
if Write_Info_Col > 1 then
Write_Info_EOL;
end if;
Curxu := XE.Eun;
Cursrc := Source_Text (Source_Index (Curxu));
Write_Info_Initiate ('X');
Write_Info_Char (' ');
Write_Info_Nat (Dependency_Num (XE.Eun));
Write_Info_Char (' ');
Write_Info_Name (Reference_Name (Source_Index (XE.Eun)));
end if;
if No (Curent)
or else
(XE.Ent /= Curent
and then
(Name_Change (XE.Ent) or else XE.Def /= Curdef))
then
Curent := XE.Ent;
Curdef := XE.Def;
Get_Unqualified_Name_String (Chars (XE.Ent));
Curlen := Name_Len;
Curnam (1 .. Curlen) := Name_Buffer (1 .. Curlen);
if Write_Info_Col > 1 then
Write_Info_EOL;
end if;
Write_Info_Nat (Int (Get_Logical_Line_Number (XE.Def)));
Write_Info_Char (Ctyp);
Write_Info_Nat (Int (Get_Column_Number (XE.Def)));
Write_Level_Info : declare
function Is_Visible_Generic_Entity
(E : Entity_Id) return Boolean;
function Is_Private_Record_Component
(E : Entity_Id) return Boolean;
function Is_Private_Record_Component
(E : Entity_Id) return Boolean
is
S : constant Entity_Id := Scope (E);
begin
return
Ekind (E) = E_Component
and then Nkind (Declaration_Node (S)) =
N_Private_Extension_Declaration
and then Original_Record_Component (E) = E;
end Is_Private_Record_Component;
function Is_Visible_Generic_Entity
(E : Entity_Id) return Boolean
is
Par : Node_Id;
begin
if Ekind (Scope (E)) /= E_Generic_Package then
return False;
end if;
Par := Parent (E);
while Present (Par) loop
if
Nkind (Par) = N_Generic_Package_Declaration
then
return False;
elsif
Nkind (Parent (Par)) = N_Package_Specification
then
return
Is_List_Member (Par)
and then List_Containing (Par) =
Visible_Declarations (Parent (Par));
else
Par := Parent (Par);
end if;
end loop;
return False;
end Is_Visible_Generic_Entity;
begin
if Is_Hidden (Curent)
or else Is_Private_Record_Component (Curent)
then
Write_Info_Char (' ');
elsif
Is_Public (Curent)
or else Is_Visible_Generic_Entity (Curent)
then
Write_Info_Char ('*');
else
Write_Info_Char (' ');
end if;
end Write_Level_Info;
P := Original_Location (Sloc (XE.Ent));
if Cursrc (P) = ''' then
Write_Info_Char (Cursrc (P));
Write_Info_Char (Cursrc (P + 1));
Write_Info_Char (Cursrc (P + 2));
elsif Cursrc (P) = '"' or else Cursrc (P) = '%' then
Write_Info_Char (Cursrc (P));
P2 := P;
loop
P2 := P2 + 1;
Write_Info_Char (Cursrc (P2));
exit when Cursrc (P2) = Cursrc (P);
end loop;
else
loop
if Is_Start_Of_Wide_Char (Cursrc, P) then
Scan_Wide (Cursrc, P, WC, Err);
elsif not Identifier_Char (Cursrc (P)) then
exit;
else
P := P + 1;
end if;
end loop;
for J in
Original_Location (Sloc (XE.Ent)) .. P - 1
loop
Write_Info_Char (Cursrc (J));
end loop;
end if;
if Is_Object (XE.Ent)
and then Present (Renamed_Object (XE.Ent))
then
Rref := Renamed_Object (XE.Ent);
elsif Is_Overloadable (XE.Ent)
and then Nkind (Parent (Declaration_Node (XE.Ent))) =
N_Subprogram_Renaming_Declaration
then
Rref := Name (Parent (Declaration_Node (XE.Ent)));
elsif Ekind (XE.Ent) = E_Package
and then Nkind (Declaration_Node (XE.Ent)) =
N_Package_Renaming_Declaration
then
Rref := Name (Declaration_Node (XE.Ent));
else
Rref := Empty;
end if;
if Present (Rref) then
if Nkind (Rref) = N_Expanded_Name then
Rref := Selector_Name (Rref);
end if;
if Nkind (Rref) /= N_Identifier then
Rref := Empty;
end if;
end if;
if Present (Rref) then
Write_Info_Char ('=');
Write_Info_Nat
(Int (Get_Logical_Line_Number (Sloc (Rref))));
Write_Info_Char (':');
Write_Info_Nat
(Int (Get_Column_Number (Sloc (Rref))));
end if;
Curru := Curxu;
Get_Type_Reference (XE.Ent, Tref, Left, Right);
if Present (Tref) then
if Sloc (Tref) = Standard_Location then
Write_Info_Char (Left);
Write_Info_Name (Chars (Tref));
Write_Info_Char (Right);
else
Write_Info_Char (Left);
Trunit := Get_Source_Unit (Sloc (Tref));
if Trunit /= Curxu then
Write_Info_Nat (Dependency_Num (Trunit));
Write_Info_Char ('|');
end if;
Write_Info_Nat
(Int (Get_Logical_Line_Number (Sloc (Tref))));
declare
Ent : Entity_Id := Tref;
Kind : constant Entity_Kind := Ekind (Ent);
Ctyp : Character := Xref_Entity_Letters (Kind);
begin
if Ctyp = '+'
and then Present (Full_View (Ent))
then
Ent := Underlying_Type (Ent);
if Present (Ent) then
Ctyp := Xref_Entity_Letters (Ekind (Ent));
end if;
end if;
Write_Info_Char (Ctyp);
end;
Write_Info_Nat
(Int (Get_Column_Number (Sloc (Tref))));
Output_Instantiation_Refs (Sloc (Tref));
Write_Info_Char (Right);
end if;
end if;
Crloc := No_Location;
end if;
if XE.Loc /= No_Location
and then XE.Loc /= Crloc
then
Crloc := XE.Loc;
if Write_Info_Col > 72 then
Write_Info_EOL;
Write_Info_Initiate ('.');
end if;
Write_Info_Char (' ');
if XE.Lun /= Curru then
Curru := XE.Lun;
Write_Info_Nat (Dependency_Num (Curru));
Write_Info_Char ('|');
end if;
Write_Info_Nat (Int (Get_Logical_Line_Number (XE.Loc)));
Write_Info_Char (XE.Typ);
if Is_Overloadable (XE.Ent)
and then Is_Imported (XE.Ent)
and then XE.Typ = 'b'
then
Output_Import_Export_Info (XE.Ent);
end if;
Write_Info_Nat (Int (Get_Column_Number (XE.Loc)));
Output_Instantiation_Refs (Sloc (XE.Ent));
end if;
end if;
end Output_One_Ref;
<<Continue>>
null;
end loop;
Write_Info_EOL;
end Output_Refs;
end Output_References;
end Lib.Xref;