mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-04-05 23:31:21 +08:00
Code Issues Packages Projects Releases Wiki Activity

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

Browse Source 
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
This commit is contained in:
Ed Schonberg 2005-09-05 09:55:30 +02:00 committed by Arnaud Charlet
parent 8e4fe95d94
commit 5ec5b8c171
4 changed files with 185 additions and 75 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

192
gcc/ada/ali.adb
View File

@ -208,6 +208,16 @@ package body ALI is
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.
@ -537,6 +547,94 @@ package body ALI is
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 --
--------------
@ -1937,80 +2035,30 @@ package body ALI is
-- 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
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
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
XE.Tref_File_Num := No_Sdep_Id;
XE.Tref_Line := 0;
XE.Tref_Type := ' ';
XE.Tref_Col := 0;
XE.Tref_Standard_Entity := No_Name;
-- We might have additional information about the
-- overloaded subprograms
declare
Ref : Tref_Kind;
Typ : Character;
Standard_Entity : Name_Id;
begin
Get_Typeref
(Current_File_Num,
Ref, XE.Oref_File_Num,
XE.Oref_Line, Typ, XE.Oref_Col, Standard_Entity);
end;
end if;
XE.First_Xref := Xref.Last + 1;

12
gcc/ada/ali.ads
View File

@ -590,7 +590,7 @@ package ALI is
type No_Dep_Record is record
ALI_File : ALI_Id;
-- ALI File containing tne entry
-- ALI File containing the entry
No_Dep_Unit : Name_Id;
-- Id for names table entry including entire name, including periods
@ -782,6 +782,16 @@ package ALI is
-- entity in package Standard, then this field is a Name_Id
-- 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;
-- Index into Xref table of first cross-reference

42
gcc/ada/lib-xref.adb
View File

@ -1172,6 +1172,10 @@ package body Lib.Xref is
-- 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 --
-------------------------------
@ -1212,6 +1216,35 @@ package body Lib.Xref is
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
@ -1661,6 +1694,15 @@ package body Lib.Xref is
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;

14
gcc/ada/lib-xref.ads
View File

@ -28,7 +28,6 @@
-- information.
with Einfo; use Einfo;
with Types; use Types;
package Lib.Xref is
@ -54,7 +53,7 @@ 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,
@ -130,6 +129,17 @@ package Lib.Xref is
-- 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 [...]