-- --
-- B o d y --
-- --
--- Copyright (C) 1998-2011, Free Software Foundation, Inc. --
+-- Copyright (C) 1998-2012, 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- --
-- Local Subprograms --
------------------------
+ procedure Add_Entry (Key : Xref_Key; Ent_Scope_File : Unit_Number_Type);
+ -- Add an entry to the tables of Xref_Entries, avoiding duplicates
+
procedure Generate_Prim_Op_References (Typ : Entity_Id);
-- For a tagged type, generate implicit references to its primitive
-- operations, for source navigation. This is done right before emitting
function Lt (T1, T2 : Xref_Entry) return Boolean;
-- Order cross-references
- procedure Add_Entry (Key : Xref_Key; Ent_Scope_File : Unit_Number_Type);
- -- Add an entry to the tables of Xref_Entries, avoiding duplicates
-
---------------
-- Add_Entry --
---------------
Set_Ref : Boolean := True;
Force : Boolean := False)
is
- Nod : Node_Id;
- Ref : Source_Ptr;
- Def : Source_Ptr;
- Ent : Entity_Id;
-
- Actual_Typ : Character := Typ;
-
- Ref_Scope : Entity_Id;
+ Actual_Typ : Character := Typ;
+ Call : Node_Id;
+ Def : Source_Ptr;
+ Ent : Entity_Id;
Ent_Scope : Entity_Id;
- Ent_Scope_File : Unit_Number_Type;
-
- Call : Node_Id;
- Formal : Entity_Id;
- -- Used for call to Find_Actual
-
- Kind : Entity_Kind;
- -- If Formal is non-Empty, then its Ekind, otherwise E_Void
+ Formal : Entity_Id;
+ Kind : Entity_Kind;
+ Nod : Node_Id;
+ Ref : Source_Ptr;
+ Ref_Scope : Entity_Id;
function Get_Through_Renamings (E : Entity_Id) return Entity_Id;
-- Get the enclosing entity through renamings, which may come from
and then Warn_On_Ada_2005_Compatibility
and then (Typ = 'm' or else Typ = 'r' or else Typ = 's')
then
- Error_Msg_NE ("& is only defined in Ada 2005?", N, E);
+ Error_Msg_NE ("& is only defined in Ada 2005?y?", N, E);
end if;
-- Warn if reference to Ada 2012 entity not in Ada 2012 mode. We only
and then Warn_On_Ada_2012_Compatibility
and then (Typ = 'm' or else Typ = 'r')
then
- Error_Msg_NE ("& is only defined in Ada 2012?", N, E);
+ Error_Msg_NE ("& is only defined in Ada 2012?y?", N, E);
end if;
-- Never collect references if not in main source unit. However, we omit
or else Typ = 'i'
or else Typ = 'k'
or else (Typ = 'b' and then Is_Generic_Instance (E))
+
+ -- Allow the generation of references to reads, writes and calls
+ -- in Alfa mode when the related context comes from an instance.
+
+ or else
+ (Alfa_Mode
+ and then In_Extended_Main_Code_Unit (N)
+ and then (Typ = 'm' or else Typ = 'r' or else Typ = 's'))
then
null;
else
while Present (BE) loop
if Chars (BE) = Chars (E) then
Error_Msg_NE -- CODEFIX
- ("?pragma Unreferenced given for&!", N, BE);
+ ("??pragma Unreferenced given for&!", N, BE);
exit;
end if;
and then Sloc (E) > No_Location
and then Sloc (N) > No_Location
- -- We ignore references from within an instance, except for default
- -- subprograms, for which we generate an implicit reference.
+ -- Ignore references from within an instance. The only exceptions to
+ -- this are default subprograms, for which we generate an implicit
+ -- reference and compilations in Alfa_Mode.
and then
- (Instantiation_Location (Sloc (N)) = No_Location or else Typ = 'i')
+ (Instantiation_Location (Sloc (N)) = No_Location
+ or else Typ = 'i'
+ or else Alfa_Mode)
- -- Ignore dummy references
+ -- Ignore dummy references
and then Typ /= ' '
then
- if Nkind (N) = N_Identifier
- or else
- Nkind (N) = N_Defining_Identifier
- or else
- Nkind (N) in N_Op
- or else
- Nkind (N) = N_Defining_Operator_Symbol
- or else
- Nkind (N) = N_Operator_Symbol
- or else
- (Nkind (N) = N_Character_Literal
- and then Sloc (Entity (N)) /= Standard_Location)
- or else
- Nkind (N) = N_Defining_Character_Literal
+ if Nkind_In (N, N_Identifier,
+ N_Defining_Identifier,
+ N_Defining_Operator_Symbol,
+ N_Operator_Symbol,
+ N_Defining_Character_Literal)
+ or else Nkind (N) in N_Op
+ or else (Nkind (N) = N_Character_Literal
+ and then Sloc (Entity (N)) /= Standard_Location)
then
Nod := N;
- elsif Nkind (N) = N_Expanded_Name
- or else
- Nkind (N) = N_Selected_Component
- then
+ elsif Nkind_In (N, N_Expanded_Name, N_Selected_Component) then
Nod := Selector_Name (N);
else
then
Ent := E;
+ -- Ditto for the formals of such a subprogram
+
+ elsif Is_Overloadable (Scope (E))
+ and then Is_Child_Unit (Scope (E))
+ then
+ Ent := E;
+
-- Record components of discriminated subtypes or derived types must
-- be treated as references to the original component.
-- Record reference to entity
- Ref := Original_Location (Sloc (Nod));
- Def := Original_Location (Sloc (Ent));
-
if Actual_Typ = 'p'
- and then Is_Subprogram (N)
- and then Present (Overridden_Operation (N))
+ and then Is_Subprogram (Nod)
+ and then Present (Overridden_Operation (Nod))
then
Actual_Typ := 'P';
end if;
if Alfa_Mode then
- Ref_Scope := Alfa.Enclosing_Subprogram_Or_Package (N);
+ Ref := Sloc (Nod);
+ Def := Sloc (Ent);
+
+ Ref_Scope := Alfa.Enclosing_Subprogram_Or_Package (Nod);
Ent_Scope := Alfa.Enclosing_Subprogram_Or_Package (Ent);
-- Since we are reaching through renamings in Alfa mode, we may
return;
end if;
- Ent_Scope_File := Get_Source_Unit (Ent_Scope);
+ Add_Entry
+ ((Ent => Ent,
+ Loc => Ref,
+ Typ => Actual_Typ,
+ Eun => Get_Code_Unit (Def),
+ Lun => Get_Code_Unit (Ref),
+ Ref_Scope => Ref_Scope,
+ Ent_Scope => Ent_Scope),
+ Ent_Scope_File => Get_Code_Unit (Ent));
+
else
- Ref_Scope := Empty;
- Ent_Scope := Empty;
- Ent_Scope_File := No_Unit;
- end if;
+ Ref := Original_Location (Sloc (Nod));
+ Def := Original_Location (Sloc (Ent));
- Add_Entry
- ((Ent => Ent,
- Loc => Ref,
- Typ => Actual_Typ,
- Eun => Get_Source_Unit (Def),
- Lun => Get_Source_Unit (Ref),
- Ref_Scope => Ref_Scope,
- Ent_Scope => Ent_Scope),
- Ent_Scope_File => Ent_Scope_File);
+ -- If this is an operator symbol, skip the initial quote for
+ -- navigation purposes. This is not done for the end label,
+ -- where we want the actual position after the closing quote.
+
+ if Typ = 't' then
+ null;
+
+ elsif Nkind (N) = N_Defining_Operator_Symbol
+ or else Nkind (Nod) = N_Operator_Symbol
+ then
+ Ref := Ref + 1;
+ end if;
+
+ Add_Entry
+ ((Ent => Ent,
+ Loc => Ref,
+ Typ => Actual_Typ,
+ Eun => Get_Source_Unit (Def),
+ Lun => Get_Source_Unit (Ref),
+ Ref_Scope => Empty,
+ Ent_Scope => Empty),
+ Ent_Scope_File => No_Unit);
+ end if;
end if;
end Generate_Reference;
-- types may be swapped, and the Sloc value may be incorrect. We
-- also set up the pointer vector for the sort.
+ -- For user-defined operators we need to skip the initial quote and
+ -- point to the first character of the name, for navigation purposes.
+
for J in 1 .. Nrefs loop
- Rnums (J) := J;
- Xrefs.Table (J).Def :=
- Original_Location (Sloc (Xrefs.Table (J).Key.Ent));
+ declare
+ E : constant Entity_Id := Xrefs.Table (J).Key.Ent;
+ Loc : constant Source_Ptr := Original_Location (Sloc (E));
+
+ begin
+ Rnums (J) := J;
+
+ if Nkind (E) = N_Defining_Operator_Symbol then
+ Xrefs.Table (J).Def := Loc + 1;
+ else
+ Xrefs.Table (J).Def := Loc;
+ end if;
+ end;
end loop;
-- Sort the references
(Int (Get_Logical_Line_Number (XE.Key.Loc)));
Write_Info_Char (XE.Key.Typ);
- if Is_Overloadable (XE.Key.Ent)
- and then Is_Imported (XE.Key.Ent)
- and then XE.Key.Typ = 'b'
- then
- Output_Import_Export_Info (XE.Key.Ent);
+ if Is_Overloadable (XE.Key.Ent) then
+ if (Is_Imported (XE.Key.Ent) and then XE.Key.Typ = 'b')
+ or else
+ (Is_Exported (XE.Key.Ent) and then XE.Key.Typ = 'i')
+ then
+ Output_Import_Export_Info (XE.Key.Ent);
+ end if;
end if;
Write_Info_Nat (Int (Get_Column_Number (XE.Key.Loc)));
end Output_Refs;
end Output_References;
+-- Start of elaboration for Lib.Xref
+
begin
-- Reset is necessary because Elmt_Ptr does not default to Null_Ptr,
-- because it's not an access type.
projects / platform / upstream / gcc48.git / blobdiff