diff options
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/ada/ali.adb | 190 | ||||
| -rw-r--r-- | gcc/ada/ali.ads | 12 | ||||
| -rw-r--r-- | gcc/ada/lib-xref.adb | 42 | ||||
| -rw-r--r-- | gcc/ada/lib-xref.ads | 14 |
4 files changed, 184 insertions, 74 deletions
diff --git a/gcc/ada/ali.adb b/gcc/ada/ali.adb index 48ad184..c1ea6c4 100644 --- a/gcc/ada/ali.adb +++ b/gcc/ada/ali.adb @@ -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 - + 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; diff --git a/gcc/ada/ali.ads b/gcc/ada/ali.ads index c6dcbee..6582a1a 100644 --- a/gcc/ada/ali.ads +++ b/gcc/ada/ali.ads @@ -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 diff --git a/gcc/ada/lib-xref.adb b/gcc/ada/lib-xref.adb index 1fc8b56..7260b0c 100644 --- a/gcc/ada/lib-xref.adb +++ b/gcc/ada/lib-xref.adb @@ -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; diff --git a/gcc/ada/lib-xref.ads b/gcc/ada/lib-xref.ads index 99a326e..154d88e 100644 --- a/gcc/ada/lib-xref.ads +++ b/gcc/ada/lib-xref.ads @@ -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 [...] |