diff options
author | charlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4> | 2005-09-05 07:55:30 +0000 |
---|---|---|
committer | charlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4> | 2005-09-05 07:55:30 +0000 |
commit | 4b0d05543a4c26571080f1154fb4584933d892a3 (patch) | |
tree | c874b7e54802e0374f0a07dfecdfa31566aa0ffe /gcc/ada/ali.adb | |
parent | 528a6b60e12138771fa33d6587bddfd0efabe6e3 (diff) | |
download | gcc-4b0d05543a4c26571080f1154fb4584933d892a3.tar.gz |
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.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@103871 138bc75d-0d04-0410-961f-82ee72b054a4
Diffstat (limited to 'gcc/ada/ali.adb')
-rw-r--r-- | gcc/ada/ali.adb | 190 |
1 files changed, 119 insertions, 71 deletions
diff --git a/gcc/ada/ali.adb b/gcc/ada/ali.adb index 48ad18450cb..c1ea6c46930 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; |