function Nextc return Character;
-- Return current character without modifying pointer P
+ procedure Get_Typeref
+ (Current_File_Num : Sdep_Id;
+ Ref : out Tref_Kind;
+ File_Num : out Sdep_Id;
+ Line : out Nat;
+ Ref_Type : out Character;
+ Col : out Nat;
+ Standard_Entity : out Name_Id);
+ -- Parse the definition of a typeref (<...>, {...} or (...))
+
procedure Skip_Eol;
-- Skip past spaces, then skip past end of line (fatal error if not
-- at end of line). Also skips past any following blank lines.
return T (P);
end Nextc;
+ -----------------
+ -- Get_Typeref --
+ -----------------
+
+ procedure Get_Typeref
+ (Current_File_Num : Sdep_Id;
+ Ref : out Tref_Kind;
+ File_Num : out Sdep_Id;
+ Line : out Nat;
+ Ref_Type : out Character;
+ Col : out Nat;
+ Standard_Entity : out Name_Id)
+ is
+ N : Nat;
+ begin
+ case Nextc is
+ when '<' => Ref := Tref_Derived;
+ when '(' => Ref := Tref_Access;
+ when '{' => Ref := Tref_Type;
+ when others => Ref := Tref_None;
+ end case;
+
+ -- Case of typeref field present
+
+ if Ref /= Tref_None then
+ P := P + 1; -- skip opening bracket
+
+ if Nextc in 'a' .. 'z' then
+ File_Num := No_Sdep_Id;
+ Line := 0;
+ Ref_Type := ' ';
+ Col := 0;
+ Standard_Entity := Get_Name (Ignore_Spaces => True);
+ else
+ N := Get_Nat;
+
+ if Nextc = '|' then
+ File_Num := Sdep_Id (N + Nat (First_Sdep_Entry) - 1);
+ P := P + 1;
+ N := Get_Nat;
+ else
+ File_Num := Current_File_Num;
+ end if;
+
+ Line := N;
+ Ref_Type := Getc;
+ Col := Get_Nat;
+ Standard_Entity := No_Name;
+ end if;
+
+ -- ??? Temporary workaround for nested generics case:
+ -- 4i4 Directories{1|4I9[4|6[3|3]]}
+ -- See C918-002
+
+ declare
+ Nested_Brackets : Natural := 0;
+
+ begin
+ loop
+ case Nextc is
+ when '[' =>
+ Nested_Brackets := Nested_Brackets + 1;
+ when ']' =>
+ Nested_Brackets := Nested_Brackets - 1;
+ when others =>
+ if Nested_Brackets = 0 then
+ exit;
+ end if;
+ end case;
+
+ Skipc;
+ end loop;
+ end;
+
+ P := P + 1; -- skip closing bracket
+ Skip_Space;
+
+ -- No typeref entry present
+
+ else
+ File_Num := No_Sdep_Id;
+ Line := 0;
+ Ref_Type := ' ';
+ Col := 0;
+ Standard_Entity := No_Name;
+ end if;
+ end Get_Typeref;
+
--------------
-- Skip_Eol --
--------------
-- See if type reference present
- case Nextc is
- when '<' => XE.Tref := Tref_Derived;
- when '(' => XE.Tref := Tref_Access;
- when '{' => XE.Tref := Tref_Type;
- when others => XE.Tref := Tref_None;
- end case;
-
- -- Case of typeref field present
-
- if XE.Tref /= Tref_None then
- P := P + 1; -- skip opening bracket
-
- if Nextc in 'a' .. 'z' then
- XE.Tref_File_Num := No_Sdep_Id;
- XE.Tref_Line := 0;
- XE.Tref_Type := ' ';
- XE.Tref_Col := 0;
- XE.Tref_Standard_Entity :=
- Get_Name (Ignore_Spaces => True);
-
- else
- N := Get_Nat;
-
- if Nextc = '|' then
- XE.Tref_File_Num :=
- Sdep_Id (N + Nat (First_Sdep_Entry) - 1);
- P := P + 1;
- N := Get_Nat;
-
- else
- XE.Tref_File_Num := Current_File_Num;
- end if;
-
- XE.Tref_Line := N;
- XE.Tref_Type := Getc;
- XE.Tref_Col := Get_Nat;
- XE.Tref_Standard_Entity := No_Name;
- end if;
-
- -- ??? Temporary workaround for nested generics case:
- -- 4i4 Directories{1|4I9[4|6[3|3]]}
- -- See C918-002
-
+ Get_Typeref
+ (Current_File_Num, XE.Tref, XE.Tref_File_Num, XE.Tref_Line,
+ XE.Tref_Type, XE.Tref_Col, XE.Tref_Standard_Entity);
+
+ -- Do we have an overriding procedure, instead ?
+ if XE.Tref_Type = 'p' then
+ XE.Oref_File_Num := XE.Tref_File_Num;
+ XE.Oref_Line := XE.Tref_Line;
+ XE.Oref_Col := XE.Tref_Col;
+ XE.Tref_File_Num := No_Sdep_Id;
+ XE.Tref := Tref_None;
+ else
+ -- We might have additional information about the
+ -- overloaded subprograms
declare
- Nested_Brackets : Natural := 0;
-
+ Ref : Tref_Kind;
+ Typ : Character;
+ Standard_Entity : Name_Id;
begin
- loop
- case Nextc is
- when '[' =>
- Nested_Brackets := Nested_Brackets + 1;
- when ']' =>
- Nested_Brackets := Nested_Brackets - 1;
- when others =>
- if Nested_Brackets = 0 then
- exit;
- end if;
- end case;
-
- Skipc;
- end loop;
+ Get_Typeref
+ (Current_File_Num,
+ Ref, XE.Oref_File_Num,
+ XE.Oref_Line, Typ, XE.Oref_Col, Standard_Entity);
end;
-
- P := P + 1; -- skip closing bracket
- Skip_Space;
-
- -- No typeref entry present
-
- else
- XE.Tref_File_Num := No_Sdep_Id;
- XE.Tref_Line := 0;
- XE.Tref_Type := ' ';
- XE.Tref_Col := 0;
- XE.Tref_Standard_Entity := No_Name;
end if;
XE.First_Xref := Xref.Last + 1;
-- the given source ptr in [file|line[...]] form. No output
-- if the given location is not a generic template reference.
+ procedure Output_Overridden_Op (Old_E : Entity_Id);
+ -- For a subprogram that is overriding, display information
+ -- about the inherited operation that it overrides.
+
-------------------------------
-- Output_Instantiation_Refs --
-------------------------------
return;
end Output_Instantiation_Refs;
+ --------------------------
+ -- Output_Overridden_Op --
+ --------------------------
+
+ procedure Output_Overridden_Op (Old_E : Entity_Id) is
+ begin
+ if Present (Old_E)
+ and then Sloc (Old_E) /= Standard_Location
+ then
+ declare
+ Loc : constant Source_Ptr := Sloc (Old_E);
+ Par_Unit : constant Unit_Number_Type :=
+ Get_Source_Unit (Loc);
+ begin
+ Write_Info_Char ('<');
+
+ if Par_Unit /= Curxu then
+ Write_Info_Nat (Dependency_Num (Par_Unit));
+ Write_Info_Char ('|');
+ end if;
+
+ Write_Info_Nat (Int (Get_Logical_Line_Number (Loc)));
+ Write_Info_Char ('p');
+ Write_Info_Nat (Int (Get_Column_Number (Loc)));
+ Write_Info_Char ('>');
+ end;
+ end if;
+ end Output_Overridden_Op;
+
-- Start of processing for Output_One_Ref
begin
end if;
end if;
+ -- If the entity is an overriding operation, write
+ -- info on operation that was overridden.
+
+ if Is_Subprogram (XE.Ent)
+ and then Is_Overriding_Operation (XE.Ent)
+ then
+ Output_Overridden_Op (Overridden_Operation (XE.Ent));
+ end if;
+
-- End of processing for entity output
Crloc := No_Location;
-- information.
with Einfo; use Einfo;
-with Types; use Types;
package Lib.Xref is
-- The lines following the header look like
- -- line type col level entity renameref instref typeref ref ref ref
+ -- line type col level entity renameref instref typeref overref ref ref
-- line is the line number of the referenced entity. The name of
-- the entity starts in column col. Columns are numbered from one,
-- referenced file. For the standard entity form, the name between
-- the brackets is the normal name of the entity in lower case.
+ -- overref is present for overriding operations (procedures and
+ -- functions), and provides information on the operation that it
+ -- overrides. This information has the format:
+
+ -- '<' file | line 'o' col '>'
+
+ -- file is the dependency number of the file containing the
+ -- declaration of the overridden operation. It and the following
+ -- vertical bar are omitted if the file is the same as that of
+ -- the overriding operation.
+
-- There may be zero or more ref entries on each line
-- file | line type col [...]
projects / platform / upstream / linaro-gcc.git / commitdiff