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

mlib-tgt-tru64.adb, [...] (Library_Exist_For, [...]): Add new parameter In_Tree to specify the project tree... 

2005-03-08  Vincent Celier  <celier@adacore.com>

	* mlib-tgt-tru64.adb, mlib-tgt-aix.adb, mlib-tgt-irix.adb,
	mlib-tgt-hpux.adb, mlib-tgt-linux.adb, mlib-tgt-solaris.adb,
	mlib-tgt-vms-alpha.adb, mlib-tgt-vms-ia64.adb, mlib-tgt-mingw.adb,
	mlib-tgt-vxworks.adb, mlib-tgt-lynxos.adb (Library_Exist_For,
	Library_File_Name_For): Add new parameter In_Tree
	to specify the project tree: needed by the project manager.
	Adapt to changes in project manager using new parameter In_Tree.
	Remove local imports, use functions in System.CRTL.

	* make.adb, clean.adb, gnatcmd.adb (Project_Tree): New constant needed
	to use the project manager.

	* makeutl.ads, makeutl.adb (Linker_Options_Switches): New parameter
	In_Tree to designate the project tree. Adapt to changes in the project
	manager, using In_Tree.

	* mlib-prj.ads, mlib-prj.adb (Build_Library, Check_Library,
	Copy_Interface_Sources): Add new parameter In_Tree to specify the
	project tree: needed by the project manager.
	(Build_Library): Check that Arg'Length >= 6 before checking if it
	contains "--RTS=...".

	* mlib-tgt.ads, mlib-tgt.adb (Library_Exist_For,
	Library_File_Name_For): Add new parameter In_Tree to specify the
	project tree: needed by the project manager.

	* prj.ads, prj.adb: Major modifications to allow several project trees
	in memory at the same time.
	Change tables to dynamic tables and hash tables to dynamic hash
	tables. Move tables and hash tables from Prj.Com (in the visible part)
	and Prj.Env (in the private part). Move some constants from the visible
	part to the private part. Make other constants deferred.
	(Project_Empty): Make it a variable, not a function
	(Empty_Project): Add parameter Tree. Returns the data with the default
	naming data of the project tree Tree.
	(Initialize): After updating Std_Naming_Data, copy its value to the
	component Naming of Project Empty.
	(Register_Default_Naming_Scheme): Use and update the default naming
	component of the project tree, instead of the global variable
	Std_Naming_Data.
	(Standard_Naming_Data): Add defaulted parameter Tree. If project tree
	Tree is not defaulted, return the default naming data of the Tree.
	(Initial_Buffer_Size): Constant moved from private part
	(Default_Ada_Spec_Suffix_Id, Default_Ada_Body_Suffix_Id, Slash_Id); new
	variables initialized in procedure Initialize.
	(Add_To_Buffer): Add two in out parameters to replace global variables
	Buffer and Buffer_Last.
	(Default_Ada_Spec_Suffix, Default_Body_Spec_Suffix, Slash): New
	functions.
	Adapt to changes to use new type Project_Tree_Ref and dynamic tables and
	hash tables.
	(Initialize, Reset, register-Default_Namng-Scheme): Add a new parameter
	for the project tree.
	(Project_Tree_Data, Project_Tree_Ref, No_Project): Declare types and
	constant at the beginning of the package spec, so that they cane be used
	in subprograms before their full declarations.
	(Standard_Naming_Data): Add defaulted parameter of type Project_Node_Ref
	(Empty_Project): Add parameter of type Project_Node_Ref
	(Private_Project_Tree_Data): Add component Default_Naming of type
	Naming_Data.
	(Buffer, Buffer_Last): remove global variables
	(Add_To_Buffer): Add two in out parameters to replace global variables
	Buffer and Buffer_Last.
	(Current_Packages_To_Check): Remove global variable
	(Empty_Name): Move to private part
	(No-Symbols): Make it a constant
	(Private_Project_Tree_Data): New type for the private part of the
	project tree data.
	(Project_Tree_Data): New type for the data of a project tree
	(Project_Tree_Ref): New type to designate a project tree
	(Initialize, Reset, register-Default_Namng-Scheme): Add a new parameter
	for the project tree.

	* prj-attr.ads: Add with Table; needed, as package Prj no longer
	imports package Table.

	* prj-com.adb: Remove empty, no longer needed body

	* prj-com.ads: Move most of the content of this package to package Prj.

	* prj-dect.ads, prj-dect.adb (Parse): New parameters In_Tree to
	designate the project node tree and Packages_To_Check to replace
	global variable Current_Packages_To_Check.
	Add new parameters In_Tree and Packages_To_Check to local subprograms,
	when needed. Adapt to changes in project manager with project node tree
	In_Tree.

	* prj-env.ads, prj-env.adb: Add new parameter In_Tree to designate the
	project tree to most subprograms. Move tables and hash tables to
	private part of package Prj.
	Adapt to changes in project manager using project tree In_Tree.

	* prj-makr.adb (Tree): New constant to designate the project node tree
	Adapt to change in project manager using project node tree Tree

	* prj-nmsc.ads, prj-nmsc.adb (Check_Stand_Alone_Library): Correctly
	display the Library_Src_Dir and the Library_Dir.
	Add new parameter In_Tree to designate the project node tree to most
	subprograms. Adapt to changes in the project manager, using project tree
	In_Tree.
	(Check_Naming_Scheme): Do not alter the casing on platforms where
	the casing of file names is not significant.
	(Check): Add new parameter In_Tree to designate the

	* prj-pars.ads, prj-pars.adb (Parse): Add new parameter In_Tree to
	designate the project tree.
	Declare a project node tree to call Prj.Part.Parse and Prj.Proc.Process

	* prj-part.ads, prj-part.adb (Buffer, Buffer_Last): Global variables,
	to replace those that were in the private part of package Prj.
	Add new parameter In__Tree to designate the project node tree to most
	subprograms. Adapt to change in Prj.Tree with project node tree In_Tree.
	(Post_Parse_Context_Clause): When specifying the project node of a with
	clause, indicate that it is a limited with only if there is "limited"
	in the with clause, not necessarily when In_Limited is True.
	(Parse): Add new parameter In_Tree to designate the project node tree

	* prj-pp.ads, prj-pp.adb (Pretty_Print): Add new parameter In_Tree to
	designate the project node tree. Adapt to change in Prj.Tree with
	project node tree In_Tree.

	* prj-proc.ads, prj-proc.adb (Recursive_Process): Specify the project
	tree In_Tree in the call to function Empty_Process to give its initial
	value to the project data Processed_Data.
	Add new parameters In_Tree to designate the project tree and
	From_Project_Node_Tree to designate the project node tree to several
	subprograms. Adapt to change in project manager with project tree
	In_Tree and project node tree From_Project_Node_Tree.

	* prj-strt.ads, prj-strt.adb (Buffer, Buffer_Last): Global variables,
	to replace those that were in the private part of package Prj.
	Add new parameter In_Tree to designate the project node tree to most
	subprograms. Adapt to change in Prj.Tree with project node tree In_Tree.

	* prj-tree.ads, prj-tree.adb: Add new parameter of type
	Project_Node_Tree_Ref to most subprograms.
	Use this new parameter to store project nodes in the designated project
	node tree.
	(Project_Node_Tree_Ref): New type to designate a project node tree
	(Tree_Private_Part): Change table to dynamic table and hash tables to
	dynamic hash tables.

	* prj-util.ads, prj-util.adb: Add new parameter In_Tree to designate
	the project tree to most subprograms. Adapt to changes in project
	manager using project tree In_Tree.

	* makegpr.adb (Project_Tree): New constant needed to use project
	manager.

From-SVN: r96481
This commit is contained in:
Vincent Celier 2005-03-15 16:46:57 +01:00 committed by Arnaud Charlet
parent 0ca89db7aa
commit 7e98a4c668
47 changed files with 5514 additions and 3564 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

65
gcc/ada/clean.adb
View File

@ -37,7 +37,6 @@ with Opt; use Opt;
with Osint; use Osint;
with Osint.M; use Osint.M;
with Prj; use Prj;
with Prj.Com;
with Prj.Env;
with Prj.Ext;
with Prj.Pars;
@ -92,6 +91,8 @@ package body Clean is
Project_File_Name : String_Access := null;
Project_Tree : constant Prj.Project_Tree_Ref := new Prj.Project_Tree_Data;
Main_Project : Prj.Project_Id := Prj.No_Project;
All_Projects : Boolean := False;
@ -328,7 +329,8 @@ package body Clean is
procedure Clean_Archive (Project : Project_Id) is
Current_Dir : constant Dir_Name_Str := Get_Current_Dir;
Data : constant Project_Data := Projects.Table (Project);
Data : constant Project_Data :=
Project_Tree.Projects.Table (Project);
Archive_Name : constant String :=
"lib" & Get_Name_String (Data.Name) & '.' & Archive_Ext;
@ -560,8 +562,9 @@ package body Clean is
-- Name of the executable file
Current_Dir : constant Dir_Name_Str := Get_Current_Dir;
Data : constant Project_Data := Projects.Table (Project);
U_Data : Prj.Com.Unit_Data;
Data : constant Project_Data :=
Project_Tree.Projects.Table (Project);
U_Data : Unit_Data;
File_Name1 : Name_Id;
Index1 : Int;
File_Name2 : Name_Id;
@ -573,8 +576,6 @@ package body Clean is
Global_Archive : Boolean := False;
use Prj.Com;
begin
-- Check that we don't specify executable on the command line for
-- a main library project.
@ -612,8 +613,10 @@ package body Clean is
-- sources or inherited sources of the project.
if Data.Languages (Ada_Language_Index) then
for Unit in 1 .. Prj.Com.Units.Last loop
U_Data := Prj.Com.Units.Table (Unit);
for Unit in Unit_Table.First ..
Unit_Table.Last (Project_Tree.Units)
loop
U_Data := Project_Tree.Units.Table (Unit);
File_Name1 := No_Name;
File_Name2 := No_Name;
@ -749,8 +752,12 @@ package body Clean is
if Project = Main_Project and then not Data.Library then
Global_Archive := False;
for Proj in 1 .. Projects.Last loop
if Projects.Table (Proj).Other_Sources_Present then
for Proj in Project_Table.First ..
Project_Table.Last (Project_Tree.Projects)
loop
if Project_Tree.Projects.Table
(Proj).Other_Sources_Present
then
Global_Archive := True;
exit;
end if;
@ -769,7 +776,8 @@ package body Clean is
Source_Id := Data.First_Other_Source;
while Source_Id /= No_Other_Source loop
Source := Other_Sources.Table (Source_Id);
Source :=
Project_Tree.Other_Sources.Table (Source_Id);
if Is_Regular_File
(Get_Name_String (Source.Object_Name))
@ -839,7 +847,7 @@ package body Clean is
-- has not been processed already.
while Imported /= Empty_Project_List loop
Element := Project_Lists.Table (Imported);
Element := Project_Tree.Project_Lists.Table (Imported);
Imported := Element.Next;
Process := True;
@ -887,6 +895,7 @@ package body Clean is
Executable :=
Executable_Of
(Main_Project,
Project_Tree,
Main_Source_File,
Current_File_Index);
@ -1099,13 +1108,14 @@ package body Clean is
-- Set the project parsing verbosity to whatever was specified
-- by a possible -vP switch.
Prj.Pars.Set_Verbosity (To => Prj.Com.Current_Verbosity);
Prj.Pars.Set_Verbosity (To => Current_Verbosity);
-- Parse the project file. If there is an error, Main_Project
-- will still be No_Project.
Prj.Pars.Parse
(Project => Main_Project,
In_Tree => Project_Tree,
Project_File_Name => Project_File_Name.all,
Packages_To_Check => Packages_To_Check_By_Gnatmake);
@ -1121,12 +1131,10 @@ package body Clean is
New_Line;
end if;
-- We add the source directories and the object directories
-- to the search paths.
Add_Source_Directories (Main_Project);
Add_Object_Directories (Main_Project);
-- Add source directories and object directories to the search paths
Add_Source_Directories (Main_Project, Project_Tree);
Add_Object_Directories (Main_Project, Project_Tree);
end if;
Osint.Add_Default_Search_Dirs;
@ -1137,11 +1145,12 @@ package body Clean is
if Main_Project /= No_Project and then Osint.Number_Of_Files = 0 then
declare
Value : String_List_Id := Projects.Table (Main_Project).Mains;
Value : String_List_Id :=
Project_Tree.Projects.Table (Main_Project).Mains;
Main : String_Element;
begin
while Value /= Prj.Nil_String loop
Main := String_Elements.Table (Value);
Main := Project_Tree.String_Elements.Table (Value);
Osint.Add_File
(File_Name => Get_Name_String (Main.Value),
Index => Main.Index);
@ -1211,24 +1220,24 @@ package body Clean is
return True;
end if;
Data := Projects.Table (Of_Project);
Data := Project_Tree.Projects.Table (Of_Project);
while Data.Extends /= No_Project loop
if Data.Extends = Prj then
return True;
end if;
Data := Projects.Table (Data.Extends);
Data := Project_Tree.Projects.Table (Data.Extends);
end loop;
Data := Projects.Table (Prj);
Data := Project_Tree.Projects.Table (Prj);
while Data.Extends /= No_Project loop
if Data.Extends = Of_Project then
return True;
end if;
Data := Projects.Table (Data.Extends);
Data := Project_Tree.Projects.Table (Data.Extends);
end loop;
return False;
@ -1258,7 +1267,7 @@ package body Clean is
Csets.Initialize;
Namet.Initialize;
Snames.Initialize;
Prj.Initialize;
Prj.Initialize (Project_Tree);
end if;
-- Reset global variables
@ -1480,13 +1489,13 @@ package body Clean is
Verbose_Mode := True;
elsif Arg = "-vP0" then
Prj.Com.Current_Verbosity := Prj.Default;
Current_Verbosity := Prj.Default;
elsif Arg = "-vP1" then
Prj.Com.Current_Verbosity := Prj.Medium;
Current_Verbosity := Prj.Medium;
elsif Arg = "-vP2" then
Prj.Com.Current_Verbosity := Prj.High;
Current_Verbosity := Prj.High;
else
Bad_Argument;

110
gcc/ada/gnatcmd.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1996-2004 Free Software Foundation, Inc. --
-- Copyright (C) 1996-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- --
@ -34,7 +34,6 @@ with Opt; use Opt;
with Osint; use Osint;
with Output;
with Prj; use Prj;
with Prj.Com;
with Prj.Env;
with Prj.Ext; use Prj.Ext;
with Prj.Pars;
@ -57,6 +56,7 @@ with Table;
with VMS_Conv; use VMS_Conv;
procedure GNATCmd is
Project_Tree : constant Project_Tree_Ref := new Project_Tree_Data;
Project_File : String_Access;
Project : Prj.Project_Id;
Current_Verbosity : Prj.Verbosity := Prj.Default;
@ -244,7 +244,7 @@ procedure GNATCmd is
procedure Check_Files is
Add_Sources : Boolean := True;
Unit_Data : Prj.Com.Unit_Data;
Unit_Data : Prj.Unit_Data;
Subunit : Boolean := False;
begin
@ -263,11 +263,11 @@ procedure GNATCmd is
if Add_Sources then
declare
Current_Last : constant Integer := Last_Switches.Last;
use Prj.Com;
begin
for Unit in 1 .. Prj.Com.Units.Last loop
Unit_Data := Prj.Com.Units.Table (Unit);
for Unit in Unit_Table.First ..
Unit_Table.Last (Project_Tree.Units)
loop
Unit_Data := Project_Tree.Units.Table (Unit);
-- For gnatls, we only need to put the library units,
-- body or spec, but not the subunits.
@ -338,7 +338,7 @@ procedure GNATCmd is
-- For gnatpp and gnatmetric, put all sources
-- of the project.
for Kind in Prj.Com.Spec_Or_Body loop
for Kind in Spec_Or_Body loop
-- Put only sources that belong to the main
-- project.
@ -430,7 +430,8 @@ procedure GNATCmd is
elsif The_Command = Metric then
declare
Data : Project_Data := Projects.Table (Root_Project);
Data : Project_Data :=
Project_Tree.Projects.Table (Root_Project);
begin
while Data.Extends /= No_Project loop
@ -438,7 +439,7 @@ procedure GNATCmd is
return True;
end if;
Data := Projects.Table (Data.Extends);
Data := Project_Tree.Projects.Table (Data.Extends);
end loop;
end;
end if;
@ -464,7 +465,7 @@ procedure GNATCmd is
end if;
end loop;
Get_Name_String (Projects.Table
Get_Name_String (Project_Tree.Projects.Table
(Project).Exec_Directory);
if Name_Buffer (Name_Len) /= Directory_Separator then
@ -487,8 +488,8 @@ procedure GNATCmd is
function Configuration_Pragmas_File return Name_Id is
begin
Prj.Env.Create_Config_Pragmas_File
(Project, Project, Include_Config_Files => False);
return Projects.Table (Project).Config_File_Name;
(Project, Project, Project_Tree, Include_Config_Files => False);
return Project_Tree.Projects.Table (Project).Config_File_Name;
end Configuration_Pragmas_File;
------------------------------
@ -501,19 +502,25 @@ procedure GNATCmd is
begin
if not Keep_Temporary_Files then
if Project /= No_Project then
for Prj in 1 .. Projects.Last loop
if Projects.Table (Prj).Config_File_Temp then
for Prj in Project_Table.First ..
Project_Table.Last (Project_Tree.Projects)
loop
if
Project_Tree.Projects.Table (Prj).Config_File_Temp
then
if Verbose_Mode then
Output.Write_Str ("Deleting temp configuration file """);
Output.Write_Str
(Get_Name_String
(Projects.Table (Prj).Config_File_Name));
(Project_Tree.Projects.Table
(Prj).Config_File_Name));
Output.Write_Line ("""");
end if;
Delete_File
(Name => Get_Name_String
(Projects.Table (Prj).Config_File_Name),
(Project_Tree.Projects.Table
(Prj).Config_File_Name),
Success => Success);
end if;
end loop;
@ -568,7 +575,7 @@ procedure GNATCmd is
-- Check if there are library project files
if MLib.Tgt.Support_For_Libraries /= MLib.Tgt.None then
Set_Libraries (Project, There_Are_Libraries);
Set_Libraries (Project, Project_Tree, There_Are_Libraries);
end if;
-- If there are, add the necessary additional switches
@ -729,8 +736,8 @@ procedure GNATCmd is
declare
Dir : constant String :=
Get_Name_String
(Projects.Table (Prj).
Object_Directory);
(Project_Tree.Projects.Table
(Prj).Object_Directory);
begin
if Is_Regular_File
(Dir &
@ -754,7 +761,8 @@ procedure GNATCmd is
-- Go to the project being extended,
-- if any.
Prj := Projects.Table (Prj).Extends;
Prj :=
Project_Tree.Projects.Table (Prj).Extends;
exit Project_Loop when Prj = No_Project;
end loop Project_Loop;
end if;
@ -811,7 +819,8 @@ procedure GNATCmd is
Last_Switches.Table (Last_Switches.Last) :=
new String'("-o");
Get_Name_String
(Projects.Table (Project).Exec_Directory);
(Project_Tree.Projects.Table
(Project).Exec_Directory);
Last_Switches.Increment_Last;
Last_Switches.Table (Last_Switches.Last) :=
new String'(Name_Buffer (1 .. Name_Len) &
@ -839,7 +848,7 @@ procedure GNATCmd is
begin
-- Case of library project
if Projects.Table (Project).Library then
if Project_Tree.Projects.Table (Project).Library then
There_Are_Libraries := True;
-- Add the -L switch
@ -848,7 +857,8 @@ procedure GNATCmd is
Last_Switches.Table (Last_Switches.Last) :=
new String'("-L" &
Get_Name_String
(Projects.Table (Project).Library_Dir));
(Project_Tree.Projects.Table
(Project).Library_Dir));
-- Add the -l switch
@ -856,18 +866,21 @@ procedure GNATCmd is
Last_Switches.Table (Last_Switches.Last) :=
new String'("-l" &
Get_Name_String
(Projects.Table (Project).Library_Name));
(Project_Tree.Projects.Table
(Project).Library_Name));
-- Add the directory to table Library_Paths, to be processed later
-- if library is not static and if Path_Option is not null.
if Projects.Table (Project).Library_Kind /= Static
if Project_Tree.Projects.Table (Project).Library_Kind /=
Static
and then Path_Option /= null
then
Library_Paths.Increment_Last;
Library_Paths.Table (Library_Paths.Last) :=
new String'(Get_Name_String
(Projects.Table (Project).Library_Dir));
(Project_Tree.Projects.Table
(Project).Library_Dir));
end if;
end if;
end Set_Library_For;
@ -988,7 +1001,7 @@ begin
Snames.Initialize;
Prj.Initialize;
Prj.Initialize (Project_Tree);
Last_Switches.Init;
Last_Switches.Set_Last (0);
@ -1297,6 +1310,7 @@ begin
Prj.Pars.Parse
(Project => Project,
In_Tree => Project_Tree,
Project_File_Name => Project_File.all,
Packages_To_Check => All_Packages);
@ -1531,6 +1545,7 @@ begin
Prj.Pars.Parse
(Project => Project,
In_Tree => Project_Tree,
Project_File_Name => Project_File.all,
Packages_To_Check => Packages_To_Check);
@ -1543,12 +1558,13 @@ begin
declare
Data : constant Prj.Project_Data :=
Prj.Projects.Table (Project);
Project_Tree.Projects.Table (Project);
Pkg : constant Prj.Package_Id :=
Prj.Util.Value_Of
(Name => Tool_Package_Name,
In_Packages => Data.Decl.Packages);
In_Packages => Data.Decl.Packages,
In_Tree => Project_Tree);
Element : Package_Element;
@ -1560,7 +1576,7 @@ begin
begin
if Pkg /= No_Package then
Element := Packages.Table (Pkg);
Element := Project_Tree.Packages.Table (Pkg);
-- Packages Gnatls has a single attribute Switches, that is
-- not an associative array.
@ -1569,7 +1585,8 @@ begin
The_Switches :=
Prj.Util.Value_Of
(Variable_Name => Snames.Name_Switches,
In_Variables => Element.Decl.Attributes);
In_Variables => Element.Decl.Attributes,
In_Tree => Project_Tree);
-- Packages Binder (for gnatbind), Cross_Reference (for
-- gnatxref), Linker (for gnatlink) Finder (for gnatfind),
@ -1584,12 +1601,14 @@ begin
if The_Switches.Kind = Prj.Undefined then
Default_Switches_Array :=
Prj.Util.Value_Of
(Name => Name_Default_Switches,
In_Arrays => Element.Decl.Arrays);
(Name => Name_Default_Switches,
In_Arrays => Element.Decl.Arrays,
In_Tree => Project_Tree);
The_Switches := Prj.Util.Value_Of
(Index => Name_Ada,
Src_Index => 0,
In_Array => Default_Switches_Array);
In_Array => Default_Switches_Array,
In_Tree => Project_Tree);
end if;
end if;
@ -1616,7 +1635,8 @@ begin
when Prj.List =>
Current := The_Switches.Values;
while Current /= Prj.Nil_String loop
The_String := String_Elements.Table (Current);
The_String := Project_Tree.String_Elements.
Table (Current);
declare
Switch : constant String :=
@ -1642,12 +1662,14 @@ begin
then
Change_Dir
(Get_Name_String
(Projects.Table (Project).Object_Directory));
(Project_Tree.Projects.Table
(Project).Object_Directory));
end if;
-- Set up the env vars for project path files
Prj.Env.Set_Ada_Paths (Project, Including_Libraries => False);
Prj.Env.Set_Ada_Paths
(Project, Project_Tree, Including_Libraries => False);
-- For gnatstub, gnatmetric, gnatpp and gnatelim, create
-- a configuration pragmas file, if necessary.
@ -1714,7 +1736,8 @@ begin
(Last_Switches.Table (J), Current_Work_Dir);
end loop;
Get_Name_String (Projects.Table (Project).Directory);
Get_Name_String
(Project_Tree.Projects.Table (Project).Directory);
declare
Project_Dir : constant String := Name_Buffer (1 .. Name_Len);
@ -1729,7 +1752,7 @@ begin
elsif The_Command = Stub then
declare
Data : constant Prj.Project_Data :=
Prj.Projects.Table (Project);
Project_Tree.Projects.Table (Project);
File_Index : Integer := 0;
Dir_Index : Integer := 0;
Last : constant Integer := Last_Switches.Last;
@ -1815,7 +1838,8 @@ begin
First_Switches.Table (1) :=
new String'("-d=" &
Get_Name_String
(Projects.Table (Project).Object_Directory));
(Project_Tree.Projects.Table
(Project).Object_Directory));
end if;
-- For gnat pretty and gnat metric, if no file has been put on the
@ -1890,12 +1914,12 @@ begin
exception
when Error_Exit =>
Prj.Env.Delete_All_Path_Files;
Prj.Env.Delete_All_Path_Files (Project_Tree);
Delete_Temp_Config_Files;
Set_Exit_Status (Failure);
when Normal_Exit =>
Prj.Env.Delete_All_Path_Files;
Prj.Env.Delete_All_Path_Files (Project_Tree);
Delete_Temp_Config_Files;
-- Since GNATCmd is normally called from DCL (the VMS shell),

489
gcc/ada/make.adb
View File

File diff suppressed because it is too large Load Diff

239
gcc/ada/makegpr.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2004 Free Software Foundation, Inc. --
-- Copyright (C) 2004-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- --
@ -46,7 +46,6 @@ with Output; use Output;
with Opt; use Opt;
with Osint; use Osint;
with Prj; use Prj;
with Prj.Com; use Prj.Com;
with Prj.Pars;
with Prj.Util; use Prj.Util;
with Snames; use Snames;
@ -168,6 +167,8 @@ package body Makegpr is
Packages_To_Check : constant String_List_Access := List_Of_Packages'Access;
-- List of the packages to be checked when parsing/processing project files
Project_Tree : constant Project_Tree_Ref := new Project_Tree_Data;
Main_Project : Project_Id;
-- The project id of the main project
@ -617,7 +618,7 @@ package body Makegpr is
-- Nothing to do when there is no project specified
if Project /= No_Project then
Data := Projects.Table (Project);
Data := Project_Tree.Projects.Table (Project);
-- Nothing to do if the project has already been processed
@ -625,7 +626,7 @@ package body Makegpr is
-- Mark the project as processed, to avoid processing it again
Projects.Table (Project).Seen := True;
Project_Tree.Projects.Table (Project).Seen := True;
Recursive_Add_Archives (Data.Extends);
@ -634,17 +635,22 @@ package body Makegpr is
-- Call itself recursively for all imported projects
while Imported /= Empty_Project_List loop
Prj := Project_Lists.Table (Imported).Project;
Prj := Project_Tree.Project_Lists.Table
(Imported).Project;
if Prj /= No_Project then
while Projects.Table (Prj).Extended_By /= No_Project loop
Prj := Projects.Table (Prj).Extended_By;
while Project_Tree.Projects.Table
(Prj).Extended_By /= No_Project
loop
Prj := Project_Tree.Projects.Table
(Prj).Extended_By;
end loop;
Recursive_Add_Archives (Prj);
end if;
Imported := Project_Lists.Table (Imported).Next;
Imported := Project_Tree.Project_Lists.Table
(Imported).Next;
end loop;
-- If there is sources of language other than Ada in this
@ -664,8 +670,10 @@ package body Makegpr is
begin
-- First, mark all projects as not processed
for Project in 1 .. Projects.Last loop
Projects.Table (Project).Seen := False;
for Project in Project_Table.First ..
Project_Table.Last (Project_Tree.Projects)
loop
Project_Tree.Projects.Table (Project).Seen := False;
end loop;
-- Take care of the run path option
@ -939,10 +947,10 @@ package body Makegpr is
raise Program_Error;
when Linker =>
Pkg := Value_Of (Name_Linker, Data.Decl.Packages);
Pkg := Value_Of (Name_Linker, Data.Decl.Packages, Project_Tree);
when Compiler =>
Pkg := Value_Of (Name_Compiler, Data.Decl.Packages);
Pkg := Value_Of (Name_Compiler, Data.Decl.Packages, Project_Tree);
end case;
if Pkg /= No_Package then
@ -950,24 +958,30 @@ package body Makegpr is
Switches_Array := Prj.Util.Value_Of
(Name => Name_Switches,
In_Arrays => Packages.Table (Pkg).Decl.Arrays);
In_Arrays => Project_Tree.Packages.Table
(Pkg).Decl.Arrays,
In_Tree => Project_Tree);
Switches :=
Prj.Util.Value_Of
(Index => File_Name,
Src_Index => 0,
In_Array => Switches_Array);
In_Array => Switches_Array,
In_Tree => Project_Tree);
-- Otherwise, get the Default_Switches ("language"), if they exist
if Switches = Nil_Variable_Value then
Defaults := Prj.Util.Value_Of
(Name => Name_Default_Switches,
In_Arrays => Packages.Table (Pkg).Decl.Arrays);
In_Arrays => Project_Tree.Packages.Table
(Pkg).Decl.Arrays,
In_Tree => Project_Tree);
Switches := Prj.Util.Value_Of
(Index => Language_Names.Table (Language),
Src_Index => 0,
In_Array => Defaults);
In_Array => Defaults,
In_Tree => Project_Tree);
end if;
-- If there are switches, add them to Arguments
@ -975,7 +989,8 @@ package body Makegpr is
if Switches /= Nil_Variable_Value then
Element_Id := Switches.Values;
while Element_Id /= Nil_String loop
Element := String_Elements.Table (Element_Id);
Element := Project_Tree.String_Elements.Table
(Element_Id);
if Element.Value /= No_Name then
Get_Name_String (Element.Value);
@ -1003,7 +1018,8 @@ package body Makegpr is
--------------------------
procedure Build_Global_Archive is
Data : Project_Data := Projects.Table (Main_Project);
Data : Project_Data :=
Project_Tree.Projects.Table (Main_Project);
Source_Id : Other_Source_Id;
Source : Other_Source;
Success : Boolean;
@ -1072,8 +1088,10 @@ package body Makegpr is
-- Put all sources of language other than Ada in
-- Source_Indexes.
for Proj in 1 .. Projects.Last loop
Data := Projects.Table (Proj);
for Proj in Project_Table.First ..
Project_Table.Last (Project_Tree.Projects)
loop
Data := Project_Tree.Projects.Table (Proj);
if not Data.Library then
Last_Source := 0;
@ -1081,7 +1099,8 @@ package body Makegpr is
while Source_Id /= No_Other_Source loop
Add_Source_Id (Proj, Source_Id);
Source_Id := Other_Sources.Table (Source_Id).Next;
Source_Id := Project_Tree.Other_Sources.Table
(Source_Id).Next;
end loop;
end if;
end loop;
@ -1100,7 +1119,8 @@ package body Makegpr is
for S in 1 .. Last_Source loop
Source_Id := Source_Indexes (S).Id;
Source := Other_Sources.Table (Source_Id);
Source := Project_Tree.Other_Sources.Table
(Source_Id);
if (not Source_Indexes (S).Found)
and then Source.Object_Path = Object_Path
@ -1219,14 +1239,17 @@ package body Makegpr is
-- Followed by all the object files of the non library projects
for Proj in 1 .. Projects.Last loop
Data := Projects.Table (Proj);
for Proj in Project_Table.First ..
Project_Table.Last (Project_Tree.Projects)
loop
Data := Project_Tree.Projects.Table (Proj);
if not Data.Library then
Source_Id := Data.First_Other_Source;
while Source_Id /= No_Other_Source loop
Source := Other_Sources.Table (Source_Id);
Source :=
Project_Tree.Other_Sources.Table (Source_Id);
-- Only include object file name that have not been
-- overriden in extending projects.
@ -1345,7 +1368,8 @@ package body Makegpr is
-------------------
procedure Build_Library (Project : Project_Id; Unconditionally : Boolean) is
Data : constant Project_Data := Projects.Table (Project);
Data : constant Project_Data :=
Project_Tree.Projects.Table (Project);
Source_Id : Other_Source_Id;
Source : Other_Source;
@ -1366,7 +1390,7 @@ package body Makegpr is
Time_Stamp : Time_Stamp_Type;
Driver_Name : Name_Id := No_Name;
Lib_Opts : Argument_List_Access := No_Argument'Unrestricted_Access;
Lib_Opts : Argument_List_Access := No_Argument'Access;
begin
Check_Archive_Builder;
@ -1414,7 +1438,8 @@ package body Makegpr is
while Source_Id /= No_Other_Source loop
Add_Source_Id (Project, Source_Id);
Source_Id := Other_Sources.Table (Source_Id).Next;
Source_Id := Project_Tree.Other_Sources.Table
(Source_Id).Next;
end loop;
-- Read the dependency file, line by line
@ -1430,16 +1455,17 @@ package body Makegpr is
-- Check if this object file is for a source of this project
for S in 1 .. Last_Source loop
if (not Source_Indexes (S).Found) and then
Other_Sources.Table
(Source_Indexes (S).Id).Object_Name =
Object_Name
if (not Source_Indexes (S).Found)
and then
Project_Tree.Other_Sources.Table
(Source_Indexes (S).Id).Object_Name = Object_Name
then
-- We have found the object file: get the source
-- data, and mark it as found.
Source_Id := Source_Indexes (S).Id;
Source := Other_Sources.Table (Source_Id);
Source := Project_Tree.Other_Sources.Table
(Source_Id);
Source_Indexes (S).Found := True;
exit;
end if;
@ -1526,7 +1552,8 @@ package body Makegpr is
if Verbose_Mode then
Source_Id := Source_Indexes (Index).Id;
Source := Other_Sources.Table (Source_Id);
Source := Project_Tree.Other_Sources.Table
(Source_Id);
Write_Str (" -> ");
Write_Str (Get_Name_String (Source.Object_Name));
Write_Str (" is not in the archive ");
@ -1566,7 +1593,7 @@ package body Makegpr is
Source_Id := Data.First_Other_Source;
while Source_Id /= No_Other_Source loop
Source := Other_Sources.Table (Source_Id);
Source := Project_Tree.Other_Sources.Table (Source_Id);
Add_Argument
(Get_Name_String (Source.Object_Name), Verbose_Mode);
Source_Id := Source.Next;
@ -1605,7 +1632,8 @@ package body Makegpr is
Library_Options : constant Variable_Value :=
Value_Of
(Name_Library_Options,
Data.Decl.Attributes);
Data.Decl.Attributes,
Project_Tree);
begin
if not Library_Options.Default then
@ -1615,7 +1643,8 @@ package body Makegpr is
begin
while Current /= Nil_String loop
Element := String_Elements.Table (Current);
Element := Project_Tree.String_Elements.
Table (Current);
Get_Name_String (Element.Value);
if Name_Len /= 0 then
@ -2034,9 +2063,12 @@ package body Makegpr is
begin
C_Plus_Plus_Is_Used := False;
for Project in 1 .. Projects.Last loop
for Project in Project_Table.First ..
Project_Table.Last (Project_Tree.Projects)
loop
if
Projects.Table (Project).Languages (C_Plus_Plus_Language_Index)
Project_Tree.Projects.Table (Project).Languages
(C_Plus_Plus_Language_Index)
then
C_Plus_Plus_Is_Used := True;
exit;
@ -2053,7 +2085,8 @@ package body Makegpr is
Data : in Project_Data;
Local_Errors : in out Boolean)
is
Source : Other_Source := Other_Sources.Table (Source_Id);
Source : Other_Source :=
Project_Tree.Other_Sources.Table (Source_Id);
Success : Boolean;
CPATH : String_Access := null;
@ -2283,7 +2316,7 @@ package body Makegpr is
else
-- Everything looks fine, update the Other_Sources table
Other_Sources.Table (Source_Id) := Source;
Project_Tree.Other_Sources.Table (Source_Id) := Source;
end if;
-- Compilation failed
@ -2302,7 +2335,8 @@ package body Makegpr is
--------------------------------
procedure Compile_Individual_Sources is
Data : Project_Data := Projects.Table (Main_Project);
Data : Project_Data :=
Project_Tree.Projects.Table (Main_Project);
Source_Id : Other_Source_Id;
Source : Other_Source;
Source_Name : Name_Id;
@ -2318,7 +2352,7 @@ package body Makegpr is
Compile_Only := True;
Get_Imported_Directories (Main_Project, Data);
Projects.Table (Main_Project) := Data;
Project_Tree.Projects.Table (Main_Project) := Data;
-- Compilation will occur in the object directory
@ -2361,7 +2395,8 @@ package body Makegpr is
Source_Id := Data.First_Other_Source;
while Source_Id /= No_Other_Source loop
Source := Other_Sources.Table (Source_Id);
Source :=
Project_Tree.Other_Sources.Table (Source_Id);
exit when Source.File_Name = Source_Name;
Source_Id := Source.Next;
end loop;
@ -2406,7 +2441,8 @@ package body Makegpr is
--------------------------------
procedure Compile_Link_With_Gnatmake (Mains_Specified : Boolean) is
Data : constant Project_Data := Projects.Table (Main_Project);
Data : constant Project_Data :=
Project_Tree.Projects.Table (Main_Project);
Success : Boolean;
begin
@ -2571,9 +2607,11 @@ package body Makegpr is
begin
-- Loop through project files
for Project in 1 .. Projects.Last loop
for Project in Project_Table.First ..
Project_Table.Last (Project_Tree.Projects)
loop
Local_Errors := False;
Data := Projects.Table (Project);
Data := Project_Tree.Projects.Table (Project);
-- Nothing to do when no sources of language other than Ada
@ -2584,7 +2622,7 @@ package body Makegpr is
if not Data.Include_Data_Set then
Get_Imported_Directories (Project, Data);
Data.Include_Data_Set := True;
Projects.Table (Project) := Data;
Project_Tree.Projects.Table (Project) := Data;
end if;
Need_To_Rebuild_Archive := Force_Compilations;
@ -2598,7 +2636,7 @@ package body Makegpr is
-- Process each source one by one
while Source_Id /= No_Other_Source loop
Source := Other_Sources.Table (Source_Id);
Source := Project_Tree.Other_Sources.Table (Source_Id);
Need_To_Compile := Force_Compilations;
-- Check if compilation is needed
@ -2679,7 +2717,7 @@ package body Makegpr is
Create (Dep_File, Append_File, Name);
while Source_Id /= No_Other_Source loop
Source := Other_Sources.Table (Source_Id);
Source := Project_Tree.Other_Sources.Table (Source_Id);
Put_Line (Dep_File, Get_Name_String (Source.Object_Name));
Put_Line (Dep_File, String (Source.Object_TS));
Source_Id := Source.Next;
@ -2713,12 +2751,15 @@ package body Makegpr is
-- Get all the object files of non-Ada sources in non-library projects
for Project in 1 .. Projects.Last loop
if not Projects.Table (Project).Library then
Source_Id := Projects.Table (Project).First_Other_Source;
for Project in Project_Table.First ..
Project_Table.Last (Project_Tree.Projects)
loop
if not Project_Tree.Projects.Table (Project).Library then
Source_Id :=
Project_Tree.Projects.Table (Project).First_Other_Source;
while Source_Id /= No_Other_Source loop
Source := Other_Sources.Table (Source_Id);
Source := Project_Tree.Other_Sources.Table (Source_Id);
-- Put only those object files that are in the global archive
@ -2791,10 +2832,14 @@ package body Makegpr is
------------------
procedure Get_Compiler (For_Language : First_Language_Indexes) is
Data : constant Project_Data := Projects.Table (Main_Project);
Data : constant Project_Data :=
Project_Tree.Projects.Table (Main_Project);
Ide : constant Package_Id :=
Value_Of (Name_Ide, In_Packages => Data.Decl.Packages);
Value_Of
(Name_Ide,
In_Packages => Data.Decl.Packages,
In_Tree => Project_Tree);
-- The id of the package IDE in the project file
Compiler : constant Variable_Value :=
@ -2802,7 +2847,8 @@ package body Makegpr is
(Name => Language_Names.Table (For_Language),
Index => 0,
Attribute_Or_Array_Name => Name_Compiler_Command,
In_Package => Ide);
In_Package => Ide,
In_Tree => Project_Tree);
-- The value of Compiler_Command ("language") in package IDE, if defined
begin
@ -2902,7 +2948,7 @@ package body Makegpr is
-- Add each source directory path name, preceded by "-I" to Arguments
while Element_Id /= Nil_String loop
Element := String_Elements.Table (Element_Id);
Element := Project_Tree.String_Elements.Table (Element_Id);
if Element.Value /= No_Name then
Get_Name_String (Element.Value);
@ -2960,7 +3006,7 @@ package body Makegpr is
-- Nothing to do if project is undefined
if Prj /= No_Project then
Data := Projects.Table (Prj);
Data := Project_Tree.Projects.Table (Prj);
-- Nothing to do if project has already been processed
@ -2969,7 +3015,7 @@ package body Makegpr is
-- Mark the project as processed, to avoid multiple processing
-- of the same project.
Projects.Table (Prj).Seen := True;
Project_Tree.Projects.Table (Prj).Seen := True;
-- Add the source directories of this project
@ -2984,8 +3030,11 @@ package body Makegpr is
-- Call itself for all imported projects, if any
while Imported /= Empty_Project_List loop
Recursive_Get_Dirs (Project_Lists.Table (Imported).Project);
Imported := Project_Lists.Table (Imported).Next;
Recursive_Get_Dirs
(Project_Tree.Project_Lists.Table
(Imported).Project);
Imported :=
Project_Tree.Project_Lists.Table (Imported).Next;
end loop;
end if;
end if;
@ -2996,8 +3045,10 @@ package body Makegpr is
begin
-- First, mark all project as not processed
for J in 1 .. Projects.Last loop
Projects.Table (J).Seen := False;
for J in Project_Table.First ..
Project_Table.Last (Project_Tree.Projects)
loop
Project_Tree.Projects.Table (J).Seen := False;
end loop;
-- Empty Arguments
@ -3006,15 +3057,18 @@ package body Makegpr is
-- Process this project individually, project data are already known
Projects.Table (Project).Seen := True;
Project_Tree.Projects.Table (Project).Seen := True;
Add (Data.Source_Dirs);
Recursive_Get_Dirs (Data.Extends);
while Imported_Projects /= Empty_Project_List loop
Recursive_Get_Dirs (Project_Lists.Table (Imported_Projects).Project);
Imported_Projects := Project_Lists.Table (Imported_Projects).Next;
Recursive_Get_Dirs
(Project_Tree.Project_Lists.Table
(Imported_Projects).Project);
Imported_Projects := Project_Tree.Project_Lists.Table
(Imported_Projects).Next;
end loop;
Data.Imported_Directories_Switches :=
@ -3059,6 +3113,7 @@ package body Makegpr is
Prj.Pars.Parse
(Project => Main_Project,
In_Tree => Project_Tree,
Project_File_Name => Project_File_Name.all,
Packages_To_Check => Packages_To_Check);
@ -3092,7 +3147,8 @@ package body Makegpr is
else
declare
Data : constant Prj.Project_Data := Projects.Table (Main_Project);
Data : constant Prj.Project_Data :=
Project_Tree.Projects.Table (Main_Project);
begin
if Data.Library and then Mains.Number_Of_Mains /= 0 then
Osint.Fail
@ -3143,7 +3199,7 @@ package body Makegpr is
Csets.Initialize;
Namet.Initialize;
Snames.Initialize;
Prj.Initialize;
Prj.Initialize (Project_Tree);
Mains.Delete;
-- Set Name_Ide and Name_Compiler_Command
@ -3198,19 +3254,22 @@ package body Makegpr is
(Object_Name : Name_Id;
Project : Project_Id) return Boolean
is
Data : Project_Data := Projects.Table (Project);
Data : Project_Data := Project_Tree.Projects.Table (Project);
Source : Other_Source_Id;
begin
while Data.Extended_By /= No_Project loop
Data := Projects.Table (Data.Extended_By);
Source := Data.First_Other_Source;
Data := Project_Tree.Projects.Table (Data.Extended_By);
Source := Data.First_Other_Source;
while Source /= No_Other_Source loop
if Other_Sources.Table (Source).Object_Name = Object_Name then
if Project_Tree.Other_Sources.Table (Source).Object_Name =
Object_Name
then
return False;
else
Source := Other_Sources.Table (Source).Next;
Source :=
Project_Tree.Other_Sources.Table (Source).Next;
end if;
end loop;
end loop;
@ -3223,7 +3282,8 @@ package body Makegpr is
----------------------
procedure Link_Executables is
Data : constant Project_Data := Projects.Table (Main_Project);
Data : constant Project_Data :=
Project_Tree.Projects.Table (Main_Project);
Mains_Specified : constant Boolean := Mains.Number_Of_Mains /= 0;
-- True if main sources were specified on the command line
@ -3288,8 +3348,10 @@ package body Makegpr is
Prj_Data : Project_Data;
begin
for Prj in 1 .. Projects.Last loop
Prj_Data := Projects.Table (Prj);
for Prj in Project_Table.First ..
Project_Table.Last (Project_Tree.Projects)
loop
Prj_Data := Project_Tree.Projects.Table (Prj);
-- There is an archive only in project
-- files with sources other than Ada
@ -3381,10 +3443,11 @@ package body Makegpr is
Executable_Name : constant String :=
Get_Name_String
(Executable_Of
(Project => Main_Project,
Main => Main_Id,
Index => 0,
Ada_Main => False));
(Project => Main_Project,
In_Tree => Project_Tree,
Main => Main_Id,
Index => 0,
Ada_Main => False));
-- File name of the executable
Executable_Path : constant String :=
@ -3453,6 +3516,7 @@ package body Makegpr is
Get_Name_String
(Executable_Of
(Project => Main_Project,
In_Tree => Project_Tree,
Main => Main_Id,
Index => 0,
Ada_Main => False)),
@ -3484,7 +3548,7 @@ package body Makegpr is
if Link_Options_Switches = null then
Link_Options_Switches :=
new Argument_List'
(Linker_Options_Switches (Main_Project));
(Linker_Options_Switches (Main_Project, Project_Tree));
end if;
Add_Arguments (Link_Options_Switches.all, True);
@ -3532,7 +3596,8 @@ package body Makegpr is
begin
while Element_Id /= Nil_String loop
Element := String_Elements.Table (Element_Id);
Element := Project_Tree.String_Elements.Table
(Element_Id);
if Element.Value /= No_Name then
Mains.Add_Main (Get_Name_String (Element.Value));
@ -3629,7 +3694,8 @@ package body Makegpr is
-- Check if it is a source of a language other than Ada
while Source_Id /= No_Other_Source loop
Source := Other_Sources.Table (Source_Id);
Source :=
Project_Tree.Other_Sources.Table (Source_Id);
exit when Source.File_Name = Main_Id;
Source_Id := Source.Next;
end loop;
@ -3674,6 +3740,7 @@ package body Makegpr is
(Get_Name_String
(Executable_Of
(Project => Main_Project,
In_Tree => Project_Tree,
Main => Other_Mains.Table (Main).File_Name,
Index => 0,
Ada_Main => False)),
@ -3774,7 +3841,8 @@ package body Makegpr is
-- Check if it is a source of the main project file
while Source_Id /= No_Other_Source loop
Source := Other_Sources.Table (Source_Id);
Source :=
Project_Tree.Other_Sources.Table (Source_Id);
exit when Source.File_Name = Main_Id;
Source_Id := Source.Next;
end loop;
@ -3815,6 +3883,7 @@ package body Makegpr is
(Get_Name_String
(Executable_Of
(Project => Main_Project,
In_Tree => Project_Tree,
Main => Main_Id,
Index => 0,
Ada_Main => False)));

52
gcc/ada/makeutl.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2004 Free Software Foundation, Inc. --
-- Copyright (C) 2004-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- --
@ -185,7 +185,8 @@ package body Makeutl is
-----------------------------
function Linker_Options_Switches
(Project : Project_Id) return String_List
(Project : Project_Id;
In_Tree : Project_Tree_Ref) return String_List
is
procedure Recursive_Add_Linker_Options (Proj : Project_Id);
-- The recursive routine used to add linker options
@ -202,29 +203,33 @@ package body Makeutl is
begin
if Proj /= No_Project then
Data := Projects.Table (Proj);
Data := In_Tree.Projects.Table (Proj);
if not Data.Seen then
Projects.Table (Proj).Seen := True;
In_Tree.Projects.Table (Proj).Seen := True;
Imported := Data.Imported_Projects;
while Imported /= Empty_Project_List loop
Recursive_Add_Linker_Options
(Project_Lists.Table (Imported).Project);
Imported := Project_Lists.Table (Imported).Next;
(In_Tree.Project_Lists.Table
(Imported).Project);
Imported := In_Tree.Project_Lists.Table
(Imported).Next;
end loop;
if Proj /= Project then
Linker_Package :=
Prj.Util.Value_Of
(Name => Name_Linker,
In_Packages => Data.Decl.Packages);
(Name => Name_Linker,
In_Packages => Data.Decl.Packages,
In_Tree => In_Tree);
Options :=
Prj.Util.Value_Of
(Name => Name_Ada,
Index => 0,
(Name => Name_Ada,
Index => 0,
Attribute_Or_Array_Name => Name_Linker_Options,
In_Package => Linker_Package);
In_Package => Linker_Package,
In_Tree => In_Tree);
-- If attribute is present, add the project with
-- the attribute to table Linker_Opts.
@ -244,8 +249,10 @@ package body Makeutl is
begin
Linker_Opts.Init;
for Index in 1 .. Projects.Last loop
Projects.Table (Index).Seen := False;
for Index in Project_Table.First ..
Project_Table.Last (In_Tree.Projects)
loop
In_Tree.Projects.Table (Index).Seen := False;
end loop;
Recursive_Add_Linker_Options (Project);
@ -262,15 +269,19 @@ package body Makeutl is
begin
-- If Dir_Path has not been computed for this project, do it now
if Projects.Table (Proj).Dir_Path = null then
Projects.Table (Proj).Dir_Path :=
if In_Tree.Projects.Table (Proj).Dir_Path = null then
In_Tree.Projects.Table (Proj).Dir_Path :=
new String'
(Get_Name_String (Projects.Table (Proj). Directory));
(Get_Name_String
(In_Tree.Projects.Table
(Proj). Directory));
end if;
while Options /= Nil_String loop
Option := String_Elements.Table (Options).Value;
Options := String_Elements.Table (Options).Next;
Option :=
In_Tree.String_Elements.Table (Options).Value;
Options :=
In_Tree.String_Elements.Table (Options).Next;
Add_Linker_Option (Get_Name_String (Option));
-- Object files and -L switches specified with
@ -280,7 +291,8 @@ package body Makeutl is
Test_If_Relative_Path
(Switch =>
Linker_Options_Buffer (Last_Linker_Option),
Parent => Projects.Table (Proj).Dir_Path,
Parent =>
In_Tree.Projects.Table (Proj).Dir_Path,
Including_L_Switch => True);
end loop;
end;
@ -326,7 +338,7 @@ package body Makeutl is
procedure Delete is
begin
Names.Set_Last (0);
Reset;
Mains.Reset;
end Delete;
---------------

11
gcc/ada/makeutl.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2004 Free Software Foundation, Inc. --
-- Copyright (C) 2004-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- --
@ -56,8 +56,13 @@ package Makeutl is
-- been entered by a call to Prj.Ext.Add, so that in a project
-- file, External ("name") will return "value".
function Linker_Options_Switches (Project : Project_Id) return String_List;
-- Comment required ???
function Linker_Options_Switches
(Project : Project_Id;
In_Tree : Project_Tree_Ref) return String_List;
-- Collect the options specified in the Linker'Linker_Options attributes
-- of project Project, in project tree In_Tree, and in the projects that
-- it imports directly or indirectly, and returns the result.
-- Package Mains is used to store the mains specified on the command line
-- and to retrieve them when a project file is used, to verify that the

126
gcc/ada/mlib-prj.adb
View File

@ -224,6 +224,7 @@ package body MLib.Prj is
procedure Copy_Interface_Sources
(For_Project : Project_Id;
In_Tree : Project_Tree_Ref;
Interfaces : Argument_List;
To_Dir : Name_Id);
-- Copy the interface sources of a SAL to directory To_Dir
@ -294,6 +295,7 @@ package body MLib.Prj is
procedure Build_Library
(For_Project : Project_Id;
In_Tree : Project_Tree_Ref;
Gnatbind : String;
Gnatbind_Path : String_Access;
Gcc : String;
@ -315,7 +317,7 @@ package body MLib.Prj is
-- On OpenVMS, set to True if library needs to be linked with
-- g-trasym.obj.
Data : Project_Data := Projects.Table (For_Project);
Data : Project_Data := In_Tree.Projects.Table (For_Project);
Object_Directory_Path : constant String :=
Get_Name_String (Data.Object_Directory);
@ -484,15 +486,15 @@ package body MLib.Prj is
elsif P /= No_Project then
declare
Data : Project_Data := Projects.Table (For_Project);
Data : Project_Data :=
In_Tree.Projects.Table (For_Project);
begin
while Data.Extends /= No_Project loop
if P = Data.Extends then
return True;
end if;
Data := Projects.Table (Data.Extends);
Data := In_Tree.Projects.Table (Data.Extends);
end loop;
end;
end if;
@ -668,7 +670,8 @@ package body MLib.Prj is
---------------------
procedure Process_Project (Project : Project_Id) is
Data : constant Project_Data := Projects.Table (Project);
Data : constant Project_Data :=
In_Tree.Projects.Table (Project);
Imported : Project_List := Data.Imported_Projects;
Element : Project_Element;
@ -683,7 +686,8 @@ package body MLib.Prj is
-- we have a proper reverse order for the libraries.
while Imported /= Empty_Project_List loop
Element := Project_Lists.Table (Imported);
Element :=
In_Tree.Project_Lists.Table (Imported);
if Element.Project /= No_Project then
Process_Project (Element.Project);
@ -718,7 +722,8 @@ package body MLib.Prj is
for Index in reverse 1 .. Library_Projs.Last loop
Current := Library_Projs.Table (Index);
Get_Name_String (Projects.Table (Current).Library_Dir);
Get_Name_String
(In_Tree.Projects.Table (Current).Library_Dir);
Opts.Increment_Last;
Opts.Table (Opts.Last) :=
new String'("-L" & Name_Buffer (1 .. Name_Len));
@ -732,7 +737,8 @@ package body MLib.Prj is
new String'
("-l" &
Get_Name_String
(Projects.Table (Current).Library_Name));
(In_Tree.Projects.Table
(Current).Library_Name));
end loop;
end Process_Imported_Libraries;
@ -812,7 +818,8 @@ package body MLib.Prj is
Binder_Package : constant Package_Id :=
Value_Of
(Name => Name_Binder,
In_Packages => Data.Decl.Packages);
In_Packages => Data.Decl.Packages,
In_Tree => In_Tree);
begin
if Binder_Package /= No_Package then
@ -821,8 +828,9 @@ package body MLib.Prj is
Value_Of
(Name => Name_Default_Switches,
In_Arrays =>
Packages.Table
(Binder_Package).Decl.Arrays);
In_Tree.Packages.Table
(Binder_Package).Decl.Arrays,
In_Tree => In_Tree);
Switches : Variable_Value := Nil_Variable_Value;
Switch : String_List_Id := Nil_String;
@ -833,7 +841,8 @@ package body MLib.Prj is
Value_Of
(Index => Name_Ada,
Src_Index => 0,
In_Array => Defaults);
In_Array => Defaults,
In_Tree => In_Tree);
if not Switches.Default then
Switch := Switches.Values;
@ -841,8 +850,10 @@ package body MLib.Prj is
while Switch /= Nil_String loop
Add_Argument
(Get_Name_String
(String_Elements.Table (Switch).Value));
Switch := String_Elements.Table (Switch).Next;
(In_Tree.String_Elements.Table
(Switch).Value));
Switch := In_Tree.String_Elements.
Table (Switch).Next;
end loop;
end if;
end if;
@ -862,8 +873,10 @@ package body MLib.Prj is
Interface_ALIs.Reset;
Processed_ALIs.Reset;
for Source in 1 .. Com.Units.Last loop
Unit := Com.Units.Table (Source);
for Source in Unit_Table.First ..
Unit_Table.Last (In_Tree.Units)
loop
Unit := In_Tree.Units.Table (Source);
if Unit.File_Names (Body_Part).Name /= No_Name
and then Unit.File_Names (Body_Part).Path /= Slash
@ -944,8 +957,8 @@ package body MLib.Prj is
declare
Arg : String_Ptr renames Args.Table (Index);
begin
if
Arg (Arg'First + 2 .. Arg'First + 5) = "RTS="
if Arg'Length >= 6 and then
Arg (Arg'First + 2 .. Arg'First + 5) = "RTS="
then
Add_Argument (Arg.all);
exit;
@ -959,7 +972,9 @@ package body MLib.Prj is
-- Set the paths
Set_Ada_Paths
(Project => For_Project, Including_Libraries => True);
(Project => For_Project,
In_Tree => In_Tree,
Including_Libraries => True);
-- Display the gnatbind command, if not in quiet output
@ -982,7 +997,9 @@ package body MLib.Prj is
-- Set the paths
Set_Ada_Paths
(Project => For_Project, Including_Libraries => True);
(Project => For_Project,
In_Tree => In_Tree,
Including_Libraries => True);
-- Invoke <gcc> -c b$$<lib>.adb
@ -1076,7 +1093,8 @@ package body MLib.Prj is
if Link then
-- If attribute Library_GCC was specified, get the driver name
Library_GCC := Value_Of (Name_Library_GCC, Data.Decl.Attributes);
Library_GCC :=
Value_Of (Name_Library_GCC, Data.Decl.Attributes, In_Tree);
if not Library_GCC.Default then
Driver_Name := Library_GCC.Value;
@ -1086,7 +1104,7 @@ package body MLib.Prj is
-- options.
Library_Options :=
Value_Of (Name_Library_Options, Data.Decl.Attributes);
Value_Of (Name_Library_Options, Data.Decl.Attributes, In_Tree);
if not Library_Options.Default then
declare
@ -1095,7 +1113,8 @@ package body MLib.Prj is
begin
while Current /= Nil_String loop
Element := String_Elements.Table (Current);
Element :=
In_Tree.String_Elements.Table (Current);
Get_Name_String (Element.Value);
if Name_Len /= 0 then
@ -1240,7 +1259,7 @@ package body MLib.Prj is
exit when Data.Extends = No_Project;
In_Main_Object_Directory := False;
Data := Projects.Table (Data.Extends);
Data := In_Tree.Projects.Table (Data.Extends);
end loop;
-- Add the -L and -l switches for the imported Library Project Files,
@ -1416,7 +1435,7 @@ package body MLib.Prj is
-- the library directory (by Copy_ALI_Files, below).
if Standalone then
Data := Projects.Table (For_Project);
Data := In_Tree.Projects.Table (For_Project);
declare
Iface : String_List_Id := Data.Lib_Interface_ALIs;
@ -1424,11 +1443,14 @@ package body MLib.Prj is
begin
while Iface /= Nil_String loop
ALI := String_Elements.Table (Iface).Value;
ALI :=
In_Tree.String_Elements.Table (Iface).Value;
Interface_ALIs.Set (ALI, True);
Get_Name_String (String_Elements.Table (Iface).Value);
Get_Name_String
(In_Tree.String_Elements.Table (Iface).Value);
Add_Argument (Name_Buffer (1 .. Name_Len));
Iface := String_Elements.Table (Iface).Next;
Iface :=
In_Tree.String_Elements.Table (Iface).Next;
end loop;
Iface := Data.Lib_Interface_ALIs;
@ -1440,9 +1462,11 @@ package body MLib.Prj is
-- interface. If it is not the case, output a warning.
while Iface /= Nil_String loop
ALI := String_Elements.Table (Iface).Value;
ALI := In_Tree.String_Elements.Table
(Iface).Value;
Process (ALI);
Iface := String_Elements.Table (Iface).Next;
Iface :=
In_Tree.String_Elements.Table (Iface).Next;
end loop;
end if;
end;
@ -1453,7 +1477,8 @@ package body MLib.Prj is
-- copy directory or because the interface copy directory is the
-- same as the library directory.
Copy_Dir := Projects.Table (For_Project).Library_Dir;
Copy_Dir :=
In_Tree.Projects.Table (For_Project).Library_Dir;
Clean (Copy_Dir);
-- Call procedure to build the library, depending on the build mode
@ -1502,21 +1527,26 @@ package body MLib.Prj is
-- Copy interface sources if Library_Src_Dir specified
if Standalone
and then Projects.Table (For_Project).Library_Src_Dir /= No_Name
and then In_Tree.Projects.Table
(For_Project).Library_Src_Dir /= No_Name
then
-- Clean the interface copy directory, if it is not also the
-- library directory. If it is also the library directory, it
-- has already been cleaned before generation of the library.
if Projects.Table (For_Project).Library_Src_Dir /= Copy_Dir then
Copy_Dir := Projects.Table (For_Project).Library_Src_Dir;
if In_Tree.Projects.Table
(For_Project).Library_Src_Dir /= Copy_Dir
then
Copy_Dir := In_Tree.Projects.Table
(For_Project).Library_Src_Dir;
Clean (Copy_Dir);
end if;
Copy_Interface_Sources
(For_Project => For_Project,
Interfaces => Arguments (1 .. Argument_Number),
To_Dir => Copy_Dir);
In_Tree => In_Tree,
Interfaces => Arguments (1 .. Argument_Number),
To_Dir => Copy_Dir);
end if;
end if;
@ -1553,8 +1583,11 @@ package body MLib.Prj is
-- Check_Library --
-------------------
procedure Check_Library (For_Project : Project_Id) is
Data : constant Project_Data := Projects.Table (For_Project);
procedure Check_Library
(For_Project : Project_Id; In_Tree : Project_Tree_Ref)
is
Data : constant Project_Data :=
In_Tree.Projects.Table (For_Project);
begin
-- No need to build the library if there is no object directory,
@ -1566,7 +1599,8 @@ package body MLib.Prj is
then
declare
Current : constant Dir_Name_Str := Get_Current_Dir;
Lib_Name : constant Name_Id := Library_File_Name_For (For_Project);
Lib_Name : constant Name_Id :=
Library_File_Name_For (For_Project, In_Tree);
Lib_TS : Time_Stamp_Type;
Obj_TS : Time_Stamp_Type;
@ -1613,7 +1647,8 @@ package body MLib.Prj is
-- Library must be rebuilt
Projects.Table (For_Project).Need_To_Build_Lib := True;
In_Tree.Projects.Table
(For_Project).Need_To_Build_Lib := True;
exit;
end if;
end if;
@ -1682,6 +1717,7 @@ package body MLib.Prj is
procedure Copy_Interface_Sources
(For_Project : Project_Id;
In_Tree : Project_Tree_Ref;
Interfaces : Argument_List;
To_Dir : Name_Id)
is
@ -1711,8 +1747,10 @@ package body MLib.Prj is
begin
Unit_Loop :
for Index in 1 .. Com.Units.Last loop
Data := Com.Units.Table (Index);
for Index in Unit_Table.First ..
Unit_Table.Last (In_Tree.Units)
loop
Data := In_Tree.Units.Table (Index);
for J in Data.File_Names'Range loop
if Data.File_Names (J).Project = For_Project
@ -1738,7 +1776,9 @@ package body MLib.Prj is
-- Change the working directory to the object directory
Change_Dir
(Get_Name_String (Projects.Table (For_Project).Object_Directory));
(Get_Name_String
(In_Tree.Projects.Table
(For_Project).Object_Directory));
for Index in Interfaces'Range loop

6
gcc/ada/mlib-prj.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2001-2003, Ada Core Technologies, Inc. --
-- Copyright (C) 2001-2005, Ada Core Technologies, 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- --
@ -32,6 +32,7 @@ package MLib.Prj is
procedure Build_Library
(For_Project : Project_Id;
In_Tree : Project_Tree_Ref;
Gnatbind : String;
Gnatbind_Path : String_Access;
Gcc : String;
@ -45,7 +46,8 @@ package MLib.Prj is
-- files. If Bind is False the binding of a stand-alone library is skipped.
-- If Link is False, the library is not linked/built.
procedure Check_Library (For_Project : Project_Id);
procedure Check_Library
(For_Project : Project_Id; In_Tree : Project_Tree_Ref);
-- Check if the library of a library project needs to be rebuilt,
-- because its time-stamp is earlier than the time stamp of one of its
-- object files.

37
gcc/ada/mlib-tgt-aix.adb
View File

@ -7,7 +7,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2003-2004, Ada Core Technologies, Inc. --
-- Copyright (C) 2003-2005, Ada Core Technologies, 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- --
@ -286,9 +286,11 @@ package body MLib.Tgt is
-- Library_Exists_For --
------------------------
function Library_Exists_For (Project : Project_Id) return Boolean is
function Library_Exists_For
(Project : Project_Id; In_Tree : Project_Tree_Ref) return Boolean
is
begin
if not Projects.Table (Project).Library then
if not In_Tree.Projects.Table (Project).Library then
Prj.Com.Fail ("INTERNAL ERROR: Library_Exists_For called " &
"for non library project");
return False;
@ -296,14 +298,17 @@ package body MLib.Tgt is
else
declare
Lib_Dir : constant String :=
Get_Name_String
(Projects.Table (Project).Library_Dir);
Get_Name_String
(In_Tree.Projects.Table (Project).Library_Dir);
Lib_Name : constant String :=
Get_Name_String
(Projects.Table (Project).Library_Name);
Get_Name_String
(In_Tree.Projects.Table (Project).Library_Name);
begin
if Projects.Table (Project).Library_Kind = Static then
if In_Tree.Projects.Table (Project).Library_Kind =
Static
then
return Is_Regular_File
(Lib_Dir & Directory_Separator & "lib" &
Fil.Ext_To (Lib_Name, Archive_Ext));
@ -321,9 +326,12 @@ package body MLib.Tgt is
-- Library_File_Name_For --
---------------------------
function Library_File_Name_For (Project : Project_Id) return Name_Id is
function Library_File_Name_For
(Project : Project_Id;
In_Tree : Project_Tree_Ref) return Name_Id
is
begin
if not Projects.Table (Project).Library then
if not In_Tree.Projects.Table (Project).Library then
Prj.Com.Fail ("INTERNAL ERROR: Library_File_Name_For called " &
"for non library project");
return No_Name;
@ -331,13 +339,16 @@ package body MLib.Tgt is
else
declare
Lib_Name : constant String :=
Get_Name_String (Projects.Table (Project).Library_Name);
Get_Name_String
(In_Tree.Projects.Table (Project).Library_Name);
begin
Name_Len := 3;
Name_Buffer (1 .. Name_Len) := "lib";
if Projects.Table (Project).Library_Kind = Static then
if In_Tree.Projects.Table (Project).Library_Kind =
Static
then
Add_Str_To_Name_Buffer (Fil.Ext_To (Lib_Name, Archive_Ext));
else
@ -382,7 +393,7 @@ package body MLib.Tgt is
function Support_For_Libraries return Library_Support is
begin
return Full;
return Static_Only;
end Support_For_Libraries;
end MLib.Tgt;

32
gcc/ada/mlib-tgt-hpux.adb
View File

@ -7,7 +7,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2003-2004, Ada Core Technologies, Inc. --
-- Copyright (C) 2003-2005, Ada Core Technologies, 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- --
@ -269,9 +269,11 @@ package body MLib.Tgt is
-- Library_Exists_For --
------------------------
function Library_Exists_For (Project : Project_Id) return Boolean is
function Library_Exists_For
(Project : Project_Id; In_Tree : Project_Tree_Ref) return Boolean
is
begin
if not Projects.Table (Project).Library then
if not In_Tree.Projects.Table (Project).Library then
Prj.Com.Fail ("INTERNAL ERROR: Library_Exists_For called " &
"for non library project");
return False;
@ -279,12 +281,16 @@ package body MLib.Tgt is
else
declare
Lib_Dir : constant String :=
Get_Name_String (Projects.Table (Project).Library_Dir);
Get_Name_String
(In_Tree.Projects.Table (Project).Library_Dir);
Lib_Name : constant String :=
Get_Name_String (Projects.Table (Project).Library_Name);
Get_Name_String
(In_Tree.Projects.Table (Project).Library_Name);
begin
if Projects.Table (Project).Library_Kind = Static then
if In_Tree.Projects.Table (Project).Library_Kind =
Static
then
return Is_Regular_File
(Lib_Dir & Directory_Separator & "lib" &
Fil.Ext_To (Lib_Name, Archive_Ext));
@ -302,9 +308,12 @@ package body MLib.Tgt is
-- Library_File_Name_For --
---------------------------
function Library_File_Name_For (Project : Project_Id) return Name_Id is
function Library_File_Name_For
(Project : Project_Id;
In_Tree : Project_Tree_Ref) return Name_Id
is
begin
if not Projects.Table (Project).Library then
if not In_Tree.Projects.Table (Project).Library then
Prj.Com.Fail ("INTERNAL ERROR: Library_File_Name_For called " &
"for non library project");
return No_Name;
@ -312,13 +321,16 @@ package body MLib.Tgt is
else
declare
Lib_Name : constant String :=
Get_Name_String (Projects.Table (Project).Library_Name);
Get_Name_String
(In_Tree.Projects.Table (Project).Library_Name);
begin
Name_Len := 3;
Name_Buffer (1 .. Name_Len) := "lib";
if Projects.Table (Project).Library_Kind = Static then
if In_Tree.Projects.Table (Project).Library_Kind =
Static
then
Add_Str_To_Name_Buffer (Fil.Ext_To (Lib_Name, Archive_Ext));
else

32
gcc/ada/mlib-tgt-irix.adb
View File

@ -7,7 +7,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2003-2004, Ada Core Technologies, Inc. --
-- Copyright (C) 2003-2005, Ada Core Technologies, 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- --
@ -309,9 +309,11 @@ package body MLib.Tgt is
-- Library_Exists_For --
------------------------
function Library_Exists_For (Project : Project_Id) return Boolean is
function Library_Exists_For
(Project : Project_Id; In_Tree : Project_Tree_Ref) return Boolean
is
begin
if not Projects.Table (Project).Library then
if not In_Tree.Projects.Table (Project).Library then
Prj.Com.Fail ("INTERNAL ERROR: Library_Exists_For called " &
"for non library project");
return False;
@ -319,12 +321,16 @@ package body MLib.Tgt is
else
declare
Lib_Dir : constant String :=
Get_Name_String (Projects.Table (Project).Library_Dir);
Get_Name_String
(In_Tree.Projects.Table (Project).Library_Dir);
Lib_Name : constant String :=
Get_Name_String (Projects.Table (Project).Library_Name);
Get_Name_String
(In_Tree.Projects.Table (Project).Library_Name);
begin
if Projects.Table (Project).Library_Kind = Static then
if In_Tree.Projects.Table (Project).Library_Kind =
Static
then
return Is_Regular_File
(Lib_Dir & Directory_Separator & "lib" &
Fil.Ext_To (Lib_Name, Archive_Ext));
@ -342,9 +348,12 @@ package body MLib.Tgt is
-- Library_File_Name_For --
---------------------------
function Library_File_Name_For (Project : Project_Id) return Name_Id is
function Library_File_Name_For
(Project : Project_Id;
In_Tree : Project_Tree_Ref) return Name_Id
is
begin
if not Projects.Table (Project).Library then
if not In_Tree.Projects.Table (Project).Library then
Prj.Com.Fail ("INTERNAL ERROR: Library_File_Name_For called " &
"for non library project");
return No_Name;
@ -352,13 +361,16 @@ package body MLib.Tgt is
else
declare
Lib_Name : constant String :=
Get_Name_String (Projects.Table (Project).Library_Name);
Get_Name_String
(In_Tree.Projects.Table (Project).Library_Name);
begin
Name_Len := 3;
Name_Buffer (1 .. Name_Len) := "lib";
if Projects.Table (Project).Library_Kind = Static then
if In_Tree.Projects.Table (Project).Library_Kind =
Static
then
Add_Str_To_Name_Buffer (Fil.Ext_To (Lib_Name, Archive_Ext));
else

32
gcc/ada/mlib-tgt-linux.adb
View File

@ -7,7 +7,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2001-2004, Free Software Foundation, Inc. --
-- Copyright (C) 2001-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- --
@ -266,9 +266,11 @@ package body MLib.Tgt is
-- Library_Exists_For --
------------------------
function Library_Exists_For (Project : Project_Id) return Boolean is
function Library_Exists_For
(Project : Project_Id; In_Tree : Project_Tree_Ref) return Boolean
is
begin
if not Projects.Table (Project).Library then
if not In_Tree.Projects.Table (Project).Library then
Prj.Com.Fail ("INTERNAL ERROR: Library_Exists_For called " &
"for non library project");
return False;
@ -276,12 +278,16 @@ package body MLib.Tgt is
else
declare
Lib_Dir : constant String :=
Get_Name_String (Projects.Table (Project).Library_Dir);
Get_Name_String
(In_Tree.Projects.Table (Project).Library_Dir);
Lib_Name : constant String :=
Get_Name_String (Projects.Table (Project).Library_Name);
Get_Name_String
(In_Tree.Projects.Table (Project).Library_Name);
begin
if Projects.Table (Project).Library_Kind = Static then
if In_Tree.Projects.Table (Project).Library_Kind =
Static
then
return Is_Regular_File
(Lib_Dir & Directory_Separator & "lib" &
Fil.Ext_To (Lib_Name, Archive_Ext));
@ -299,9 +305,12 @@ package body MLib.Tgt is
-- Library_File_Name_For --
---------------------------
function Library_File_Name_For (Project : Project_Id) return Name_Id is
function Library_File_Name_For
(Project : Project_Id;
In_Tree : Project_Tree_Ref) return Name_Id
is
begin
if not Projects.Table (Project).Library then
if not In_Tree.Projects.Table (Project).Library then
Prj.Com.Fail ("INTERNAL ERROR: Library_File_Name_For called " &
"for non library project");
return No_Name;
@ -309,13 +318,16 @@ package body MLib.Tgt is
else
declare
Lib_Name : constant String :=
Get_Name_String (Projects.Table (Project).Library_Name);
Get_Name_String
(In_Tree.Projects.Table (Project).Library_Name);
begin
Name_Len := 3;
Name_Buffer (1 .. Name_Len) := "lib";
if Projects.Table (Project).Library_Kind = Static then
if In_Tree.Projects.Table (Project).Library_Kind =
Static
then
Add_Str_To_Name_Buffer (Fil.Ext_To (Lib_Name, Archive_Ext));
else

32
gcc/ada/mlib-tgt-lynxos.adb
View File

@ -7,7 +7,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2003-2004 Free Software Foundation, Inc. --
-- Copyright (C) 2003-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- --
@ -174,9 +174,11 @@ package body MLib.Tgt is
-- Library_Exists_For --
------------------------
function Library_Exists_For (Project : Project_Id) return Boolean is
function Library_Exists_For
(Project : Project_Id; In_Tree : Project_Tree_Ref) return Boolean
is
begin
if not Projects.Table (Project).Library then
if not In_Tree.Projects.Table (Project).Library then
Prj.Com.Fail ("INTERNAL ERROR: Library_Exists_For called " &
"for non library project");
return False;
@ -184,12 +186,16 @@ package body MLib.Tgt is
else
declare
Lib_Dir : constant String :=
Get_Name_String (Projects.Table (Project).Library_Dir);
Get_Name_String
(In_Tree.Projects.Table (Project).Library_Dir);
Lib_Name : constant String :=
Get_Name_String (Projects.Table (Project).Library_Name);
Get_Name_String
(In_Tree.Projects.Table (Project).Library_Name);
begin
if Projects.Table (Project).Library_Kind = Static then
if In_Tree.Projects.Table (Project).Library_Kind =
Static
then
return Is_Regular_File
(Lib_Dir & Directory_Separator & "lib" &
Fil.Ext_To (Lib_Name, Archive_Ext));
@ -207,9 +213,12 @@ package body MLib.Tgt is
-- Library_File_Name_For --
---------------------------
function Library_File_Name_For (Project : Project_Id) return Name_Id is
function Library_File_Name_For
(Project : Project_Id;
In_Tree : Project_Tree_Ref) return Name_Id
is
begin
if not Projects.Table (Project).Library then
if not In_Tree.Projects.Table (Project).Library then
Prj.Com.Fail ("INTERNAL ERROR: Library_File_Name_For called " &
"for non library project");
return No_Name;
@ -217,13 +226,16 @@ package body MLib.Tgt is
else
declare
Lib_Name : constant String :=
Get_Name_String (Projects.Table (Project).Library_Name);
Get_Name_String
(In_Tree.Projects.Table (Project).Library_Name);
begin
Name_Len := 3;
Name_Buffer (1 .. Name_Len) := "lib";
if Projects.Table (Project).Library_Kind = Static then
if In_Tree.Projects.Table (Project).Library_Kind =
Static
then
Add_Str_To_Name_Buffer (Fil.Ext_To (Lib_Name, Archive_Ext));
else

34
gcc/ada/mlib-tgt-mingw.adb
View File

@ -7,7 +7,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2002-2004, Free Software Foundation, Inc. --
-- Copyright (C) 2002-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- --
@ -194,9 +194,11 @@ package body MLib.Tgt is
-- Library_Exists_For --
------------------------
function Library_Exists_For (Project : Project_Id) return Boolean is
function Library_Exists_For
(Project : Project_Id; In_Tree : Project_Tree_Ref) return Boolean
is
begin
if not Projects.Table (Project).Library then
if not In_Tree.Projects.Table (Project).Library then
Prj.Com.Fail ("INTERNAL ERROR: Library_Exists_For called " &
"for non library project");
return False;
@ -204,14 +206,16 @@ package body MLib.Tgt is
else
declare
Lib_Dir : constant String :=
Get_Name_String
(Projects.Table (Project).Library_Dir);
Get_Name_String
(In_Tree.Projects.Table (Project).Library_Dir);
Lib_Name : constant String :=
Get_Name_String
(Projects.Table (Project).Library_Name);
Get_Name_String
(In_Tree.Projects.Table (Project).Library_Name);
begin
if Projects.Table (Project).Library_Kind = Static then
if In_Tree.Projects.Table (Project).Library_Kind =
Static
then
return Is_Regular_File
(Lib_Dir & Directory_Separator & "lib" &
MLib.Fil.Ext_To (Lib_Name, Archive_Ext));
@ -229,9 +233,12 @@ package body MLib.Tgt is
-- Library_File_Name_For --
---------------------------
function Library_File_Name_For (Project : Project_Id) return Name_Id is
function Library_File_Name_For
(Project : Project_Id;
In_Tree : Project_Tree_Ref) return Name_Id
is
begin
if not Projects.Table (Project).Library then
if not In_Tree.Projects.Table (Project).Library then
Prj.Com.Fail ("INTERNAL ERROR: Library_File_Name_For called " &
"for non library project");
return No_Name;
@ -239,10 +246,13 @@ package body MLib.Tgt is
else
declare
Lib_Name : constant String :=
Get_Name_String (Projects.Table (Project).Library_Name);
Get_Name_String
(In_Tree.Projects.Table (Project).Library_Name);
begin
if Projects.Table (Project).Library_Kind = Static then
if In_Tree.Projects.Table (Project).Library_Kind =
Static
then
Name_Len := 3;
Name_Buffer (1 .. Name_Len) := "lib";
Add_Str_To_Name_Buffer (Fil.Ext_To (Lib_Name, Archive_Ext));

32
gcc/ada/mlib-tgt-solaris.adb
View File

@ -7,7 +7,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2002-2004 Free Software Foundation, Inc. --
-- Copyright (C) 2002-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- --
@ -263,9 +263,11 @@ package body MLib.Tgt is
-- Library_Exists_For --
------------------------
function Library_Exists_For (Project : Project_Id) return Boolean is
function Library_Exists_For
(Project : Project_Id; In_Tree : Project_Tree_Ref) return Boolean
is
begin
if not Projects.Table (Project).Library then
if not In_Tree.Projects.Table (Project).Library then
Prj.Com.Fail ("INTERNAL ERROR: Library_Exists_For called " &
"for non library project");
return False;
@ -273,12 +275,16 @@ package body MLib.Tgt is
else
declare
Lib_Dir : constant String :=
Get_Name_String (Projects.Table (Project).Library_Dir);
Get_Name_String
(In_Tree.Projects.Table (Project).Library_Dir);
Lib_Name : constant String :=
Get_Name_String (Projects.Table (Project).Library_Name);
Get_Name_String
(In_Tree.Projects.Table (Project).Library_Name);
begin
if Projects.Table (Project).Library_Kind = Static then
if In_Tree.Projects.Table (Project).Library_Kind =
Static
then
return Is_Regular_File
(Lib_Dir & Directory_Separator & "lib" &
Fil.Ext_To (Lib_Name, Archive_Ext));
@ -296,9 +302,12 @@ package body MLib.Tgt is
-- Library_File_Name_For --
---------------------------
function Library_File_Name_For (Project : Project_Id) return Name_Id is
function Library_File_Name_For
(Project : Project_Id;
In_Tree : Project_Tree_Ref) return Name_Id
is
begin
if not Projects.Table (Project).Library then
if not In_Tree.Projects.Table (Project).Library then
Prj.Com.Fail ("INTERNAL ERROR: Library_File_Name_For called " &
"for non library project");
return No_Name;
@ -306,13 +315,16 @@ package body MLib.Tgt is
else
declare
Lib_Name : constant String :=
Get_Name_String (Projects.Table (Project).Library_Name);
Get_Name_String
(In_Tree.Projects.Table (Project).Library_Name);
begin
Name_Len := 3;
Name_Buffer (1 .. Name_Len) := "lib";
if Projects.Table (Project).Library_Kind = Static then
if In_Tree.Projects.Table (Project).Library_Kind =
Static
then
Add_Str_To_Name_Buffer (Fil.Ext_To (Lib_Name, Archive_Ext));
else

32
gcc/ada/mlib-tgt-tru64.adb
View File

@ -7,7 +7,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2002-2004 Free Software Foundation, Inc. --
-- Copyright (C) 2002-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- --
@ -280,9 +280,11 @@ package body MLib.Tgt is
-- Library_Exists_For --
------------------------
function Library_Exists_For (Project : Project_Id) return Boolean is
function Library_Exists_For
(Project : Project_Id; In_Tree : Project_Tree_Ref) return Boolean
is
begin
if not Projects.Table (Project).Library then
if not In_Tree.Projects.Table (Project).Library then
Prj.Com.Fail ("INTERNAL ERROR: Library_Exists_For called " &
"for non library project");
return False;
@ -290,12 +292,16 @@ package body MLib.Tgt is
else
declare
Lib_Dir : constant String :=
Get_Name_String (Projects.Table (Project).Library_Dir);
Get_Name_String
(In_Tree.Projects.Table (Project).Library_Dir);
Lib_Name : constant String :=
Get_Name_String (Projects.Table (Project).Library_Name);
Get_Name_String
(In_Tree.Projects.Table (Project).Library_Name);
begin
if Projects.Table (Project).Library_Kind = Static then
if In_Tree.Projects.Table (Project).Library_Kind =
Static
then
return Is_Regular_File
(Lib_Dir & Directory_Separator & "lib" &
Fil.Ext_To (Lib_Name, Archive_Ext));
@ -313,9 +319,12 @@ package body MLib.Tgt is
-- Library_File_Name_For --
---------------------------
function Library_File_Name_For (Project : Project_Id) return Name_Id is
function Library_File_Name_For
(Project : Project_Id;
In_Tree : Project_Tree_Ref) return Name_Id
is
begin
if not Projects.Table (Project).Library then
if not In_Tree.Projects.Table (Project).Library then
Prj.Com.Fail ("INTERNAL ERROR: Library_File_Name_For called " &
"for non library project");
return No_Name;
@ -323,13 +332,16 @@ package body MLib.Tgt is
else
declare
Lib_Name : constant String :=
Get_Name_String (Projects.Table (Project).Library_Name);
Get_Name_String
(In_Tree.Projects.Table (Project).Library_Name);
begin
Name_Len := 3;
Name_Buffer (1 .. Name_Len) := "lib";
if Projects.Table (Project).Library_Kind = Static then
if In_Tree.Projects.Table (Project).Library_Kind =
Static
then
Add_Str_To_Name_Buffer (Fil.Ext_To (Lib_Name, Archive_Ext));
else

70
gcc/ada/mlib-tgt-vms-alpha.adb
View File

@ -7,7 +7,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2003-2004, Free Software Foundation, Inc. --
-- Copyright (C) 2003-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- --
@ -29,17 +29,19 @@
with Ada.Characters.Handling; use Ada.Characters.Handling;
with GNAT.Directory_Operations; use GNAT.Directory_Operations;
with GNAT.OS_Lib; use GNAT.OS_Lib;
with GNAT.Directory_Operations; use GNAT.Directory_Operations;
with GNAT.OS_Lib; use GNAT.OS_Lib;
with MLib.Fil;
with MLib.Utl;
with Namet; use Namet;
with Opt; use Opt;
with Output; use Output;
with Namet; use Namet;
with Opt; use Opt;
with Output; use Output;
with Prj.Com;
with System; use System;
with System.Case_Util; use System.Case_Util;
with System; use System;
with System.Case_Util; use System.Case_Util;
with System.CRTL; use System.CRTL;
package body MLib.Tgt is
@ -50,7 +52,7 @@ package body MLib.Tgt is
-- Used to add the generated auto-init object files for auto-initializing
-- stand-alone libraries.
Macro_Name : constant String := "mcr gnu:[bin]gcc -c -x assembler";
Macro_Name : constant String := "mcr gnu:[bin]gcc -c -x assembler";
-- The name of the command to invoke the macro-assembler
VMS_Options : Argument_List := (1 .. 1 => null);
@ -72,16 +74,6 @@ package body MLib.Tgt is
Link_With_Shared_Libgcc : Argument_List_Access :=
No_Shared_Libgcc_Switch'Access;
------------------------------
-- Target dependent section --
------------------------------
function Popen (Command, Mode : System.Address) return System.Address;
pragma Import (C, Popen);
function Pclose (File : System.Address) return Integer;
pragma Import (C, Pclose);
---------------------
-- Archive_Builder --
---------------------
@ -302,12 +294,12 @@ package body MLib.Tgt is
Len : Natural;
OK : Boolean := True;
Command : constant String :=
command : constant String :=
Macro_Name & " " & Macro_File_Name & ASCII.NUL;
-- The command to invoke the assembler on the generated auto-init
-- assembly file.
Mode : constant String := "r" & ASCII.NUL;
mode : constant String := "r" & ASCII.NUL;
-- The mode for the invocation of Popen
begin
@ -365,8 +357,8 @@ package body MLib.Tgt is
Write_Line ("""");
end if;
Popen_Result := Popen (Command (Command'First)'Address,
Mode (Mode'First)'Address);
Popen_Result := popen (command (command'First)'Address,
mode (mode'First)'Address);
if Popen_Result = Null_Address then
Fail ("assembly of auto-init assembly file """,
@ -375,7 +367,7 @@ package body MLib.Tgt is
-- Wait for the end of execution of the macro-assembler
Pclose_Result := Pclose (Popen_Result);
Pclose_Result := pclose (Popen_Result);
if Pclose_Result < 0 then
Fail ("assembly of auto init assembly file """,
@ -604,9 +596,11 @@ package body MLib.Tgt is
-- Library_Exists_For --
------------------------
function Library_Exists_For (Project : Project_Id) return Boolean is
function Library_Exists_For
(Project : Project_Id; In_Tree : Project_Tree_Ref) return Boolean
is
begin
if not Projects.Table (Project).Library then
if not In_Tree.Projects.Table (Project).Library then
Fail ("INTERNAL ERROR: Library_Exists_For called " &
"for non library project");
return False;
@ -614,12 +608,16 @@ package body MLib.Tgt is
else
declare
Lib_Dir : constant String :=
Get_Name_String (Projects.Table (Project).Library_Dir);
Get_Name_String
(In_Tree.Projects.Table (Project).Library_Dir);
Lib_Name : constant String :=
Get_Name_String (Projects.Table (Project).Library_Name);
Get_Name_String
(In_Tree.Projects.Table (Project).Library_Name);
begin
if Projects.Table (Project).Library_Kind = Static then
if In_Tree.Projects.Table (Project).Library_Kind =
Static
then
return Is_Regular_File
(Lib_Dir & Directory_Separator & "lib" &
Fil.Ext_To (Lib_Name, Archive_Ext));
@ -637,9 +635,12 @@ package body MLib.Tgt is
-- Library_File_Name_For --
---------------------------
function Library_File_Name_For (Project : Project_Id) return Name_Id is
function Library_File_Name_For
(Project : Project_Id;
In_Tree : Project_Tree_Ref) return Name_Id
is
begin
if not Projects.Table (Project).Library then
if not In_Tree.Projects.Table (Project).Library then
Prj.Com.Fail ("INTERNAL ERROR: Library_File_Name_For called " &
"for non library project");
return No_Name;
@ -647,13 +648,16 @@ package body MLib.Tgt is
else
declare
Lib_Name : constant String :=
Get_Name_String (Projects.Table (Project).Library_Name);
Get_Name_String
(In_Tree.Projects.Table (Project).Library_Name);
begin
Name_Len := 3;
Name_Buffer (1 .. Name_Len) := "lib";
if Projects.Table (Project).Library_Kind = Static then
if In_Tree.Projects.Table (Project).Library_Kind =
Static
then
Add_Str_To_Name_Buffer (Fil.Ext_To (Lib_Name, Archive_Ext));
else

65
gcc/ada/mlib-tgt-vms-ia64.adb
View File

@ -29,17 +29,19 @@
with Ada.Characters.Handling; use Ada.Characters.Handling;
with GNAT.Directory_Operations; use GNAT.Directory_Operations;
with GNAT.OS_Lib; use GNAT.OS_Lib;
with GNAT.Directory_Operations; use GNAT.Directory_Operations;
with GNAT.OS_Lib; use GNAT.OS_Lib;
with MLib.Fil;
with MLib.Utl;
with Namet; use Namet;
with Opt; use Opt;
with Output; use Output;
with Namet; use Namet;
with Opt; use Opt;
with Output; use Output;
with Prj.Com;
with System; use System;
with System.Case_Util; use System.Case_Util;
with System; use System;
with System.Case_Util; use System.Case_Util;
with System.CRTL; use System.CRTL;
package body MLib.Tgt is
@ -72,16 +74,6 @@ package body MLib.Tgt is
Link_With_Shared_Libgcc : Argument_List_Access :=
No_Shared_Libgcc_Switch'Access;
------------------------------
-- Target dependent section --
------------------------------
function Popen (Command, Mode : System.Address) return System.Address;
pragma Import (C, Popen, "decc$popen");
function Pclose (File : System.Address) return Integer;
pragma Import (C, Pclose, "decc$pclose");
---------------------
-- Archive_Builder --
---------------------
@ -300,12 +292,12 @@ package body MLib.Tgt is
Len : Natural;
OK : Boolean := True;
Command : constant String :=
command : constant String :=
Macro_Name & " " & Macro_File_Name & ASCII.NUL;
-- The command to invoke the assembler on the generated auto-init
-- assembly file.
Mode : constant String := "r" & ASCII.NUL;
mode : constant String := "r" & ASCII.NUL;
-- The mode for the invocation of Popen
begin
@ -398,8 +390,8 @@ package body MLib.Tgt is
Write_Line ("""");
end if;
Popen_Result := Popen (Command (Command'First)'Address,
Mode (Mode'First)'Address);
Popen_Result := popen (command (command'First)'Address,
mode (mode'First)'Address);
if Popen_Result = Null_Address then
Fail ("assembly of auto-init assembly file """,
@ -408,7 +400,7 @@ package body MLib.Tgt is
-- Wait for the end of execution of the macro-assembler
Pclose_Result := Pclose (Popen_Result);
Pclose_Result := pclose (Popen_Result);
if Pclose_Result < 0 then
Fail ("assembly of auto init assembly file """,
@ -637,9 +629,11 @@ package body MLib.Tgt is
-- Library_Exists_For --
------------------------
function Library_Exists_For (Project : Project_Id) return Boolean is
function Library_Exists_For
(Project : Project_Id; In_Tree : Project_Tree_Ref) return Boolean
is
begin
if not Projects.Table (Project).Library then
if not In_Tree.Projects.Table (Project).Library then
Fail ("INTERNAL ERROR: Library_Exists_For called " &
"for non library project");
return False;
@ -647,12 +641,16 @@ package body MLib.Tgt is
else
declare
Lib_Dir : constant String :=
Get_Name_String (Projects.Table (Project).Library_Dir);
Get_Name_String
(In_Tree.Projects.Table (Project).Library_Dir);
Lib_Name : constant String :=
Get_Name_String (Projects.Table (Project).Library_Name);
Get_Name_String
(In_Tree.Projects.Table (Project).Library_Name);
begin
if Projects.Table (Project).Library_Kind = Static then
if In_Tree.Projects.Table (Project).Library_Kind =
Static
then
return Is_Regular_File
(Lib_Dir & Directory_Separator & "lib" &
Fil.Ext_To (Lib_Name, Archive_Ext));
@ -670,9 +668,12 @@ package body MLib.Tgt is
-- Library_File_Name_For --
---------------------------
function Library_File_Name_For (Project : Project_Id) return Name_Id is
function Library_File_Name_For
(Project : Project_Id;
In_Tree : Project_Tree_Ref) return Name_Id
is
begin
if not Projects.Table (Project).Library then
if not In_Tree.Projects.Table (Project).Library then
Prj.Com.Fail ("INTERNAL ERROR: Library_File_Name_For called " &
"for non library project");
return No_Name;
@ -680,13 +681,15 @@ package body MLib.Tgt is
else
declare
Lib_Name : constant String :=
Get_Name_String (Projects.Table (Project).Library_Name);
Get_Name_String
(In_Tree.Projects.Table (Project).Library_Name);
begin
Name_Len := 3;
Name_Buffer (1 .. Name_Len) := "lib";
if Projects.Table (Project).Library_Kind = Static then
if In_Tree.Projects.Table (Project).Library_Kind =
Static then
Add_Str_To_Name_Buffer (Fil.Ext_To (Lib_Name, Archive_Ext));
else

32
gcc/ada/mlib-tgt-vxworks.adb
View File

@ -7,7 +7,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2003-2004 Free Software Foundation, Inc. --
-- Copyright (C) 2003-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- --
@ -215,9 +215,11 @@ package body MLib.Tgt is
-- Library_Exists_For --
------------------------
function Library_Exists_For (Project : Project_Id) return Boolean is
function Library_Exists_For
(Project : Project_Id; In_Tree : Project_Tree_Ref) return Boolean
is
begin
if not Projects.Table (Project).Library then
if not In_Tree.Projects.Table (Project).Library then
Prj.Com.Fail ("INTERNAL ERROR: Library_Exists_For called " &
"for non library project");
return False;
@ -225,12 +227,16 @@ package body MLib.Tgt is
else
declare
Lib_Dir : constant String :=
Get_Name_String (Projects.Table (Project).Library_Dir);
Get_Name_String
(In_Tree.Projects.Table (Project).Library_Dir);
Lib_Name : constant String :=
Get_Name_String (Projects.Table (Project).Library_Name);
Get_Name_String
(In_Tree.Projects.Table (Project).Library_Name);
begin
if Projects.Table (Project).Library_Kind = Static then
if In_Tree.Projects.Table (Project).Library_Kind =
Static
then
return Is_Regular_File
(Lib_Dir & Directory_Separator & "lib" &
Fil.Ext_To (Lib_Name, Archive_Ext));
@ -248,9 +254,12 @@ package body MLib.Tgt is
-- Library_File_Name_For --
---------------------------
function Library_File_Name_For (Project : Project_Id) return Name_Id is
function Library_File_Name_For
(Project : Project_Id;
In_Tree : Project_Tree_Ref) return Name_Id
is
begin
if not Projects.Table (Project).Library then
if not In_Tree.Projects.Table (Project).Library then
Prj.Com.Fail ("INTERNAL ERROR: Library_File_Name_For called " &
"for non library project");
return No_Name;
@ -258,13 +267,16 @@ package body MLib.Tgt is
else
declare
Lib_Name : constant String :=
Get_Name_String (Projects.Table (Project).Library_Name);
Get_Name_String
(In_Tree.Projects.Table (Project).Library_Name);
begin
Name_Len := 3;
Name_Buffer (1 .. Name_Len) := "lib";
if Projects.Table (Project).Library_Kind = Static then
if In_Tree.Projects.Table (Project).Library_Kind =
Static
then
Add_Str_To_Name_Buffer (Fil.Ext_To (Lib_Name, Archive_Ext));
else

13
gcc/ada/mlib-tgt.adb
View File

@ -7,7 +7,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2001-2004, Ada Core Technologies, Inc. --
-- Copyright (C) 2001-2005, Ada Core Technologies, 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- --
@ -172,8 +172,11 @@ package body MLib.Tgt is
-- Library_Exists_For --
------------------------
function Library_Exists_For (Project : Project_Id) return Boolean is
function Library_Exists_For
(Project : Project_Id; In_Tree : Project_Tree_Ref) return Boolean
is
pragma Unreferenced (Project);
pragma Unreferenced (In_Tree);
begin
return False;
end Library_Exists_For;
@ -182,8 +185,12 @@ package body MLib.Tgt is
-- Library_File_Name_For --
---------------------------
function Library_File_Name_For (Project : Project_Id) return Name_Id is
function Library_File_Name_For
(Project : Project_Id;
In_Tree : Project_Tree_Ref) return Name_Id
is
pragma Unreferenced (Project);
pragma Unreferenced (In_Tree);
begin
return No_Name;
end Library_File_Name_For;

9
gcc/ada/mlib-tgt.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2001-2004, Ada Core Technologies, Inc. --
-- Copyright (C) 2001-2005, Ada Core Technologies, 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- --
@ -147,11 +147,14 @@ package MLib.Tgt is
-- into account. For example, on Linux, Foreign, Afiles Lib_Address and
-- Relocatable are ignored.
function Library_Exists_For (Project : Project_Id) return Boolean;
function Library_Exists_For
(Project : Project_Id; In_Tree : Project_Tree_Ref) return Boolean;
-- Return True if the library file for a library project already exists.
-- This function can only be called for library projects.
function Library_File_Name_For (Project : Project_Id) return Name_Id;
function Library_File_Name_For
(Project : Project_Id;
In_Tree : Project_Tree_Ref) return Name_Id;
-- Returns the file name of the library file of a library project.
-- This function can only be called for library projects.

3
gcc/ada/prj-attr.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2001-2004 Free Software Foundation, Inc. --
-- Copyright (C) 2001-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- --
@ -28,6 +28,7 @@
-- There are predefined packages and attributes.
-- It is also possible to define new packages with their attributes.
with Table;
with Types; use Types;
package Prj.Attr is

42
gcc/ada/prj-com.adb
View File

@ -1,42 +0,0 @@
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- P R J . C O M --
-- --
-- B o d y --
-- --
-- Copyright (C) 2000-2004 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- --
-- ware Foundation; either version 2, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
-- for more details. You should have received a copy of the GNU General --
-- Public License distributed with GNAT; see file COPYING. If not, write --
-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
-- MA 02111-1307, USA. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
with Namet; use Namet;
with Stringt; use Stringt;
package body Prj.Com is
----------
-- Hash --
----------
function Hash (Name : String_Id) return Header_Num is
begin
String_To_Name_Buffer (Name);
return Hash (Name_Buffer (1 .. Name_Len));
end Hash;
end Prj.Com;

84
gcc/ada/prj-com.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2000-2004 Free Software Foundation, Inc. --
-- Copyright (C) 2000-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- --
@ -27,88 +27,18 @@
-- The following package declares data types for GNAT project.
-- These data types are used in the bodies of the Prj hierarchy.
with GNAT.HTable;
with Osint;
with Table;
with Types; use Types;
package Prj.Com is
-- At one point, this package was private.
-- It cannot be private, because it is used outside of
-- the Prj hierarchy.
type Fail_Proc is access procedure
(S1 : String; S2 : String := ""; S3 : String := "");
(S1 : String;
S2 : String := "";
S3 : String := "");
Fail : Fail_Proc := Osint.Fail'Access;
-- This procedure is used in the project facility, instead of
-- directly calling Osint.Fail.
-- It may be specified by tools to do clean up before calling
-- Osint.Fail, or to simply report an error and return.
Tool_Name : Name_Id := No_Name;
Current_Verbosity : Verbosity := Default;
type Spec_Or_Body is
(Specification, Body_Part);
type File_Name_Data is record
Name : Name_Id := No_Name;
Index : Int := 0;
Display_Name : Name_Id := No_Name;
Path : Name_Id := No_Name;
Display_Path : Name_Id := No_Name;
Project : Project_Id := No_Project;
Needs_Pragma : Boolean := False;
end record;
-- File and Path name of a spec or body.
type File_Names_Data is array (Spec_Or_Body) of File_Name_Data;
type Unit_Id is new Nat;
No_Unit : constant Unit_Id := 0;
type Unit_Data is record
Name : Name_Id := No_Name;
File_Names : File_Names_Data;
end record;
-- File and Path names of a unit, with a reference to its
-- GNAT Project File.
package Units is new Table.Table
(Table_Component_Type => Unit_Data,
Table_Index_Type => Unit_Id,
Table_Low_Bound => 1,
Table_Initial => 100,
Table_Increment => 100,
Table_Name => "Prj.Com.Units");
function Hash (Name : String_Id) return Header_Num;
package Units_Htable is new GNAT.HTable.Simple_HTable
(Header_Num => Header_Num,
Element => Unit_Id,
No_Element => No_Unit,
Key => Name_Id,
Hash => Hash,
Equal => "=");
-- Mapping of unit names to indexes in the Units table
type Unit_Project is record
Unit : Unit_Id := No_Unit;
Project : Project_Id := No_Project;
end record;
No_Unit_Project : constant Unit_Project := (No_Unit, No_Project);
package Files_Htable is new GNAT.HTable.Simple_HTable
(Header_Num => Header_Num,
Element => Unit_Project,
No_Element => No_Unit_Project,
Key => Name_Id,
Hash => Hash,
Equal => "=");
-- Mapping of file names to indexes in the Units table
-- This procedure is used in the project facility, instead of directly
-- calling Osint.Fail. It may be specified by tools to do clean up before
-- calling Osint.Fail, or to simply report an error and return.
end Prj.Com;

570
gcc/ada/prj-dect.adb
View File

File diff suppressed because it is too large Load Diff

28
gcc/ada/prj-dect.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2001-2003 Free Software Foundation, Inc. --
-- Copyright (C) 2001-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- --
@ -31,9 +31,27 @@ with Prj.Tree;
private package Prj.Dect is
procedure Parse
(Declarations : out Prj.Tree.Project_Node_Id;
Current_Project : Prj.Tree.Project_Node_Id;
Extends : Prj.Tree.Project_Node_Id);
-- Parse project declarative items. What are parameters ???
(In_Tree : Prj.Tree.Project_Node_Tree_Ref;
Declarations : out Prj.Tree.Project_Node_Id;
Current_Project : Prj.Tree.Project_Node_Id;
Extends : Prj.Tree.Project_Node_Id;
Packages_To_Check : String_List_Access);
-- Parse project declarative items
--
-- In_Tree is the project node tree
--
-- Declarations is the resulting project node
--
-- Current_Project is the project node of the project for which the
-- declarative items are parsed.
--
-- Extends is the project node of the project that project Current_Project
-- extends. If project Current-Project does not extend any project,
-- Extends has the value Empty_Node.
--
-- Packages_To_Check is the list of packages that needs to be checked.
-- For legal packages declared in project Current_Project that are not in
-- Packages_To_Check, only the syntax of the declarations are checked, not
-- the attribute names and kinds.
end Prj.Dect;

621
gcc/ada/prj-env.adb
View File

File diff suppressed because it is too large Load Diff

43
gcc/ada/prj-env.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2001-2004 Free Software Foundation, Inc --
-- Copyright (C) 2001-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- --
@ -32,14 +32,15 @@ with GNAT.OS_Lib; use GNAT.OS_Lib;
package Prj.Env is
procedure Initialize;
-- Called by Prj.Initialize to perform required initialization
-- steps for this package.
-- Called by Prj.Initialize to perform required initialization steps for
-- this package.
procedure Print_Sources;
procedure Print_Sources (In_Tree : Project_Tree_Ref);
-- Output the list of sources, after Project files have been scanned
procedure Create_Mapping_File
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
Name : out Name_Id);
-- Create a temporary mapping file for project Project. For each unit
-- in the closure of immediate sources of Project, put the mapping of
@ -52,6 +53,7 @@ package Prj.Env is
procedure Create_Config_Pragmas_File
(For_Project : Project_Id;
Main_Project : Project_Id;
In_Tree : Project_Tree_Ref;
Include_Config_Files : Boolean := True);
-- If there needs to have SFN pragmas, either for non standard naming
-- schemes or for individual units, or (when Include_Config_Files is True)
@ -61,12 +63,15 @@ package Prj.Env is
-- a temporary file that contains all configuration pragmas, and specify
-- the configuration pragmas file in the project data.
function Ada_Include_Path (Project : Project_Id) return String_Access;
function Ada_Include_Path
(Project : Project_Id;
In_Tree : Project_Tree_Ref) return String_Access;
-- Get the ADA_INCLUDE_PATH of a Project file. For the first call, compute
-- it and cache it.
function Ada_Include_Path
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
Recursive : Boolean) return String;
-- Get the ADA_INCLUDE_PATH of a Project file. If Recursive it True,
-- get all the source directories of the imported and modified project
@ -76,6 +81,7 @@ package Prj.Env is
function Ada_Objects_Path
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
Including_Libraries : Boolean := True) return String_Access;
-- Get the ADA_OBJECTS_PATH of a Project file. For the first call, compute
-- it and cache it. When Including_Libraries is False, do not include the
@ -83,22 +89,25 @@ package Prj.Env is
procedure Set_Ada_Paths
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
Including_Libraries : Boolean);
-- Set the env vars for additional project path files, after
-- creating the path files if necessary.
procedure Delete_All_Path_Files;
procedure Delete_All_Path_Files (In_Tree : Project_Tree_Ref);
-- Delete all temporary path files that have been created by
-- calls to Set_Ada_Paths.
function Path_Name_Of_Library_Unit_Body
(Name : String;
Project : Project_Id) return String;
Project : Project_Id;
In_Tree : Project_Tree_Ref) return String;
-- Returns the Path of a library unit
function File_Name_Of_Library_Unit_Body
(Name : String;
Project : Project_Id;
In_Tree : Project_Tree_Ref;
Main_Project_Only : Boolean := True;
Full_Path : Boolean := False) return String;
-- Returns the file name of a library unit, in canonical case. Name may or
@ -117,7 +126,8 @@ package Prj.Env is
function Project_Of
(Name : String;
Main_Project : Project_Id) return Project_Id;
Main_Project : Project_Id;
In_Tree : Project_Tree_Ref) return Project_Id;
-- Get the project of a source. The source file name may be truncated
-- (".adb" or ".ads" may be missing). If the source is in a project being
-- extended, return the ultimate extending project. If it is not a source
@ -125,20 +135,25 @@ package Prj.Env is
procedure Get_Reference
(Source_File_Name : String;
In_Tree : Project_Tree_Ref;
Project : out Project_Id;
Path : out Name_Id);
-- Returns the project of a source and its path in displayable form
generic
with procedure Action (Path : String);
procedure For_All_Source_Dirs (Project : Project_Id);
-- Iterate through all the source directories of a project,
-- including those of imported or modified projects.
procedure For_All_Source_Dirs
(Project : Project_Id;
In_Tree : Project_Tree_Ref);
-- Iterate through all the source directories of a project, including
-- those of imported or modified projects.
generic
with procedure Action (Path : String);
procedure For_All_Object_Dirs (Project : Project_Id);
-- Iterate through all the object directories of a project,
-- including those of imported or modified projects.
procedure For_All_Object_Dirs
(Project : Project_Id;
In_Tree : Project_Tree_Ref);
-- Iterate through all the object directories of a project, including
-- those of imported or modified projects.
end Prj.Env;

355
gcc/ada/prj-makr.adb
View File

@ -117,6 +117,10 @@ package body Prj.Makr is
Preproc_Switches : Argument_List;
Very_Verbose : Boolean)
is
Tree : constant Project_Node_Tree_Ref := new Project_Node_Tree_Data;
Path_Name : String (1 .. File_Path'Length +
Project_File_Extension'Length);
Path_Last : Natural := File_Path'Length;
@ -475,46 +479,57 @@ package body Prj.Makr is
Decl_Item : constant Project_Node_Id :=
Default_Project_Node
(Of_Kind =>
N_Declarative_Item);
N_Declarative_Item,
In_Tree => Tree);
Attribute : constant Project_Node_Id :=
Default_Project_Node
(Of_Kind =>
N_Attribute_Declaration);
N_Attribute_Declaration,
In_Tree => Tree);
Expression : constant Project_Node_Id :=
Default_Project_Node
(Of_Kind => N_Expression,
And_Expr_Kind => Single);
And_Expr_Kind => Single,
In_Tree => Tree);
Term : constant Project_Node_Id :=
Default_Project_Node
(Of_Kind => N_Term,
And_Expr_Kind => Single);
And_Expr_Kind => Single,
In_Tree => Tree);
Value : constant Project_Node_Id :=
Default_Project_Node
(Of_Kind => N_Literal_String,
And_Expr_Kind => Single);
(Of_Kind => N_Literal_String,
And_Expr_Kind => Single,
In_Tree => Tree);
begin
Set_Next_Declarative_Item
(Decl_Item,
To => First_Declarative_Item_Of
(Naming_Package));
(Naming_Package, Tree),
In_Tree => Tree);
Set_First_Declarative_Item_Of
(Naming_Package, To => Decl_Item);
(Naming_Package,
To => Decl_Item,
In_Tree => Tree);
Set_Current_Item_Node
(Decl_Item, To => Attribute);
(Decl_Item,
To => Attribute,
In_Tree => Tree);
-- Is it a spec or a body?
if SFN_Prag.Spec then
Set_Name_Of
(Attribute, To => Name_Spec);
(Attribute, Tree,
To => Name_Spec);
else
Set_Name_Of
(Attribute,
(Attribute, Tree,
To => Name_Body);
end if;
@ -523,20 +538,21 @@ package body Prj.Makr is
Get_Name_String (SFN_Prag.Unit);
To_Lower (Name_Buffer (1 .. Name_Len));
Set_Associative_Array_Index_Of
(Attribute, To => Name_Find);
(Attribute, Tree, To => Name_Find);
Set_Expression_Of
(Attribute, To => Expression);
(Attribute, Tree, To => Expression);
Set_First_Term
(Expression, To => Term);
Set_Current_Term (Term, To => Value);
(Expression, Tree, To => Term);
Set_Current_Term
(Term, Tree, To => Value);
-- And set the name of the file
Set_String_Value_Of
(Value, To => File_Name_Id);
(Value, Tree, To => File_Name_Id);
Set_Source_Index_Of
(Value, To => SFN_Prag.Index);
(Value, Tree, To => SFN_Prag.Index);
end;
end if;
end loop;
@ -649,7 +665,8 @@ package body Prj.Makr is
Csets.Initialize;
Namet.Initialize;
Snames.Initialize;
Prj.Initialize;
Prj.Initialize (No_Project_Tree);
Prj.Tree.Initialize (Tree);
SFN_Pragmas.Set_Last (0);
@ -707,7 +724,8 @@ package body Prj.Makr is
end if;
Part.Parse
(Project => Project_Node,
(In_Tree => Tree,
Project => Project_Node,
Project_File_Name => Output_Name (1 .. Output_Name_Last),
Always_Errout_Finalize => False);
@ -725,27 +743,29 @@ package body Prj.Makr is
declare
With_Clause : Project_Node_Id :=
First_With_Clause_Of (Project_Node);
First_With_Clause_Of (Project_Node, Tree);
Previous : Project_Node_Id := Empty_Node;
begin
while With_Clause /= Empty_Node loop
if Tree.Name_Of (With_Clause) = Project_Naming_Id then
if Prj.Tree.Name_Of (With_Clause, Tree) =
Project_Naming_Id
then
if Previous = Empty_Node then
Set_First_With_Clause_Of
(Project_Node,
To => Next_With_Clause_Of (With_Clause));
(Project_Node, Tree,
To => Next_With_Clause_Of (With_Clause, Tree));
else
Set_Next_With_Clause_Of
(Previous,
To => Next_With_Clause_Of (With_Clause));
(Previous, Tree,
To => Next_With_Clause_Of (With_Clause, Tree));
end if;
exit;
end if;
Previous := With_Clause;
With_Clause := Next_With_Clause_Of (With_Clause);
With_Clause := Next_With_Clause_Of (With_Clause, Tree);
end loop;
end;
@ -757,41 +777,45 @@ package body Prj.Makr is
Declaration : Project_Node_Id :=
First_Declarative_Item_Of
(Project_Declaration_Of
(Project_Node));
(Project_Node, Tree),
Tree);
Previous : Project_Node_Id := Empty_Node;
Current_Node : Project_Node_Id := Empty_Node;
begin
while Declaration /= Empty_Node loop
Current_Node := Current_Item_Node (Declaration);
Current_Node := Current_Item_Node (Declaration, Tree);
if (Kind_Of (Current_Node) = N_Attribute_Declaration
if (Kind_Of (Current_Node, Tree) = N_Attribute_Declaration
and then
(Tree.Name_Of (Current_Node) = Name_Source_Files
or else Tree.Name_Of (Current_Node) =
Name_Source_List_File
or else Tree.Name_Of (Current_Node) =
Name_Source_Dirs))
(Prj.Tree.Name_Of (Current_Node, Tree) =
Name_Source_Files
or else Prj.Tree.Name_Of (Current_Node, Tree) =
Name_Source_List_File
or else Prj.Tree.Name_Of (Current_Node, Tree) =
Name_Source_Dirs))
or else
(Kind_Of (Current_Node) = N_Package_Declaration
and then Tree.Name_Of (Current_Node) = Name_Naming)
(Kind_Of (Current_Node, Tree) = N_Package_Declaration
and then Prj.Tree.Name_Of (Current_Node, Tree) =
Name_Naming)
then
if Previous = Empty_Node then
Set_First_Declarative_Item_Of
(Project_Declaration_Of (Project_Node),
To => Next_Declarative_Item (Declaration));
(Project_Declaration_Of (Project_Node, Tree),
Tree,
To => Next_Declarative_Item (Declaration, Tree));
else
Set_Next_Declarative_Item
(Previous,
To => Next_Declarative_Item (Declaration));
(Previous, Tree,
To => Next_Declarative_Item (Declaration, Tree));
end if;
else
Previous := Declaration;
end if;
Declaration := Next_Declarative_Item (Declaration);
Declaration := Next_Declarative_Item (Declaration, Tree);
end loop;
end;
end if;
@ -971,11 +995,13 @@ package body Prj.Makr is
-- name and its project declaration node.
if Project_Node = Empty_Node then
Project_Node := Default_Project_Node (Of_Kind => N_Project);
Set_Name_Of (Project_Node, To => Output_Name_Id);
Project_Node :=
Default_Project_Node (Of_Kind => N_Project, In_Tree => Tree);
Set_Name_Of (Project_Node, Tree, To => Output_Name_Id);
Set_Project_Declaration_Of
(Project_Node,
To => Default_Project_Node (Of_Kind => N_Project_Declaration));
(Project_Node, Tree,
To => Default_Project_Node
(Of_Kind => N_Project_Declaration, In_Tree => Tree));
end if;
@ -983,93 +1009,109 @@ package body Prj.Makr is
-- for Source_Files as an empty list, to indicate there are no
-- sources in the naming project.
Project_Naming_Node := Default_Project_Node (Of_Kind => N_Project);
Set_Name_Of (Project_Naming_Node, To => Project_Naming_Id);
Project_Naming_Node :=
Default_Project_Node (Of_Kind => N_Project, In_Tree => Tree);
Set_Name_Of (Project_Naming_Node, Tree, To => Project_Naming_Id);
Project_Naming_Decl :=
Default_Project_Node (Of_Kind => N_Project_Declaration);
Set_Project_Declaration_Of (Project_Naming_Node, Project_Naming_Decl);
Default_Project_Node
(Of_Kind => N_Project_Declaration, In_Tree => Tree);
Set_Project_Declaration_Of
(Project_Naming_Node, Tree, Project_Naming_Decl);
Naming_Package :=
Default_Project_Node (Of_Kind => N_Package_Declaration);
Set_Name_Of (Naming_Package, To => Name_Naming);
Default_Project_Node
(Of_Kind => N_Package_Declaration, In_Tree => Tree);
Set_Name_Of (Naming_Package, Tree, To => Name_Naming);
declare
Decl_Item : constant Project_Node_Id :=
Default_Project_Node (Of_Kind => N_Declarative_Item);
Default_Project_Node
(Of_Kind => N_Declarative_Item, In_Tree => Tree);
Attribute : constant Project_Node_Id :=
Default_Project_Node
(Of_Kind => N_Attribute_Declaration,
And_Expr_Kind => List);
Default_Project_Node
(Of_Kind => N_Attribute_Declaration,
In_Tree => Tree,
And_Expr_Kind => List);
Expression : constant Project_Node_Id :=
Default_Project_Node
(Of_Kind => N_Expression,
And_Expr_Kind => List);
Default_Project_Node
(Of_Kind => N_Expression,
In_Tree => Tree,
And_Expr_Kind => List);
Term : constant Project_Node_Id :=
Default_Project_Node
(Of_Kind => N_Term,
And_Expr_Kind => List);
Term : constant Project_Node_Id :=
Default_Project_Node
(Of_Kind => N_Term,
In_Tree => Tree,
And_Expr_Kind => List);
Empty_List : constant Project_Node_Id :=
Default_Project_Node
(Of_Kind => N_Literal_String_List);
Default_Project_Node
(Of_Kind => N_Literal_String_List,
In_Tree => Tree);
begin
Set_First_Declarative_Item_Of
(Project_Naming_Decl, To => Decl_Item);
Set_Next_Declarative_Item (Decl_Item, Naming_Package);
Set_Current_Item_Node (Decl_Item, To => Attribute);
Set_Name_Of (Attribute, To => Name_Source_Files);
Set_Expression_Of (Attribute, To => Expression);
Set_First_Term (Expression, To => Term);
Set_Current_Term (Term, To => Empty_List);
(Project_Naming_Decl, Tree, To => Decl_Item);
Set_Next_Declarative_Item (Decl_Item, Tree, Naming_Package);
Set_Current_Item_Node (Decl_Item, Tree, To => Attribute);
Set_Name_Of (Attribute, Tree, To => Name_Source_Files);
Set_Expression_Of (Attribute, Tree, To => Expression);
Set_First_Term (Expression, Tree, To => Term);
Set_Current_Term (Term, Tree, To => Empty_List);
end;
-- Add a with clause on the naming project in the main project
declare
With_Clause : constant Project_Node_Id :=
Default_Project_Node (Of_Kind => N_With_Clause);
Default_Project_Node
(Of_Kind => N_With_Clause, In_Tree => Tree);
begin
Set_Next_With_Clause_Of
(With_Clause, To => First_With_Clause_Of (Project_Node));
Set_First_With_Clause_Of (Project_Node, To => With_Clause);
Set_Name_Of (With_Clause, To => Project_Naming_Id);
(With_Clause, Tree,
To => First_With_Clause_Of (Project_Node, Tree));
Set_First_With_Clause_Of (Project_Node, Tree, To => With_Clause);
Set_Name_Of (With_Clause, Tree, To => Project_Naming_Id);
-- We set the project node to something different than
-- Empty_Node, so that Prj.PP does not generate a limited
-- with clause.
Set_Project_Node_Of (With_Clause, Non_Empty_Node);
Set_Project_Node_Of (With_Clause, Tree, Non_Empty_Node);
Name_Len := Project_Naming_Last;
Name_Buffer (1 .. Name_Len) :=
Project_Naming_File_Name (1 .. Project_Naming_Last);
Set_String_Value_Of (With_Clause, To => Name_Find);
Set_String_Value_Of (With_Clause, Tree, To => Name_Find);
end;
Project_Declaration := Project_Declaration_Of (Project_Node);
Project_Declaration := Project_Declaration_Of (Project_Node, Tree);
-- Add a renaming declaration for package Naming in the main project
declare
Decl_Item : constant Project_Node_Id :=
Default_Project_Node (Of_Kind => N_Declarative_Item);
Default_Project_Node
(Of_Kind => N_Declarative_Item,
In_Tree => Tree);
Naming : constant Project_Node_Id :=
Default_Project_Node (Of_Kind => N_Package_Declaration);
Default_Project_Node
(Of_Kind => N_Package_Declaration,
In_Tree => Tree);
begin
Set_Next_Declarative_Item
(Decl_Item,
To => First_Declarative_Item_Of (Project_Declaration));
(Decl_Item, Tree,
To => First_Declarative_Item_Of (Project_Declaration, Tree));
Set_First_Declarative_Item_Of
(Project_Declaration, To => Decl_Item);
Set_Current_Item_Node (Decl_Item, To => Naming);
Set_Name_Of (Naming, To => Name_Naming);
(Project_Declaration, Tree, To => Decl_Item);
Set_Current_Item_Node (Decl_Item, Tree, To => Naming);
Set_Name_Of (Naming, Tree, To => Name_Naming);
Set_Project_Of_Renamed_Package_Of
(Naming, To => Project_Naming_Node);
(Naming, Tree, To => Project_Naming_Node);
end;
-- Add an attribute declaration for Source_Dirs, initialized as an
@ -1078,36 +1120,43 @@ package body Prj.Makr is
declare
Decl_Item : constant Project_Node_Id :=
Default_Project_Node (Of_Kind => N_Declarative_Item);
Default_Project_Node
(Of_Kind => N_Declarative_Item,
In_Tree => Tree);
Attribute : constant Project_Node_Id :=
Default_Project_Node
(Of_Kind => N_Attribute_Declaration,
And_Expr_Kind => List);
Default_Project_Node
(Of_Kind => N_Attribute_Declaration,
In_Tree => Tree,
And_Expr_Kind => List);
Expression : constant Project_Node_Id :=
Default_Project_Node
(Of_Kind => N_Expression,
And_Expr_Kind => List);
Default_Project_Node
(Of_Kind => N_Expression,
In_Tree => Tree,
And_Expr_Kind => List);
Term : constant Project_Node_Id :=
Default_Project_Node
(Of_Kind => N_Term, And_Expr_Kind => List);
Default_Project_Node
(Of_Kind => N_Term, In_Tree => Tree,
And_Expr_Kind => List);
begin
Set_Next_Declarative_Item
(Decl_Item,
To => First_Declarative_Item_Of (Project_Declaration));
(Decl_Item, Tree,
To => First_Declarative_Item_Of (Project_Declaration, Tree));
Set_First_Declarative_Item_Of
(Project_Declaration, To => Decl_Item);
Set_Current_Item_Node (Decl_Item, To => Attribute);
Set_Name_Of (Attribute, To => Name_Source_Dirs);
Set_Expression_Of (Attribute, To => Expression);
Set_First_Term (Expression, To => Term);
(Project_Declaration, Tree, To => Decl_Item);
Set_Current_Item_Node (Decl_Item, Tree, To => Attribute);
Set_Name_Of (Attribute, Tree, To => Name_Source_Dirs);
Set_Expression_Of (Attribute, Tree, To => Expression);
Set_First_Term (Expression, Tree, To => Term);
Source_Dirs_List :=
Default_Project_Node (Of_Kind => N_Literal_String_List,
And_Expr_Kind => List);
Set_Current_Term (Term, To => Source_Dirs_List);
Default_Project_Node
(Of_Kind => N_Literal_String_List,
In_Tree => Tree,
And_Expr_Kind => List);
Set_Current_Term (Term, Tree, To => Source_Dirs_List);
end;
-- Add an attribute declaration for Source_List_File with the
@ -1115,43 +1164,49 @@ package body Prj.Makr is
declare
Decl_Item : constant Project_Node_Id :=
Default_Project_Node (Of_Kind => N_Declarative_Item);
Default_Project_Node
(Of_Kind => N_Declarative_Item,
In_Tree => Tree);
Attribute : constant Project_Node_Id :=
Default_Project_Node
(Of_Kind => N_Attribute_Declaration,
And_Expr_Kind => Single);
Attribute : constant Project_Node_Id :=
Default_Project_Node
(Of_Kind => N_Attribute_Declaration,
In_Tree => Tree,
And_Expr_Kind => Single);
Expression : constant Project_Node_Id :=
Default_Project_Node
(Of_Kind => N_Expression,
And_Expr_Kind => Single);
Default_Project_Node
(Of_Kind => N_Expression,
In_Tree => Tree,
And_Expr_Kind => Single);
Term : constant Project_Node_Id :=
Default_Project_Node
(Of_Kind => N_Term,
And_Expr_Kind => Single);
Term : constant Project_Node_Id :=
Default_Project_Node
(Of_Kind => N_Term,
In_Tree => Tree,
And_Expr_Kind => Single);
Value : constant Project_Node_Id :=
Default_Project_Node
(Of_Kind => N_Literal_String,
And_Expr_Kind => Single);
Value : constant Project_Node_Id :=
Default_Project_Node
(Of_Kind => N_Literal_String,
In_Tree => Tree,
And_Expr_Kind => Single);
begin
Set_Next_Declarative_Item
(Decl_Item,
To => First_Declarative_Item_Of (Project_Declaration));
(Decl_Item, Tree,
To => First_Declarative_Item_Of (Project_Declaration, Tree));
Set_First_Declarative_Item_Of
(Project_Declaration, To => Decl_Item);
Set_Current_Item_Node (Decl_Item, To => Attribute);
Set_Name_Of (Attribute, To => Name_Source_List_File);
Set_Expression_Of (Attribute, To => Expression);
Set_First_Term (Expression, To => Term);
Set_Current_Term (Term, To => Value);
(Project_Declaration, Tree, To => Decl_Item);
Set_Current_Item_Node (Decl_Item, Tree, To => Attribute);
Set_Name_Of (Attribute, Tree, To => Name_Source_List_File);
Set_Expression_Of (Attribute, Tree, To => Expression);
Set_First_Term (Expression, Tree, To => Term);
Set_Current_Term (Term, Tree, To => Value);
Name_Len := Source_List_Last;
Name_Buffer (1 .. Name_Len) :=
Source_List_Path (1 .. Source_List_Last);
Set_String_Value_Of (Value, To => Name_Find);
Set_String_Value_Of (Value, Tree, To => Name_Find);
end;
end if;
@ -1163,6 +1218,7 @@ package body Prj.Makr is
Dir_Name : constant String := Directories (Index).all;
Last : Natural := Dir_Name'Last;
Recursively : Boolean := False;
begin
if Dir_Name'Length >= 4
and then (Dir_Name (Last - 2 .. Last) = "/**")
@ -1177,35 +1233,38 @@ package body Prj.Makr is
declare
Expression : constant Project_Node_Id :=
Default_Project_Node
(Of_Kind => N_Expression,
And_Expr_Kind => Single);
Default_Project_Node
(Of_Kind => N_Expression,
In_Tree => Tree,
And_Expr_Kind => Single);
Term : constant Project_Node_Id :=
Default_Project_Node
(Of_Kind => N_Term,
And_Expr_Kind => Single);
Term : constant Project_Node_Id :=
Default_Project_Node
(Of_Kind => N_Term,
In_Tree => Tree,
And_Expr_Kind => Single);
Value : constant Project_Node_Id :=
Default_Project_Node
(Of_Kind => N_Literal_String,
And_Expr_Kind => Single);
Value : constant Project_Node_Id :=
Default_Project_Node
(Of_Kind => N_Literal_String,
In_Tree => Tree,
And_Expr_Kind => Single);
begin
if Current_Source_Dir = Empty_Node then
Set_First_Expression_In_List
(Source_Dirs_List, To => Expression);
(Source_Dirs_List, Tree, To => Expression);
else
Set_Next_Expression_In_List
(Current_Source_Dir, To => Expression);
(Current_Source_Dir, Tree, To => Expression);
end if;
Current_Source_Dir := Expression;
Set_First_Term (Expression, To => Term);
Set_Current_Term (Term, To => Value);
Set_First_Term (Expression, Tree, To => Term);
Set_Current_Term (Term, Tree, To => Value);
Name_Len := Dir_Name'Length;
Name_Buffer (1 .. Name_Len) := Dir_Name;
Set_String_Value_Of (Value, To => Name_Find);
Set_String_Value_Of (Value, Tree, To => Name_Find);
end;
end if;
@ -1252,7 +1311,7 @@ package body Prj.Makr is
-- Output the project file
Prj.PP.Pretty_Print
(Project_Node,
(Project_Node, Tree,
W_Char => Write_A_Char'Access,
W_Eol => Write_Eol'Access,
W_Str => Write_A_String'Access,
@ -1290,7 +1349,7 @@ package body Prj.Makr is
-- Output the naming project file
Prj.PP.Pretty_Print
(Project_Naming_Node,
(Project_Naming_Node, Tree,
W_Char => Write_A_Char'Access,
W_Eol => Write_Eol'Access,
W_Str => Write_A_String'Access,

871
gcc/ada/prj-nmsc.adb
View File

File diff suppressed because it is too large Load Diff

3
gcc/ada/prj-nmsc.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2000-2004 Free Software Foundation, Inc. --
-- Copyright (C) 2000-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- --
@ -34,6 +34,7 @@ private package Prj.Nmsc is
procedure Check
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
Report_Error : Put_Line_Access;
Follow_Links : Boolean);
-- Check the object directory and the source directories

29
gcc/ada/prj-pars.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2001-2004 Free Software Foundation, Inc. --
-- Copyright (C) 2001-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- --
@ -28,7 +28,6 @@ with Ada.Exceptions; use Ada.Exceptions;
with Opt;
with Output; use Output;
with Prj.Com; use Prj.Com;
with Prj.Err; use Prj.Err;
with Prj.Part;
with Prj.Proc;
@ -41,32 +40,40 @@ package body Prj.Pars is
-----------
procedure Parse
(Project : out Project_Id;
(In_Tree : Project_Tree_Ref;
Project : out Project_Id;
Project_File_Name : String;
Packages_To_Check : String_List_Access := All_Packages)
is
Project_Tree : Project_Node_Id := Empty_Node;
Project_Node_Tree : constant Project_Node_Tree_Ref :=
new Project_Node_Tree_Data;
Project_Node : Project_Node_Id := Empty_Node;
The_Project : Project_Id := No_Project;
Success : Boolean := True;
begin
Prj.Tree.Initialize (Project_Node_Tree);
-- Parse the main project file into a tree
Prj.Part.Parse
(Project => Project_Tree,
(In_Tree => Project_Node_Tree,
Project => Project_Node,
Project_File_Name => Project_File_Name,
Always_Errout_Finalize => False,
Packages_To_Check => Packages_To_Check);
-- If there were no error, process the tree
if Project_Tree /= Empty_Node then
if Project_Node /= Empty_Node then
Prj.Proc.Process
(Project => The_Project,
Success => Success,
From_Project_Node => Project_Tree,
Report_Error => null,
Follow_Links => Opt.Follow_Links);
(In_Tree => In_Tree,
Project => The_Project,
Success => Success,
From_Project_Node => Project_Node,
From_Project_Node_Tree => Project_Node_Tree,
Report_Error => null,
Follow_Links => Opt.Follow_Links);
Prj.Err.Finalize;
if not Success then

8
gcc/ada/prj-pars.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2000-2004 Free Software Foundation, Inc. --
-- Copyright (C) 2000-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- --
@ -34,10 +34,12 @@ package Prj.Pars is
-- Set the verbosity when parsing the project files
procedure Parse
(Project : out Project_Id;
(In_Tree : Project_Tree_Ref;
Project : out Project_Id;
Project_File_Name : String;
Packages_To_Check : String_List_Access := All_Packages);
-- Parse a project files and all its imported project files.
-- Parse a project files and all its imported project files, in the
-- project tree In_Tree.
--
-- If parsing is successful, Project_Id is the project ID
-- of the main project file; otherwise, Project_Id is set

425
gcc/ada/prj-part.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2001-2004 Free Software Foundation, Inc. --
-- Copyright (C) 2001-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- --
@ -52,6 +52,9 @@ pragma Elaborate_All (GNAT.OS_Lib);
package body Prj.Part is
Buffer : String_Access;
Buffer_Last : Natural := 0;
Dir_Sep : Character renames GNAT.OS_Lib.Directory_Separator;
type Extension_Origin is (None, Extending_Simple, Extending_All);
@ -104,7 +107,7 @@ package body Prj.Part is
-- limited imported projects when there is a circularity with at least
-- one limited imported project file.
package Virtual_Hash is new Simple_HTable
package Virtual_Hash is new System.HTable.Simple_HTable
(Header_Num => Header_Num,
Element => Project_Node_Id,
No_Element => Empty_Node,
@ -114,7 +117,7 @@ package body Prj.Part is
-- Hash table to store the node id of the project for which a virtual
-- extending project need to be created.
package Processed_Hash is new Simple_HTable
package Processed_Hash is new System.HTable.Simple_HTable
(Header_Num => Header_Num,
Element => Boolean,
No_Element => False,
@ -127,12 +130,14 @@ package body Prj.Part is
procedure Create_Virtual_Extending_Project
(For_Project : Project_Node_Id;
Main_Project : Project_Node_Id);
Main_Project : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref);
-- Create a virtual extending project of For_Project. Main_Project is
-- the extending all project.
procedure Look_For_Virtual_Projects_For
(Proj : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref;
Potentially_Virtual : Boolean);
-- Look for projects that need to have a virtual extending project.
-- This procedure is recursive. If called with Potentially_Virtual set to
@ -140,7 +145,9 @@ package body Prj.Part is
-- does not (because it is already extended), but other projects that it
-- imports may need to be virtually extended.
procedure Pre_Parse_Context_Clause (Context_Clause : out With_Id);
procedure Pre_Parse_Context_Clause
(In_Tree : Project_Node_Tree_Ref;
Context_Clause : out With_Id);
-- Parse the context clause of a project.
-- Store the paths and locations of the imported projects in table Withs.
-- Does nothing if there is no context clause (if the current
@ -148,22 +155,26 @@ package body Prj.Part is
procedure Post_Parse_Context_Clause
(Context_Clause : With_Id;
In_Tree : Project_Node_Tree_Ref;
Imported_Projects : out Project_Node_Id;
Project_Directory : Name_Id;
From_Extended : Extension_Origin;
In_Limited : Boolean);
In_Limited : Boolean;
Packages_To_Check : String_List_Access);
-- Parse the imported projects that have been stored in table Withs,
-- if any. From_Extended is used for the call to Parse_Single_Project
-- below. When In_Limited is True, the importing path includes at least
-- one "limited with".
procedure Parse_Single_Project
(Project : out Project_Node_Id;
Extends_All : out Boolean;
Path_Name : String;
Extended : Boolean;
From_Extended : Extension_Origin;
In_Limited : Boolean);
(In_Tree : Project_Node_Tree_Ref;
Project : out Project_Node_Id;
Extends_All : out Boolean;
Path_Name : String;
Extended : Boolean;
From_Extended : Extension_Origin;
In_Limited : Boolean;
Packages_To_Check : String_List_Access);
-- Parse a project file.
-- Recursive procedure: it calls itself for imported and extended
-- projects. When From_Extended is not None, if the project has already
@ -193,12 +204,13 @@ package body Prj.Part is
procedure Create_Virtual_Extending_Project
(For_Project : Project_Node_Id;
Main_Project : Project_Node_Id)
Main_Project : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref)
is
Virtual_Name : constant String :=
Virtual_Prefix &
Get_Name_String (Name_Of (For_Project));
Get_Name_String (Name_Of (For_Project, In_Tree));
-- The name of the virtual extending project
Virtual_Name_Id : Name_Id;
@ -209,7 +221,7 @@ package body Prj.Part is
-- the same directory as the extending all project.
Virtual_Dir_Id : constant Name_Id :=
Immediate_Directory_Of (Path_Name_Of (Main_Project));
Immediate_Directory_Of (Path_Name_Of (Main_Project, In_Tree));
-- The directory of the extending all project
-- The source of the virtual extending project is something like:
@ -226,23 +238,29 @@ package body Prj.Part is
-- Nodes that made up the virtual extending project
Virtual_Project : constant Project_Node_Id :=
Default_Project_Node (N_Project);
Default_Project_Node
(In_Tree, N_Project);
With_Clause : constant Project_Node_Id :=
Default_Project_Node (N_With_Clause);
Default_Project_Node
(In_Tree, N_With_Clause);
Project_Declaration : constant Project_Node_Id :=
Default_Project_Node (N_Project_Declaration);
Default_Project_Node
(In_Tree, N_Project_Declaration);
Source_Dirs_Declaration : constant Project_Node_Id :=
Default_Project_Node (N_Declarative_Item);
Default_Project_Node
(In_Tree, N_Declarative_Item);
Source_Dirs_Attribute : constant Project_Node_Id :=
Default_Project_Node
(N_Attribute_Declaration, List);
(In_Tree, N_Attribute_Declaration, List);
Source_Dirs_Expression : constant Project_Node_Id :=
Default_Project_Node (N_Expression, List);
Default_Project_Node
(In_Tree, N_Expression, List);
Source_Dirs_Term : constant Project_Node_Id :=
Default_Project_Node (N_Term, List);
Default_Project_Node
(In_Tree, N_Term, List);
Source_Dirs_List : constant Project_Node_Id :=
Default_Project_Node
(N_Literal_String_List, List);
(In_Tree, N_Literal_String_List, List);
begin
-- Get the virtual name id
@ -253,7 +271,7 @@ package body Prj.Part is
-- Get the virtual path name
Get_Name_String (Path_Name_Of (Main_Project));
Get_Name_String (Path_Name_Of (Main_Project, In_Tree));
while Name_Len > 0
and then Name_Buffer (Name_Len) /= Directory_Separator
@ -269,45 +287,49 @@ package body Prj.Part is
-- With clause
Set_Name_Of (With_Clause, Virtual_Name_Id);
Set_Path_Name_Of (With_Clause, Virtual_Path_Id);
Set_Project_Node_Of (With_Clause, Virtual_Project);
Set_Name_Of (With_Clause, In_Tree, Virtual_Name_Id);
Set_Path_Name_Of (With_Clause, In_Tree, Virtual_Path_Id);
Set_Project_Node_Of (With_Clause, In_Tree, Virtual_Project);
Set_Next_With_Clause_Of
(With_Clause, First_With_Clause_Of (Main_Project));
Set_First_With_Clause_Of (Main_Project, With_Clause);
(With_Clause, In_Tree, First_With_Clause_Of (Main_Project, In_Tree));
Set_First_With_Clause_Of (Main_Project, In_Tree, With_Clause);
-- Virtual project node
Set_Name_Of (Virtual_Project, Virtual_Name_Id);
Set_Path_Name_Of (Virtual_Project, Virtual_Path_Id);
Set_Location_Of (Virtual_Project, Location_Of (Main_Project));
Set_Directory_Of (Virtual_Project, Virtual_Dir_Id);
Set_Project_Declaration_Of (Virtual_Project, Project_Declaration);
Set_Name_Of (Virtual_Project, In_Tree, Virtual_Name_Id);
Set_Path_Name_Of (Virtual_Project, In_Tree, Virtual_Path_Id);
Set_Location_Of
(Virtual_Project, In_Tree, Location_Of (Main_Project, In_Tree));
Set_Directory_Of (Virtual_Project, In_Tree, Virtual_Dir_Id);
Set_Project_Declaration_Of
(Virtual_Project, In_Tree, Project_Declaration);
Set_Extended_Project_Path_Of
(Virtual_Project, Path_Name_Of (For_Project));
(Virtual_Project, In_Tree, Path_Name_Of (For_Project, In_Tree));
-- Project declaration
Set_First_Declarative_Item_Of
(Project_Declaration, Source_Dirs_Declaration);
Set_Extended_Project_Of (Project_Declaration, For_Project);
(Project_Declaration, In_Tree, Source_Dirs_Declaration);
Set_Extended_Project_Of (Project_Declaration, In_Tree, For_Project);
-- Source_Dirs declaration
Set_Current_Item_Node (Source_Dirs_Declaration, Source_Dirs_Attribute);
Set_Current_Item_Node
(Source_Dirs_Declaration, In_Tree, Source_Dirs_Attribute);
-- Source_Dirs attribute
Set_Name_Of (Source_Dirs_Attribute, Snames.Name_Source_Dirs);
Set_Expression_Of (Source_Dirs_Attribute, Source_Dirs_Expression);
Set_Name_Of (Source_Dirs_Attribute, In_Tree, Snames.Name_Source_Dirs);
Set_Expression_Of
(Source_Dirs_Attribute, In_Tree, Source_Dirs_Expression);
-- Source_Dirs expression
Set_First_Term (Source_Dirs_Expression, Source_Dirs_Term);
Set_First_Term (Source_Dirs_Expression, In_Tree, Source_Dirs_Term);
-- Source_Dirs term
Set_Current_Term (Source_Dirs_Term, Source_Dirs_List);
Set_Current_Term (Source_Dirs_Term, In_Tree, Source_Dirs_List);
-- Source_Dirs empty list: nothing to do
@ -352,6 +374,7 @@ package body Prj.Part is
procedure Look_For_Virtual_Projects_For
(Proj : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref;
Potentially_Virtual : Boolean)
is
@ -376,10 +399,10 @@ package body Prj.Part is
Processed_Hash.Set (Proj, True);
Declaration := Project_Declaration_Of (Proj);
Declaration := Project_Declaration_Of (Proj, In_Tree);
if Declaration /= Empty_Node then
Extended := Extended_Project_Of (Declaration);
Extended := Extended_Project_Of (Declaration, In_Tree);
end if;
-- If this is a project that may need a virtual extending project
@ -391,17 +414,17 @@ package body Prj.Part is
-- Now check the projects it imports
With_Clause := First_With_Clause_Of (Proj);
With_Clause := First_With_Clause_Of (Proj, In_Tree);
while With_Clause /= Empty_Node loop
Imported := Project_Node_Of (With_Clause);
Imported := Project_Node_Of (With_Clause, In_Tree);
if Imported /= Empty_Node then
Look_For_Virtual_Projects_For
(Imported, Potentially_Virtual => True);
(Imported, In_Tree, Potentially_Virtual => True);
end if;
With_Clause := Next_With_Clause_Of (With_Clause);
With_Clause := Next_With_Clause_Of (With_Clause, In_Tree);
end loop;
-- Check also the eventual project extended by Proj. As this project
@ -409,7 +432,7 @@ package body Prj.Part is
-- being False.
Look_For_Virtual_Projects_For
(Extended, Potentially_Virtual => False);
(Extended, In_Tree, Potentially_Virtual => False);
end if;
end Look_For_Virtual_Projects_For;
@ -418,7 +441,8 @@ package body Prj.Part is
-----------
procedure Parse
(Project : out Project_Node_Id;
(In_Tree : Project_Node_Tree_Ref;
Project : out Project_Node_Id;
Project_File_Name : String;
Always_Errout_Finalize : Boolean;
Packages_To_Check : String_List_Access := All_Packages;
@ -428,11 +452,6 @@ package body Prj.Part is
Dummy : Boolean;
begin
-- Save the Packages_To_Check in Prj, so that it is visible from
-- Prj.Dect.
Current_Packages_To_Check := Packages_To_Check;
Project := Empty_Node;
if Current_Verbosity >= Medium then
@ -461,18 +480,22 @@ package body Prj.Part is
end if;
Parse_Single_Project
(Project => Project,
Extends_All => Dummy,
Path_Name => Path_Name,
Extended => False,
From_Extended => None,
In_Limited => False);
(In_Tree => In_Tree,
Project => Project,
Extends_All => Dummy,
Path_Name => Path_Name,
Extended => False,
From_Extended => None,
In_Limited => False,
Packages_To_Check => Packages_To_Check);
-- If Project is an extending-all project, create the eventual
-- virtual extending projects and check that there are no illegally
-- imported projects.
if Project /= Empty_Node and then Is_Extending_All (Project) then
if Project /= Empty_Node
and then Is_Extending_All (Project, In_Tree)
then
-- First look for projects that potentially need a virtual
-- extending project.
@ -487,10 +510,10 @@ package body Prj.Part is
declare
Declaration : constant Project_Node_Id :=
Project_Declaration_Of (Project);
Project_Declaration_Of (Project, In_Tree);
begin
Look_For_Virtual_Projects_For
(Extended_Project_Of (Declaration),
(Extended_Project_Of (Declaration, In_Tree), In_Tree,
Potentially_Virtual => False);
end;
@ -501,30 +524,33 @@ package body Prj.Part is
-- the project being "extended-all" by the main project.
declare
With_Clause : Project_Node_Id :=
First_With_Clause_Of (Project);
With_Clause : Project_Node_Id;
Imported : Project_Node_Id := Empty_Node;
Declaration : Project_Node_Id := Empty_Node;
begin
With_Clause := First_With_Clause_Of (Project, In_Tree);
while With_Clause /= Empty_Node loop
Imported := Project_Node_Of (With_Clause);
Imported := Project_Node_Of (With_Clause, In_Tree);
if Imported /= Empty_Node then
Declaration := Project_Declaration_Of (Imported);
Declaration := Project_Declaration_Of (Imported, In_Tree);
if Extended_Project_Of (Declaration) /= Empty_Node then
if Extended_Project_Of (Declaration, In_Tree) /=
Empty_Node
then
loop
Imported := Extended_Project_Of (Declaration);
Imported :=
Extended_Project_Of (Declaration, In_Tree);
exit when Imported = Empty_Node;
Virtual_Hash.Remove (Imported);
Declaration := Project_Declaration_Of (Imported);
Declaration :=
Project_Declaration_Of (Imported, In_Tree);
end loop;
end if;
end if;
With_Clause := Next_With_Clause_Of (With_Clause);
With_Clause := Next_With_Clause_Of (With_Clause, In_Tree);
end loop;
end;
@ -534,7 +560,7 @@ package body Prj.Part is
Proj : Project_Node_Id := Virtual_Hash.Get_First;
begin
while Proj /= Empty_Node loop
Create_Virtual_Extending_Project (Proj, Project);
Create_Virtual_Extending_Project (Proj, Project, In_Tree);
Proj := Virtual_Hash.Get_Next;
end loop;
end;
@ -568,7 +594,10 @@ package body Prj.Part is
-- Pre_Parse_Context_Clause --
------------------------------
procedure Pre_Parse_Context_Clause (Context_Clause : out With_Id) is
procedure Pre_Parse_Context_Clause
(In_Tree : Project_Node_Tree_Ref;
Context_Clause : out With_Id)
is
Current_With_Clause : With_Id := No_With;
Limited_With : Boolean := False;
@ -582,22 +611,23 @@ package body Prj.Part is
Context_Clause := No_With;
With_Loop :
-- If Token is not WITH or LIMITED, there is no context clause,
-- or we have exhausted the with clauses.
-- If Token is not WITH or LIMITED, there is no context clause, or we
-- have exhausted the with clauses.
while Token = Tok_With or else Token = Tok_Limited loop
Current_With_Node := Default_Project_Node (Of_Kind => N_With_Clause);
Current_With_Node :=
Default_Project_Node (Of_Kind => N_With_Clause, In_Tree => In_Tree);
Limited_With := Token = Tok_Limited;
if Limited_With then
Scan; -- scan past LIMITED
Scan (In_Tree); -- scan past LIMITED
Expect (Tok_With, "WITH");
exit With_Loop when Token /= Tok_With;
end if;
Comma_Loop :
loop
Scan; -- scan past WITH or ","
Scan (In_Tree); -- scan past WITH or ","
Expect (Tok_String_Literal, "literal string");
@ -626,7 +656,7 @@ package body Prj.Part is
Current_With_Clause := Withs.Last;
Scan;
Scan (In_Tree);
if Token = Tok_Semicolon then
Set_End_Of_Line (Current_With_Node);
@ -634,7 +664,7 @@ package body Prj.Part is
-- End of (possibly multiple) with clause;
Scan; -- scan past the semicolon.
Scan (In_Tree); -- scan past the semicolon.
exit Comma_Loop;
elsif Token /= Tok_Comma then
@ -643,7 +673,8 @@ package body Prj.Part is
end if;
Current_With_Node :=
Default_Project_Node (Of_Kind => N_With_Clause);
Default_Project_Node
(Of_Kind => N_With_Clause, In_Tree => In_Tree);
end loop Comma_Loop;
end loop With_Loop;
end Pre_Parse_Context_Clause;
@ -655,10 +686,12 @@ package body Prj.Part is
procedure Post_Parse_Context_Clause
(Context_Clause : With_Id;
In_Tree : Project_Node_Tree_Ref;
Imported_Projects : out Project_Node_Id;
Project_Directory : Name_Id;
From_Extended : Extension_Origin;
In_Limited : Boolean)
In_Limited : Boolean;
Packages_To_Check : String_List_Access)
is
Current_With_Clause : With_Id := Context_Clause;
@ -684,12 +717,11 @@ package body Prj.Part is
declare
Original_Path : constant String :=
Get_Name_String (Current_With.Path);
Get_Name_String (Current_With.Path);
Imported_Path_Name : constant String :=
Project_Path_Name_Of
(Original_Path,
Project_Directory_Path);
(Original_Path, Project_Directory_Path);
Resolved_Path : constant String :=
Normalize_Pathname
@ -732,13 +764,15 @@ package body Prj.Part is
else
Next_Project := Current_With.Node;
Set_Next_With_Clause_Of (Current_Project, Next_Project);
Set_Next_With_Clause_Of
(Current_Project, In_Tree, Next_Project);
Current_Project := Next_Project;
end if;
Set_String_Value_Of
(Current_Project, Current_With.Path);
Set_Location_Of (Current_Project, Current_With.Location);
(Current_Project, In_Tree, Current_With.Path);
Set_Location_Of
(Current_Project, In_Tree, Current_With.Location);
-- If this is a "limited with", check if we have a circularity.
-- If we have one, get the project id of the limited imported
@ -772,15 +806,17 @@ package body Prj.Part is
if Withed_Project = Empty_Node then
Parse_Single_Project
(Project => Withed_Project,
Extends_All => Extends_All,
Path_Name => Imported_Path_Name,
Extended => False,
From_Extended => From_Extended,
In_Limited => Limited_With);
(In_Tree => In_Tree,
Project => Withed_Project,
Extends_All => Extends_All,
Path_Name => Imported_Path_Name,
Extended => False,
From_Extended => From_Extended,
In_Limited => Limited_With,
Packages_To_Check => Packages_To_Check);
else
Extends_All := Is_Extending_All (Withed_Project);
Extends_All := Is_Extending_All (Withed_Project, In_Tree);
end if;
if Withed_Project = Empty_Node then
@ -794,7 +830,7 @@ package body Prj.Part is
else
Set_Next_With_Clause_Of
(Current_Project, Empty_Node);
(Current_Project, In_Tree, Empty_Node);
end if;
else
-- If parsing was successful, record project name
@ -802,16 +838,20 @@ package body Prj.Part is
Set_Project_Node_Of
(Node => Current_Project,
In_Tree => In_Tree,
To => Withed_Project,
Limited_With => Limited_With);
Set_Name_Of (Current_Project, Name_Of (Withed_Project));
Limited_With => Current_With.Limited_With);
Set_Name_Of
(Current_Project,
In_Tree,
Name_Of (Withed_Project, In_Tree));
Name_Len := Resolved_Path'Length;
Name_Buffer (1 .. Name_Len) := Resolved_Path;
Set_Path_Name_Of (Current_Project, Name_Find);
Set_Path_Name_Of (Current_Project, In_Tree, Name_Find);
if Extends_All then
Set_Is_Extending_All (Current_Project);
Set_Is_Extending_All (Current_Project, In_Tree);
end if;
end if;
end if;
@ -824,12 +864,14 @@ package body Prj.Part is
--------------------------
procedure Parse_Single_Project
(Project : out Project_Node_Id;
Extends_All : out Boolean;
Path_Name : String;
Extended : Boolean;
From_Extended : Extension_Origin;
In_Limited : Boolean)
(In_Tree : Project_Node_Tree_Ref;
Project : out Project_Node_Id;
Extends_All : out Boolean;
Path_Name : String;
Extended : Boolean;
From_Extended : Extension_Origin;
In_Limited : Boolean;
Packages_To_Check : String_List_Access)
is
Normed_Path_Name : Name_Id;
Canonical_Path_Name : Name_Id;
@ -842,7 +884,8 @@ package body Prj.Part is
Extended_Project : Project_Node_Id := Empty_Node;
A_Project_Name_And_Node : Tree_Private_Part.Project_Name_And_Node :=
Tree_Private_Part.Projects_Htable.Get_First;
Tree_Private_Part.Projects_Htable.Get_First
(In_Tree.Projects_HT);
Name_From_Path : constant Name_Id := Project_Name_From (Path_Name);
@ -931,7 +974,7 @@ package body Prj.Part is
elsif A_Project_Name_And_Node.Extended then
Extends_All :=
Is_Extending_All (A_Project_Name_And_Node.Node);
Is_Extending_All (A_Project_Name_And_Node.Node, In_Tree);
-- If the imported project is an extended project A,
-- and we are in an extended project, replace A with the
@ -941,15 +984,17 @@ package body Prj.Part is
declare
Decl : Project_Node_Id :=
Project_Declaration_Of
(A_Project_Name_And_Node.Node);
(A_Project_Name_And_Node.Node, In_Tree);
Prj : Project_Node_Id := Extending_Project_Of (Decl);
Prj : Project_Node_Id :=
Extending_Project_Of (Decl, In_Tree);
begin
loop
Decl := Project_Declaration_Of (Prj);
exit when Extending_Project_Of (Decl) = Empty_Node;
Prj := Extending_Project_Of (Decl);
Decl := Project_Declaration_Of (Prj, In_Tree);
exit when Extending_Project_Of (Decl, In_Tree) =
Empty_Node;
Prj := Extending_Project_Of (Decl, In_Tree);
end loop;
A_Project_Name_And_Node.Node := Prj;
@ -966,7 +1011,8 @@ package body Prj.Part is
return;
end if;
A_Project_Name_And_Node := Tree_Private_Part.Projects_Htable.Get_Next;
A_Project_Name_And_Node :=
Tree_Private_Part.Projects_Htable.Get_Next (In_Tree.Projects_HT);
end loop;
-- We never encountered this project file
@ -986,7 +1032,7 @@ package body Prj.Part is
Prj.Err.Scanner.Initialize_Scanner (Types.No_Unit, Source_Index);
Tree.Reset_State;
Scan;
Scan (In_Tree);
if Name_From_Path = No_Name then
@ -1007,22 +1053,23 @@ package body Prj.Part is
-- Is there any imported project?
Pre_Parse_Context_Clause (First_With);
Pre_Parse_Context_Clause (In_Tree, First_With);
Project_Directory := Immediate_Directory_Of (Normed_Path_Name);
Project := Default_Project_Node (Of_Kind => N_Project);
Project := Default_Project_Node
(Of_Kind => N_Project, In_Tree => In_Tree);
Project_Stack.Table (Project_Stack.Last).Id := Project;
Set_Directory_Of (Project, Project_Directory);
Set_Path_Name_Of (Project, Normed_Path_Name);
Set_Location_Of (Project, Token_Ptr);
Set_Directory_Of (Project, In_Tree, Project_Directory);
Set_Path_Name_Of (Project, In_Tree, Normed_Path_Name);
Set_Location_Of (Project, In_Tree, Token_Ptr);
Expect (Tok_Project, "PROJECT");
-- Mark location of PROJECT token if present
if Token = Tok_Project then
Set_Location_Of (Project, Token_Ptr);
Scan; -- scan past project
Set_Location_Of (Project, In_Tree, Token_Ptr);
Scan (In_Tree); -- scan past project
end if;
-- Clear the Buffer
@ -1042,21 +1089,21 @@ package body Prj.Part is
-- Add the identifier name to the buffer
Get_Name_String (Token_Name);
Add_To_Buffer (Name_Buffer (1 .. Name_Len));
Add_To_Buffer (Name_Buffer (1 .. Name_Len), Buffer, Buffer_Last);
-- Scan past the identifier
Scan;
Scan (In_Tree);
-- If we have a dot, add a dot the the Buffer and look for the next
-- identifier.
exit when Token /= Tok_Dot;
Add_To_Buffer (".");
Add_To_Buffer (".", Buffer, Buffer_Last);
-- Scan past the dot
Scan;
Scan (In_Tree);
end loop;
-- See if this is an extending project
@ -1071,12 +1118,12 @@ package body Prj.Part is
Extending := True;
Scan; -- scan past EXTENDS
Scan (In_Tree); -- scan past EXTENDS
if Token = Tok_All then
Extends_All := True;
Set_Is_Extending_All (Project);
Scan; -- scan past ALL
Set_Is_Extending_All (Project, In_Tree);
Scan (In_Tree); -- scan past ALL
end if;
end if;
@ -1089,7 +1136,7 @@ package body Prj.Part is
Name_Len := Buffer_Last;
Name_Buffer (1 .. Name_Len) := Buffer (1 .. Buffer_Last);
Name_Of_Project := Name_Find;
Set_Name_Of (Project, Name_Of_Project);
Set_Name_Of (Project, In_Tree, Name_Of_Project);
-- To get expected name of the project file, replace dots by dashes
@ -1138,17 +1185,20 @@ package body Prj.Part is
end if;
Post_Parse_Context_Clause
(Context_Clause => First_With,
(In_Tree => In_Tree,
Context_Clause => First_With,
Imported_Projects => Imported_Projects,
Project_Directory => Project_Directory,
From_Extended => From_Ext,
In_Limited => In_Limited);
Set_First_With_Clause_Of (Project, Imported_Projects);
In_Limited => In_Limited,
Packages_To_Check => Packages_To_Check);
Set_First_With_Clause_Of (Project, In_Tree, Imported_Projects);
end;
declare
Name_And_Node : Tree_Private_Part.Project_Name_And_Node :=
Tree_Private_Part.Projects_Htable.Get_First;
Tree_Private_Part.Projects_Htable.Get_First
(In_Tree.Projects_HT);
Project_Name : Name_Id := Name_And_Node.Name;
begin
@ -1157,7 +1207,9 @@ package body Prj.Part is
while Project_Name /= No_Name
and then Project_Name /= Name_Of_Project
loop
Name_And_Node := Tree_Private_Part.Projects_Htable.Get_Next;
Name_And_Node :=
Tree_Private_Part.Projects_Htable.Get_Next
(In_Tree.Projects_HT);
Project_Name := Name_And_Node.Name;
end loop;
@ -1165,9 +1217,12 @@ package body Prj.Part is
if Project_Name /= No_Name then
Error_Msg_Name_1 := Project_Name;
Error_Msg ("duplicate project name {", Location_Of (Project));
Error_Msg_Name_1 := Path_Name_Of (Name_And_Node.Node);
Error_Msg ("\already in {", Location_Of (Project));
Error_Msg
("duplicate project name {", Location_Of (Project, In_Tree));
Error_Msg_Name_1 :=
Path_Name_Of (Name_And_Node.Node, In_Tree);
Error_Msg
("\already in {", Location_Of (Project, In_Tree));
else
-- Otherwise, add the name of the project to the hash table, so
@ -1175,7 +1230,8 @@ package body Prj.Part is
-- the same name.
Tree_Private_Part.Projects_Htable.Set
(K => Name_Of_Project,
(T => In_Tree.Projects_HT,
K => Name_Of_Project,
E => (Name => Name_Of_Project,
Node => Project,
Canonical_Path => Canonical_Path_Name,
@ -1189,7 +1245,7 @@ package body Prj.Part is
Expect (Tok_String_Literal, "literal string");
if Token = Tok_String_Literal then
Set_Extended_Project_Path_Of (Project, Token_Name);
Set_Extended_Project_Path_Of (Project, In_Tree, Token_Name);
declare
Original_Path_Name : constant String :=
@ -1198,8 +1254,8 @@ package body Prj.Part is
Extended_Project_Path_Name : constant String :=
Project_Path_Name_Of
(Original_Path_Name,
Get_Name_String
(Project_Directory));
Get_Name_String
(Project_Directory));
begin
if Extended_Project_Path_Name = "" then
@ -1235,50 +1291,53 @@ package body Prj.Part is
end if;
Parse_Single_Project
(Project => Extended_Project,
Extends_All => Extends_All,
Path_Name => Extended_Project_Path_Name,
Extended => True,
From_Extended => From_Ext,
In_Limited => In_Limited);
(In_Tree => In_Tree,
Project => Extended_Project,
Extends_All => Extends_All,
Path_Name => Extended_Project_Path_Name,
Extended => True,
From_Extended => From_Ext,
In_Limited => In_Limited,
Packages_To_Check => Packages_To_Check);
end;
-- A project that extends an extending-all project is also
-- an extending-all project.
if Extended_Project /= Empty_Node
and then Is_Extending_All (Extended_Project)
and then Is_Extending_All (Extended_Project, In_Tree)
then
Set_Is_Extending_All (Project);
Set_Is_Extending_All (Project, In_Tree);
end if;
end if;
end;
Scan; -- scan past the extended project path
Scan (In_Tree); -- scan past the extended project path
end if;
end if;
-- Check that a non extending-all project does not import an
-- extending-all project.
if not Is_Extending_All (Project) then
if not Is_Extending_All (Project, In_Tree) then
declare
With_Clause : Project_Node_Id := First_With_Clause_Of (Project);
With_Clause : Project_Node_Id :=
First_With_Clause_Of (Project, In_Tree);
Imported : Project_Node_Id := Empty_Node;
begin
With_Clause_Loop :
while With_Clause /= Empty_Node loop
Imported := Project_Node_Of (With_Clause);
Imported := Project_Node_Of (With_Clause, In_Tree);
if Is_Extending_All (With_Clause) then
Error_Msg_Name_1 := Name_Of (Imported);
if Is_Extending_All (With_Clause, In_Tree) then
Error_Msg_Name_1 := Name_Of (Imported, In_Tree);
Error_Msg ("cannot import extending-all project {",
Token_Ptr);
exit With_Clause_Loop;
end if;
With_Clause := Next_With_Clause_Of (With_Clause);
With_Clause := Next_With_Clause_Of (With_Clause, In_Tree);
end loop With_Clause_Loop;
end;
end if;
@ -1308,22 +1367,25 @@ package body Prj.Part is
declare
Parent_Name : constant Name_Id := Name_Find;
Parent_Found : Boolean := False;
With_Clause : Project_Node_Id := First_With_Clause_Of (Project);
With_Clause : Project_Node_Id :=
First_With_Clause_Of (Project, In_Tree);
begin
-- If there is an extended project, check its name
if Extended_Project /= Empty_Node then
Parent_Found := Name_Of (Extended_Project) = Parent_Name;
Parent_Found :=
Name_Of (Extended_Project, In_Tree) = Parent_Name;
end if;
-- If the parent project is not the extended project,
-- check each imported project until we find the parent project.
while not Parent_Found and then With_Clause /= Empty_Node loop
Parent_Found := Name_Of (Project_Node_Of (With_Clause))
= Parent_Name;
With_Clause := Next_With_Clause_Of (With_Clause);
Parent_Found :=
Name_Of (Project_Node_Of (With_Clause, In_Tree), In_Tree) =
Parent_Name;
With_Clause := Next_With_Clause_Of (With_Clause, In_Tree);
end loop;
-- If the parent project was not found, report an error
@ -1332,7 +1394,7 @@ package body Prj.Part is
Error_Msg_Name_1 := Name_Of_Project;
Error_Msg_Name_2 := Parent_Name;
Error_Msg ("project { does not import or extend project {",
Location_Of (Project));
Location_Of (Project, In_Tree));
end if;
end;
end if;
@ -1349,14 +1411,17 @@ package body Prj.Part is
-- No need to Scan past "is", Prj.Dect.Parse will do it
Prj.Dect.Parse
(Declarations => Project_Declaration,
Current_Project => Project,
Extends => Extended_Project);
Set_Project_Declaration_Of (Project, Project_Declaration);
(In_Tree => In_Tree,
Declarations => Project_Declaration,
Current_Project => Project,
Extends => Extended_Project,
Packages_To_Check => Packages_To_Check);
Set_Project_Declaration_Of (Project, In_Tree, Project_Declaration);
if Extended_Project /= Empty_Node then
Set_Extending_Project_Of
(Project_Declaration_Of (Extended_Project), To => Project);
(Project_Declaration_Of (Extended_Project, In_Tree), In_Tree,
To => Project);
end if;
end;
@ -1366,7 +1431,7 @@ package body Prj.Part is
-- Skip "end" if present
if Token = Tok_End then
Scan;
Scan (In_Tree);
end if;
-- Clear the Buffer
@ -1389,26 +1454,26 @@ package body Prj.Part is
-- Add the identifier to the Buffer
Get_Name_String (Token_Name);
Add_To_Buffer (Name_Buffer (1 .. Name_Len));
Add_To_Buffer (Name_Buffer (1 .. Name_Len), Buffer, Buffer_Last);
-- Scan past the identifier
Scan;
Scan (In_Tree);
exit when Token /= Tok_Dot;
Add_To_Buffer (".");
Scan;
Add_To_Buffer (".", Buffer, Buffer_Last);
Scan (In_Tree);
end loop;
-- If we have a valid name, check if it is the name of the project
if Name_Of_Project /= No_Name and then Buffer_Last > 0 then
if To_Lower (Buffer (1 .. Buffer_Last)) /=
Get_Name_String (Name_Of (Project))
Get_Name_String (Name_Of (Project, In_Tree))
then
-- Invalid name: report an error
Error_Msg ("Expected """ &
Get_Name_String (Name_Of (Project)) & """",
Get_Name_String (Name_Of (Project, In_Tree)) & """",
Token_Ptr);
end if;
end if;
@ -1420,7 +1485,7 @@ package body Prj.Part is
if Token = Tok_Semicolon then
Set_Previous_End_Node (Project);
Scan;
Scan (In_Tree);
if Token /= Tok_EOF then
Error_Msg
@ -1439,7 +1504,9 @@ package body Prj.Part is
-- Indicate if there are unkept comments
Tree.Set_Project_File_Includes_Unkept_Comments
(Node => Project, To => Tree.There_Are_Unkept_Comments);
(Node => Project,
In_Tree => In_Tree,
To => Tree.There_Are_Unkept_Comments);
-- And restore the comment state that was saved

5
gcc/ada/prj-part.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2000-2003 Free Software Foundation, Inc. --
-- Copyright (C) 2000-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- --
@ -31,7 +31,8 @@ with Prj.Tree; use Prj.Tree;
package Prj.Part is
procedure Parse
(Project : out Project_Node_Id;
(In_Tree : Project_Node_Tree_Ref;
Project : out Project_Node_Id;
Project_File_Name : String;
Always_Errout_Finalize : Boolean;
Packages_To_Check : String_List_Access := All_Packages;

254
gcc/ada/prj-pp.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2001-2004 Free Software Foundation, Inc. --
-- Copyright (C) 2001-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- --
@ -63,6 +63,7 @@ package body Prj.PP is
procedure Pretty_Print
(Project : Prj.Tree.Project_Node_Id;
In_Tree : Prj.Tree.Project_Node_Tree_Ref;
Increment : Positive := 3;
Eliminate_Empty_Case_Constructions : Boolean := False;
Minimize_Empty_Lines : Boolean := False;
@ -254,7 +255,7 @@ package body Prj.PP is
-------------------------------
procedure Write_End_Of_Line_Comment (Node : Project_Node_Id) is
Value : constant Name_Id := End_Of_Line_Comment (Node);
Value : constant Name_Id := End_Of_Line_Comment (Node, In_Tree);
begin
if Value /= No_Name then
@ -309,136 +310,152 @@ package body Prj.PP is
begin
if Node /= Empty_Node then
case Kind_Of (Node) is
case Kind_Of (Node, In_Tree) is
when N_Project =>
pragma Debug (Indicate_Tested (N_Project));
if First_With_Clause_Of (Node) /= Empty_Node then
if First_With_Clause_Of (Node, In_Tree) /= Empty_Node then
-- with clause(s)
Print (First_With_Clause_Of (Node), Indent);
Print (First_With_Clause_Of (Node, In_Tree), Indent);
Write_Empty_Line (Always => True);
end if;
Print (First_Comment_Before (Node), Indent);
Print (First_Comment_Before (Node, In_Tree), Indent);
Start_Line (Indent);
Write_String ("project ");
Output_Name (Name_Of (Node));
Output_Name (Name_Of (Node, In_Tree));
-- Check if this project extends another project
if Extended_Project_Path_Of (Node) /= No_Name then
if Extended_Project_Path_Of (Node, In_Tree) /= No_Name then
Write_String (" extends ");
Output_String (Extended_Project_Path_Of (Node));
Output_String (Extended_Project_Path_Of (Node, In_Tree));
end if;
Write_String (" is");
Write_End_Of_Line_Comment (Node);
Print (First_Comment_After (Node), Indent + Increment);
Print
(First_Comment_After (Node, In_Tree), Indent + Increment);
Write_Empty_Line (Always => True);
-- Output all of the declarations in the project
Print (Project_Declaration_Of (Node), Indent);
Print (First_Comment_Before_End (Node), Indent + Increment);
Print (Project_Declaration_Of (Node, In_Tree), Indent);
Print
(First_Comment_Before_End (Node, In_Tree),
Indent + Increment);
Start_Line (Indent);
Write_String ("end ");
Output_Name (Name_Of (Node));
Output_Name (Name_Of (Node, In_Tree));
Write_Line (";");
Print (First_Comment_After_End (Node), Indent);
Print (First_Comment_After_End (Node, In_Tree), Indent);
when N_With_Clause =>
pragma Debug (Indicate_Tested (N_With_Clause));
if Name_Of (Node) /= No_Name then
Print (First_Comment_Before (Node), Indent);
if Name_Of (Node, In_Tree) /= No_Name then
Print (First_Comment_Before (Node, In_Tree), Indent);
Start_Line (Indent);
if Non_Limited_Project_Node_Of (Node) = Empty_Node then
if Non_Limited_Project_Node_Of (Node, In_Tree) =
Empty_Node
then
Write_String ("limited ");
end if;
Write_String ("with ");
Output_String (String_Value_Of (Node));
Output_String (String_Value_Of (Node, In_Tree));
Write_String (";");
Write_End_Of_Line_Comment (Node);
Print (First_Comment_After (Node), Indent);
Print (First_Comment_After (Node, In_Tree), Indent);
end if;
Print (Next_With_Clause_Of (Node), Indent);
Print (Next_With_Clause_Of (Node, In_Tree), Indent);
when N_Project_Declaration =>
pragma Debug (Indicate_Tested (N_Project_Declaration));
if First_Declarative_Item_Of (Node) /= Empty_Node then
if
First_Declarative_Item_Of (Node, In_Tree) /= Empty_Node
then
Print
(First_Declarative_Item_Of (Node), Indent + Increment);
(First_Declarative_Item_Of (Node, In_Tree),
Indent + Increment);
Write_Empty_Line (Always => True);
end if;
when N_Declarative_Item =>
pragma Debug (Indicate_Tested (N_Declarative_Item));
Print (Current_Item_Node (Node), Indent);
Print (Next_Declarative_Item (Node), Indent);
Print (Current_Item_Node (Node, In_Tree), Indent);
Print (Next_Declarative_Item (Node, In_Tree), Indent);
when N_Package_Declaration =>
pragma Debug (Indicate_Tested (N_Package_Declaration));
Write_Empty_Line (Always => True);
Print (First_Comment_Before (Node), Indent);
Print (First_Comment_Before (Node, In_Tree), Indent);
Start_Line (Indent);
Write_String ("package ");
Output_Name (Name_Of (Node));
Output_Name (Name_Of (Node, In_Tree));
if Project_Of_Renamed_Package_Of (Node) /= Empty_Node then
if Project_Of_Renamed_Package_Of (Node, In_Tree) /=
Empty_Node
then
Write_String (" renames ");
Output_Name
(Name_Of (Project_Of_Renamed_Package_Of (Node)));
(Name_Of
(Project_Of_Renamed_Package_Of (Node, In_Tree),
In_Tree));
Write_String (".");
Output_Name (Name_Of (Node));
Output_Name (Name_Of (Node, In_Tree));
Write_String (";");
Write_End_Of_Line_Comment (Node);
Print (First_Comment_After_End (Node), Indent);
Print (First_Comment_After_End (Node, In_Tree), Indent);
else
Write_String (" is");
Write_End_Of_Line_Comment (Node);
Print (First_Comment_After (Node), Indent + Increment);
Print (First_Comment_After (Node, In_Tree),
Indent + Increment);
if First_Declarative_Item_Of (Node) /= Empty_Node then
if First_Declarative_Item_Of (Node, In_Tree) /=
Empty_Node
then
Print
(First_Declarative_Item_Of (Node),
(First_Declarative_Item_Of (Node, In_Tree),
Indent + Increment);
end if;
Print (First_Comment_Before_End (Node),
Print (First_Comment_Before_End (Node, In_Tree),
Indent + Increment);
Start_Line (Indent);
Write_String ("end ");
Output_Name (Name_Of (Node));
Output_Name (Name_Of (Node, In_Tree));
Write_Line (";");
Print (First_Comment_After_End (Node), Indent);
Print (First_Comment_After_End (Node, In_Tree), Indent);
Write_Empty_Line;
end if;
when N_String_Type_Declaration =>
pragma Debug (Indicate_Tested (N_String_Type_Declaration));
Print (First_Comment_Before (Node), Indent);
Print (First_Comment_Before (Node, In_Tree), Indent);
Start_Line (Indent);
Write_String ("type ");
Output_Name (Name_Of (Node));
Output_Name (Name_Of (Node, In_Tree));
Write_Line (" is");
Start_Line (Indent + Increment);
Write_String ("(");
declare
String_Node : Project_Node_Id :=
First_Literal_String (Node);
First_Literal_String (Node, In_Tree);
begin
while String_Node /= Empty_Node loop
Output_String (String_Value_Of (String_Node));
String_Node := Next_Literal_String (String_Node);
Output_String (String_Value_Of (String_Node, In_Tree));
String_Node :=
Next_Literal_String (String_Node, In_Tree);
if String_Node /= Empty_Node then
Write_String (", ");
@ -448,76 +465,78 @@ package body Prj.PP is
Write_String (");");
Write_End_Of_Line_Comment (Node);
Print (First_Comment_After (Node), Indent);
Print (First_Comment_After (Node, In_Tree), Indent);
when N_Literal_String =>
pragma Debug (Indicate_Tested (N_Literal_String));
Output_String (String_Value_Of (Node));
Output_String (String_Value_Of (Node, In_Tree));
if Source_Index_Of (Node) /= 0 then
if Source_Index_Of (Node, In_Tree) /= 0 then
Write_String (" at ");
Write_String (Source_Index_Of (Node)'Img);
Write_String (Source_Index_Of (Node, In_Tree)'Img);
end if;
when N_Attribute_Declaration =>
pragma Debug (Indicate_Tested (N_Attribute_Declaration));
Print (First_Comment_Before (Node), Indent);
Print (First_Comment_Before (Node, In_Tree), Indent);
Start_Line (Indent);
Write_String ("for ");
Output_Attribute_Name (Name_Of (Node));
Output_Attribute_Name (Name_Of (Node, In_Tree));
if Associative_Array_Index_Of (Node) /= No_Name then
if Associative_Array_Index_Of (Node, In_Tree) /= No_Name then
Write_String (" (");
Output_String (Associative_Array_Index_Of (Node));
Output_String
(Associative_Array_Index_Of (Node, In_Tree));
if Source_Index_Of (Node) /= 0 then
if Source_Index_Of (Node, In_Tree) /= 0 then
Write_String (" at ");
Write_String (Source_Index_Of (Node)'Img);
Write_String (Source_Index_Of (Node, In_Tree)'Img);
end if;
Write_String (")");
end if;
Write_String (" use ");
Print (Expression_Of (Node), Indent);
Print (Expression_Of (Node, In_Tree), Indent);
Write_String (";");
Write_End_Of_Line_Comment (Node);
Print (First_Comment_After (Node), Indent);
Print (First_Comment_After (Node, In_Tree), Indent);
when N_Typed_Variable_Declaration =>
pragma Debug
(Indicate_Tested (N_Typed_Variable_Declaration));
Print (First_Comment_Before (Node), Indent);
Print (First_Comment_Before (Node, In_Tree), Indent);
Start_Line (Indent);
Output_Name (Name_Of (Node));
Output_Name (Name_Of (Node, In_Tree));
Write_String (" : ");
Output_Name (Name_Of (String_Type_Of (Node)));
Output_Name
(Name_Of (String_Type_Of (Node, In_Tree), In_Tree));
Write_String (" := ");
Print (Expression_Of (Node), Indent);
Print (Expression_Of (Node, In_Tree), Indent);
Write_String (";");
Write_End_Of_Line_Comment (Node);
Print (First_Comment_After (Node), Indent);
Print (First_Comment_After (Node, In_Tree), Indent);
when N_Variable_Declaration =>
pragma Debug (Indicate_Tested (N_Variable_Declaration));
Print (First_Comment_Before (Node), Indent);
Print (First_Comment_Before (Node, In_Tree), Indent);
Start_Line (Indent);
Output_Name (Name_Of (Node));
Output_Name (Name_Of (Node, In_Tree));
Write_String (" := ");
Print (Expression_Of (Node), Indent);
Print (Expression_Of (Node, In_Tree), Indent);
Write_String (";");
Write_End_Of_Line_Comment (Node);
Print (First_Comment_After (Node), Indent);
Print (First_Comment_After (Node, In_Tree), Indent);
when N_Expression =>
pragma Debug (Indicate_Tested (N_Expression));
declare
Term : Project_Node_Id := First_Term (Node);
Term : Project_Node_Id := First_Term (Node, In_Tree);
begin
while Term /= Empty_Node loop
Print (Term, Indent);
Term := Next_Term (Term);
Term := Next_Term (Term, In_Tree);
if Term /= Empty_Node then
Write_String (" & ");
@ -527,7 +546,7 @@ package body Prj.PP is
when N_Term =>
pragma Debug (Indicate_Tested (N_Term));
Print (Current_Term (Node), Indent);
Print (Current_Term (Node, In_Tree), Indent);
when N_Literal_String_List =>
pragma Debug (Indicate_Tested (N_Literal_String_List));
@ -535,12 +554,13 @@ package body Prj.PP is
declare
Expression : Project_Node_Id :=
First_Expression_In_List (Node);
First_Expression_In_List (Node, In_Tree);
begin
while Expression /= Empty_Node loop
Print (Expression, Indent);
Expression := Next_Expression_In_List (Expression);
Expression :=
Next_Expression_In_List (Expression, In_Tree);
if Expression /= Empty_Node then
Write_String (", ");
@ -552,26 +572,28 @@ package body Prj.PP is
when N_Variable_Reference =>
pragma Debug (Indicate_Tested (N_Variable_Reference));
if Project_Node_Of (Node) /= Empty_Node then
Output_Name (Name_Of (Project_Node_Of (Node)));
if Project_Node_Of (Node, In_Tree) /= Empty_Node then
Output_Name
(Name_Of (Project_Node_Of (Node, In_Tree), In_Tree));
Write_String (".");
end if;
if Package_Node_Of (Node) /= Empty_Node then
Output_Name (Name_Of (Package_Node_Of (Node)));
if Package_Node_Of (Node, In_Tree) /= Empty_Node then
Output_Name
(Name_Of (Package_Node_Of (Node, In_Tree), In_Tree));
Write_String (".");
end if;
Output_Name (Name_Of (Node));
Output_Name (Name_Of (Node, In_Tree));
when N_External_Value =>
pragma Debug (Indicate_Tested (N_External_Value));
Write_String ("external (");
Print (External_Reference_Of (Node), Indent);
Print (External_Reference_Of (Node, In_Tree), Indent);
if External_Default_Of (Node) /= Empty_Node then
if External_Default_Of (Node, In_Tree) /= Empty_Node then
Write_String (", ");
Print (External_Default_Of (Node), Indent);
Print (External_Default_Of (Node, In_Tree), Indent);
end if;
Write_String (")");
@ -579,29 +601,32 @@ package body Prj.PP is
when N_Attribute_Reference =>
pragma Debug (Indicate_Tested (N_Attribute_Reference));
if Project_Node_Of (Node) /= Empty_Node
and then Project_Node_Of (Node) /= Project
if Project_Node_Of (Node, In_Tree) /= Empty_Node
and then Project_Node_Of (Node, In_Tree) /= Project
then
Output_Name (Name_Of (Project_Node_Of (Node)));
Output_Name
(Name_Of (Project_Node_Of (Node, In_Tree), In_Tree));
if Package_Node_Of (Node) /= Empty_Node then
if Package_Node_Of (Node, In_Tree) /= Empty_Node then
Write_String (".");
Output_Name (Name_Of (Package_Node_Of (Node)));
Output_Name
(Name_Of (Package_Node_Of (Node, In_Tree), In_Tree));
end if;
elsif Package_Node_Of (Node) /= Empty_Node then
Output_Name (Name_Of (Package_Node_Of (Node)));
elsif Package_Node_Of (Node, In_Tree) /= Empty_Node then
Output_Name
(Name_Of (Package_Node_Of (Node, In_Tree), In_Tree));
else
Write_String ("project");
end if;
Write_String ("'");
Output_Attribute_Name (Name_Of (Node));
Output_Attribute_Name (Name_Of (Node, In_Tree));
declare
Index : constant Name_Id :=
Associative_Array_Index_Of (Node);
Associative_Array_Index_Of (Node, In_Tree);
begin
if Index /= No_Name then
@ -615,72 +640,81 @@ package body Prj.PP is
pragma Debug (Indicate_Tested (N_Case_Construction));
declare
Case_Item : Project_Node_Id := First_Case_Item_Of (Node);
Case_Item : Project_Node_Id;
Is_Non_Empty : Boolean := False;
begin
Case_Item := First_Case_Item_Of (Node, In_Tree);
while Case_Item /= Empty_Node loop
if First_Declarative_Item_Of (Case_Item) /= Empty_Node
if First_Declarative_Item_Of (Case_Item, In_Tree) /=
Empty_Node
or else not Eliminate_Empty_Case_Constructions
then
Is_Non_Empty := True;
exit;
end if;
Case_Item := Next_Case_Item (Case_Item);
Case_Item := Next_Case_Item (Case_Item, In_Tree);
end loop;
if Is_Non_Empty then
Write_Empty_Line;
Print (First_Comment_Before (Node), Indent);
Print (First_Comment_Before (Node, In_Tree), Indent);
Start_Line (Indent);
Write_String ("case ");
Print (Case_Variable_Reference_Of (Node), Indent);
Print
(Case_Variable_Reference_Of (Node, In_Tree),
Indent);
Write_String (" is");
Write_End_Of_Line_Comment (Node);
Print (First_Comment_After (Node), Indent + Increment);
Print
(First_Comment_After (Node, In_Tree),
Indent + Increment);
declare
Case_Item : Project_Node_Id :=
First_Case_Item_Of (Node);
First_Case_Item_Of (Node, In_Tree);
begin
while Case_Item /= Empty_Node loop
pragma Assert
(Kind_Of (Case_Item) = N_Case_Item);
(Kind_Of (Case_Item, In_Tree) = N_Case_Item);
Print (Case_Item, Indent + Increment);
Case_Item := Next_Case_Item (Case_Item);
Case_Item :=
Next_Case_Item (Case_Item, In_Tree);
end loop;
end;
Print (First_Comment_Before_End (Node),
Print (First_Comment_Before_End (Node, In_Tree),
Indent + Increment);
Start_Line (Indent);
Write_Line ("end case;");
Print (First_Comment_After_End (Node), Indent);
Print
(First_Comment_After_End (Node, In_Tree), Indent);
end if;
end;
when N_Case_Item =>
pragma Debug (Indicate_Tested (N_Case_Item));
if First_Declarative_Item_Of (Node) /= Empty_Node
if First_Declarative_Item_Of (Node, In_Tree) /= Empty_Node
or else not Eliminate_Empty_Case_Constructions
then
Write_Empty_Line;
Print (First_Comment_Before (Node), Indent);
Print (First_Comment_Before (Node, In_Tree), Indent);
Start_Line (Indent);
Write_String ("when ");
if First_Choice_Of (Node) = Empty_Node then
if First_Choice_Of (Node, In_Tree) = Empty_Node then
Write_String ("others");
else
declare
Label : Project_Node_Id := First_Choice_Of (Node);
Label : Project_Node_Id :=
First_Choice_Of (Node, In_Tree);
begin
while Label /= Empty_Node loop
Print (Label, Indent);
Label := Next_Literal_String (Label);
Label := Next_Literal_String (Label, In_Tree);
if Label /= Empty_Node then
Write_String (" | ");
@ -691,16 +725,16 @@ package body Prj.PP is
Write_String (" =>");
Write_End_Of_Line_Comment (Node);
Print (First_Comment_After (Node), Indent + Increment);
Print
(First_Comment_After (Node, In_Tree),
Indent + Increment);
declare
First : constant Project_Node_Id :=
First_Declarative_Item_Of (Node);
First_Declarative_Item_Of (Node, In_Tree);
begin
if First = Empty_Node then
Write_Empty_Line;
else
Print (First, Indent + Increment);
end if;
@ -716,22 +750,22 @@ package body Prj.PP is
when N_Comment =>
pragma Debug (Indicate_Tested (N_Comment));
if Follows_Empty_Line (Node) then
if Follows_Empty_Line (Node, In_Tree) then
Write_Empty_Line;
end if;
Start_Line (Indent);
Write_String ("--");
Write_String
(Get_Name_String (String_Value_Of (Node)),
(Get_Name_String (String_Value_Of (Node, In_Tree)),
Truncated => True);
Write_Line ("");
if Is_Followed_By_Empty_Line (Node) then
if Is_Followed_By_Empty_Line (Node, In_Tree) then
Write_Empty_Line;
end if;
Print (Next_Comment (Node), Indent);
Print (Next_Comment (Node, In_Tree), Indent);
end case;
end if;
end Print;

5
gcc/ada/prj-pp.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2001-2003 Free Software Foundation, Inc. --
-- Copyright (C) 2001-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- --
@ -27,7 +27,7 @@
-- This package is the Project File Pretty Printer.
-- It is used to output a project file from a project file tree.
-- It is used by gnatname to update or create project files.
-- It is also used GLIDE2 to display project file trees.
-- It is also used GPS to display project file trees.
-- It can also be used for debugging purposes for tools that create project
-- file trees.
@ -46,6 +46,7 @@ package Prj.PP is
procedure Pretty_Print
(Project : Prj.Tree.Project_Node_Id;
In_Tree : Prj.Tree.Project_Node_Tree_Ref;
Increment : Positive := 3;
Eliminate_Empty_Case_Constructions : Boolean := False;
Minimize_Empty_Lines : Boolean := False;

1263
gcc/ada/prj-proc.adb
View File

File diff suppressed because it is too large Load Diff

14
gcc/ada/prj-proc.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2001-2004 Free Software Foundation, Inc. --
-- Copyright (C) 2001-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- --
@ -33,11 +33,13 @@ with Prj.Tree; use Prj.Tree;
package Prj.Proc is
procedure Process
(Project : out Project_Id;
Success : out Boolean;
From_Project_Node : Project_Node_Id;
Report_Error : Put_Line_Access;
Follow_Links : Boolean := True);
(In_Tree : Project_Tree_Ref;
Project : out Project_Id;
Success : out Boolean;
From_Project_Node : Project_Node_Id;
From_Project_Node_Tree : Project_Node_Tree_Ref;
Report_Error : Put_Line_Access;
Follow_Links : Boolean := True);
-- Process a project file tree into project file data structures.
-- If Report_Error is null, use the error reporting mechanism.
-- Otherwise, report errors using Report_Error.

423
gcc/ada/prj-strt.adb
View File

File diff suppressed because it is too large Load Diff

19
gcc/ada/prj-strt.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2001-2004 Free Software Foundation, Inc. --
-- Copyright (C) 2001-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- --
@ -30,7 +30,9 @@ with Prj.Tree; use Prj.Tree;
private package Prj.Strt is
procedure Parse_String_Type_List (First_String : out Project_Node_Id);
procedure Parse_String_Type_List
(In_Tree : Project_Node_Tree_Ref;
First_String : out Project_Node_Id);
-- Get the list of literal strings that are allowed for a typed string.
-- On entry, the current token is the first literal string following
-- a left parenthesis in a string type declaration such as:
@ -45,7 +47,9 @@ private package Prj.Strt is
-- or after a comma
-- - two literal strings in the list are equal
procedure Start_New_Case_Construction (String_Type : Project_Node_Id);
procedure Start_New_Case_Construction
(In_Tree : Project_Node_Tree_Ref;
String_Type : Project_Node_Id);
-- This procedure is called at the beginning of a case construction
-- The parameter String_Type is the node for the string type
-- of the case label variable.
@ -65,7 +69,8 @@ private package Prj.Strt is
-- not been specified.
procedure Parse_Choice_List
(First_Choice : out Project_Node_Id);
(In_Tree : Project_Node_Tree_Ref;
First_Choice : out Project_Node_Id);
-- Get the label for a choice list.
-- Report an error if
-- - a case label is not a literal string
@ -73,7 +78,8 @@ private package Prj.Strt is
-- - the same case label is repeated in the same case construction
procedure Parse_Expression
(Expression : out Project_Node_Id;
(In_Tree : Project_Node_Tree_Ref;
Expression : out Project_Node_Id;
Current_Project : Project_Node_Id;
Current_Package : Project_Node_Id;
Optional_Index : Boolean);
@ -85,7 +91,8 @@ private package Prj.Strt is
-- been parsed.
procedure Parse_Variable_Reference
(Variable : out Project_Node_Id;
(In_Tree : Project_Node_Tree_Ref;
Variable : out Project_Node_Id;
Current_Project : Project_Node_Id;
Current_Package : Project_Node_Id);
-- Parse a variable or attribute reference.

1175
gcc/ada/prj-tree.adb
View File

File diff suppressed because it is too large Load Diff

493
gcc/ada/prj-tree.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2001-2004 Free Software Foundation, Inc. --
-- Copyright (C) 2001-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- --
@ -26,14 +26,19 @@
-- This package defines the structure of the Project File tree
with GNAT.HTable;
with GNAT.Dynamic_HTables;
with GNAT.Dynamic_Tables;
with Prj.Attr; use Prj.Attr;
with Table; use Table;
with Types; use Types;
package Prj.Tree is
type Project_Node_Tree_Data;
type Project_Node_Tree_Ref is access all Project_Node_Tree_Data;
-- Type to designate a project node tree, so that several project node
-- trees can coexist in memory.
Project_Nodes_Initial : constant := 1_000;
Project_Nodes_Increment : constant := 100;
-- Allocation parameters for initializing and extending number
@ -85,12 +90,13 @@ package Prj.Tree is
-- For the signification of the fields in each node of a
-- Project_Node_Kind, look at package Tree_Private_Part.
procedure Initialize;
procedure Initialize (Tree : Project_Node_Tree_Ref);
-- Initialize the Project File tree: empty the Project_Nodes table
-- and reset the Projects_Htable.
function Default_Project_Node
(Of_Kind : Project_Node_Kind;
(In_Tree : Project_Node_Tree_Ref;
Of_Kind : Project_Node_Kind;
And_Expr_Kind : Variable_Kind := Undefined) return Project_Node_Id;
-- Returns a Project_Node_Record with the specified Kind and
-- Expr_Kind; all the other components have default nil values.
@ -100,6 +106,7 @@ package Prj.Tree is
function Imported_Or_Extended_Project_Of
(Project : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref;
With_Name : Name_Id) return Project_Node_Id;
-- Return the node of a project imported or extended by project Project and
-- whose name is With_Name. Return Empty_Node if there is no such project.
@ -170,13 +177,16 @@ package Prj.Tree is
Table_Name => "Prj.Tree.Comments");
-- A table to store the comments that may be stored is the tree
procedure Scan;
procedure Scan (In_Tree : Project_Node_Tree_Ref);
-- Scan the tokens and accumulate comments
type Comment_Location is
(Before, After, Before_End, After_End, End_Of_Line);
procedure Add_Comments (To : Project_Node_Id; Where : Comment_Location);
procedure Add_Comments
(To : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref;
Where : Comment_Location);
-- Add comments to this node
----------------------
@ -186,287 +196,360 @@ package Prj.Tree is
-- The following query functions are part of the abstract interface
-- of the Project File tree
function Name_Of (Node : Project_Node_Id) return Name_Id;
function Name_Of
(Node : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref) return Name_Id;
pragma Inline (Name_Of);
-- Valid for all non empty nodes. May return No_Name for nodes that have
-- no names.
function Kind_Of (Node : Project_Node_Id) return Project_Node_Kind;
function Kind_Of
(Node : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref) return Project_Node_Kind;
pragma Inline (Kind_Of);
-- Valid for all non empty nodes
function Location_Of (Node : Project_Node_Id) return Source_Ptr;
function Location_Of
(Node : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref) return Source_Ptr;
pragma Inline (Location_Of);
-- Valid for all non empty nodes
function First_Comment_After
(Node : Project_Node_Id) return Project_Node_Id;
(Node : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref) return Project_Node_Id;
-- Valid only for N_Comment_Zones nodes
function First_Comment_After_End
(Node : Project_Node_Id) return Project_Node_Id;
(Node : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref) return Project_Node_Id;
-- Valid only for N_Comment_Zones nodes
function First_Comment_Before
(Node : Project_Node_Id) return Project_Node_Id;
(Node : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref) return Project_Node_Id;
-- Valid only for N_Comment_Zones nodes
function First_Comment_Before_End
(Node : Project_Node_Id) return Project_Node_Id;
(Node : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref) return Project_Node_Id;
-- Valid only for N_Comment_Zones nodes
function Next_Comment (Node : Project_Node_Id) return Project_Node_Id;
function Next_Comment
(Node : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref) return Project_Node_Id;
-- Valid only for N_Comment nodes
function End_Of_Line_Comment (Node : Project_Node_Id) return Name_Id;
function End_Of_Line_Comment
(Node : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref) return Name_Id;
-- Valid only for non empty nodes
function Follows_Empty_Line (Node : Project_Node_Id) return Boolean;
function Follows_Empty_Line
(Node : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref) return Boolean;
-- Valid only for N_Comment nodes
function Is_Followed_By_Empty_Line (Node : Project_Node_Id) return Boolean;
function Is_Followed_By_Empty_Line
(Node : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref) return Boolean;
-- Valid only for N_Comment nodes
function Project_File_Includes_Unkept_Comments
(Node : Project_Node_Id)
(Node : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref)
return Boolean;
-- Valid only for N_Project nodes
function Directory_Of (Node : Project_Node_Id) return Name_Id;
function Directory_Of
(Node : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref) return Name_Id;
pragma Inline (Directory_Of);
-- Only valid for N_Project nodes
function Expression_Kind_Of (Node : Project_Node_Id) return Variable_Kind;
function Expression_Kind_Of
(Node : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref) return Variable_Kind;
pragma Inline (Expression_Kind_Of);
-- Only valid for N_Literal_String, N_Attribute_Declaration,
-- N_Variable_Declaration, N_Typed_Variable_Declaration, N_Expression,
-- N_Term, N_Variable_Reference or N_Attribute_Reference nodes.
function Is_Extending_All (Node : Project_Node_Id) return Boolean;
function Is_Extending_All
(Node : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref) return Boolean;
pragma Inline (Is_Extending_All);
-- Only valid for N_Project and N_With_Clause
function First_Variable_Of
(Node : Project_Node_Id) return Variable_Node_Id;
(Node : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref) return Variable_Node_Id;
pragma Inline (First_Variable_Of);
-- Only valid for N_Project or N_Package_Declaration nodes
function First_Package_Of
(Node : Project_Node_Id) return Package_Declaration_Id;
(Node : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref) return Package_Declaration_Id;
pragma Inline (First_Package_Of);
-- Only valid for N_Project nodes
function Package_Id_Of (Node : Project_Node_Id) return Package_Node_Id;
function Package_Id_Of
(Node : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref) return Package_Node_Id;
pragma Inline (Package_Id_Of);
-- Only valid for N_Package_Declaration nodes
function Path_Name_Of (Node : Project_Node_Id) return Name_Id;
function Path_Name_Of
(Node : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref) return Name_Id;
pragma Inline (Path_Name_Of);
-- Only valid for N_Project and N_With_Clause nodes
function String_Value_Of (Node : Project_Node_Id) return Name_Id;
function String_Value_Of
(Node : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref) return Name_Id;
pragma Inline (String_Value_Of);
-- Only valid for N_With_Clause, N_Literal_String nodes or N_Comment
function Source_Index_Of (Node : Project_Node_Id) return Int;
function Source_Index_Of
(Node : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref) return Int;
pragma Inline (Source_Index_Of);
-- Only valid for N_Literal_String and N_Attribute_Declaration nodes
function First_With_Clause_Of
(Node : Project_Node_Id) return Project_Node_Id;
(Node : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref) return Project_Node_Id;
pragma Inline (First_With_Clause_Of);
-- Only valid for N_Project nodes
function Project_Declaration_Of
(Node : Project_Node_Id) return Project_Node_Id;
(Node : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref) return Project_Node_Id;
pragma Inline (Project_Declaration_Of);
-- Only valid for N_Project nodes
function Extending_Project_Of
(Node : Project_Node_Id) return Project_Node_Id;
(Node : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref) return Project_Node_Id;
pragma Inline (Extending_Project_Of);
-- Only valid for N_Project_Declaration nodes
function First_String_Type_Of
(Node : Project_Node_Id) return Project_Node_Id;
(Node : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref) return Project_Node_Id;
pragma Inline (First_String_Type_Of);
-- Only valid for N_Project nodes
function Extended_Project_Path_Of
(Node : Project_Node_Id) return Name_Id;
(Node : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref) return Name_Id;
pragma Inline (Extended_Project_Path_Of);
-- Only valid for N_With_Clause nodes
function Project_Node_Of
(Node : Project_Node_Id) return Project_Node_Id;
(Node : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref) return Project_Node_Id;
pragma Inline (Project_Node_Of);
-- Only valid for N_With_Clause, N_Variable_Reference and
-- N_Attribute_Reference nodes.
function Non_Limited_Project_Node_Of
(Node : Project_Node_Id) return Project_Node_Id;
(Node : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref) return Project_Node_Id;
pragma Inline (Non_Limited_Project_Node_Of);
-- Only valid for N_With_Clause nodes. Returns Empty_Node for limited
-- imported project files, otherwise returns the same result as
-- Project_Node_Of.
function Next_With_Clause_Of
(Node : Project_Node_Id) return Project_Node_Id;
(Node : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref) return Project_Node_Id;
pragma Inline (Next_With_Clause_Of);
-- Only valid for N_With_Clause nodes
function First_Declarative_Item_Of
(Node : Project_Node_Id) return Project_Node_Id;
(Node : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref) return Project_Node_Id;
pragma Inline (First_Declarative_Item_Of);
-- Only valid for N_With_Clause nodes
function Extended_Project_Of
(Node : Project_Node_Id) return Project_Node_Id;
(Node : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref) return Project_Node_Id;
pragma Inline (Extended_Project_Of);
-- Only valid for N_Project_Declaration nodes
function Current_Item_Node
(Node : Project_Node_Id) return Project_Node_Id;
(Node : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref) return Project_Node_Id;
pragma Inline (Current_Item_Node);
-- Only valid for N_Declarative_Item nodes
function Next_Declarative_Item
(Node : Project_Node_Id) return Project_Node_Id;
(Node : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref) return Project_Node_Id;
pragma Inline (Next_Declarative_Item);
-- Only valid for N_Declarative_Item node
function Project_Of_Renamed_Package_Of
(Node : Project_Node_Id) return Project_Node_Id;
(Node : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref) return Project_Node_Id;
pragma Inline (Project_Of_Renamed_Package_Of);
-- Only valid for N_Package_Declaration nodes.
-- May return Empty_Node.
function Next_Package_In_Project
(Node : Project_Node_Id) return Project_Node_Id;
(Node : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref) return Project_Node_Id;
pragma Inline (Next_Package_In_Project);
-- Only valid for N_Package_Declaration nodes
function First_Literal_String
(Node : Project_Node_Id) return Project_Node_Id;
(Node : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref) return Project_Node_Id;
pragma Inline (First_Literal_String);
-- Only valid for N_String_Type_Declaration nodes
function Next_String_Type
(Node : Project_Node_Id) return Project_Node_Id;
(Node : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref) return Project_Node_Id;
pragma Inline (Next_String_Type);
-- Only valid for N_String_Type_Declaration nodes
function Next_Literal_String
(Node : Project_Node_Id) return Project_Node_Id;
(Node : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref) return Project_Node_Id;
pragma Inline (Next_Literal_String);
-- Only valid for N_Literal_String nodes
function Expression_Of
(Node : Project_Node_Id) return Project_Node_Id;
(Node : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref) return Project_Node_Id;
pragma Inline (Expression_Of);
-- Only valid for N_Attribute_Declaration, N_Typed_Variable_Declaration
-- or N_Variable_Declaration nodes
function Associative_Project_Of
(Node : Project_Node_Id)
(Node : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref)
return Project_Node_Id;
pragma Inline (Associative_Project_Of);
-- Only valid for N_Attribute_Declaration nodes
function Associative_Package_Of
(Node : Project_Node_Id)
(Node : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref)
return Project_Node_Id;
pragma Inline (Associative_Package_Of);
-- Only valid for N_Attribute_Declaration nodes
function Value_Is_Valid
(For_Typed_Variable : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref;
Value : Name_Id) return Boolean;
pragma Inline (Value_Is_Valid);
-- Only valid for N_Typed_Variable_Declaration. Returns True if Value is
-- in the list of allowed strings for For_Typed_Variable. False otherwise.
function Associative_Array_Index_Of
(Node : Project_Node_Id) return Name_Id;
(Node : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref) return Name_Id;
pragma Inline (Associative_Array_Index_Of);
-- Only valid for N_Attribute_Declaration and N_Attribute_Reference.
-- Returns No_String for non associative array attributes.
function Next_Variable
(Node : Project_Node_Id) return Project_Node_Id;
(Node : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref) return Project_Node_Id;
pragma Inline (Next_Variable);
-- Only valid for N_Typed_Variable_Declaration or N_Variable_Declaration
-- nodes.
function First_Term
(Node : Project_Node_Id) return Project_Node_Id;
(Node : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref) return Project_Node_Id;
pragma Inline (First_Term);
-- Only valid for N_Expression nodes
function Next_Expression_In_List
(Node : Project_Node_Id) return Project_Node_Id;
(Node : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref) return Project_Node_Id;
pragma Inline (Next_Expression_In_List);
-- Only valid for N_Expression nodes
function Current_Term
(Node : Project_Node_Id) return Project_Node_Id;
(Node : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref) return Project_Node_Id;
pragma Inline (Current_Term);
-- Only valid for N_Term nodes
function Next_Term
(Node : Project_Node_Id) return Project_Node_Id;
(Node : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref) return Project_Node_Id;
pragma Inline (Next_Term);
-- Only valid for N_Term nodes
function First_Expression_In_List
(Node : Project_Node_Id) return Project_Node_Id;
(Node : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref) return Project_Node_Id;
pragma Inline (First_Expression_In_List);
-- Only valid for N_Literal_String_List nodes
function Package_Node_Of
(Node : Project_Node_Id) return Project_Node_Id;
(Node : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref) return Project_Node_Id;
pragma Inline (Package_Node_Of);
-- Only valid for N_Variable_Reference or N_Attribute_Reference nodes.
-- May return Empty_Node.
function String_Type_Of
(Node : Project_Node_Id) return Project_Node_Id;
(Node : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref) return Project_Node_Id;
pragma Inline (String_Type_Of);
-- Only valid for N_Variable_Reference or N_Typed_Variable_Declaration
-- nodes.
function External_Reference_Of
(Node : Project_Node_Id) return Project_Node_Id;
(Node : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref) return Project_Node_Id;
pragma Inline (External_Reference_Of);
-- Only valid for N_External_Value nodes
function External_Default_Of
(Node : Project_Node_Id) return Project_Node_Id;
(Node : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref) return Project_Node_Id;
pragma Inline (External_Default_Of);
-- Only valid for N_External_Value nodes
function Case_Variable_Reference_Of
(Node : Project_Node_Id) return Project_Node_Id;
(Node : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref) return Project_Node_Id;
pragma Inline (Case_Variable_Reference_Of);
-- Only valid for N_Case_Construction nodes
function First_Case_Item_Of
(Node : Project_Node_Id) return Project_Node_Id;
(Node : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref) return Project_Node_Id;
pragma Inline (First_Case_Item_Of);
-- Only valid for N_Case_Construction nodes
function First_Choice_Of
(Node : Project_Node_Id) return Project_Node_Id;
(Node : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref) return Project_Node_Id;
pragma Inline (First_Choice_Of);
-- Return the first choice in a N_Case_Item, or Empty_Node if
-- this is when others.
function Next_Case_Item
(Node : Project_Node_Id) return Project_Node_Id;
(Node : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref) return Project_Node_Id;
pragma Inline (Next_Case_Item);
-- Only valid for N_Case_Item nodes
function Case_Insensitive (Node : Project_Node_Id) return Boolean;
function Case_Insensitive
(Node : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref) return Boolean;
-- Only valid for N_Attribute_Declaration and N_Attribute_Reference nodes
--------------------
@ -480,266 +563,320 @@ package Prj.Tree is
-- nodes as the corresponding query function above.
procedure Set_Name_Of
(Node : Project_Node_Id;
To : Name_Id);
(Node : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref;
To : Name_Id);
pragma Inline (Set_Name_Of);
procedure Set_Kind_Of
(Node : Project_Node_Id;
To : Project_Node_Kind);
(Node : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref;
To : Project_Node_Kind);
pragma Inline (Set_Kind_Of);
procedure Set_Location_Of
(Node : Project_Node_Id;
To : Source_Ptr);
(Node : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref;
To : Source_Ptr);
pragma Inline (Set_Location_Of);
procedure Set_First_Comment_After
(Node : Project_Node_Id;
To : Project_Node_Id);
(Node : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref;
To : Project_Node_Id);
pragma Inline (Set_First_Comment_After);
procedure Set_First_Comment_After_End
(Node : Project_Node_Id;
To : Project_Node_Id);
(Node : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref;
To : Project_Node_Id);
pragma Inline (Set_First_Comment_After_End);
procedure Set_First_Comment_Before
(Node : Project_Node_Id;
To : Project_Node_Id);
(Node : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref;
To : Project_Node_Id);
pragma Inline (Set_First_Comment_Before);
procedure Set_First_Comment_Before_End
(Node : Project_Node_Id;
To : Project_Node_Id);
(Node : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref;
To : Project_Node_Id);
pragma Inline (Set_First_Comment_Before_End);
procedure Set_Next_Comment
(Node : Project_Node_Id;
To : Project_Node_Id);
(Node : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref;
To : Project_Node_Id);
pragma Inline (Set_Next_Comment);
procedure Set_Project_File_Includes_Unkept_Comments
(Node : Project_Node_Id;
To : Boolean);
(Node : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref;
To : Boolean);
procedure Set_Directory_Of
(Node : Project_Node_Id;
To : Name_Id);
(Node : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref;
To : Name_Id);
pragma Inline (Set_Directory_Of);
procedure Set_Expression_Kind_Of
(Node : Project_Node_Id;
To : Variable_Kind);
(Node : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref;
To : Variable_Kind);
pragma Inline (Set_Expression_Kind_Of);
procedure Set_Is_Extending_All (Node : Project_Node_Id);
procedure Set_Is_Extending_All
(Node : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref);
pragma Inline (Set_Is_Extending_All);
procedure Set_First_Variable_Of
(Node : Project_Node_Id;
To : Variable_Node_Id);
(Node : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref;
To : Variable_Node_Id);
pragma Inline (Set_First_Variable_Of);
procedure Set_First_Package_Of
(Node : Project_Node_Id;
To : Package_Declaration_Id);
(Node : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref;
To : Package_Declaration_Id);
pragma Inline (Set_First_Package_Of);
procedure Set_Package_Id_Of
(Node : Project_Node_Id;
To : Package_Node_Id);
(Node : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref;
To : Package_Node_Id);
pragma Inline (Set_Package_Id_Of);
procedure Set_Path_Name_Of
(Node : Project_Node_Id;
To : Name_Id);
(Node : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref;
To : Name_Id);
pragma Inline (Set_Path_Name_Of);
procedure Set_String_Value_Of
(Node : Project_Node_Id;
To : Name_Id);
(Node : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref;
To : Name_Id);
pragma Inline (Set_String_Value_Of);
procedure Set_First_With_Clause_Of
(Node : Project_Node_Id;
To : Project_Node_Id);
(Node : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref;
To : Project_Node_Id);
pragma Inline (Set_First_With_Clause_Of);
procedure Set_Project_Declaration_Of
(Node : Project_Node_Id;
To : Project_Node_Id);
(Node : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref;
To : Project_Node_Id);
pragma Inline (Set_Project_Declaration_Of);
procedure Set_Extending_Project_Of
(Node : Project_Node_Id;
To : Project_Node_Id);
(Node : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref;
To : Project_Node_Id);
pragma Inline (Set_Extending_Project_Of);
procedure Set_First_String_Type_Of
(Node : Project_Node_Id;
To : Project_Node_Id);
(Node : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref;
To : Project_Node_Id);
pragma Inline (Set_First_String_Type_Of);
procedure Set_Extended_Project_Path_Of
(Node : Project_Node_Id;
To : Name_Id);
(Node : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref;
To : Name_Id);
pragma Inline (Set_Extended_Project_Path_Of);
procedure Set_Project_Node_Of
(Node : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref;
To : Project_Node_Id;
Limited_With : Boolean := False);
pragma Inline (Set_Project_Node_Of);
procedure Set_Next_With_Clause_Of
(Node : Project_Node_Id;
To : Project_Node_Id);
(Node : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref;
To : Project_Node_Id);
pragma Inline (Set_Next_With_Clause_Of);
procedure Set_First_Declarative_Item_Of
(Node : Project_Node_Id;
To : Project_Node_Id);
(Node : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref;
To : Project_Node_Id);
pragma Inline (Set_First_Declarative_Item_Of);
procedure Set_Extended_Project_Of
(Node : Project_Node_Id;
To : Project_Node_Id);
(Node : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref;
To : Project_Node_Id);
pragma Inline (Set_Extended_Project_Of);
procedure Set_Current_Item_Node
(Node : Project_Node_Id;
To : Project_Node_Id);
(Node : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref;
To : Project_Node_Id);
pragma Inline (Set_Current_Item_Node);
procedure Set_Next_Declarative_Item
(Node : Project_Node_Id;
To : Project_Node_Id);
(Node : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref;
To : Project_Node_Id);
pragma Inline (Set_Next_Declarative_Item);
procedure Set_Project_Of_Renamed_Package_Of
(Node : Project_Node_Id;
To : Project_Node_Id);
(Node : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref;
To : Project_Node_Id);
pragma Inline (Set_Project_Of_Renamed_Package_Of);
procedure Set_Next_Package_In_Project
(Node : Project_Node_Id;
To : Project_Node_Id);
(Node : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref;
To : Project_Node_Id);
pragma Inline (Set_Next_Package_In_Project);
procedure Set_First_Literal_String
(Node : Project_Node_Id;
To : Project_Node_Id);
(Node : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref;
To : Project_Node_Id);
pragma Inline (Set_First_Literal_String);
procedure Set_Next_String_Type
(Node : Project_Node_Id;
To : Project_Node_Id);
(Node : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref;
To : Project_Node_Id);
pragma Inline (Set_Next_String_Type);
procedure Set_Next_Literal_String
(Node : Project_Node_Id;
To : Project_Node_Id);
(Node : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref;
To : Project_Node_Id);
pragma Inline (Set_Next_Literal_String);
procedure Set_Expression_Of
(Node : Project_Node_Id;
To : Project_Node_Id);
(Node : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref;
To : Project_Node_Id);
pragma Inline (Set_Expression_Of);
procedure Set_Associative_Project_Of
(Node : Project_Node_Id;
To : Project_Node_Id);
(Node : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref;
To : Project_Node_Id);
pragma Inline (Set_Associative_Project_Of);
procedure Set_Associative_Package_Of
(Node : Project_Node_Id;
To : Project_Node_Id);
(Node : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref;
To : Project_Node_Id);
pragma Inline (Set_Associative_Package_Of);
procedure Set_Associative_Array_Index_Of
(Node : Project_Node_Id;
To : Name_Id);
(Node : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref;
To : Name_Id);
pragma Inline (Set_Associative_Array_Index_Of);
procedure Set_Next_Variable
(Node : Project_Node_Id;
To : Project_Node_Id);
(Node : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref;
To : Project_Node_Id);
pragma Inline (Set_Next_Variable);
procedure Set_First_Term
(Node : Project_Node_Id;
To : Project_Node_Id);
(Node : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref;
To : Project_Node_Id);
pragma Inline (Set_First_Term);
procedure Set_Next_Expression_In_List
(Node : Project_Node_Id;
To : Project_Node_Id);
(Node : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref;
To : Project_Node_Id);
pragma Inline (Set_Next_Expression_In_List);
procedure Set_Current_Term
(Node : Project_Node_Id;
To : Project_Node_Id);
(Node : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref;
To : Project_Node_Id);
pragma Inline (Set_Current_Term);
procedure Set_Next_Term
(Node : Project_Node_Id;
To : Project_Node_Id);
(Node : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref;
To : Project_Node_Id);
pragma Inline (Set_Next_Term);
procedure Set_First_Expression_In_List
(Node : Project_Node_Id;
To : Project_Node_Id);
(Node : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref;
To : Project_Node_Id);
pragma Inline (Set_First_Expression_In_List);
procedure Set_Package_Node_Of
(Node : Project_Node_Id;
To : Project_Node_Id);
(Node : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref;
To : Project_Node_Id);
pragma Inline (Set_Package_Node_Of);
procedure Set_Source_Index_Of
(Node : Project_Node_Id;
To : Int);
(Node : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref;
To : Int);
pragma Inline (Set_Source_Index_Of);
procedure Set_String_Type_Of
(Node : Project_Node_Id;
To : Project_Node_Id);
(Node : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref;
To : Project_Node_Id);
pragma Inline (Set_String_Type_Of);
procedure Set_External_Reference_Of
(Node : Project_Node_Id;
To : Project_Node_Id);
(Node : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref;
To : Project_Node_Id);
pragma Inline (Set_External_Reference_Of);
procedure Set_External_Default_Of
(Node : Project_Node_Id;
To : Project_Node_Id);
(Node : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref;
To : Project_Node_Id);
pragma Inline (Set_External_Default_Of);
procedure Set_Case_Variable_Reference_Of
(Node : Project_Node_Id;
To : Project_Node_Id);
(Node : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref;
To : Project_Node_Id);
pragma Inline (Set_Case_Variable_Reference_Of);
procedure Set_First_Case_Item_Of
(Node : Project_Node_Id;
To : Project_Node_Id);
(Node : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref;
To : Project_Node_Id);
pragma Inline (Set_First_Case_Item_Of);
procedure Set_First_Choice_Of
(Node : Project_Node_Id;
To : Project_Node_Id);
(Node : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref;
To : Project_Node_Id);
pragma Inline (Set_First_Choice_Of);
procedure Set_Next_Case_Item
(Node : Project_Node_Id;
To : Project_Node_Id);
(Node : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref;
To : Project_Node_Id);
pragma Inline (Set_Next_Case_Item);
procedure Set_Case_Insensitive
(Node : Project_Node_Id;
To : Boolean);
(Node : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref;
To : Boolean);
-------------------------------
-- Restricted Access Section --
@ -1028,13 +1165,13 @@ package Prj.Tree is
-- -- Flag2: comment is followed by an empty line
-- -- Comments: next comment
package Project_Nodes is
new Table.Table (Table_Component_Type => Project_Node_Record,
Table_Index_Type => Project_Node_Id,
Table_Low_Bound => First_Node_Id,
Table_Initial => Project_Nodes_Initial,
Table_Increment => Project_Nodes_Increment,
Table_Name => "Project_Nodes");
package Project_Node_Table is
new GNAT.Dynamic_Tables
(Table_Component_Type => Project_Node_Record,
Table_Index_Type => Project_Node_Id,
Table_Low_Bound => First_Node_Id,
Table_Initial => Project_Nodes_Initial,
Table_Increment => Project_Nodes_Increment);
-- This table contains the syntactic tree of project data
-- from project files.
@ -1058,7 +1195,7 @@ package Prj.Tree is
Canonical_Path => No_Name,
Extended => True);
package Projects_Htable is new GNAT.HTable.Simple_HTable
package Projects_Htable is new GNAT.Dynamic_HTables.Simple_HTable
(Header_Num => Header_Num,
Element => Project_Name_And_Node,
No_Element => No_Project_Name_And_Node,
@ -1073,6 +1210,12 @@ package Prj.Tree is
end Tree_Private_Part;
type Project_Node_Tree_Data is record
Project_Nodes : Tree_Private_Part.Project_Node_Table.Instance;
Projects_HT : Tree_Private_Part.Projects_Htable.Instance;
end record;
-- The data for a project node tree
private
type Comment_Array is array (Positive range <>) of Comment_Data;
type Comments_Ptr is access Comment_Array;

74
gcc/ada/prj-util.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2001-2004 Free Software Foundation, Inc. --
-- Copyright (C) 2001-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- --
@ -75,6 +75,7 @@ package body Prj.Util is
function Executable_Of
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
Main : Name_Id;
Index : Int;
Ada_Main : Boolean := True) return Name_Id
@ -82,19 +83,21 @@ package body Prj.Util is
pragma Assert (Project /= No_Project);
The_Packages : constant Package_Id :=
Projects.Table (Project).Decl.Packages;
In_Tree.Projects.Table (Project).Decl.Packages;
Builder_Package : constant Prj.Package_Id :=
Prj.Util.Value_Of
(Name => Name_Builder,
In_Packages => The_Packages);
In_Packages => The_Packages,
In_Tree => In_Tree);
Executable : Variable_Value :=
Prj.Util.Value_Of
(Name => Main,
Index => Index,
Attribute_Or_Array_Name => Name_Executable,
In_Package => Builder_Package);
In_Package => Builder_Package,
In_Tree => In_Tree);
Executable_Suffix : constant Variable_Value :=
Prj.Util.Value_Of
@ -102,15 +105,16 @@ package body Prj.Util is
Index => 0,
Attribute_Or_Array_Name =>
Name_Executable_Suffix,
In_Package => Builder_Package);
In_Package => Builder_Package,
In_Tree => In_Tree);
Body_Append : constant String := Get_Name_String
(Projects.Table
(In_Tree.Projects.Table
(Project).
Naming.Ada_Body_Suffix);
Spec_Append : constant String := Get_Name_String
(Projects.Table
(In_Tree.Projects.Table
(Project).
Naming.Ada_Spec_Suffix);
@ -128,7 +132,7 @@ package body Prj.Util is
Last : Positive := Name_Len;
Naming : constant Naming_Data :=
Projects.Table (Project).Naming;
In_Tree.Projects.Table (Project).Naming;
Spec_Suffix : constant String :=
Get_Name_String (Naming.Ada_Spec_Suffix);
@ -163,7 +167,8 @@ package body Prj.Util is
(Name => Name_Find,
Index => 0,
Attribute_Or_Array_Name => Name_Executable,
In_Package => Builder_Package);
In_Package => Builder_Package,
In_Tree => In_Tree);
end if;
end;
end if;
@ -400,7 +405,8 @@ package body Prj.Util is
function Value_Of
(Index : Name_Id;
In_Array : Array_Element_Id) return Name_Id
In_Array : Array_Element_Id;
In_Tree : Project_Tree_Ref) return Name_Id
is
Current : Array_Element_Id := In_Array;
Element : Array_Element;
@ -411,7 +417,7 @@ package body Prj.Util is
return No_Name;
end if;
Element := Array_Elements.Table (Current);
Element := In_Tree.Array_Elements.Table (Current);
if not Element.Index_Case_Sensitive then
Get_Name_String (Index);
@ -420,7 +426,7 @@ package body Prj.Util is
end if;
while Current /= No_Array_Element loop
Element := Array_Elements.Table (Current);
Element := In_Tree.Array_Elements.Table (Current);
if Real_Index = Element.Index then
exit when Element.Value.Kind /= Single;
@ -437,7 +443,8 @@ package body Prj.Util is
function Value_Of
(Index : Name_Id;
Src_Index : Int := 0;
In_Array : Array_Element_Id) return Variable_Value
In_Array : Array_Element_Id;
In_Tree : Project_Tree_Ref) return Variable_Value
is
Current : Array_Element_Id := In_Array;
Element : Array_Element;
@ -448,7 +455,7 @@ package body Prj.Util is
return Nil_Variable_Value;
end if;
Element := Array_Elements.Table (Current);
Element := In_Tree.Array_Elements.Table (Current);
if not Element.Index_Case_Sensitive then
Get_Name_String (Index);
@ -457,7 +464,7 @@ package body Prj.Util is
end if;
while Current /= No_Array_Element loop
Element := Array_Elements.Table (Current);
Element := In_Tree.Array_Elements.Table (Current);
if Real_Index = Element.Index and then
Src_Index = Element.Src_Index
@ -475,7 +482,8 @@ package body Prj.Util is
(Name : Name_Id;
Index : Int := 0;
Attribute_Or_Array_Name : Name_Id;
In_Package : Package_Id) return Variable_Value
In_Package : Package_Id;
In_Tree : Project_Tree_Ref) return Variable_Value
is
The_Array : Array_Element_Id;
The_Attribute : Variable_Value := Nil_Variable_Value;
@ -488,12 +496,14 @@ package body Prj.Util is
The_Array :=
Value_Of
(Name => Attribute_Or_Array_Name,
In_Arrays => Packages.Table (In_Package).Decl.Arrays);
In_Arrays => In_Tree.Packages.Table (In_Package).Decl.Arrays,
In_Tree => In_Tree);
The_Attribute :=
Value_Of
(Index => Name,
Src_Index => Index,
In_Array => The_Array);
In_Array => The_Array,
In_Tree => In_Tree);
-- If there is no array element, look for a variable
@ -501,7 +511,9 @@ package body Prj.Util is
The_Attribute :=
Value_Of
(Variable_Name => Attribute_Or_Array_Name,
In_Variables => Packages.Table (In_Package).Decl.Attributes);
In_Variables => In_Tree.Packages.Table
(In_Package).Decl.Attributes,
In_Tree => In_Tree);
end if;
end if;
@ -511,16 +523,18 @@ package body Prj.Util is
function Value_Of
(Index : Name_Id;
In_Array : Name_Id;
In_Arrays : Array_Id) return Name_Id
In_Arrays : Array_Id;
In_Tree : Project_Tree_Ref) return Name_Id
is
Current : Array_Id := In_Arrays;
The_Array : Array_Data;
begin
while Current /= No_Array loop
The_Array := Arrays.Table (Current);
The_Array := In_Tree.Arrays.Table (Current);
if The_Array.Name = In_Array then
return Value_Of (Index, In_Array => The_Array.Value);
return Value_Of
(Index, In_Array => The_Array.Value, In_Tree => In_Tree);
else
Current := The_Array.Next;
end if;
@ -531,14 +545,15 @@ package body Prj.Util is
function Value_Of
(Name : Name_Id;
In_Arrays : Array_Id) return Array_Element_Id
In_Arrays : Array_Id;
In_Tree : Project_Tree_Ref) return Array_Element_Id
is
Current : Array_Id := In_Arrays;
The_Array : Array_Data;
begin
while Current /= No_Array loop
The_Array := Arrays.Table (Current);
The_Array := In_Tree.Arrays.Table (Current);
if The_Array.Name = Name then
return The_Array.Value;
@ -552,14 +567,15 @@ package body Prj.Util is
function Value_Of
(Name : Name_Id;
In_Packages : Package_Id) return Package_Id
In_Packages : Package_Id;
In_Tree : Project_Tree_Ref) return Package_Id
is
Current : Package_Id := In_Packages;
The_Package : Package_Element;
begin
while Current /= No_Package loop
The_Package := Packages.Table (Current);
The_Package := In_Tree.Packages.Table (Current);
exit when The_Package.Name /= No_Name
and then The_Package.Name = Name;
Current := The_Package.Next;
@ -570,14 +586,16 @@ package body Prj.Util is
function Value_Of
(Variable_Name : Name_Id;
In_Variables : Variable_Id) return Variable_Value
In_Variables : Variable_Id;
In_Tree : Project_Tree_Ref) return Variable_Value
is
Current : Variable_Id := In_Variables;
The_Variable : Variable;
begin
while Current /= No_Variable loop
The_Variable := Variable_Elements.Table (Current);
The_Variable :=
In_Tree.Variable_Elements.Table (Current);
if Variable_Name = The_Variable.Name then
return The_Variable.Value;

24
gcc/ada/prj-util.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2001-2004 Free Software Foundation, Inc. --
-- Copyright (C) 2001-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- --
@ -34,6 +34,7 @@ package Prj.Util is
function Executable_Of
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
Main : Name_Id;
Index : Int;
Ada_Main : Boolean := True) return Name_Id;
@ -51,7 +52,8 @@ package Prj.Util is
function Value_Of
(Index : Name_Id;
In_Array : Array_Element_Id) return Name_Id;
In_Array : Array_Element_Id;
In_Tree : Project_Tree_Ref) return Name_Id;
-- Get a single string array component. Returns No_Name if there is no
-- component Index, if In_Array is null, or if the component is a String
-- list. Depending on the attribute (only attributes may be associative
@ -62,7 +64,8 @@ package Prj.Util is
function Value_Of
(Index : Name_Id;
Src_Index : Int := 0;
In_Array : Array_Element_Id) return Variable_Value;
In_Array : Array_Element_Id;
In_Tree : Project_Tree_Ref) return Variable_Value;
-- Get a string array component (single String or String list).
-- Returns Nil_Variable_Value if there is no component Index
-- or if In_Array is null.
@ -76,7 +79,8 @@ package Prj.Util is
(Name : Name_Id;
Index : Int := 0;
Attribute_Or_Array_Name : Name_Id;
In_Package : Package_Id) return Variable_Value;
In_Package : Package_Id;
In_Tree : Project_Tree_Ref) return Variable_Value;
-- In a specific package,
-- - if there exists an array Attribute_Or_Array_Name with an index
-- Name, returns the corresponding component (depending on the
@ -90,28 +94,32 @@ package Prj.Util is
function Value_Of
(Index : Name_Id;
In_Array : Name_Id;
In_Arrays : Array_Id) return Name_Id;
In_Arrays : Array_Id;
In_Tree : Project_Tree_Ref) return Name_Id;
-- Get a string array component in an array of an array list.
-- Returns No_Name if there is no component Index, if In_Arrays is null, if
-- In_Array is not found in In_Arrays or if the component is a String list.
function Value_Of
(Name : Name_Id;
In_Arrays : Array_Id) return Array_Element_Id;
In_Arrays : Array_Id;
In_Tree : Project_Tree_Ref) return Array_Element_Id;
-- Returns a specified array in an array list. Returns No_Array_Element
-- if In_Arrays is null or if Name is not the name of an array in
-- In_Arrays. The caller must ensure that Name is in lower case.
function Value_Of
(Name : Name_Id;
In_Packages : Package_Id) return Package_Id;
In_Packages : Package_Id;
In_Tree : Project_Tree_Ref) return Package_Id;
-- Returns a specified package in a package list. Returns No_Package
-- if In_Packages is null or if Name is not the name of a package in
-- Package_List. The caller must ensure that Name is in lower case.
function Value_Of
(Variable_Name : Name_Id;
In_Variables : Variable_Id) return Variable_Value;
In_Variables : Variable_Id;
In_Tree : Project_Tree_Ref) return Variable_Value;
-- Returns a specified variable in a variable list. Returns null if
-- In_Variables is null or if Variable_Name is not the name of a
-- variable in In_Variables. Caller must ensure that Name is lower case.

296
gcc/ada/prj.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2001-2004 Free Software Foundation, Inc. --
-- Copyright (C) 2001-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- --
@ -30,7 +30,6 @@ with Namet; use Namet;
with Output; use Output;
with Osint; use Osint;
with Prj.Attr;
with Prj.Com;
with Prj.Env;
with Prj.Err; use Prj.Err;
with Scans; use Scans;
@ -42,10 +41,18 @@ with GNAT.OS_Lib; use GNAT.OS_Lib;
package body Prj is
Initial_Buffer_Size : constant := 100;
-- Initial size for extensible buffer used in Add_To_Buffer
The_Empty_String : Name_Id;
Name_C_Plus_Plus : Name_Id;
Default_Ada_Spec_Suffix_Id : Name_Id;
Default_Ada_Body_Suffix_Id : Name_Id;
Slash_Id : Name_Id;
-- Initialized in Prj.Initialized, then never modified
subtype Known_Casing is Casing_Type range All_Upper_Case .. Mixed_Case;
The_Casing_Images : constant array (Known_Casing) of String_Access :=
@ -77,7 +84,7 @@ package body Prj is
Specification_Exceptions => No_Array_Element,
Implementation_Exceptions => No_Array_Element);
Project_Empty : constant Project_Data :=
Project_Empty : Project_Data :=
(Externally_Built => False,
Languages => No_Languages,
Supp_Languages => No_Supp_Language_Index,
@ -157,26 +164,53 @@ package body Prj is
-- Add_To_Buffer --
-------------------
procedure Add_To_Buffer (S : String) is
procedure Add_To_Buffer
(S : String;
To : in out String_Access;
Last : in out Natural)
is
begin
-- If Buffer is too small, double its size
if Buffer_Last + S'Length > Buffer'Last then
declare
New_Buffer : constant String_Access :=
new String (1 .. 2 * Buffer'Last);
begin
New_Buffer (1 .. Buffer_Last) := Buffer (1 .. Buffer_Last);
Free (Buffer);
Buffer := New_Buffer;
end;
if To = null then
To := new String (1 .. Initial_Buffer_Size);
Last := 0;
end if;
Buffer (Buffer_Last + 1 .. Buffer_Last + S'Length) := S;
Buffer_Last := Buffer_Last + S'Length;
-- If Buffer is too small, double its size
while Last + S'Length > To'Last loop
declare
New_Buffer : constant String_Access :=
new String (1 .. 2 * Last);
begin
New_Buffer (1 .. Last) := To (1 .. Last);
Free (To);
To := New_Buffer;
end;
end loop;
To (Last + 1 .. Last + S'Length) := S;
Last := Last + S'Length;
end Add_To_Buffer;
-----------------------------
-- Default_Ada_Body_Suffix --
-----------------------------
function Default_Ada_Body_Suffix return Name_Id is
begin
return Default_Ada_Body_Suffix_Id;
end Default_Ada_Body_Suffix;
-----------------------------
-- Default_Ada_Spec_Suffix --
-----------------------------
function Default_Ada_Spec_Suffix return Name_Id is
begin
return Default_Ada_Spec_Suffix_Id;
end Default_Ada_Spec_Suffix;
---------------------------
-- Display_Language_Name --
---------------------------
@ -192,10 +226,12 @@ package body Prj is
-- Empty_Project --
-------------------
function Empty_Project return Project_Data is
function Empty_Project (Tree : Project_Tree_Ref) return Project_Data is
Value : Project_Data := Project_Empty;
begin
Prj.Initialize;
return Project_Empty;
Prj.Initialize (Tree => No_Project_Tree);
Value.Naming := Tree.Private_Part.Default_Naming;
return Value;
end Empty_Project;
------------------
@ -224,41 +260,45 @@ package body Prj is
procedure For_Every_Project_Imported
(By : Project_Id;
In_Tree : Project_Tree_Ref;
With_State : in out State)
is
procedure Check (Project : Project_Id);
procedure Recursive_Check (Project : Project_Id);
-- Check if a project has already been seen. If not seen, mark it as
-- Seen, Call Action, and check all its imported projects.
-----------
-- Check --
-----------
---------------------
-- Recursive_Check --
---------------------
procedure Check (Project : Project_Id) is
procedure Recursive_Check (Project : Project_Id) is
List : Project_List;
begin
if not Projects.Table (Project).Seen then
Projects.Table (Project).Seen := True;
if not In_Tree.Projects.Table (Project).Seen then
In_Tree.Projects.Table (Project).Seen := True;
Action (Project, With_State);
List := Projects.Table (Project).Imported_Projects;
List :=
In_Tree.Projects.Table (Project).Imported_Projects;
while List /= Empty_Project_List loop
Check (Project_Lists.Table (List).Project);
List := Project_Lists.Table (List).Next;
Recursive_Check (In_Tree.Project_Lists.Table (List).Project);
List := In_Tree.Project_Lists.Table (List).Next;
end loop;
end if;
end Check;
end Recursive_Check;
-- Start of procecessing for For_Every_Project_Imported
-- Start of processing for For_Every_Project_Imported
begin
for Project in Projects.First .. Projects.Last loop
Projects.Table (Project).Seen := False;
for Project in Project_Table.First ..
Project_Table.Last (In_Tree.Projects)
loop
In_Tree.Projects.Table (Project).Seen := False;
end loop;
Check (Project => By);
Recursive_Check (Project => By);
end For_Every_Project_Imported;
----------
@ -283,7 +323,7 @@ package body Prj is
-- Initialize --
----------------
procedure Initialize is
procedure Initialize (Tree : Project_Tree_Ref) is
begin
if not Initialized then
Initialized := True;
@ -293,24 +333,21 @@ package body Prj is
Empty_Name := The_Empty_String;
Name_Len := 4;
Name_Buffer (1 .. 4) := ".ads";
Default_Ada_Spec_Suffix := Name_Find;
Default_Ada_Spec_Suffix_Id := Name_Find;
Name_Len := 4;
Name_Buffer (1 .. 4) := ".adb";
Default_Ada_Body_Suffix := Name_Find;
Default_Ada_Body_Suffix_Id := Name_Find;
Name_Len := 1;
Name_Buffer (1) := '/';
Slash := Name_Find;
Slash_Id := Name_Find;
Name_Len := 3;
Name_Buffer (1 .. 3) := "c++";
Name_C_Plus_Plus := Name_Find;
Std_Naming_Data.Ada_Spec_Suffix := Default_Ada_Spec_Suffix;
Std_Naming_Data.Ada_Body_Suffix := Default_Ada_Body_Suffix;
Std_Naming_Data.Separate_Suffix := Default_Ada_Body_Suffix;
Register_Default_Naming_Scheme
(Language => Name_Ada,
Default_Spec_Suffix => Default_Ada_Spec_Suffix,
Default_Body_Suffix => Default_Ada_Body_Suffix);
Std_Naming_Data.Separate_Suffix := Default_Ada_Body_Suffix;
Project_Empty.Naming := Std_Naming_Data;
Prj.Env.Initialize;
Prj.Attr.Initialize;
Set_Name_Table_Byte (Name_Project, Token_Type'Pos (Tok_Project));
@ -324,6 +361,10 @@ package body Prj is
Add_Language_Name (Name_C);
Add_Language_Name (Name_C_Plus_Plus);
end if;
if Tree /= No_Project_Tree then
Reset (Tree);
end if;
end Initialize;
----------------
@ -332,7 +373,8 @@ package body Prj is
function Is_Present
(Language : Language_Index;
In_Project : Project_Data) return Boolean
In_Project : Project_Data;
In_Tree : Project_Tree_Ref) return Boolean
is
begin
case Language is
@ -349,7 +391,7 @@ package body Prj is
begin
while Supp_Index /= No_Supp_Language_Index loop
Supp := Present_Languages.Table (Supp_Index);
Supp := In_Tree.Present_Languages.Table (Supp_Index);
if Supp.Index = Language then
return Supp.Present;
@ -369,7 +411,8 @@ package body Prj is
function Language_Processing_Data_Of
(Language : Language_Index;
In_Project : Project_Data) return Language_Processing_Data
In_Project : Project_Data;
In_Tree : Project_Tree_Ref) return Language_Processing_Data
is
begin
case Language is
@ -387,7 +430,7 @@ package body Prj is
begin
while Supp_Index /= No_Supp_Language_Index loop
Supp := Supp_Languages.Table (Supp_Index);
Supp := In_Tree.Supp_Languages.Table (Supp_Index);
if Supp.Index = Language then
return Supp.Data;
@ -408,7 +451,8 @@ package body Prj is
procedure Register_Default_Naming_Scheme
(Language : Name_Id;
Default_Spec_Suffix : Name_Id;
Default_Body_Suffix : Name_Id)
Default_Body_Suffix : Name_Id;
In_Tree : Project_Tree_Ref)
is
Lang : Name_Id;
Suffix : Array_Element_Id;
@ -422,19 +466,19 @@ package body Prj is
Name_Buffer (1 .. Name_Len) := To_Lower (Name_Buffer (1 .. Name_Len));
Lang := Name_Find;
Suffix := Std_Naming_Data.Spec_Suffix;
Suffix := In_Tree.Private_Part.Default_Naming.Spec_Suffix;
Found := False;
-- Look for an element of the spec sufix array indexed by the language
-- name. If one is found, put the default value.
while Suffix /= No_Array_Element and then not Found loop
Element := Array_Elements.Table (Suffix);
Element := In_Tree.Array_Elements.Table (Suffix);
if Element.Index = Lang then
Found := True;
Element.Value.Value := Default_Spec_Suffix;
Array_Elements.Table (Suffix) := Element;
In_Tree.Array_Elements.Table (Suffix) := Element;
else
Suffix := Element.Next;
@ -454,25 +498,28 @@ package body Prj is
Default => False,
Value => Default_Spec_Suffix,
Index => 0),
Next => Std_Naming_Data.Spec_Suffix);
Array_Elements.Increment_Last;
Array_Elements.Table (Array_Elements.Last) := Element;
Std_Naming_Data.Spec_Suffix := Array_Elements.Last;
Next => In_Tree.Private_Part.Default_Naming.Spec_Suffix);
Array_Element_Table.Increment_Last (In_Tree.Array_Elements);
In_Tree.Array_Elements.Table
(Array_Element_Table.Last (In_Tree.Array_Elements)) :=
Element;
In_Tree.Private_Part.Default_Naming.Spec_Suffix :=
Array_Element_Table.Last (In_Tree.Array_Elements);
end if;
Suffix := Std_Naming_Data.Body_Suffix;
Suffix := In_Tree.Private_Part.Default_Naming.Body_Suffix;
Found := False;
-- Look for an element of the body sufix array indexed by the language
-- name. If one is found, put the default value.
while Suffix /= No_Array_Element and then not Found loop
Element := Array_Elements.Table (Suffix);
Element := In_Tree.Array_Elements.Table (Suffix);
if Element.Index = Lang then
Found := True;
Element.Value.Value := Default_Body_Suffix;
Array_Elements.Table (Suffix) := Element;
In_Tree.Array_Elements.Table (Suffix) := Element;
else
Suffix := Element.Next;
@ -492,10 +539,14 @@ package body Prj is
Default => False,
Value => Default_Body_Suffix,
Index => 0),
Next => Std_Naming_Data.Body_Suffix);
Array_Elements.Increment_Last;
Array_Elements.Table (Array_Elements.Last) := Element;
Std_Naming_Data.Body_Suffix := Array_Elements.Last;
Next => In_Tree.Private_Part.Default_Naming.Body_Suffix);
Array_Element_Table.Increment_Last
(In_Tree.Array_Elements);
In_Tree.Array_Elements.Table
(Array_Element_Table.Last (In_Tree.Array_Elements))
:= Element;
In_Tree.Private_Part.Default_Naming.Body_Suffix :=
Array_Element_Table.Last (In_Tree.Array_Elements);
end if;
end Register_Default_Naming_Scheme;
@ -503,17 +554,34 @@ package body Prj is
-- Reset --
-----------
procedure Reset is
procedure Reset (Tree : Project_Tree_Ref) is
begin
Projects.Init;
Project_Lists.Init;
Packages.Init;
Arrays.Init;
Variable_Elements.Init;
String_Elements.Init;
Prj.Com.Units.Init;
Prj.Com.Units_Htable.Reset;
Prj.Com.Files_Htable.Reset;
Prj.Env.Initialize;
Present_Language_Table.Init (Tree.Present_Languages);
Supp_Suffix_Table.Init (Tree.Supp_Suffixes);
Name_List_Table.Init (Tree.Name_Lists);
Supp_Language_Table.Init (Tree.Supp_Languages);
Other_Source_Table.Init (Tree.Other_Sources);
String_Element_Table.Init (Tree.String_Elements);
Variable_Element_Table.Init (Tree.Variable_Elements);
Array_Element_Table.Init (Tree.Array_Elements);
Array_Table.Init (Tree.Arrays);
Package_Table.Init (Tree.Packages);
Project_List_Table.Init (Tree.Project_Lists);
Project_Table.Init (Tree.Projects);
Unit_Table.Init (Tree.Units);
Units_Htable.Reset (Tree.Units_HT);
Files_Htable.Reset (Tree.Files_HT);
Naming_Table.Init (Tree.Private_Part.Namings);
Path_File_Table.Init (Tree.Private_Part.Path_Files);
Source_Path_Table.Init (Tree.Private_Part.Source_Paths);
Object_Path_Table.Init (Tree.Private_Part.Object_Paths);
Tree.Private_Part.Default_Naming := Std_Naming_Data;
Register_Default_Naming_Scheme
(Language => Name_Ada,
Default_Spec_Suffix => Default_Ada_Spec_Suffix,
Default_Body_Suffix => Default_Ada_Body_Suffix,
In_Tree => Tree);
end Reset;
------------------------
@ -538,7 +606,8 @@ package body Prj is
procedure Set
(Language : Language_Index;
Present : Boolean;
In_Project : in out Project_Data)
In_Project : in out Project_Data;
In_Tree : Project_Tree_Ref)
is
begin
case Language is
@ -555,10 +624,12 @@ package body Prj is
begin
while Supp_Index /= No_Supp_Language_Index loop
Supp := Present_Languages.Table (Supp_Index);
Supp := In_Tree.Present_Languages.Table
(Supp_Index);
if Supp.Index = Language then
Present_Languages.Table (Supp_Index).Present := Present;
In_Tree.Present_Languages.Table
(Supp_Index).Present := Present;
return;
end if;
@ -567,9 +638,12 @@ package body Prj is
Supp := (Index => Language, Present => Present,
Next => In_Project.Supp_Languages);
Present_Languages.Increment_Last;
Supp_Index := Present_Languages.Last;
Present_Languages.Table (Supp_Index) := Supp;
Present_Language_Table.Increment_Last
(In_Tree.Present_Languages);
Supp_Index := Present_Language_Table.Last
(In_Tree.Present_Languages);
In_Tree.Present_Languages.Table (Supp_Index) :=
Supp;
In_Project.Supp_Languages := Supp_Index;
end;
end case;
@ -578,7 +652,8 @@ package body Prj is
procedure Set
(Language_Processing : in Language_Processing_Data;
For_Language : Language_Index;
In_Project : in out Project_Data)
In_Project : in out Project_Data;
In_Tree : Project_Tree_Ref)
is
begin
case For_Language is
@ -597,11 +672,12 @@ package body Prj is
begin
while Supp_Index /= No_Supp_Language_Index loop
Supp := Supp_Languages.Table (Supp_Index);
Supp := In_Tree.Supp_Languages.Table
(Supp_Index);
if Supp.Index = For_Language then
Supp_Languages.Table (Supp_Index).Data :=
Language_Processing;
In_Tree.Supp_Languages.Table
(Supp_Index).Data := Language_Processing;
return;
end if;
@ -610,9 +686,11 @@ package body Prj is
Supp := (Index => For_Language, Data => Language_Processing,
Next => In_Project.Supp_Language_Processing);
Supp_Languages.Increment_Last;
Supp_Index := Supp_Languages.Last;
Supp_Languages.Table (Supp_Index) := Supp;
Supp_Language_Table.Increment_Last
(In_Tree.Supp_Languages);
Supp_Index := Supp_Language_Table.Last
(In_Tree.Supp_Languages);
In_Tree.Supp_Languages.Table (Supp_Index) := Supp;
In_Project.Supp_Language_Processing := Supp_Index;
end;
end case;
@ -621,7 +699,8 @@ package body Prj is
procedure Set
(Suffix : Name_Id;
For_Language : Language_Index;
In_Project : in out Project_Data)
In_Project : in out Project_Data;
In_Tree : Project_Tree_Ref)
is
begin
case For_Language is
@ -639,10 +718,12 @@ package body Prj is
begin
while Supp_Index /= No_Supp_Language_Index loop
Supp := Supp_Suffix_Table.Table (Supp_Index);
Supp := In_Tree.Supp_Suffixes.Table
(Supp_Index);
if Supp.Index = For_Language then
Supp_Suffix_Table.Table (Supp_Index).Suffix := Suffix;
In_Tree.Supp_Suffixes.Table
(Supp_Index).Suffix := Suffix;
return;
end if;
@ -651,23 +732,40 @@ package body Prj is
Supp := (Index => For_Language, Suffix => Suffix,
Next => In_Project.Naming.Supp_Suffixes);
Supp_Suffix_Table.Increment_Last;
Supp_Index := Supp_Suffix_Table.Last;
Supp_Suffix_Table.Table (Supp_Index) := Supp;
Supp_Suffix_Table.Increment_Last
(In_Tree.Supp_Suffixes);
Supp_Index := Supp_Suffix_Table.Last
(In_Tree.Supp_Suffixes);
In_Tree.Supp_Suffixes.Table (Supp_Index) := Supp;
In_Project.Naming.Supp_Suffixes := Supp_Index;
end;
end case;
end Set;
-----------
-- Slash --
-----------
function Slash return Name_Id is
begin
return Slash_Id;
end Slash;
--------------------------
-- Standard_Naming_Data --
--------------------------
function Standard_Naming_Data return Naming_Data is
function Standard_Naming_Data (Tree : Project_Tree_Ref := No_Project_Tree)
return Naming_Data
is
begin
Prj.Initialize;
return Std_Naming_Data;
if Tree = No_Project_Tree then
Prj.Initialize (Tree => No_Project_Tree);
return Std_Naming_Data;
else
return Tree.Private_Part.Default_Naming;
end if;
end Standard_Naming_Data;
---------------
@ -676,7 +774,8 @@ package body Prj is
function Suffix_Of
(Language : Language_Index;
In_Project : Project_Data) return Name_Id
In_Project : Project_Data;
In_Tree : Project_Tree_Ref) return Name_Id
is
begin
case Language is
@ -694,7 +793,8 @@ package body Prj is
begin
while Supp_Index /= No_Supp_Language_Index loop
Supp := Supp_Suffix_Table.Table (Supp_Index);
Supp := In_Tree.Supp_Suffixes.Table
(Supp_Index);
if Supp.Index = Language then
return Supp.Suffix;

401
gcc/ada/prj.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2001-2004 Free Software Foundation, Inc. --
-- Copyright (C) 2001-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- --
@ -35,38 +35,46 @@ with Scans; use Scans;
with Table;
with Types; use Types;
with GNAT.OS_Lib; use GNAT.OS_Lib;
with GNAT.Dynamic_HTables; use GNAT.Dynamic_HTables;
with GNAT.Dynamic_Tables;
with GNAT.OS_Lib; use GNAT.OS_Lib;
with System.HTable; use System.HTable;
with System.HTable;
package Prj is
Empty_Name : Name_Id;
-- Name_Id for an empty name (no characters). Initialized by the call
-- to procedure Initialize.
All_Packages : constant String_List_Access := null;
All_Packages : constant String_List_Access;
-- Default value of parameter Packages of procedures Parse, in Prj.Pars and
-- Prj.Part, indicating that all packages should be checked.
Virtual_Prefix : constant String := "v$";
-- The prefix for virtual extending projects. Because of the '$', which is
-- normally forbidden for project names, there cannot be any name clash.
type Project_Tree_Data;
type Project_Tree_Ref is access all Project_Tree_Data;
-- Reference to a project tree.
-- Several project trees may exist in memory at the same time.
No_Project_Tree : constant Project_Tree_Ref;
function Default_Ada_Spec_Suffix return Name_Id;
pragma Inline (Default_Ada_Spec_Suffix);
-- The Name_Id for the standard GNAT suffix for Ada spec source file
-- name ".ads". Initialized by Prj.Initialize.
function Default_Ada_Body_Suffix return Name_Id;
pragma Inline (Default_Ada_Body_Suffix);
-- The Name_Id for the standard GNAT suffix for Ada body source file
-- name ".adb". Initialized by Prj.Initialize.
function Slash return Name_Id;
pragma Inline (Slash);
-- "/", used as the path of locally removed files
Project_File_Extension : String := ".gpr";
-- The standard project file name extension. It is not a constant, because
-- Canonical_Case_File_Name is called on this variable in the body of Prj.
Default_Ada_Spec_Suffix : Name_Id;
-- The Name_Id for the standard GNAT suffix for Ada spec source file
-- name ".ads". Initialized by Prj.Initialize.
Default_Ada_Body_Suffix : Name_Id;
-- The Name_Id for the standard GNAT suffix for Ada body source file
-- name ".adb". Initialized by Prj.Initialize.
Slash : Name_Id;
-- "/", used as the path of locally removed files
-----------------------------------------------------
-- Multi-language stuff that will be modified soon --
-----------------------------------------------------
type Language_Index is new Nat;
@ -129,13 +137,12 @@ package Prj is
Next : Supp_Language_Index := No_Supp_Language_Index;
end record;
package Present_Languages is new Table.Table
package Present_Language_Table is new GNAT.Dynamic_Tables
(Table_Component_Type => Supp_Language,
Table_Index_Type => Supp_Language_Index,
Table_Low_Bound => 1,
Table_Initial => 4,
Table_Increment => 100,
Table_Name => "Prj.Present_Languages");
Table_Increment => 100);
-- The table for the presence of languages with an index that is outside
-- of First_Language_Indexes.
@ -152,13 +159,12 @@ package Prj is
Next : Supp_Language_Index := No_Supp_Language_Index;
end record;
package Supp_Suffix_Table is new Table.Table
package Supp_Suffix_Table is new GNAT.Dynamic_Tables
(Table_Component_Type => Supp_Suffix,
Table_Index_Type => Supp_Language_Index,
Table_Low_Bound => 1,
Table_Initial => 4,
Table_Increment => 100,
Table_Name => "Prj.Supp_Suffix_Table");
Table_Increment => 100);
-- The table for the presence of languages with an index that is outside
-- of First_Language_Indexes.
@ -172,13 +178,12 @@ package Prj is
Next : Name_List_Index := No_Name_List;
end record;
package Name_Lists is new Table.Table
package Name_List_Table is new GNAT.Dynamic_Tables
(Table_Component_Type => Name_Node,
Table_Index_Type => Name_List_Index,
Table_Low_Bound => 1,
Table_Initial => 10,
Table_Increment => 100,
Table_Name => "Prj.Name_Lists");
Table_Increment => 100);
-- The table for lists of names used in package Language_Processing
type Language_Processing_Data is record
@ -206,8 +211,9 @@ package Prj is
type First_Language_Processing_Data is
array (First_Language_Indexes) of Language_Processing_Data;
Default_First_Language_Processing_Data : First_Language_Processing_Data :=
(others => Default_Language_Processing_Data);
Default_First_Language_Processing_Data :
constant First_Language_Processing_Data :=
(others => Default_Language_Processing_Data);
type Supp_Language_Data is record
Index : Language_Index := No_Language_Index;
@ -215,13 +221,12 @@ package Prj is
Next : Supp_Language_Index := No_Supp_Language_Index;
end record;
package Supp_Languages is new Table.Table
package Supp_Language_Table is new GNAT.Dynamic_Tables
(Table_Component_Type => Supp_Language_Data,
Table_Index_Type => Supp_Language_Index,
Table_Low_Bound => 1,
Table_Initial => 4,
Table_Increment => 100,
Table_Name => "Prj.Supp_Languages");
Table_Increment => 100);
-- The table for language data when there are more languages than
-- in First_Language_Indexes.
@ -243,21 +248,27 @@ package Prj is
end record;
-- Data for a source in a language other than Ada
package Other_Sources is new Table.Table
package Other_Source_Table is new GNAT.Dynamic_Tables
(Table_Component_Type => Other_Source,
Table_Index_Type => Other_Source_Id,
Table_Low_Bound => 1,
Table_Initial => 200,
Table_Increment => 100,
Table_Name => "Prj.Other_Sources");
Table_Increment => 100);
-- The table for sources of languages other than Ada
----------------------------------
-- End of multi-language stuff --
----------------------------------
type Verbosity is (Default, Medium, High);
-- Verbosity when parsing GNAT Project Files
-- Default is default (very quiet, if no errors).
-- Medium is more verbose.
-- High is extremely verbose.
Current_Verbosity : Verbosity := Default;
-- The current value of the verbosity the project files are parsed with
type Lib_Kind is (Static, Dynamic, Relocatable);
type Policy is (Autonomous, Compliant, Controlled, Restricted);
-- Type to specify the symbol policy, when symbol control is supported.
@ -274,7 +285,7 @@ package Prj is
end record;
-- Type to keep the symbol data to be used when building a shared library
No_Symbols : Symbol_Record :=
No_Symbols : constant Symbol_Record :=
(Symbol_File => No_Name,
Reference => No_Name,
Symbol_Policy => Autonomous);
@ -301,13 +312,12 @@ package Prj is
-- Component Flag may be used for various purposes. For source
-- directories, it indicates if the directory contains Ada source(s).
package String_Elements is new Table.Table
package String_Element_Table is new GNAT.Dynamic_Tables
(Table_Component_Type => String_Element,
Table_Index_Type => String_List_Id,
Table_Low_Bound => 1,
Table_Initial => 200,
Table_Increment => 100,
Table_Name => "Prj.String_Elements");
Table_Increment => 100);
-- The table for string elements in string lists
type Variable_Kind is (Undefined, List, Single);
@ -316,7 +326,7 @@ package Prj is
subtype Defined_Variable_Kind is Variable_Kind range List .. Single;
-- The defined kinds of variables
Ignored : constant Variable_Kind := Single;
Ignored : constant Variable_Kind;
-- Used to indicate that a package declaration must be ignored
-- while processing the project tree (unknown package name).
@ -337,11 +347,7 @@ package Prj is
-- Values for variables and array elements. Default is True if the
-- current value is the default one for the variable
Nil_Variable_Value : constant Variable_Value :=
(Project => No_Project,
Kind => Undefined,
Location => No_Location,
Default => False);
Nil_Variable_Value : constant Variable_Value;
-- Value of a non existing variable or array element
type Variable_Id is new Nat;
@ -353,13 +359,12 @@ package Prj is
end record;
-- To hold the list of variables in a project file and in packages
package Variable_Elements is new Table.Table
package Variable_Element_Table is new GNAT.Dynamic_Tables
(Table_Component_Type => Variable,
Table_Index_Type => Variable_Id,
Table_Low_Bound => 1,
Table_Initial => 200,
Table_Increment => 100,
Table_Name => "Prj.Variable_Elements");
Table_Increment => 100);
-- The table of variable in list of variables
type Array_Element_Id is new Nat;
@ -374,13 +379,12 @@ package Prj is
-- Each Array_Element represents an array element and is linked (Next)
-- to the next array element, if any, in the array.
package Array_Elements is new Table.Table
package Array_Element_Table is new GNAT.Dynamic_Tables
(Table_Component_Type => Array_Element,
Table_Index_Type => Array_Element_Id,
Table_Low_Bound => 1,
Table_Initial => 200,
Table_Increment => 100,
Table_Name => "Prj.Array_Elements");
Table_Increment => 100);
-- The table that contains all array elements
type Array_Id is new Nat;
@ -394,13 +398,12 @@ package Prj is
-- Value is the id of the first element.
-- Next is the id of the next array in the project file or package.
package Arrays is new Table.Table
package Array_Table is new GNAT.Dynamic_Tables
(Table_Component_Type => Array_Data,
Table_Index_Type => Array_Id,
Table_Low_Bound => 1,
Table_Initial => 200,
Table_Increment => 100,
Table_Name => "Prj.Arrays");
Table_Increment => 100);
-- The table that contains all arrays
type Package_Id is new Nat;
@ -429,13 +432,12 @@ package Prj is
end record;
-- A package. Includes declarations that may include other packages.
package Packages is new Table.Table
package Package_Table is new GNAT.Dynamic_Tables
(Table_Component_Type => Package_Element,
Table_Index_Type => Package_Id,
Table_Low_Bound => 1,
Table_Initial => 100,
Table_Increment => 100,
Table_Name => "Prj.Packages");
Table_Increment => 100);
-- The table that contains all packages.
function Image (Casing : Casing_Type) return String;
@ -511,9 +513,12 @@ package Prj is
end record;
function Standard_Naming_Data return Naming_Data;
function Standard_Naming_Data (Tree : Project_Tree_Ref := No_Project_Tree)
return Naming_Data;
pragma Inline (Standard_Naming_Data);
-- The standard GNAT naming scheme
-- The standard GNAT naming scheme when Tree is No_Project_Tree.
-- Otherwise, return the default naming scheme for the project tree Tree,
-- which must have been Initialized.
function Same_Naming_Scheme
(Left, Right : Naming_Data) return Boolean;
@ -531,13 +536,12 @@ package Prj is
-- Element in a list of project files. Next is the id of the next
-- project file in the list.
package Project_Lists is new Table.Table
package Project_List_Table is new GNAT.Dynamic_Tables
(Table_Component_Type => Project_Element,
Table_Index_Type => Project_List,
Table_Low_Bound => 1,
Table_Initial => 100,
Table_Increment => 100,
Table_Name => "Prj.Project_Lists");
Table_Increment => 100);
-- The table that contains the lists of project files
-- The following record describes a project file representation
@ -782,80 +786,126 @@ package Prj is
end record;
function Is_Present
(Language : Language_Index;
In_Project : Project_Data) return Boolean;
-- Return True when Language is one of the languages used in
-- project Project.
procedure Set
(Language : Language_Index;
Present : Boolean;
In_Project : in out Project_Data);
-- Indicate if Language is or not a language used in project Project
function Language_Processing_Data_Of
(Language : Language_Index;
In_Project : Project_Data) return Language_Processing_Data;
-- Return the Language_Processing_Data for language Language in project
-- In_Project. Return the default when no Language_Processing_Data are
-- defined for the language.
procedure Set
(Language_Processing : Language_Processing_Data;
For_Language : Language_Index;
In_Project : in out Project_Data);
-- Set the Language_Processing_Data for language Language in project
-- In_Project.
function Suffix_Of
(Language : Language_Index;
In_Project : Project_Data) return Name_Id;
-- Return the suffix for language Language in project In_Project. Return
-- No_Name when no suffix is defined for the language.
procedure Set
(Suffix : Name_Id;
For_Language : Language_Index;
In_Project : in out Project_Data);
-- Set the suffix for language Language in project In_Project
function Empty_Project (Tree : Project_Tree_Ref) return Project_Data;
-- Return the representation of an empty project in project Tree tree.
-- The project tree Tree must have been Initialized and/or Reset.
Project_Error : exception;
-- Raised by some subprograms in Prj.Attr.
function Empty_Project return Project_Data;
-- Return the representation of an empty project
package Projects is new Table.Table (
package Project_Table is new GNAT.Dynamic_Tables (
Table_Component_Type => Project_Data,
Table_Index_Type => Project_Id,
Table_Low_Bound => 1,
Table_Initial => 100,
Table_Increment => 100,
Table_Name => "Prj.Projects");
Table_Increment => 100);
-- The set of all project files
type Spec_Or_Body is
(Specification, Body_Part);
type File_Name_Data is record
Name : Name_Id := No_Name;
Index : Int := 0;
Display_Name : Name_Id := No_Name;
Path : Name_Id := No_Name;
Display_Path : Name_Id := No_Name;
Project : Project_Id := No_Project;
Needs_Pragma : Boolean := False;
end record;
-- File and Path name of a spec or body.
type File_Names_Data is array (Spec_Or_Body) of File_Name_Data;
type Unit_Id is new Nat;
No_Unit : constant Unit_Id := 0;
type Unit_Data is record
Name : Name_Id := No_Name;
File_Names : File_Names_Data;
end record;
-- Name and File and Path names of a unit, with a reference to its
-- GNAT Project File(s).
package Unit_Table is new GNAT.Dynamic_Tables
(Table_Component_Type => Unit_Data,
Table_Index_Type => Unit_Id,
Table_Low_Bound => 1,
Table_Initial => 100,
Table_Increment => 100);
-- Table of all units in a project tree
package Units_Htable is new Simple_HTable
(Header_Num => Header_Num,
Element => Unit_Id,
No_Element => No_Unit,
Key => Name_Id,
Hash => Hash,
Equal => "=");
-- Mapping of unit names to indexes in the Units table
type Unit_Project is record
Unit : Unit_Id := No_Unit;
Project : Project_Id := No_Project;
end record;
No_Unit_Project : constant Unit_Project := (No_Unit, No_Project);
package Files_Htable is new Simple_HTable
(Header_Num => Header_Num,
Element => Unit_Project,
No_Element => No_Unit_Project,
Key => Name_Id,
Hash => Hash,
Equal => "=");
-- Mapping of file names to indexes in the Units table
type Private_Project_Tree_Data is private;
-- Data for a project tree that is used only by the Project Manager
type Project_Tree_Data is
record
Present_Languages : Present_Language_Table.Instance;
Supp_Suffixes : Supp_Suffix_Table.Instance;
Name_Lists : Name_List_Table.Instance;
Supp_Languages : Supp_Language_Table.Instance;
Other_Sources : Other_Source_Table.Instance;
String_Elements : String_Element_Table.Instance;
Variable_Elements : Variable_Element_Table.Instance;
Array_Elements : Array_Element_Table.Instance;
Arrays : Array_Table.Instance;
Packages : Package_Table.Instance;
Project_Lists : Project_List_Table.Instance;
Projects : Project_Table.Instance;
Units : Unit_Table.Instance;
Units_HT : Units_Htable.Instance;
Files_HT : Files_Htable.Instance;
Private_Part : Private_Project_Tree_Data;
end record;
-- Data for a project tree
type Put_Line_Access is access procedure
(Line : String;
Project : Project_Id);
Project : Project_Id;
In_Tree : Project_Tree_Ref);
-- Use to customize error reporting in Prj.Proc and Prj.Nmsc
procedure Expect (The_Token : Token_Type; Token_Image : String);
-- Check that the current token is The_Token. If it is not, then
-- output an error message.
procedure Initialize;
procedure Initialize (Tree : Project_Tree_Ref);
-- This procedure must be called before using any services from the Prj
-- hierarchy. Namet.Initialize must be called before Prj.Initialize.
procedure Reset;
procedure Reset (Tree : Project_Tree_Ref);
-- This procedure resets all the tables that are used when processing a
-- project file tree. Initialize must be called before the call to Reset.
procedure Register_Default_Naming_Scheme
(Language : Name_Id;
Default_Spec_Suffix : Name_Id;
Default_Body_Suffix : Name_Id);
Default_Body_Suffix : Name_Id;
In_Tree : Project_Tree_Ref);
-- Register the default suffixes for a given language. These extensions
-- will be ignored if the user has specified a new naming scheme in a
-- project file.
@ -870,29 +920,132 @@ package Prj is
With_State : in out State);
procedure For_Every_Project_Imported
(By : Project_Id;
In_Tree : Project_Tree_Ref;
With_State : in out State);
-- Call Action for each project imported directly or indirectly by project
-- By. Action is called according to the order of importation: if A
-- imports B, directly or indirectly, Action will be called for A before
-- it is called for B. With_State may be used by Action to choose a
-- behavior or to report some global result.
-- it is called for B. If two projects import each other directly or
-- indirectly (using at least one "limited with"), it is not specified
-- for which of these two projects Action will be called first. Projects
-- that are extended by other projects are not considered. With_State may
-- be used by Action to choose a behavior or to report some global result.
----------------------------------------------------------
-- Other multi-language stuff that may be modified soon --
----------------------------------------------------------
function Is_Present
(Language : Language_Index;
In_Project : Project_Data;
In_Tree : Project_Tree_Ref) return Boolean;
-- Return True when Language is one of the languages used in
-- project Project.
procedure Set
(Language : Language_Index;
Present : Boolean;
In_Project : in out Project_Data;
In_Tree : Project_Tree_Ref);
-- Indicate if Language is or not a language used in project Project
function Language_Processing_Data_Of
(Language : Language_Index;
In_Project : Project_Data;
In_Tree : Project_Tree_Ref) return Language_Processing_Data;
-- Return the Language_Processing_Data for language Language in project
-- In_Project. Return the default when no Language_Processing_Data are
-- defined for the language.
procedure Set
(Language_Processing : Language_Processing_Data;
For_Language : Language_Index;
In_Project : in out Project_Data;
In_Tree : Project_Tree_Ref);
-- Set the Language_Processing_Data for language Language in project
-- In_Project.
function Suffix_Of
(Language : Language_Index;
In_Project : Project_Data;
In_Tree : Project_Tree_Ref) return Name_Id;
-- Return the suffix for language Language in project In_Project. Return
-- No_Name when no suffix is defined for the language.
procedure Set
(Suffix : Name_Id;
For_Language : Language_Index;
In_Project : in out Project_Data;
In_Tree : Project_Tree_Ref);
-- Set the suffix for language Language in project In_Project
private
Initial_Buffer_Size : constant := 100;
-- Initial size for extensible buffer used below
All_Packages : constant String_List_Access := null;
Buffer : String_Access := new String (1 .. Initial_Buffer_Size);
-- An extensible character buffer to store names. Used in Prj.Part and
-- Prj.Strt.
No_Project_Tree : constant Project_Tree_Ref := null;
Buffer_Last : Natural := 0;
-- The index of the last character in the Buffer
Ignored : constant Variable_Kind := Single;
Current_Packages_To_Check : String_List_Access := All_Packages;
-- Global variable, set by Prj.Part.Parse, used by Prj.Dect.
Nil_Variable_Value : constant Variable_Value :=
(Project => No_Project,
Kind => Undefined,
Location => No_Location,
Default => False);
procedure Add_To_Buffer (S : String);
Virtual_Prefix : constant String := "v$";
-- The prefix for virtual extending projects. Because of the '$', which is
-- normally forbidden for project names, there cannot be any name clash.
Empty_Name : Name_Id;
-- Name_Id for an empty name (no characters). Initialized by the call
-- to procedure Initialize.
procedure Add_To_Buffer
(S : String;
To : in out String_Access;
Last : in out Natural);
-- Append a String to the Buffer
type Naming_Id is new Nat;
package Naming_Table is new GNAT.Dynamic_Tables
(Table_Component_Type => Naming_Data,
Table_Index_Type => Naming_Id,
Table_Low_Bound => 1,
Table_Initial => 5,
Table_Increment => 100);
package Path_File_Table is new GNAT.Dynamic_Tables
(Table_Component_Type => Name_Id,
Table_Index_Type => Natural,
Table_Low_Bound => 1,
Table_Initial => 50,
Table_Increment => 50);
-- Table storing all the temp path file names.
-- Used by Delete_All_Path_Files.
package Source_Path_Table is new GNAT.Dynamic_Tables
(Table_Component_Type => Name_Id,
Table_Index_Type => Natural,
Table_Low_Bound => 1,
Table_Initial => 50,
Table_Increment => 50);
-- A table to store the source dirs before creating the source path file
package Object_Path_Table is new GNAT.Dynamic_Tables
(Table_Component_Type => Name_Id,
Table_Index_Type => Natural,
Table_Low_Bound => 1,
Table_Initial => 50,
Table_Increment => 50);
-- A table to store the object dirs, before creating the object path file
type Private_Project_Tree_Data is record
Namings : Naming_Table.Instance;
Path_Files : Path_File_Table.Instance;
Source_Paths : Source_Path_Table.Instance;
Object_Paths : Object_Path_Table.Instance;
Default_Naming : Naming_Data;
end record;
end Prj;