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;
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
-- 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 (
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
-- 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 (
--
-- 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
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;
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;
-- 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;
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)
exit;
end if;
- -- For a subtype, go to ancestor subtype.
+ -- For a subtype, go to ancestor subtype
else
Tref := Ancestor_Subtype (Tref);
(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;
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;
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
end;
end if;
- -- Special handling for abstract types and operations.
+ -- Special handling for abstract types and operations
if Is_Abstract (XE.Ent) then
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;
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);
-- --
-- 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- --
-- 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,
-- 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:
-- 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
-- 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
-- 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,
-- Output references to the current ali file
procedure Initialize;
- -- Initialize internal tables.
+ -- Initialize internal tables
end Lib.Xref;
-- --
-- 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- --
-- 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 --
---------------------
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
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
-- 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 '>'
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) >= ' '
projects / thirdparty / gcc.git / commitdiff
