OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

make.adb: (Kill): New procedure (__gnat_kill imported) 

2007-09-26  Vincent Celier  <celier@adacore.com>

	* make.adb: (Kill): New procedure (__gnat_kill imported)
	(Running_Compile, Outstanding_Compiles): Global variables that
	were previously local to procedure Compile_Sources.
	(Sigint_Intercepted): Send signal SIGINT to all outstanding
	compilation processes.

	(Gnatmake): If project files are used, create the mapping of all the
	sources, so that the correct paths will be found.

	* prj-env.ads, prj-env.adb (Create_Mapping): New procedure

From-SVN: r128795
This commit is contained in:
Vincent Celier 2007-09-26 12:44:46 +02:00 committed by Arnaud Charlet
parent a338b0e349
commit 0a8e311d15
2 changed files with 102 additions and 79 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

172
gcc/ada/lib-xref.adb
View File

@ -62,10 +62,10 @@ package body Lib.Xref is
-- Entity referenced (E parameter to Generate_Reference) -- Entity referenced (E parameter to Generate_Reference)
Def : Source_Ptr; Def : Source_Ptr;
-- Original source location for entity being referenced. Note that -- Original source location for entity being referenced. Note that these
-- these values are used only during the output process, they are -- values are used only during the output process, they are not set when
-- not set when the entries are originally built. This is because -- the entries are originally built. This is because private entities
-- private entities can be swapped when the initial call is made. -- can be swapped when the initial call is made.
Loc : Source_Ptr; Loc : Source_Ptr;
-- Location of reference (Original_Location (Sloc field of N parameter -- Location of reference (Original_Location (Sloc field of N parameter
@ -103,17 +103,17 @@ package body Lib.Xref is
begin begin
pragma Assert (Nkind (E) in N_Entity); pragma Assert (Nkind (E) in N_Entity);
-- Note that we do not test Xref_Entity_Letters here. It is too -- Note that we do not test Xref_Entity_Letters here. It is too early
-- early to do so, since we are often called before the entity -- to do so, since we are often called before the entity is fully
-- is fully constructed, so that the Ekind is still E_Void. -- constructed, so that the Ekind is still E_Void.
if Opt.Xref_Active if Opt.Xref_Active
-- Definition must come from source -- Definition must come from source
-- We make an exception for subprogram child units that have no -- We make an exception for subprogram child units that have no spec.
-- spec. For these we generate a subprogram declaration for library -- For these we generate a subprogram declaration for library use,
-- use, and the corresponding entity does not come from source. -- and the corresponding entity does not come from source.
-- Nevertheless, all references will be attached to it and we have -- Nevertheless, all references will be attached to it and we have
-- to treat is as coming from user code. -- to treat is as coming from user code.
@ -161,8 +161,8 @@ package body Lib.Xref is
return; return;
end if; end if;
-- If the operator is not a Standard operator, then we generate -- If the operator is not a Standard operator, then we generate a real
-- a real reference to the user defined operator. -- reference to the user defined operator.
if Sloc (Entity (N)) /= Standard_Location then if Sloc (Entity (N)) /= Standard_Location then
Generate_Reference (Entity (N), N); Generate_Reference (Entity (N), N);
@ -177,19 +177,18 @@ package body Lib.Xref is
Generate_Reference (Corresponding_Equality (Entity (N)), N); Generate_Reference (Corresponding_Equality (Entity (N)), N);
end if; end if;
-- For the case of Standard operators, we mark the result type -- For the case of Standard operators, we mark the result type as
-- as referenced. This ensures that in the case where we are -- referenced. This ensures that in the case where we are using a
-- using a derived operator, we mark an entity of the unit that -- derived operator, we mark an entity of the unit that implicitly
-- implicitly defines this operator as used. Otherwise we may -- defines this operator as used. Otherwise we may think that no entity
-- think that no entity of the unit is used. The actual entity -- of the unit is used. The actual entity marked as referenced is the
-- marked as referenced is the first subtype, which is the user -- first subtype, which is the relevant user defined entity.
-- defined entity that is relevant.
-- Note: we only do this for operators that come from source. -- Note: we only do this for operators that come from source. The
-- The generated code sometimes reaches for entities that do -- generated code sometimes reaches for entities that do not need to be
-- not need to be explicitly visible (for example, when we -- explicitly visible (for example, when we expand the code for
-- expand the code for comparing two record types, the fields -- comparing two record objects, the fields of the record may not be
-- of the record may not be visible). -- visible).
elsif Comes_From_Source (N) then elsif Comes_From_Source (N) then
Set_Referenced (First_Subtype (T)); Set_Referenced (First_Subtype (T));
@ -370,7 +369,7 @@ package body Lib.Xref is
end if; end if;
-- Unless the reference is forced, we ignore references where the -- Unless the reference is forced, we ignore references where the
-- reference itself does not come from Source. -- reference itself does not come from source.
if not Force and then not Comes_From_Source (N) then if not Force and then not Comes_From_Source (N) then
return; return;
@ -445,13 +444,13 @@ package body Lib.Xref is
end if; end if;
-- Check for pragma Unreferenced given and reference is within -- Check for pragma Unreferenced given and reference is within
-- this source unit (occasion for possible warning to be issued) -- this source unit (occasion for possible warning to be issued).
if Has_Pragma_Unreferenced (E) if Has_Pragma_Unreferenced (E)
and then In_Same_Extended_Unit (E, N) and then In_Same_Extended_Unit (E, N)
then then
-- A reference as a named parameter in a call does not count -- A reference as a named parameter in a call does not count
-- as a violation of pragma Unreferenced for this purpose. -- as a violation of pragma Unreferenced for this purpose...
if Nkind (N) = N_Identifier if Nkind (N) = N_Identifier
and then Nkind (Parent (N)) = N_Parameter_Association and then Nkind (Parent (N)) = N_Parameter_Association
@ -459,7 +458,7 @@ package body Lib.Xref is
then then
null; null;
-- Neither does a reference to a variable on the left side -- ... Neither does a reference to a variable on the left side
-- of an assignment. -- of an assignment.
elsif Is_On_LHS (N) then elsif Is_On_LHS (N) then
@ -564,8 +563,8 @@ package body Lib.Xref is
if Comes_From_Source (E) then if Comes_From_Source (E) then
Ent := E; Ent := E;
-- Entity does not come from source, but is a derived subprogram -- Entity does not come from source, but is a derived subprogram and
-- and the derived subprogram comes from source (after one or more -- the derived subprogram comes from source (after one or more
-- derivations) in which case the reference is to parent subprogram. -- derivations) in which case the reference is to parent subprogram.
elsif Is_Overloadable (E) elsif Is_Overloadable (E)
@ -588,8 +587,8 @@ package body Lib.Xref is
then then
Ent := E; Ent := E;
-- Record components of discriminated subtypes or derived types -- Record components of discriminated subtypes or derived types must
-- must be treated as references to the original component. -- be treated as references to the original component.
elsif Ekind (E) = E_Component elsif Ekind (E) = E_Component
and then Comes_From_Source (Original_Record_Component (E)) and then Comes_From_Source (Original_Record_Component (E))
@ -711,11 +710,11 @@ package body Lib.Xref is
Tref : out Entity_Id; Tref : out Entity_Id;
Left : out Character; Left : out Character;
Right : out Character); Right : out Character);
-- Given an entity id Ent, determines whether a type reference is -- Given an Entity_Id Ent, determines whether a type reference is
-- required. If so, Tref is set to the entity for the type reference -- required. If so, Tref is set to the entity for the type reference
-- and Left and Right are set to the left/right brackets to be -- and Left and Right are set to the left/right brackets to be output
-- output for the reference. If no type reference is required, then -- for the reference. If no type reference is required, then Tref is
-- Tref is set to Empty, and Left/Right are set to space. -- set to Empty, and Left/Right are set to space.
procedure Output_Import_Export_Info (Ent : Entity_Id); procedure Output_Import_Export_Info (Ent : Entity_Id);
-- Ouput language and external name information for an interfaced -- Ouput language and external name information for an interfaced
@ -756,9 +755,9 @@ package body Lib.Xref is
if Tref /= Etype (Tref) then if Tref /= Etype (Tref) then
Tref := First_Subtype (Etype (Tref)); Tref := First_Subtype (Etype (Tref));
-- Set brackets for derived type, but don't -- Set brackets for derived type, but don't override
-- override pointer case since the fact that -- pointer case since the fact that something is a
-- something is a pointer is more important -- pointer is more important.
if Left /= '(' then if Left /= '(' then
Left := '<'; Left := '<';
@ -766,8 +765,8 @@ package body Lib.Xref is
end if; end if;
-- If non-derived ptr, get directly designated type. -- If non-derived ptr, get directly designated type.
-- If the type has a full view, all references are -- If the type has a full view, all references are on the
-- on the partial view, that is seen first. -- partial view, that is seen first.
elsif Is_Access_Type (Tref) then elsif Is_Access_Type (Tref) then
Tref := Directly_Designated_Type (Tref); Tref := Directly_Designated_Type (Tref);
@ -822,8 +821,8 @@ package body Lib.Xref is
end if; end if;
end if; end if;
-- For objects, functions, enum literals, -- For objects, functions, enum literals, just get type from
-- just get type from Etype field. -- Etype field.
elsif Is_Object (Tref) elsif Is_Object (Tref)
or else Ekind (Tref) = E_Enumeration_Literal or else Ekind (Tref) = E_Enumeration_Literal
@ -838,26 +837,24 @@ package body Lib.Xref is
exit; exit;
end if; end if;
-- Exit if no type reference, or we are stuck in -- Exit if no type reference, or we are stuck in some loop trying
-- some loop trying to find the type reference, or -- to find the type reference, or if the type is standard void
-- if the type is standard void type (the latter is -- type (the latter is an implementation artifact that should not
-- an implementation artifact that should not show -- show up in the generated cross-references).
-- up in the generated cross-references).
exit when No (Tref) exit when No (Tref)
or else Tref = Sav or else Tref = Sav
or else Tref = Standard_Void_Type; or else Tref = Standard_Void_Type;
-- If we have a usable type reference, return, otherwise -- If we have a usable type reference, return, otherwise keep
-- keep looking for something useful (we are looking for -- looking for something useful (we are looking for something
-- something that either comes from source or standard) -- that either comes from source or standard)
if Sloc (Tref) = Standard_Location if Sloc (Tref) = Standard_Location
or else Comes_From_Source (Tref) or else Comes_From_Source (Tref)
then then
-- If the reference is a subtype created for a generic -- If the reference is a subtype created for a generic actual,
-- actual, go to actual directly, the inner subtype is -- go actual directly, the inner subtype is not user visible.
-- not user visible.
if Nkind (Parent (Tref)) = N_Subtype_Declaration if Nkind (Parent (Tref)) = N_Subtype_Declaration
and then not Comes_From_Source (Parent (Tref)) and then not Comes_From_Source (Parent (Tref))
@ -964,7 +961,7 @@ package body Lib.Xref is
procedure New_Entry (E : Entity_Id); procedure New_Entry (E : Entity_Id);
-- Make an additional entry into the Xref table for a type entity -- Make an additional entry into the Xref table for a type entity
-- that is related to the current entity (parent, type. ancestor, -- that is related to the current entity (parent, type ancestor,
-- progenitor, etc.). -- progenitor, etc.).
---------------- ----------------
@ -993,7 +990,7 @@ package body Lib.Xref is
begin begin
-- Note that this is not a for loop for a very good reason. The -- Note that this is not a for loop for a very good reason. The
-- processing of items in the table can add new items to the table, -- processing of items in the table can add new items to the table,
-- and they must be processed as well -- and they must be processed as well.
J := 1; J := 1;
while J <= Xrefs.Last loop while J <= Xrefs.Last loop
@ -1040,8 +1037,8 @@ package body Lib.Xref is
Prim : Entity_Id; Prim : Entity_Id;
function Parent_Op (E : Entity_Id) return Entity_Id; function Parent_Op (E : Entity_Id) return Entity_Id;
-- Find original operation, which may be inherited -- Find original operation, which may be inherited through
-- through several derivations. -- several derivations.
function Parent_Op (E : Entity_Id) return Entity_Id is function Parent_Op (E : Entity_Id) return Entity_Id is
Orig_Op : constant Entity_Id := Alias (E); Orig_Op : constant Entity_Id := Alias (E);
@ -1090,8 +1087,8 @@ package body Lib.Xref is
Output_Refs : declare Output_Refs : declare
Nrefs : Nat := Xrefs.Last; Nrefs : Nat := Xrefs.Last;
-- Number of references in table. This value may get reset -- Number of references in table. This value may get reset (reduced)
-- (reduced) when we eliminate duplicate reference entries. -- when we eliminate duplicate reference entries.
Rnums : array (0 .. Nrefs) of Nat; Rnums : array (0 .. Nrefs) of Nat;
-- This array contains numbers of references in the Xrefs table. -- This array contains numbers of references in the Xrefs table.
@ -1152,17 +1149,17 @@ package body Lib.Xref is
T2 : Xref_Entry renames Xrefs.Table (Rnums (Nat (Op2))); T2 : Xref_Entry renames Xrefs.Table (Rnums (Nat (Op2)));
begin begin
-- First test. If entity is in different unit, sort by unit -- First test: if entity is in different unit, sort by unit
if T1.Eun /= T2.Eun then if T1.Eun /= T2.Eun then
return Dependency_Num (T1.Eun) < Dependency_Num (T2.Eun); return Dependency_Num (T1.Eun) < Dependency_Num (T2.Eun);
-- Second test, within same unit, sort by entity Sloc -- Second test: within same unit, sort by entity Sloc
elsif T1.Def /= T2.Def then elsif T1.Def /= T2.Def then
return T1.Def < T2.Def; return T1.Def < T2.Def;
-- Third test, sort definitions ahead of references -- Third test: sort definitions ahead of references
elsif T1.Loc = No_Location then elsif T1.Loc = No_Location then
return True; return True;
@ -1170,12 +1167,12 @@ package body Lib.Xref is
elsif T2.Loc = No_Location then elsif T2.Loc = No_Location then
return False; return False;
-- Fourth test, for same entity, sort by reference location unit -- Fourth test: for same entity, sort by reference location unit
elsif T1.Lun /= T2.Lun then elsif T1.Lun /= T2.Lun then
return Dependency_Num (T1.Lun) < Dependency_Num (T2.Lun); return Dependency_Num (T1.Lun) < Dependency_Num (T2.Lun);
-- Fifth test order of location within referencing unit -- Fifth test: order of location within referencing unit
elsif T1.Loc /= T2.Loc then elsif T1.Loc /= T2.Loc then
return T1.Loc < T2.Loc; return T1.Loc < T2.Loc;
@ -1318,8 +1315,8 @@ package body Lib.Xref is
begin begin
if List_Interface then if List_Interface then
-- This is a progenitor interface of the type for -- This is a progenitor interface of the type for which
-- which xref information is being generated. -- xref information is being generated.
Tref := Ent; Tref := Ent;
Left := '<'; Left := '<';
@ -1374,8 +1371,8 @@ package body Lib.Xref is
Write_Info_Nat Write_Info_Nat
(Int (Get_Column_Number (Sloc (Tref)))); (Int (Get_Column_Number (Sloc (Tref))));
-- If the type comes from an instantiation, -- If the type comes from an instantiation, add the
-- add the corresponding info. -- corresponding info.
Output_Instantiation_Refs (Sloc (Tref)); Output_Instantiation_Refs (Sloc (Tref));
Write_Info_Char (Right); Write_Info_Char (Right);
@ -1459,9 +1456,9 @@ package body Lib.Xref is
Ctyp := Xref_Entity_Letters (Ekind (Ent)); Ctyp := Xref_Entity_Letters (Ekind (Ent));
-- Skip reference if it is the only reference to an entity, -- Skip reference if it is the only reference to an entity,
-- and it is an end-line reference, and the entity is not in -- and it is an END line reference, and the entity is not in
-- the current extended source. This prevents junk entries -- the current extended source. This prevents junk entries
-- consisting only of packages with end lines, where no -- consisting only of packages with END lines, where no
-- entity from the package is actually referenced. -- entity from the package is actually referenced.
if XE.Typ = 'e' if XE.Typ = 'e'
@ -1511,7 +1508,7 @@ package body Lib.Xref is
elsif Is_Generic_Type (Ent) then elsif Is_Generic_Type (Ent) then
-- If the type of the entity is a generic private type -- If the type of the entity is a generic private type,
-- there is no usable full view, so retain the indication -- there is no usable full view, so retain the indication
-- that this is an object. -- that this is an object.
@ -1547,10 +1544,10 @@ package body Lib.Xref is
and then Is_Abstract_Subprogram (XE.Ent) and then Is_Abstract_Subprogram (XE.Ent)
then then
if Ctyp = 'U' then if Ctyp = 'U' then
Ctyp := 'x'; -- abstract procedure Ctyp := 'x'; -- Abstract procedure
elsif Ctyp = 'V' then elsif Ctyp = 'V' then
Ctyp := 'y'; -- abstract function Ctyp := 'y'; -- Abstract function
end if; end if;
elsif Is_Type (XE.Ent) elsif Is_Type (XE.Ent)
@ -1560,7 +1557,7 @@ package body Lib.Xref is
Ctyp := 'h'; Ctyp := 'h';
elsif Ctyp = 'R' then elsif Ctyp = 'R' then
Ctyp := 'H'; -- abstract type Ctyp := 'H'; -- Abstract type
end if; end if;
end if; end if;
@ -1717,7 +1714,7 @@ package body Lib.Xref is
end Write_Level_Info; end Write_Level_Info;
-- Output entity name. We use the occurrence from the -- Output entity name. We use the occurrence from the
-- actual source program at the definition point -- actual source program at the definition point.
P := Original_Location (Sloc (XE.Ent)); P := Original_Location (Sloc (XE.Ent));
@ -1828,7 +1825,7 @@ package body Lib.Xref is
end if; end if;
-- Indicate that the entity is in the unit of the current -- Indicate that the entity is in the unit of the current
-- xref xection. -- xref section.
Curru := Curxu; Curru := Curxu;
@ -1862,6 +1859,8 @@ package body Lib.Xref is
Check_Type_Reference (XE.Ent, False); Check_Type_Reference (XE.Ent, False);
-- Additional information for types with progenitors
if Is_Record_Type (XE.Ent) if Is_Record_Type (XE.Ent)
and then Present (Abstract_Interfaces (XE.Ent)) and then Present (Abstract_Interfaces (XE.Ent))
then then
@ -1875,10 +1874,25 @@ package body Lib.Xref is
Next_Elmt (Elmt); Next_Elmt (Elmt);
end loop; end loop;
end; end;
-- For array types, list index types as well.
-- (This is not C, indices have distinct types).
elsif Is_Array_Type (XE.Ent) then
declare
Indx : Node_Id;
begin
Indx := First_Index (XE.Ent);
while Present (Indx) loop
Check_Type_Reference
(First_Subtype (Etype (Indx)), True);
Next_Index (Indx);
end loop;
end;
end if; end if;
-- If the entity is an overriding operation, write -- If the entity is an overriding operation, write info
-- info on operation that was overridden. -- on operation that was overridden.
if Is_Subprogram (XE.Ent) if Is_Subprogram (XE.Ent)
and then Is_Overriding_Operation (XE.Ent) and then Is_Overriding_Operation (XE.Ent)

9
gcc/ada/lib-xref.ads
View File

@ -117,6 +117,10 @@ package Lib.Xref is
-- entry of the form LR=<> for each of the interfaces appearing -- entry of the form LR=<> for each of the interfaces appearing
-- in the type declaration. -- in the type declaration.
-- For an array type, there is an entry of the form LR=<> for
-- each of the index types appearing in the type declaration.
-- The index types follow the entry for the component type.
-- In the above list LR shows the brackets used in the output, -- In the above list LR shows the brackets used in the output,
-- which has one of the two following forms: -- which has one of the two following forms:
@ -169,6 +173,7 @@ package Lib.Xref is
-- p = primitive operation -- p = primitive operation
-- P = overriding primitive operation -- P = overriding primitive operation
-- r = reference -- r = reference
-- R = subprogram reference in dispatching call
-- t = end of body -- t = end of body
-- w = WITH line -- w = WITH line
-- x = type extension -- x = type extension
@ -249,6 +254,10 @@ package Lib.Xref is
-- operation of the parent type, the letter 'P' is used in the -- operation of the parent type, the letter 'P' is used in the
-- corresponding entry. -- corresponding entry.
-- R is used to mark a dispatching call. The reference is to
-- the specification of the primitive operation of the root
-- type when the call has a controlling argument in its class.
-- t is similar to e. It identifies the end of a corresponding -- t is similar to e. It identifies the end of a corresponding
-- body (such a reference always links up with a b reference) -- body (such a reference always links up with a b reference)