diff options
| -rw-r--r-- | gcc/ada/ali.adb | 26 | ||||
| -rw-r--r-- | gcc/ada/ali.ads | 20 | ||||
| -rw-r--r-- | gcc/ada/lib-xref.adb | 73 | ||||
| -rw-r--r-- | gcc/ada/lib-xref.ads | 25 | ||||
| -rw-r--r-- | gcc/ada/xref_lib.adb | 48 |
5 files changed, 161 insertions, 31 deletions
diff --git a/gcc/ada/ali.adb b/gcc/ada/ali.adb index 4c8a08b05a8..22c5e526968 100644 --- a/gcc/ada/ali.adb +++ b/gcc/ada/ali.adb @@ -439,6 +439,7 @@ package body ALI is or else Nextc = '(' or else Nextc = ')' or else Nextc = '{' or else Nextc = '}' or else Nextc = '<' or else Nextc = '>' + or else Nextc = '[' or else Nextc = ']' or else Nextc = '='; end if; end loop; @@ -1886,6 +1887,31 @@ package body ALI is XE.Lib := (Getc = '*'); XE.Entity := Get_Name; + -- Handle the information about generic instantiations + + if Nextc = '[' then + Skipc; -- Opening '[' + N := Get_Nat; + + if Nextc /= '|' then + XE.Iref_File_Num := Current_File_Num; + XE.Iref_Line := N; + else + XE.Iref_File_Num := + Sdep_Id (N + Nat (First_Sdep_Entry) - 1); + Skipc; + XE.Iref_Line := Get_Nat; + end if; + + if Getc /= ']' then + Fatal_Error; + end if; + + else + XE.Iref_File_Num := No_Sdep_Id; + XE.Iref_Line := 0; + end if; + Current_File_Num := XS.File_Num; -- Renaming reference is present diff --git a/gcc/ada/ali.ads b/gcc/ada/ali.ads index cab4b062365..91ecd2dd16c 100644 --- a/gcc/ada/ali.ads +++ b/gcc/ada/ali.ads @@ -593,7 +593,7 @@ package ALI is -- ALI File containing tne entry 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 end record; package No_Deps is new Table.Table ( @@ -731,6 +731,16 @@ package ALI is Entity : Name_Id; -- Name of entity + Iref_File_Num : Sdep_Id; + -- This field is set to the dependency reference for the file containing + -- the generic entity that this one instantiates, or to No_Sdep_Id if + -- the current entity is not an instantiation + + Iref_Line : Nat; + -- This field is set to the line number in Iref_File_Num of the generic + -- entity that this one instantiates, or to zero if the current entity + -- is not an instantiation. + Rref_Line : Nat; -- This field is set to the line number of a renaming reference if -- one is present, or to zero if no renaming reference is present @@ -815,6 +825,11 @@ package ALI is -- Note: for instantiation references, Rtype is set to ' ', and Col is -- set to zero. One or more such entries can follow any other reference. + -- When there is more than one such entry, this is to be read as: + -- e.g. ref1 ref2 ref3 + -- ref1 is a reference to an entity that was instantied at ref2. + -- ref2 itself is also the result of an instantiation, that took + -- place at ref3 end record; package Xref is new Table.Table ( @@ -848,7 +863,8 @@ package ALI is -- -- Ignore_ED is normally False. If set to True, it indicates that -- all ED (elaboration desirable) indications in the ALI file are - -- to be ignored. + -- to be ignored. This parameter is obsolete now that the -f switch + -- is removed from gnatbind, and should be removed ??? -- -- Err determines the action taken on an incorrectly formatted file. -- If Err is False, then an error message is output, and the program diff --git a/gcc/ada/lib-xref.adb b/gcc/ada/lib-xref.adb index 5afc12bf13f..78e14b2d493 100644 --- a/gcc/ada/lib-xref.adb +++ b/gcc/ada/lib-xref.adb @@ -34,6 +34,7 @@ with Nlists; use Nlists; with Opt; use Opt; with Restrict; use Restrict; with Rident; use Rident; +with Sem; use Sem; with Sem_Prag; use Sem_Prag; with Sem_Util; use Sem_Util; with Sinfo; use Sinfo; @@ -133,6 +134,10 @@ package body Lib.Xref is Xrefs.Table (Indx).Eun := Get_Source_Unit (Loc); Xrefs.Table (Indx).Lun := No_Unit; Set_Has_Xref_Entry (E); + + if In_Inlined_Body then + Set_Referenced (E); + end if; end if; end Generate_Definition; @@ -269,7 +274,10 @@ package body Lib.Xref is -- Warn if reference to Ada 2005 entity not in Ada 2005 mode - if Is_Ada_2005 (E) and then Ada_Version < Ada_05 then + if Is_Ada_2005 (E) + and then Ada_Version < Ada_05 + and then Warn_On_Ada_2005_Compatibility + then Error_Msg_NE ("& is only defined in Ada 2005?", N, E); end if; @@ -534,7 +542,7 @@ package body Lib.Xref is Xrefs.Table (Indx).Loc := Ref; - -- Overriding operations are marked with 'P'. + -- Overriding operations are marked with 'P' if Typ = 'p' and then Is_Subprogram (N) @@ -723,7 +731,7 @@ package body Lib.Xref is exit; end if; - -- For a subtype, go to ancestor subtype. + -- For a subtype, go to ancestor subtype else Tref := Ancestor_Subtype (Tref); @@ -778,7 +786,7 @@ package body Lib.Xref is (Is_Wrapper_Package (Scope (Tref)) or else Is_Generic_Instance (Scope (Tref))) then - Tref := Base_Type (Tref); + Tref := First_Subtype (Base_Type (Tref)); end if; return; @@ -810,7 +818,7 @@ package body Lib.Xref is Language_Name := Name_Ada; else - -- These are the only languages that GPS knows about. + -- These are the only languages that GPS knows about return; end if; @@ -1260,6 +1268,14 @@ package body Lib.Xref is if Present (Ent) then Ctyp := Fold_Lower (Xref_Entity_Letters (Ekind (Ent))); end if; + + elsif Is_Generic_Type (Ent) then + + -- If the type of the entity is a generic private type + -- there is no usable full view, so retain the indication + -- that this is an object. + + Ctyp := '*'; end if; -- Special handling for access parameter @@ -1285,7 +1301,7 @@ package body Lib.Xref is end; end if; - -- Special handling for abstract types and operations. + -- Special handling for abstract types and operations if Is_Abstract (XE.Ent) then @@ -1524,7 +1540,25 @@ package body Lib.Xref is Rref := Selector_Name (Rref); end if; - if Nkind (Rref) /= N_Identifier then + if Nkind (Rref) = N_Identifier + or else Nkind (Rref) = N_Operator_Symbol + then + null; + + -- For renamed array components, use the array name + -- for the renamed entity, which reflect the fact that + -- in general the whole array is aliased. + + elsif Nkind (Rref) = N_Indexed_Component then + if Nkind (Prefix (Rref)) = N_Identifier then + Rref := Prefix (Rref); + elsif Nkind (Prefix (Rref)) = N_Expanded_Name then + Rref := Selector_Name (Prefix (Rref)); + else + Rref := Empty; + end if; + + else Rref := Empty; end if; end if; @@ -1545,6 +1579,31 @@ package body Lib.Xref is Curru := Curxu; + -- Write out information about generic parent, + -- if entity is an instance. + + if Is_Generic_Instance (XE.Ent) then + declare + Gen_Par : constant Entity_Id := + Generic_Parent + (Specification + (Unit_Declaration_Node (XE.Ent))); + Loc : constant Source_Ptr := Sloc (Gen_Par); + Gen_U : constant Unit_Number_Type := + Get_Source_Unit (Loc); + begin + Write_Info_Char ('['); + if Curru /= Gen_U then + Write_Info_Nat (Dependency_Num (Gen_U)); + Write_Info_Char ('|'); + end if; + + Write_Info_Nat + (Int (Get_Logical_Line_Number (Loc))); + Write_Info_Char (']'); + end; + end if; + -- See if we have a type reference and if so output Get_Type_Reference (XE.Ent, Tref, Left, Right); diff --git a/gcc/ada/lib-xref.ads b/gcc/ada/lib-xref.ads index 59c703fb78e..1a0055e5c2b 100644 --- a/gcc/ada/lib-xref.ads +++ b/gcc/ada/lib-xref.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1998-2004, Free Software Foundation, Inc. -- +-- Copyright (C) 1998-2005, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -54,7 +54,7 @@ package Lib.Xref is -- The lines following the header look like - -- line type col level entity renameref typeref ref ref ref + -- line type col level entity renameref instref typeref ref 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, @@ -93,6 +93,17 @@ package Lib.Xref is -- reference is a complex expressions, then renameref is omitted. -- Here line/col give line/column as defined above. + -- instref is only present for package and subprogram instances. + -- The information in instref is the location of the point of + -- declaration of the generic parent unit. This part has the form: + + -- [file|line] + + -- without column information, on the reasonable assumption that + -- there is only one unit per line (the same assumption is made + -- in references to entities that are declared within instances, + -- see below). + -- typeref is the reference for a related type. This part is -- optional. It is present for the following cases: @@ -130,7 +141,7 @@ package Lib.Xref is -- line is the line number of the reference - -- col is the column number of the reference, as defined above. + -- col is the column number of the reference, as defined above -- type is one of -- b = body entity @@ -296,7 +307,7 @@ package Lib.Xref is -- the END line of the body has an explict reference to -- the name of the procedure at line 12, column 13. - -- the body ends at line 12, column 15, just past this label. + -- the body ends at line 12, column 15, just past this label -- 16I9*My_Type<2|4I9> 18r8 @@ -350,7 +361,9 @@ package Lib.Xref is -- For private types, the character + appears in the table. In this -- case the kind of the underlying type is used, if available, to -- determine the character to use in the xref listing. The listing - -- will still include a '+' for a generic private type, for example. + -- will still include a '+' for a generic private type, for example, + -- but will retain the '*' for an object or formal parameter of such + -- a type. -- For subprograms, the characters 'U' and 'V' appear in the table, -- indicating procedures and functions. If the operation is abstract, @@ -597,6 +610,6 @@ package Lib.Xref is -- Output references to the current ali file procedure Initialize; - -- Initialize internal tables. + -- Initialize internal tables end Lib.Xref; diff --git a/gcc/ada/xref_lib.adb b/gcc/ada/xref_lib.adb index 5b953e441e1..b6054b62285 100644 --- a/gcc/ada/xref_lib.adb +++ b/gcc/ada/xref_lib.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1998-2003 Free Software Foundation, Inc. -- +-- Copyright (C) 1998-2005 Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -755,6 +755,10 @@ package body Xref_Lib is -- to parse the ali file again because the parent entity is not in -- the declaration table if it did not match the search pattern. + procedure Skip_To_Matching_Closing_Bracket; + -- When Ptr points to an opening square bracket, moves it to the + -- character following the matching closing bracket + --------------------- -- Get_Symbol_Name -- --------------------- @@ -806,6 +810,27 @@ package body Xref_Lib is return "???"; end Get_Symbol_Name; + -------------------------------------- + -- Skip_To_Matching_Closing_Bracket -- + -------------------------------------- + + procedure Skip_To_Matching_Closing_Bracket is + Num_Brackets : Natural; + + begin + Num_Brackets := 1; + while Num_Brackets /= 0 loop + Ptr := Ptr + 1; + if Ali (Ptr) = '[' then + Num_Brackets := Num_Brackets + 1; + elsif Ali (Ptr) = ']' then + Num_Brackets := Num_Brackets - 1; + end if; + end loop; + + Ptr := Ptr + 1; + end Skip_To_Matching_Closing_Bracket; + -- Start of processing for Parse_Identifier_Info begin @@ -862,7 +887,10 @@ package body Xref_Lib is Decl_Ref := Add_Declaration (File.X_File, Ali (E_Name .. Ptr - 1), E_Line, E_Col, E_Type); - if Ali (Ptr) = '<' + if Ali (Ptr) = '[' then + Skip_To_Matching_Closing_Bracket; + + elsif Ali (Ptr) = '<' or else Ali (Ptr) = '(' or else Ali (Ptr) = '{' then @@ -918,20 +946,7 @@ package body Xref_Lib is -- Skip the information for generics instantiations if Ali (Ptr) = '[' then - declare - Num_Brackets : Natural := 1; - begin - while Num_Brackets /= 0 loop - Ptr := Ptr + 1; - if Ali (Ptr) = '[' then - Num_Brackets := Num_Brackets + 1; - elsif Ali (Ptr) = ']' then - Num_Brackets := Num_Brackets - 1; - end if; - end loop; - - Ptr := Ptr + 1; - end; + Skip_To_Matching_Closing_Bracket; end if; -- Skip '>', or ')' or '>' @@ -1169,6 +1184,7 @@ package body Xref_Lib is or else Source (Ptr) = ASCII.HT or else Source (Ptr) = '<' or else Source (Ptr) = '{' + or else Source (Ptr) = '[' or else Source (Ptr) = '=' or else Source (Ptr) = '(')) and then Source (Ptr) >= ' ' |