Skip to content

R
riscv-gcc-1
Commit 5ec5b8c1 by Ed Schonberg Committed by Arnaud Charlet
Options

lib-xref.adb (Output_Overridden_Op): Display information on overridden operation. 

2005-09-01  Ed Schonberg  <schonberg@adacore.com>
	    Emmanuel Briot  <briot@adacore.com>

	* lib-xref.adb (Output_Overridden_Op): Display information on
	overridden operation.

	* lib-xref.ads: Add documentation on overridden operations.

	* ali.ads (Xref_Entity_Record): Add support for storing the overriding
	information.

	* ali.adb (Get_Typeref): New subprogram. Adds support for parsing the
	overriding entity information.

From-SVN: r103871
parent 8e4fe95d
Showing with 184 additions and 74 deletions
gcc/ada/ali.adb
...@@ -208,6 +208,16 @@ package body ALI is ...@@ -208,6 +208,16 @@ package body ALI is
function Nextc return Character; function Nextc return Character;
-- Return current character without modifying pointer P -- 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; procedure Skip_Eol;
-- Skip past spaces, then skip past end of line (fatal error if not -- Skip past spaces, then skip past end of line (fatal error if not
-- at end of line). Also skips past any following blank lines. -- at end of line). Also skips past any following blank lines.
...@@ -537,6 +547,94 @@ package body ALI is ...@@ -537,6 +547,94 @@ package body ALI is
return T (P); return T (P);
end Nextc; 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 -- -- Skip_Eol --
-------------- --------------
...@@ -1937,80 +2035,30 @@ package body ALI is ...@@ -1937,80 +2035,30 @@ package body ALI is
-- See if type reference present -- See if type reference present
case Nextc is Get_Typeref
when '<' => XE.Tref := Tref_Derived; (Current_File_Num, XE.Tref, XE.Tref_File_Num, XE.Tref_Line,
when '(' => XE.Tref := Tref_Access; XE.Tref_Type, XE.Tref_Col, XE.Tref_Standard_Entity);
when '{' => XE.Tref := Tref_Type;
when others => XE.Tref := Tref_None; -- Do we have an overriding procedure, instead ?
end case; if XE.Tref_Type = 'p' then
XE.Oref_File_Num := XE.Tref_File_Num;
-- Case of typeref field present XE.Oref_Line := XE.Tref_Line;
XE.Oref_Col := XE.Tref_Col;
if XE.Tref /= Tref_None then XE.Tref_File_Num := No_Sdep_Id;
P := P + 1; -- skip opening bracket XE.Tref := Tref_None;
else
if Nextc in 'a' .. 'z' then -- We might have additional information about the
XE.Tref_File_Num := No_Sdep_Id; -- overloaded subprograms
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
declare declare
Nested_Brackets : Natural := 0; Ref : Tref_Kind;
Typ : Character;
Standard_Entity : Name_Id;
begin begin
loop Get_Typeref
case Nextc is (Current_File_Num,
when '[' => Ref, XE.Oref_File_Num,
Nested_Brackets := Nested_Brackets + 1; XE.Oref_Line, Typ, XE.Oref_Col, Standard_Entity);
when ']' =>
Nested_Brackets := Nested_Brackets - 1;
when others =>
if Nested_Brackets = 0 then
exit;
end if;
end case;
Skipc;
end loop;
end; 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; end if;
XE.First_Xref := Xref.Last + 1; XE.First_Xref := Xref.Last + 1;
......
gcc/ada/ali.ads
...@@ -590,7 +590,7 @@ package ALI is ...@@ -590,7 +590,7 @@ package ALI is
type No_Dep_Record is record type No_Dep_Record is record
ALI_File : ALI_Id; ALI_File : ALI_Id;
-- ALI File containing tne entry -- ALI File containing the entry
No_Dep_Unit : Name_Id; No_Dep_Unit : Name_Id;
-- Id for names table entry including entire name, including periods -- Id for names table entry including entire name, including periods
...@@ -782,6 +782,16 @@ package ALI is ...@@ -782,6 +782,16 @@ package ALI is
-- entity in package Standard, then this field is a Name_Id -- entity in package Standard, then this field is a Name_Id
-- reference for the entity name. -- reference for the entity name.
Oref_File_Num : Sdep_Id;
-- This field is set to No_Sdep_Id is the entity doesn't override any
-- other entity, or to the dependency reference for the overriden
-- entity.
Oref_Line : Nat;
Oref_Col : Nat;
-- These two fields are set to the line and column of the overriden
-- entity.
First_Xref : Nat; First_Xref : Nat;
-- Index into Xref table of first cross-reference -- Index into Xref table of first cross-reference
......
gcc/ada/lib-xref.adb
...@@ -1172,6 +1172,10 @@ package body Lib.Xref is ...@@ -1172,6 +1172,10 @@ package body Lib.Xref is
-- the given source ptr in [file|line[...]] form. No output -- the given source ptr in [file|line[...]] form. No output
-- if the given location is not a generic template reference. -- 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 -- -- Output_Instantiation_Refs --
------------------------------- -------------------------------
...@@ -1212,6 +1216,35 @@ package body Lib.Xref is ...@@ -1212,6 +1216,35 @@ package body Lib.Xref is
return; return;
end Output_Instantiation_Refs; 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 -- Start of processing for Output_One_Ref
begin begin
...@@ -1661,6 +1694,15 @@ package body Lib.Xref is ...@@ -1661,6 +1694,15 @@ package body Lib.Xref is
end if; end if;
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 -- End of processing for entity output
Crloc := No_Location; Crloc := No_Location;
......
gcc/ada/lib-xref.ads
...@@ -28,7 +28,6 @@ ...@@ -28,7 +28,6 @@
-- information. -- information.
with Einfo; use Einfo; with Einfo; use Einfo;
with Types; use Types;
package Lib.Xref is package Lib.Xref is
...@@ -54,7 +53,7 @@ package Lib.Xref is ...@@ -54,7 +53,7 @@ package Lib.Xref is
-- The lines following the header look like -- 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 -- line is the line number of the referenced entity. The name of
-- the entity starts in column col. Columns are numbered from one, -- the entity starts in column col. Columns are numbered from one,
...@@ -130,6 +129,17 @@ package Lib.Xref is ...@@ -130,6 +129,17 @@ package Lib.Xref is
-- referenced file. For the standard entity form, the name between -- referenced file. For the standard entity form, the name between
-- the brackets is the normal name of the entity in lower case. -- 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 -- There may be zero or more ref entries on each line
-- file | line type col [...] -- file | line type col [...]
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment