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

110
gcc/ada/gnatcmd.adb
View File

@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- 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 Osint; use Osint;
with Output; with Output;
with Prj; use Prj; with Prj; use Prj;
with Prj.Com;
with Prj.Env; with Prj.Env;
with Prj.Ext; use Prj.Ext; with Prj.Ext; use Prj.Ext;
with Prj.Pars; with Prj.Pars;
@ -57,6 +56,7 @@ with Table;
with VMS_Conv; use VMS_Conv; with VMS_Conv; use VMS_Conv;
procedure GNATCmd is procedure GNATCmd is
Project_Tree : constant Project_Tree_Ref := new Project_Tree_Data;
Project_File : String_Access; Project_File : String_Access;
Project : Prj.Project_Id; Project : Prj.Project_Id;
Current_Verbosity : Prj.Verbosity := Prj.Default; Current_Verbosity : Prj.Verbosity := Prj.Default;
@ -244,7 +244,7 @@ procedure GNATCmd is
procedure Check_Files is procedure Check_Files is
Add_Sources : Boolean := True; Add_Sources : Boolean := True;
Unit_Data : Prj.Com.Unit_Data; Unit_Data : Prj.Unit_Data;
Subunit : Boolean := False; Subunit : Boolean := False;
begin begin
@ -263,11 +263,11 @@ procedure GNATCmd is
if Add_Sources then if Add_Sources then
declare declare
Current_Last : constant Integer := Last_Switches.Last; Current_Last : constant Integer := Last_Switches.Last;
use Prj.Com;
begin begin
for Unit in 1 .. Prj.Com.Units.Last loop for Unit in Unit_Table.First ..
Unit_Data := Prj.Com.Units.Table (Unit); Unit_Table.Last (Project_Tree.Units)
loop
Unit_Data := Project_Tree.Units.Table (Unit);
-- For gnatls, we only need to put the library units, -- For gnatls, we only need to put the library units,
-- body or spec, but not the subunits. -- body or spec, but not the subunits.
@ -338,7 +338,7 @@ procedure GNATCmd is
-- For gnatpp and gnatmetric, put all sources -- For gnatpp and gnatmetric, put all sources
-- of the project. -- 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 -- Put only sources that belong to the main
-- project. -- project.
@ -430,7 +430,8 @@ procedure GNATCmd is
elsif The_Command = Metric then elsif The_Command = Metric then
declare declare
Data : Project_Data := Projects.Table (Root_Project); Data : Project_Data :=
Project_Tree.Projects.Table (Root_Project);
begin begin
while Data.Extends /= No_Project loop while Data.Extends /= No_Project loop
@ -438,7 +439,7 @@ procedure GNATCmd is
return True; return True;
end if; end if;
Data := Projects.Table (Data.Extends); Data := Project_Tree.Projects.Table (Data.Extends);
end loop; end loop;
end; end;
end if; end if;
@ -464,7 +465,7 @@ procedure GNATCmd is
end if; end if;
end loop; end loop;
Get_Name_String (Projects.Table Get_Name_String (Project_Tree.Projects.Table
(Project).Exec_Directory); (Project).Exec_Directory);
if Name_Buffer (Name_Len) /= Directory_Separator then if Name_Buffer (Name_Len) /= Directory_Separator then
@ -487,8 +488,8 @@ procedure GNATCmd is
function Configuration_Pragmas_File return Name_Id is function Configuration_Pragmas_File return Name_Id is
begin begin
Prj.Env.Create_Config_Pragmas_File Prj.Env.Create_Config_Pragmas_File
(Project, Project, Include_Config_Files => False); (Project, Project, Project_Tree, Include_Config_Files => False);
return Projects.Table (Project).Config_File_Name; return Project_Tree.Projects.Table (Project).Config_File_Name;
end Configuration_Pragmas_File; end Configuration_Pragmas_File;
------------------------------ ------------------------------
@ -501,19 +502,25 @@ procedure GNATCmd is
begin begin
if not Keep_Temporary_Files then if not Keep_Temporary_Files then
if Project /= No_Project then if Project /= No_Project then
for Prj in 1 .. Projects.Last loop for Prj in Project_Table.First ..
if Projects.Table (Prj).Config_File_Temp then Project_Table.Last (Project_Tree.Projects)
loop
if
Project_Tree.Projects.Table (Prj).Config_File_Temp
then
if Verbose_Mode then if Verbose_Mode then
Output.Write_Str ("Deleting temp configuration file """); Output.Write_Str ("Deleting temp configuration file """);
Output.Write_Str Output.Write_Str
(Get_Name_String (Get_Name_String
(Projects.Table (Prj).Config_File_Name)); (Project_Tree.Projects.Table
(Prj).Config_File_Name));
Output.Write_Line (""""); Output.Write_Line ("""");
end if; end if;
Delete_File Delete_File
(Name => Get_Name_String (Name => Get_Name_String
(Projects.Table (Prj).Config_File_Name), (Project_Tree.Projects.Table
(Prj).Config_File_Name),
Success => Success); Success => Success);
end if; end if;
end loop; end loop;
@ -568,7 +575,7 @@ procedure GNATCmd is
-- Check if there are library project files -- Check if there are library project files
if MLib.Tgt.Support_For_Libraries /= MLib.Tgt.None then 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; end if;
-- If there are, add the necessary additional switches -- If there are, add the necessary additional switches
@ -729,8 +736,8 @@ procedure GNATCmd is
declare declare
Dir : constant String := Dir : constant String :=
Get_Name_String Get_Name_String
(Projects.Table (Prj). (Project_Tree.Projects.Table
Object_Directory); (Prj).Object_Directory);
begin begin
if Is_Regular_File if Is_Regular_File
(Dir & (Dir &
@ -754,7 +761,8 @@ procedure GNATCmd is
-- Go to the project being extended, -- Go to the project being extended,
-- if any. -- if any.
Prj := Projects.Table (Prj).Extends; Prj :=
Project_Tree.Projects.Table (Prj).Extends;
exit Project_Loop when Prj = No_Project; exit Project_Loop when Prj = No_Project;
end loop Project_Loop; end loop Project_Loop;
end if; end if;
@ -811,7 +819,8 @@ procedure GNATCmd is
Last_Switches.Table (Last_Switches.Last) := Last_Switches.Table (Last_Switches.Last) :=
new String'("-o"); new String'("-o");
Get_Name_String Get_Name_String
(Projects.Table (Project).Exec_Directory); (Project_Tree.Projects.Table
(Project).Exec_Directory);
Last_Switches.Increment_Last; Last_Switches.Increment_Last;
Last_Switches.Table (Last_Switches.Last) := Last_Switches.Table (Last_Switches.Last) :=
new String'(Name_Buffer (1 .. Name_Len) & new String'(Name_Buffer (1 .. Name_Len) &
@ -839,7 +848,7 @@ procedure GNATCmd is
begin begin
-- Case of library project -- Case of library project
if Projects.Table (Project).Library then if Project_Tree.Projects.Table (Project).Library then
There_Are_Libraries := True; There_Are_Libraries := True;
-- Add the -L switch -- Add the -L switch
@ -848,7 +857,8 @@ procedure GNATCmd is
Last_Switches.Table (Last_Switches.Last) := Last_Switches.Table (Last_Switches.Last) :=
new String'("-L" & new String'("-L" &
Get_Name_String Get_Name_String
(Projects.Table (Project).Library_Dir)); (Project_Tree.Projects.Table
(Project).Library_Dir));
-- Add the -l switch -- Add the -l switch
@ -856,18 +866,21 @@ procedure GNATCmd is
Last_Switches.Table (Last_Switches.Last) := Last_Switches.Table (Last_Switches.Last) :=
new String'("-l" & new String'("-l" &
Get_Name_String 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 -- Add the directory to table Library_Paths, to be processed later
-- if library is not static and if Path_Option is not null. -- 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 and then Path_Option /= null
then then
Library_Paths.Increment_Last; Library_Paths.Increment_Last;
Library_Paths.Table (Library_Paths.Last) := Library_Paths.Table (Library_Paths.Last) :=
new String'(Get_Name_String new String'(Get_Name_String
(Projects.Table (Project).Library_Dir)); (Project_Tree.Projects.Table
(Project).Library_Dir));
end if; end if;
end if; end if;
end Set_Library_For; end Set_Library_For;
@ -988,7 +1001,7 @@ begin
Snames.Initialize; Snames.Initialize;
Prj.Initialize; Prj.Initialize (Project_Tree);
Last_Switches.Init; Last_Switches.Init;
Last_Switches.Set_Last (0); Last_Switches.Set_Last (0);
@ -1297,6 +1310,7 @@ begin
Prj.Pars.Parse Prj.Pars.Parse
(Project => Project, (Project => Project,
In_Tree => Project_Tree,
Project_File_Name => Project_File.all, Project_File_Name => Project_File.all,
Packages_To_Check => All_Packages); Packages_To_Check => All_Packages);
@ -1531,6 +1545,7 @@ begin
Prj.Pars.Parse Prj.Pars.Parse
(Project => Project, (Project => Project,
In_Tree => Project_Tree,
Project_File_Name => Project_File.all, Project_File_Name => Project_File.all,
Packages_To_Check => Packages_To_Check); Packages_To_Check => Packages_To_Check);
@ -1543,12 +1558,13 @@ begin
declare declare
Data : constant Prj.Project_Data := Data : constant Prj.Project_Data :=
Prj.Projects.Table (Project); Project_Tree.Projects.Table (Project);
Pkg : constant Prj.Package_Id := Pkg : constant Prj.Package_Id :=
Prj.Util.Value_Of Prj.Util.Value_Of
(Name => Tool_Package_Name, (Name => Tool_Package_Name,
In_Packages => Data.Decl.Packages); In_Packages => Data.Decl.Packages,
In_Tree => Project_Tree);
Element : Package_Element; Element : Package_Element;
@ -1560,7 +1576,7 @@ begin
begin begin
if Pkg /= No_Package then if Pkg /= No_Package then
Element := Packages.Table (Pkg); Element := Project_Tree.Packages.Table (Pkg);
-- Packages Gnatls has a single attribute Switches, that is -- Packages Gnatls has a single attribute Switches, that is
-- not an associative array. -- not an associative array.
@ -1569,7 +1585,8 @@ begin
The_Switches := The_Switches :=
Prj.Util.Value_Of Prj.Util.Value_Of
(Variable_Name => Snames.Name_Switches, (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 -- Packages Binder (for gnatbind), Cross_Reference (for
-- gnatxref), Linker (for gnatlink) Finder (for gnatfind), -- gnatxref), Linker (for gnatlink) Finder (for gnatfind),
@ -1584,12 +1601,14 @@ begin
if The_Switches.Kind = Prj.Undefined then if The_Switches.Kind = Prj.Undefined then
Default_Switches_Array := Default_Switches_Array :=
Prj.Util.Value_Of Prj.Util.Value_Of
(Name => Name_Default_Switches, (Name => Name_Default_Switches,
In_Arrays => Element.Decl.Arrays); In_Arrays => Element.Decl.Arrays,
In_Tree => Project_Tree);
The_Switches := Prj.Util.Value_Of The_Switches := Prj.Util.Value_Of
(Index => Name_Ada, (Index => Name_Ada,
Src_Index => 0, Src_Index => 0,
In_Array => Default_Switches_Array); In_Array => Default_Switches_Array,
In_Tree => Project_Tree);
end if; end if;
end if; end if;
@ -1616,7 +1635,8 @@ begin
when Prj.List => when Prj.List =>
Current := The_Switches.Values; Current := The_Switches.Values;
while Current /= Prj.Nil_String loop while Current /= Prj.Nil_String loop
The_String := String_Elements.Table (Current); The_String := Project_Tree.String_Elements.
Table (Current);
declare declare
Switch : constant String := Switch : constant String :=
@ -1642,12 +1662,14 @@ begin
then then
Change_Dir Change_Dir
(Get_Name_String (Get_Name_String
(Projects.Table (Project).Object_Directory)); (Project_Tree.Projects.Table
(Project).Object_Directory));
end if; end if;
-- Set up the env vars for project path files -- 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 -- For gnatstub, gnatmetric, gnatpp and gnatelim, create
-- a configuration pragmas file, if necessary. -- a configuration pragmas file, if necessary.
@ -1714,7 +1736,8 @@ begin
(Last_Switches.Table (J), Current_Work_Dir); (Last_Switches.Table (J), Current_Work_Dir);
end loop; end loop;
Get_Name_String (Projects.Table (Project).Directory); Get_Name_String
(Project_Tree.Projects.Table (Project).Directory);
declare declare
Project_Dir : constant String := Name_Buffer (1 .. Name_Len); Project_Dir : constant String := Name_Buffer (1 .. Name_Len);
@ -1729,7 +1752,7 @@ begin
elsif The_Command = Stub then elsif The_Command = Stub then
declare declare
Data : constant Prj.Project_Data := Data : constant Prj.Project_Data :=
Prj.Projects.Table (Project); Project_Tree.Projects.Table (Project);
File_Index : Integer := 0; File_Index : Integer := 0;
Dir_Index : Integer := 0; Dir_Index : Integer := 0;
Last : constant Integer := Last_Switches.Last; Last : constant Integer := Last_Switches.Last;
@ -1815,7 +1838,8 @@ begin
First_Switches.Table (1) := First_Switches.Table (1) :=
new String'("-d=" & new String'("-d=" &
Get_Name_String Get_Name_String
(Projects.Table (Project).Object_Directory)); (Project_Tree.Projects.Table
(Project).Object_Directory));
end if; end if;
-- For gnat pretty and gnat metric, if no file has been put on the -- For gnat pretty and gnat metric, if no file has been put on the
@ -1890,12 +1914,12 @@ begin
exception exception
when Error_Exit => when Error_Exit =>
Prj.Env.Delete_All_Path_Files; Prj.Env.Delete_All_Path_Files (Project_Tree);
Delete_Temp_Config_Files; Delete_Temp_Config_Files;
Set_Exit_Status (Failure); Set_Exit_Status (Failure);
when Normal_Exit => when Normal_Exit =>
Prj.Env.Delete_All_Path_Files; Prj.Env.Delete_All_Path_Files (Project_Tree);
Delete_Temp_Config_Files; Delete_Temp_Config_Files;
-- Since GNATCmd is normally called from DCL (the VMS shell), -- 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 -- -- 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 -- -- 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- -- -- 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 Opt; use Opt;
with Osint; use Osint; with Osint; use Osint;
with Prj; use Prj; with Prj; use Prj;
with Prj.Com; use Prj.Com;
with Prj.Pars; with Prj.Pars;
with Prj.Util; use Prj.Util; with Prj.Util; use Prj.Util;
with Snames; use Snames; with Snames; use Snames;
@ -168,6 +167,8 @@ package body Makegpr is
Packages_To_Check : constant String_List_Access := List_Of_Packages'Access; Packages_To_Check : constant String_List_Access := List_Of_Packages'Access;
-- List of the packages to be checked when parsing/processing project files -- 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; Main_Project : Project_Id;
-- The project id of the main project -- The project id of the main project
@ -617,7 +618,7 @@ package body Makegpr is
-- Nothing to do when there is no project specified -- Nothing to do when there is no project specified
if Project /= No_Project then 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 -- 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 -- 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); Recursive_Add_Archives (Data.Extends);
@ -634,17 +635,22 @@ package body Makegpr is
-- Call itself recursively for all imported projects -- Call itself recursively for all imported projects
while Imported /= Empty_Project_List loop 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 if Prj /= No_Project then
while Projects.Table (Prj).Extended_By /= No_Project loop while Project_Tree.Projects.Table
Prj := Projects.Table (Prj).Extended_By; (Prj).Extended_By /= No_Project
loop
Prj := Project_Tree.Projects.Table
(Prj).Extended_By;
end loop; end loop;
Recursive_Add_Archives (Prj); Recursive_Add_Archives (Prj);
end if; end if;
Imported := Project_Lists.Table (Imported).Next; Imported := Project_Tree.Project_Lists.Table
(Imported).Next;
end loop; end loop;
-- If there is sources of language other than Ada in this -- If there is sources of language other than Ada in this
@ -664,8 +670,10 @@ package body Makegpr is
begin begin
-- First, mark all projects as not processed -- First, mark all projects as not processed
for Project in 1 .. Projects.Last loop for Project in Project_Table.First ..
Projects.Table (Project).Seen := False; Project_Table.Last (Project_Tree.Projects)
loop
Project_Tree.Projects.Table (Project).Seen := False;
end loop; end loop;
-- Take care of the run path option -- Take care of the run path option
@ -939,10 +947,10 @@ package body Makegpr is
raise Program_Error; raise Program_Error;
when Linker => when Linker =>
Pkg := Value_Of (Name_Linker, Data.Decl.Packages); Pkg := Value_Of (Name_Linker, Data.Decl.Packages, Project_Tree);
when Compiler => when Compiler =>
Pkg := Value_Of (Name_Compiler, Data.Decl.Packages); Pkg := Value_Of (Name_Compiler, Data.Decl.Packages, Project_Tree);
end case; end case;
if Pkg /= No_Package then if Pkg /= No_Package then
@ -950,24 +958,30 @@ package body Makegpr is
Switches_Array := Prj.Util.Value_Of Switches_Array := Prj.Util.Value_Of
(Name => Name_Switches, (Name => Name_Switches,
In_Arrays => Packages.Table (Pkg).Decl.Arrays); In_Arrays => Project_Tree.Packages.Table
(Pkg).Decl.Arrays,
In_Tree => Project_Tree);
Switches := Switches :=
Prj.Util.Value_Of Prj.Util.Value_Of
(Index => File_Name, (Index => File_Name,
Src_Index => 0, Src_Index => 0,
In_Array => Switches_Array); In_Array => Switches_Array,
In_Tree => Project_Tree);
-- Otherwise, get the Default_Switches ("language"), if they exist -- Otherwise, get the Default_Switches ("language"), if they exist
if Switches = Nil_Variable_Value then if Switches = Nil_Variable_Value then
Defaults := Prj.Util.Value_Of Defaults := Prj.Util.Value_Of
(Name => Name_Default_Switches, (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 Switches := Prj.Util.Value_Of
(Index => Language_Names.Table (Language), (Index => Language_Names.Table (Language),
Src_Index => 0, Src_Index => 0,
In_Array => Defaults); In_Array => Defaults,
In_Tree => Project_Tree);
end if; end if;
-- If there are switches, add them to Arguments -- If there are switches, add them to Arguments
@ -975,7 +989,8 @@ package body Makegpr is
if Switches /= Nil_Variable_Value then if Switches /= Nil_Variable_Value then
Element_Id := Switches.Values; Element_Id := Switches.Values;
while Element_Id /= Nil_String loop 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 if Element.Value /= No_Name then
Get_Name_String (Element.Value); Get_Name_String (Element.Value);
@ -1003,7 +1018,8 @@ package body Makegpr is
-------------------------- --------------------------
procedure Build_Global_Archive 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_Id : Other_Source_Id;
Source : Other_Source; Source : Other_Source;
Success : Boolean; Success : Boolean;
@ -1072,8 +1088,10 @@ package body Makegpr is
-- Put all sources of language other than Ada in -- Put all sources of language other than Ada in
-- Source_Indexes. -- Source_Indexes.
for Proj in 1 .. Projects.Last loop for Proj in Project_Table.First ..
Data := Projects.Table (Proj); Project_Table.Last (Project_Tree.Projects)
loop
Data := Project_Tree.Projects.Table (Proj);
if not Data.Library then if not Data.Library then
Last_Source := 0; Last_Source := 0;
@ -1081,7 +1099,8 @@ package body Makegpr is
while Source_Id /= No_Other_Source loop while Source_Id /= No_Other_Source loop
Add_Source_Id (Proj, Source_Id); 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 loop;
end if; end if;
end loop; end loop;
@ -1100,7 +1119,8 @@ package body Makegpr is
for S in 1 .. Last_Source loop for S in 1 .. Last_Source loop
Source_Id := Source_Indexes (S).Id; 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) if (not Source_Indexes (S).Found)
and then Source.Object_Path = Object_Path 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 -- Followed by all the object files of the non library projects
for Proj in 1 .. Projects.Last loop for Proj in Project_Table.First ..
Data := Projects.Table (Proj); Project_Table.Last (Project_Tree.Projects)
loop
Data := Project_Tree.Projects.Table (Proj);
if not Data.Library then if not Data.Library then
Source_Id := Data.First_Other_Source; Source_Id := Data.First_Other_Source;
while Source_Id /= No_Other_Source loop 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 -- Only include object file name that have not been
-- overriden in extending projects. -- overriden in extending projects.
@ -1345,7 +1368,8 @@ package body Makegpr is
------------------- -------------------
procedure Build_Library (Project : Project_Id; Unconditionally : Boolean) 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_Id : Other_Source_Id;
Source : Other_Source; Source : Other_Source;
@ -1366,7 +1390,7 @@ package body Makegpr is
Time_Stamp : Time_Stamp_Type; Time_Stamp : Time_Stamp_Type;
Driver_Name : Name_Id := No_Name; Driver_Name : Name_Id := No_Name;
Lib_Opts : Argument_List_Access := No_Argument'Unrestricted_Access; Lib_Opts : Argument_List_Access := No_Argument'Access;
begin begin
Check_Archive_Builder; Check_Archive_Builder;
@ -1414,7 +1438,8 @@ package body Makegpr is
while Source_Id /= No_Other_Source loop while Source_Id /= No_Other_Source loop
Add_Source_Id (Project, Source_Id); 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; end loop;
-- Read the dependency file, line by line -- 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 -- Check if this object file is for a source of this project
for S in 1 .. Last_Source loop for S in 1 .. Last_Source loop
if (not Source_Indexes (S).Found) and then if (not Source_Indexes (S).Found)
Other_Sources.Table and then
(Source_Indexes (S).Id).Object_Name = Project_Tree.Other_Sources.Table
Object_Name (Source_Indexes (S).Id).Object_Name = Object_Name
then then
-- We have found the object file: get the source -- We have found the object file: get the source
-- data, and mark it as found. -- data, and mark it as found.
Source_Id := Source_Indexes (S).Id; 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; Source_Indexes (S).Found := True;
exit; exit;
end if; end if;
@ -1526,7 +1552,8 @@ package body Makegpr is
if Verbose_Mode then if Verbose_Mode then
Source_Id := Source_Indexes (Index).Id; Source_Id := Source_Indexes (Index).Id;
Source := Other_Sources.Table (Source_Id); Source := Project_Tree.Other_Sources.Table
(Source_Id);
Write_Str (" -> "); Write_Str (" -> ");
Write_Str (Get_Name_String (Source.Object_Name)); Write_Str (Get_Name_String (Source.Object_Name));
Write_Str (" is not in the archive "); Write_Str (" is not in the archive ");
@ -1566,7 +1593,7 @@ package body Makegpr is
Source_Id := Data.First_Other_Source; Source_Id := Data.First_Other_Source;
while Source_Id /= No_Other_Source loop while Source_Id /= No_Other_Source loop
Source := Other_Sources.Table (Source_Id); Source := Project_Tree.Other_Sources.Table (Source_Id);
Add_Argument Add_Argument
(Get_Name_String (Source.Object_Name), Verbose_Mode); (Get_Name_String (Source.Object_Name), Verbose_Mode);
Source_Id := Source.Next; Source_Id := Source.Next;
@ -1605,7 +1632,8 @@ package body Makegpr is
Library_Options : constant Variable_Value := Library_Options : constant Variable_Value :=
Value_Of Value_Of
(Name_Library_Options, (Name_Library_Options,
Data.Decl.Attributes); Data.Decl.Attributes,
Project_Tree);
begin begin
if not Library_Options.Default then if not Library_Options.Default then
@ -1615,7 +1643,8 @@ package body Makegpr is
begin begin
while Current /= Nil_String loop while Current /= Nil_String loop
Element := String_Elements.Table (Current); Element := Project_Tree.String_Elements.
Table (Current);
Get_Name_String (Element.Value); Get_Name_String (Element.Value);
if Name_Len /= 0 then if Name_Len /= 0 then
@ -2034,9 +2063,12 @@ package body Makegpr is
begin begin
C_Plus_Plus_Is_Used := False; 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 if
Projects.Table (Project).Languages (C_Plus_Plus_Language_Index) Project_Tree.Projects.Table (Project).Languages
(C_Plus_Plus_Language_Index)
then then
C_Plus_Plus_Is_Used := True; C_Plus_Plus_Is_Used := True;
exit; exit;
@ -2053,7 +2085,8 @@ package body Makegpr is
Data : in Project_Data; Data : in Project_Data;
Local_Errors : in out Boolean) Local_Errors : in out Boolean)
is is
Source : Other_Source := Other_Sources.Table (Source_Id); Source : Other_Source :=
Project_Tree.Other_Sources.Table (Source_Id);
Success : Boolean; Success : Boolean;
CPATH : String_Access := null; CPATH : String_Access := null;
@ -2283,7 +2316,7 @@ package body Makegpr is
else else
-- Everything looks fine, update the Other_Sources table -- Everything looks fine, update the Other_Sources table
Other_Sources.Table (Source_Id) := Source; Project_Tree.Other_Sources.Table (Source_Id) := Source;
end if; end if;
-- Compilation failed -- Compilation failed
@ -2302,7 +2335,8 @@ package body Makegpr is
-------------------------------- --------------------------------
procedure Compile_Individual_Sources 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_Id : Other_Source_Id;
Source : Other_Source; Source : Other_Source;
Source_Name : Name_Id; Source_Name : Name_Id;
@ -2318,7 +2352,7 @@ package body Makegpr is
Compile_Only := True; Compile_Only := True;
Get_Imported_Directories (Main_Project, Data); 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 -- Compilation will occur in the object directory
@ -2361,7 +2395,8 @@ package body Makegpr is
Source_Id := Data.First_Other_Source; Source_Id := Data.First_Other_Source;
while Source_Id /= No_Other_Source loop 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; exit when Source.File_Name = Source_Name;
Source_Id := Source.Next; Source_Id := Source.Next;
end loop; end loop;
@ -2406,7 +2441,8 @@ package body Makegpr is
-------------------------------- --------------------------------
procedure Compile_Link_With_Gnatmake (Mains_Specified : Boolean) 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; Success : Boolean;
begin begin
@ -2571,9 +2607,11 @@ package body Makegpr is
begin begin
-- Loop through project files -- 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; Local_Errors := False;
Data := Projects.Table (Project); Data := Project_Tree.Projects.Table (Project);
-- Nothing to do when no sources of language other than Ada -- 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 if not Data.Include_Data_Set then
Get_Imported_Directories (Project, Data); Get_Imported_Directories (Project, Data);
Data.Include_Data_Set := True; Data.Include_Data_Set := True;
Projects.Table (Project) := Data; Project_Tree.Projects.Table (Project) := Data;
end if; end if;
Need_To_Rebuild_Archive := Force_Compilations; Need_To_Rebuild_Archive := Force_Compilations;
@ -2598,7 +2636,7 @@ package body Makegpr is
-- Process each source one by one -- Process each source one by one
while Source_Id /= No_Other_Source loop 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; Need_To_Compile := Force_Compilations;
-- Check if compilation is needed -- Check if compilation is needed
@ -2679,7 +2717,7 @@ package body Makegpr is
Create (Dep_File, Append_File, Name); Create (Dep_File, Append_File, Name);
while Source_Id /= No_Other_Source loop 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, Get_Name_String (Source.Object_Name));
Put_Line (Dep_File, String (Source.Object_TS)); Put_Line (Dep_File, String (Source.Object_TS));
Source_Id := Source.Next; 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 -- Get all the object files of non-Ada sources in non-library projects
for Project in 1 .. Projects.Last loop for Project in Project_Table.First ..
if not Projects.Table (Project).Library then Project_Table.Last (Project_Tree.Projects)
Source_Id := Projects.Table (Project).First_Other_Source; 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 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 -- 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 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 := 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 -- The id of the package IDE in the project file
Compiler : constant Variable_Value := Compiler : constant Variable_Value :=
@ -2802,7 +2847,8 @@ package body Makegpr is
(Name => Language_Names.Table (For_Language), (Name => Language_Names.Table (For_Language),
Index => 0, Index => 0,
Attribute_Or_Array_Name => Name_Compiler_Command, 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 -- The value of Compiler_Command ("language") in package IDE, if defined
begin begin
@ -2902,7 +2948,7 @@ package body Makegpr is
-- Add each source directory path name, preceded by "-I" to Arguments -- Add each source directory path name, preceded by "-I" to Arguments
while Element_Id /= Nil_String loop 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 if Element.Value /= No_Name then
Get_Name_String (Element.Value); Get_Name_String (Element.Value);
@ -2960,7 +3006,7 @@ package body Makegpr is
-- Nothing to do if project is undefined -- Nothing to do if project is undefined
if Prj /= No_Project then if Prj /= No_Project then
Data := Projects.Table (Prj); Data := Project_Tree.Projects.Table (Prj);
-- Nothing to do if project has already been processed -- 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 -- Mark the project as processed, to avoid multiple processing
-- of the same project. -- of the same project.
Projects.Table (Prj).Seen := True; Project_Tree.Projects.Table (Prj).Seen := True;
-- Add the source directories of this project -- Add the source directories of this project
@ -2984,8 +3030,11 @@ package body Makegpr is
-- Call itself for all imported projects, if any -- Call itself for all imported projects, if any
while Imported /= Empty_Project_List loop while Imported /= Empty_Project_List loop
Recursive_Get_Dirs (Project_Lists.Table (Imported).Project); Recursive_Get_Dirs
Imported := Project_Lists.Table (Imported).Next; (Project_Tree.Project_Lists.Table
(Imported).Project);
Imported :=
Project_Tree.Project_Lists.Table (Imported).Next;
end loop; end loop;
end if; end if;
end if; end if;
@ -2996,8 +3045,10 @@ package body Makegpr is
begin begin
-- First, mark all project as not processed -- First, mark all project as not processed
for J in 1 .. Projects.Last loop for J in Project_Table.First ..
Projects.Table (J).Seen := False; Project_Table.Last (Project_Tree.Projects)
loop
Project_Tree.Projects.Table (J).Seen := False;
end loop; end loop;
-- Empty Arguments -- Empty Arguments
@ -3006,15 +3057,18 @@ package body Makegpr is
-- Process this project individually, project data are already known -- 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); Add (Data.Source_Dirs);
Recursive_Get_Dirs (Data.Extends); Recursive_Get_Dirs (Data.Extends);
while Imported_Projects /= Empty_Project_List loop while Imported_Projects /= Empty_Project_List loop
Recursive_Get_Dirs (Project_Lists.Table (Imported_Projects).Project); Recursive_Get_Dirs
Imported_Projects := Project_Lists.Table (Imported_Projects).Next; (Project_Tree.Project_Lists.Table
(Imported_Projects).Project);
Imported_Projects := Project_Tree.Project_Lists.Table
(Imported_Projects).Next;
end loop; end loop;
Data.Imported_Directories_Switches := Data.Imported_Directories_Switches :=
@ -3059,6 +3113,7 @@ package body Makegpr is
Prj.Pars.Parse Prj.Pars.Parse
(Project => Main_Project, (Project => Main_Project,
In_Tree => Project_Tree,
Project_File_Name => Project_File_Name.all, Project_File_Name => Project_File_Name.all,
Packages_To_Check => Packages_To_Check); Packages_To_Check => Packages_To_Check);
@ -3092,7 +3147,8 @@ package body Makegpr is
else else
declare declare
Data : constant Prj.Project_Data := Projects.Table (Main_Project); Data : constant Prj.Project_Data :=
Project_Tree.Projects.Table (Main_Project);
begin begin
if Data.Library and then Mains.Number_Of_Mains /= 0 then if Data.Library and then Mains.Number_Of_Mains /= 0 then
Osint.Fail Osint.Fail
@ -3143,7 +3199,7 @@ package body Makegpr is
Csets.Initialize; Csets.Initialize;
Namet.Initialize; Namet.Initialize;
Snames.Initialize; Snames.Initialize;
Prj.Initialize; Prj.Initialize (Project_Tree);
Mains.Delete; Mains.Delete;
-- Set Name_Ide and Name_Compiler_Command -- Set Name_Ide and Name_Compiler_Command
@ -3198,19 +3254,22 @@ package body Makegpr is
(Object_Name : Name_Id; (Object_Name : Name_Id;
Project : Project_Id) return Boolean Project : Project_Id) return Boolean
is is
Data : Project_Data := Projects.Table (Project); Data : Project_Data := Project_Tree.Projects.Table (Project);
Source : Other_Source_Id; Source : Other_Source_Id;
begin begin
while Data.Extended_By /= No_Project loop while Data.Extended_By /= No_Project loop
Data := Projects.Table (Data.Extended_By); Data := Project_Tree.Projects.Table (Data.Extended_By);
Source := Data.First_Other_Source;
Source := Data.First_Other_Source;
while Source /= No_Other_Source loop 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; return False;
else else
Source := Other_Sources.Table (Source).Next; Source :=
Project_Tree.Other_Sources.Table (Source).Next;
end if; end if;
end loop; end loop;
end loop; end loop;
@ -3223,7 +3282,8 @@ package body Makegpr is
---------------------- ----------------------
procedure Link_Executables 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; Mains_Specified : constant Boolean := Mains.Number_Of_Mains /= 0;
-- True if main sources were specified on the command line -- True if main sources were specified on the command line
@ -3288,8 +3348,10 @@ package body Makegpr is
Prj_Data : Project_Data; Prj_Data : Project_Data;
begin begin
for Prj in 1 .. Projects.Last loop for Prj in Project_Table.First ..
Prj_Data := Projects.Table (Prj); Project_Table.Last (Project_Tree.Projects)
loop
Prj_Data := Project_Tree.Projects.Table (Prj);
-- There is an archive only in project -- There is an archive only in project
-- files with sources other than Ada -- files with sources other than Ada
@ -3381,10 +3443,11 @@ package body Makegpr is
Executable_Name : constant String := Executable_Name : constant String :=
Get_Name_String Get_Name_String
(Executable_Of (Executable_Of
(Project => Main_Project, (Project => Main_Project,
Main => Main_Id, In_Tree => Project_Tree,
Index => 0, Main => Main_Id,
Ada_Main => False)); Index => 0,
Ada_Main => False));
-- File name of the executable -- File name of the executable
Executable_Path : constant String := Executable_Path : constant String :=
@ -3453,6 +3516,7 @@ package body Makegpr is
Get_Name_String Get_Name_String
(Executable_Of (Executable_Of
(Project => Main_Project, (Project => Main_Project,
In_Tree => Project_Tree,
Main => Main_Id, Main => Main_Id,
Index => 0, Index => 0,
Ada_Main => False)), Ada_Main => False)),
@ -3484,7 +3548,7 @@ package body Makegpr is
if Link_Options_Switches = null then if Link_Options_Switches = null then
Link_Options_Switches := Link_Options_Switches :=
new Argument_List' new Argument_List'
(Linker_Options_Switches (Main_Project)); (Linker_Options_Switches (Main_Project, Project_Tree));
end if; end if;
Add_Arguments (Link_Options_Switches.all, True); Add_Arguments (Link_Options_Switches.all, True);
@ -3532,7 +3596,8 @@ package body Makegpr is
begin begin
while Element_Id /= Nil_String loop 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 if Element.Value /= No_Name then
Mains.Add_Main (Get_Name_String (Element.Value)); 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 -- Check if it is a source of a language other than Ada
while Source_Id /= No_Other_Source loop 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; exit when Source.File_Name = Main_Id;
Source_Id := Source.Next; Source_Id := Source.Next;
end loop; end loop;
@ -3674,6 +3740,7 @@ package body Makegpr is
(Get_Name_String (Get_Name_String
(Executable_Of (Executable_Of
(Project => Main_Project, (Project => Main_Project,
In_Tree => Project_Tree,
Main => Other_Mains.Table (Main).File_Name, Main => Other_Mains.Table (Main).File_Name,
Index => 0, Index => 0,
Ada_Main => False)), Ada_Main => False)),
@ -3774,7 +3841,8 @@ package body Makegpr is
-- Check if it is a source of the main project file -- Check if it is a source of the main project file
while Source_Id /= No_Other_Source loop 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; exit when Source.File_Name = Main_Id;
Source_Id := Source.Next; Source_Id := Source.Next;
end loop; end loop;
@ -3815,6 +3883,7 @@ package body Makegpr is
(Get_Name_String (Get_Name_String
(Executable_Of (Executable_Of
(Project => Main_Project, (Project => Main_Project,
In_Tree => Project_Tree,
Main => Main_Id, Main => Main_Id,
Index => 0, Index => 0,
Ada_Main => False))); Ada_Main => False)));

52
gcc/ada/makeutl.adb
View File

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

11
gcc/ada/makeutl.ads
View File

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

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

@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
@ -32,6 +32,7 @@ package MLib.Prj is
procedure Build_Library procedure Build_Library
(For_Project : Project_Id; (For_Project : Project_Id;
In_Tree : Project_Tree_Ref;
Gnatbind : String; Gnatbind : String;
Gnatbind_Path : String_Access; Gnatbind_Path : String_Access;
Gcc : String; Gcc : String;
@ -45,7 +46,8 @@ package MLib.Prj is
-- files. If Bind is False the binding of a stand-alone library is skipped. -- files. If Bind is False the binding of a stand-alone library is skipped.
-- If Link is False, the library is not linked/built. -- 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, -- 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 -- because its time-stamp is earlier than the time stamp of one of its
-- object files. -- object files.

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

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

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

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

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

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

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

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

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

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

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

@ -7,7 +7,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- 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 -- -- 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 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 " & Prj.Com.Fail ("INTERNAL ERROR: Library_Exists_For called " &
"for non library project"); "for non library project");
return False; return False;
@ -204,14 +206,16 @@ package body MLib.Tgt is
else else
declare declare
Lib_Dir : constant String := Lib_Dir : constant String :=
Get_Name_String Get_Name_String
(Projects.Table (Project).Library_Dir); (In_Tree.Projects.Table (Project).Library_Dir);
Lib_Name : constant String := Lib_Name : constant String :=
Get_Name_String Get_Name_String
(Projects.Table (Project).Library_Name); (In_Tree.Projects.Table (Project).Library_Name);
begin begin
if Projects.Table (Project).Library_Kind = Static then if In_Tree.Projects.Table (Project).Library_Kind =
Static
then
return Is_Regular_File return Is_Regular_File
(Lib_Dir & Directory_Separator & "lib" & (Lib_Dir & Directory_Separator & "lib" &
MLib.Fil.Ext_To (Lib_Name, Archive_Ext)); MLib.Fil.Ext_To (Lib_Name, Archive_Ext));
@ -229,9 +233,12 @@ package body MLib.Tgt is
-- Library_File_Name_For -- -- 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 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 " & Prj.Com.Fail ("INTERNAL ERROR: Library_File_Name_For called " &
"for non library project"); "for non library project");
return No_Name; return No_Name;
@ -239,10 +246,13 @@ package body MLib.Tgt is
else else
declare declare
Lib_Name : constant String := Lib_Name : constant String :=
Get_Name_String (Projects.Table (Project).Library_Name); Get_Name_String
(In_Tree.Projects.Table (Project).Library_Name);
begin begin
if Projects.Table (Project).Library_Kind = Static then if In_Tree.Projects.Table (Project).Library_Kind =
Static
then
Name_Len := 3; Name_Len := 3;
Name_Buffer (1 .. Name_Len) := "lib"; Name_Buffer (1 .. Name_Len) := "lib";
Add_Str_To_Name_Buffer (Fil.Ext_To (Lib_Name, Archive_Ext)); 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 -- -- 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 -- -- 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- -- -- 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 -- -- 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 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 " & Prj.Com.Fail ("INTERNAL ERROR: Library_Exists_For called " &
"for non library project"); "for non library project");
return False; return False;
@ -273,12 +275,16 @@ package body MLib.Tgt is
else else
declare declare
Lib_Dir : constant String := 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 := Lib_Name : constant String :=
Get_Name_String (Projects.Table (Project).Library_Name); Get_Name_String
(In_Tree.Projects.Table (Project).Library_Name);
begin begin
if Projects.Table (Project).Library_Kind = Static then if In_Tree.Projects.Table (Project).Library_Kind =
Static
then
return Is_Regular_File return Is_Regular_File
(Lib_Dir & Directory_Separator & "lib" & (Lib_Dir & Directory_Separator & "lib" &
Fil.Ext_To (Lib_Name, Archive_Ext)); Fil.Ext_To (Lib_Name, Archive_Ext));
@ -296,9 +302,12 @@ package body MLib.Tgt is
-- Library_File_Name_For -- -- 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 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 " & Prj.Com.Fail ("INTERNAL ERROR: Library_File_Name_For called " &
"for non library project"); "for non library project");
return No_Name; return No_Name;
@ -306,13 +315,16 @@ package body MLib.Tgt is
else else
declare declare
Lib_Name : constant String := Lib_Name : constant String :=
Get_Name_String (Projects.Table (Project).Library_Name); Get_Name_String
(In_Tree.Projects.Table (Project).Library_Name);
begin begin
Name_Len := 3; Name_Len := 3;
Name_Buffer (1 .. Name_Len) := "lib"; 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)); Add_Str_To_Name_Buffer (Fil.Ext_To (Lib_Name, Archive_Ext));
else else

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

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

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

@ -7,7 +7,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- 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 Ada.Characters.Handling; use Ada.Characters.Handling;
with GNAT.Directory_Operations; use GNAT.Directory_Operations; with GNAT.Directory_Operations; use GNAT.Directory_Operations;
with GNAT.OS_Lib; use GNAT.OS_Lib; with GNAT.OS_Lib; use GNAT.OS_Lib;
with MLib.Fil; with MLib.Fil;
with MLib.Utl; with MLib.Utl;
with Namet; use Namet; with Namet; use Namet;
with Opt; use Opt; with Opt; use Opt;
with Output; use Output; with Output; use Output;
with Prj.Com; 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 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 -- Used to add the generated auto-init object files for auto-initializing
-- stand-alone libraries. -- 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 -- The name of the command to invoke the macro-assembler
VMS_Options : Argument_List := (1 .. 1 => null); VMS_Options : Argument_List := (1 .. 1 => null);
@ -72,16 +74,6 @@ package body MLib.Tgt is
Link_With_Shared_Libgcc : Argument_List_Access := Link_With_Shared_Libgcc : Argument_List_Access :=
No_Shared_Libgcc_Switch'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 -- -- Archive_Builder --
--------------------- ---------------------
@ -302,12 +294,12 @@ package body MLib.Tgt is
Len : Natural; Len : Natural;
OK : Boolean := True; OK : Boolean := True;
Command : constant String := command : constant String :=
Macro_Name & " " & Macro_File_Name & ASCII.NUL; Macro_Name & " " & Macro_File_Name & ASCII.NUL;
-- The command to invoke the assembler on the generated auto-init -- The command to invoke the assembler on the generated auto-init
-- assembly file. -- assembly file.
Mode : constant String := "r" & ASCII.NUL; mode : constant String := "r" & ASCII.NUL;
-- The mode for the invocation of Popen -- The mode for the invocation of Popen
begin begin
@ -365,8 +357,8 @@ package body MLib.Tgt is
Write_Line (""""); Write_Line ("""");
end if; end if;
Popen_Result := Popen (Command (Command'First)'Address, Popen_Result := popen (command (command'First)'Address,
Mode (Mode'First)'Address); mode (mode'First)'Address);
if Popen_Result = Null_Address then if Popen_Result = Null_Address then
Fail ("assembly of auto-init assembly file """, 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 -- 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 if Pclose_Result < 0 then
Fail ("assembly of auto init assembly file """, Fail ("assembly of auto init assembly file """,
@ -604,9 +596,11 @@ package body MLib.Tgt is
-- Library_Exists_For -- -- 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 begin
if not Projects.Table (Project).Library then if not In_Tree.Projects.Table (Project).Library then
Fail ("INTERNAL ERROR: Library_Exists_For called " & Fail ("INTERNAL ERROR: Library_Exists_For called " &
"for non library project"); "for non library project");
return False; return False;
@ -614,12 +608,16 @@ package body MLib.Tgt is
else else
declare declare
Lib_Dir : constant String := 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 := Lib_Name : constant String :=
Get_Name_String (Projects.Table (Project).Library_Name); Get_Name_String
(In_Tree.Projects.Table (Project).Library_Name);
begin begin
if Projects.Table (Project).Library_Kind = Static then if In_Tree.Projects.Table (Project).Library_Kind =
Static
then
return Is_Regular_File return Is_Regular_File
(Lib_Dir & Directory_Separator & "lib" & (Lib_Dir & Directory_Separator & "lib" &
Fil.Ext_To (Lib_Name, Archive_Ext)); Fil.Ext_To (Lib_Name, Archive_Ext));
@ -637,9 +635,12 @@ package body MLib.Tgt is
-- Library_File_Name_For -- -- 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 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 " & Prj.Com.Fail ("INTERNAL ERROR: Library_File_Name_For called " &
"for non library project"); "for non library project");
return No_Name; return No_Name;
@ -647,13 +648,16 @@ package body MLib.Tgt is
else else
declare declare
Lib_Name : constant String := Lib_Name : constant String :=
Get_Name_String (Projects.Table (Project).Library_Name); Get_Name_String
(In_Tree.Projects.Table (Project).Library_Name);
begin begin
Name_Len := 3; Name_Len := 3;
Name_Buffer (1 .. Name_Len) := "lib"; 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)); Add_Str_To_Name_Buffer (Fil.Ext_To (Lib_Name, Archive_Ext));
else else

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

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

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

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

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

@ -7,7 +7,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- 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 -- -- 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 (Project);
pragma Unreferenced (In_Tree);
begin begin
return False; return False;
end Library_Exists_For; end Library_Exists_For;
@ -182,8 +185,12 @@ package body MLib.Tgt is
-- Library_File_Name_For -- -- 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 (Project);
pragma Unreferenced (In_Tree);
begin begin
return No_Name; return No_Name;
end Library_File_Name_For; end Library_File_Name_For;

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

@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- 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 -- -- 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- -- -- 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 -- into account. For example, on Linux, Foreign, Afiles Lib_Address and
-- Relocatable are ignored. -- 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. -- Return True if the library file for a library project already exists.
-- This function can only be called for library projects. -- 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. -- Returns the file name of the library file of a library project.
-- This function can only be called for library projects. -- 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 -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
@ -28,6 +28,7 @@
-- There are predefined packages and attributes. -- There are predefined packages and attributes.
-- It is also possible to define new packages with their attributes. -- It is also possible to define new packages with their attributes.
with Table;
with Types; use Types; with Types; use Types;
package Prj.Attr is 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 -- -- 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 -- -- 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- -- -- 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. -- The following package declares data types for GNAT project.
-- These data types are used in the bodies of the Prj hierarchy. -- These data types are used in the bodies of the Prj hierarchy.
with GNAT.HTable;
with Osint; with Osint;
with Table;
with Types; use Types;
package Prj.Com is 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 type Fail_Proc is access procedure
(S1 : String; S2 : String := ""; S3 : String := ""); (S1 : String;
S2 : String := "";
S3 : String := "");
Fail : Fail_Proc := Osint.Fail'Access; Fail : Fail_Proc := Osint.Fail'Access;
-- This procedure is used in the project facility, instead of -- This procedure is used in the project facility, instead of directly
-- directly calling Osint.Fail. -- calling Osint.Fail. It may be specified by tools to do clean up before
-- It may be specified by tools to do clean up before calling -- calling Osint.Fail, or to simply report an error and return.
-- 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
end Prj.Com; 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 -- -- 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 -- -- 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- -- -- 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 private package Prj.Dect is
procedure Parse procedure Parse
(Declarations : out Prj.Tree.Project_Node_Id; (In_Tree : Prj.Tree.Project_Node_Tree_Ref;
Current_Project : Prj.Tree.Project_Node_Id; Declarations : out Prj.Tree.Project_Node_Id;
Extends : Prj.Tree.Project_Node_Id); Current_Project : Prj.Tree.Project_Node_Id;
-- Parse project declarative items. What are parameters ??? 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; 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 -- -- 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 -- -- 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- -- -- 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 package Prj.Env is
procedure Initialize; procedure Initialize;
-- Called by Prj.Initialize to perform required initialization -- Called by Prj.Initialize to perform required initialization steps for
-- steps for this package. -- this package.
procedure Print_Sources; procedure Print_Sources (In_Tree : Project_Tree_Ref);
-- Output the list of sources, after Project files have been scanned -- Output the list of sources, after Project files have been scanned
procedure Create_Mapping_File procedure Create_Mapping_File
(Project : Project_Id; (Project : Project_Id;
In_Tree : Project_Tree_Ref;
Name : out Name_Id); Name : out Name_Id);
-- Create a temporary mapping file for project Project. For each unit -- Create a temporary mapping file for project Project. For each unit
-- in the closure of immediate sources of Project, put the mapping of -- 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 procedure Create_Config_Pragmas_File
(For_Project : Project_Id; (For_Project : Project_Id;
Main_Project : Project_Id; Main_Project : Project_Id;
In_Tree : Project_Tree_Ref;
Include_Config_Files : Boolean := True); Include_Config_Files : Boolean := True);
-- If there needs to have SFN pragmas, either for non standard naming -- If there needs to have SFN pragmas, either for non standard naming
-- schemes or for individual units, or (when Include_Config_Files is True) -- 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 -- a temporary file that contains all configuration pragmas, and specify
-- the configuration pragmas file in the project data. -- 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 -- Get the ADA_INCLUDE_PATH of a Project file. For the first call, compute
-- it and cache it. -- it and cache it.
function Ada_Include_Path function Ada_Include_Path
(Project : Project_Id; (Project : Project_Id;
In_Tree : Project_Tree_Ref;
Recursive : Boolean) return String; Recursive : Boolean) return String;
-- Get the ADA_INCLUDE_PATH of a Project file. If Recursive it True, -- Get the ADA_INCLUDE_PATH of a Project file. If Recursive it True,
-- get all the source directories of the imported and modified project -- get all the source directories of the imported and modified project
@ -76,6 +81,7 @@ package Prj.Env is
function Ada_Objects_Path function Ada_Objects_Path
(Project : Project_Id; (Project : Project_Id;
In_Tree : Project_Tree_Ref;
Including_Libraries : Boolean := True) return String_Access; Including_Libraries : Boolean := True) return String_Access;
-- Get the ADA_OBJECTS_PATH of a Project file. For the first call, compute -- 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 -- 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 procedure Set_Ada_Paths
(Project : Project_Id; (Project : Project_Id;
In_Tree : Project_Tree_Ref;
Including_Libraries : Boolean); Including_Libraries : Boolean);
-- Set the env vars for additional project path files, after -- Set the env vars for additional project path files, after
-- creating the path files if necessary. -- 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 -- Delete all temporary path files that have been created by
-- calls to Set_Ada_Paths. -- calls to Set_Ada_Paths.
function Path_Name_Of_Library_Unit_Body function Path_Name_Of_Library_Unit_Body
(Name : String; (Name : String;
Project : Project_Id) return String; Project : Project_Id;
In_Tree : Project_Tree_Ref) return String;
-- Returns the Path of a library unit -- Returns the Path of a library unit
function File_Name_Of_Library_Unit_Body function File_Name_Of_Library_Unit_Body
(Name : String; (Name : String;
Project : Project_Id; Project : Project_Id;
In_Tree : Project_Tree_Ref;
Main_Project_Only : Boolean := True; Main_Project_Only : Boolean := True;
Full_Path : Boolean := False) return String; Full_Path : Boolean := False) return String;
-- Returns the file name of a library unit, in canonical case. Name may or -- 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 function Project_Of
(Name : String; (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 -- 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 -- (".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 -- extended, return the ultimate extending project. If it is not a source
@ -125,20 +135,25 @@ package Prj.Env is
procedure Get_Reference procedure Get_Reference
(Source_File_Name : String; (Source_File_Name : String;
In_Tree : Project_Tree_Ref;
Project : out Project_Id; Project : out Project_Id;
Path : out Name_Id); Path : out Name_Id);
-- Returns the project of a source and its path in displayable form -- Returns the project of a source and its path in displayable form
generic generic
with procedure Action (Path : String); with procedure Action (Path : String);
procedure For_All_Source_Dirs (Project : Project_Id); procedure For_All_Source_Dirs
-- Iterate through all the source directories of a project, (Project : Project_Id;
-- including those of imported or modified projects. In_Tree : Project_Tree_Ref);
-- Iterate through all the source directories of a project, including
-- those of imported or modified projects.
generic generic
with procedure Action (Path : String); with procedure Action (Path : String);
procedure For_All_Object_Dirs (Project : Project_Id); procedure For_All_Object_Dirs
-- Iterate through all the object directories of a project, (Project : Project_Id;
-- including those of imported or modified projects. In_Tree : Project_Tree_Ref);
-- Iterate through all the object directories of a project, including
-- those of imported or modified projects.
end Prj.Env; end Prj.Env;

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

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

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

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

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

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

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

@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- 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 -- -- 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- -- -- 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 package Prj.Part is
procedure Parse procedure Parse
(Project : out Project_Node_Id; (In_Tree : Project_Node_Tree_Ref;
Project : out Project_Node_Id;
Project_File_Name : String; Project_File_Name : String;
Always_Errout_Finalize : Boolean; Always_Errout_Finalize : Boolean;
Packages_To_Check : String_List_Access := All_Packages; Packages_To_Check : String_List_Access := All_Packages;

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

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

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

@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- 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 -- -- 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- -- -- 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. -- This package is the Project File Pretty Printer.
-- It is used to output a project file from a project file tree. -- 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 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 -- It can also be used for debugging purposes for tools that create project
-- file trees. -- file trees.
@ -46,6 +46,7 @@ package Prj.PP is
procedure Pretty_Print procedure Pretty_Print
(Project : Prj.Tree.Project_Node_Id; (Project : Prj.Tree.Project_Node_Id;
In_Tree : Prj.Tree.Project_Node_Tree_Ref;
Increment : Positive := 3; Increment : Positive := 3;
Eliminate_Empty_Case_Constructions : Boolean := False; Eliminate_Empty_Case_Constructions : Boolean := False;
Minimize_Empty_Lines : 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 -- -- 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 -- -- 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- -- -- 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 package Prj.Proc is
procedure Process procedure Process
(Project : out Project_Id; (In_Tree : Project_Tree_Ref;
Success : out Boolean; Project : out Project_Id;
From_Project_Node : Project_Node_Id; Success : out Boolean;
Report_Error : Put_Line_Access; From_Project_Node : Project_Node_Id;
Follow_Links : Boolean := True); 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. -- Process a project file tree into project file data structures.
-- If Report_Error is null, use the error reporting mechanism. -- If Report_Error is null, use the error reporting mechanism.
-- Otherwise, report errors using Report_Error. -- 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 -- -- 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 -- -- 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- -- -- 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 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. -- Get the list of literal strings that are allowed for a typed string.
-- On entry, the current token is the first literal string following -- On entry, the current token is the first literal string following
-- a left parenthesis in a string type declaration such as: -- a left parenthesis in a string type declaration such as:
@ -45,7 +47,9 @@ private package Prj.Strt is
-- or after a comma -- or after a comma
-- - two literal strings in the list are equal -- - 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 -- This procedure is called at the beginning of a case construction
-- The parameter String_Type is the node for the string type -- The parameter String_Type is the node for the string type
-- of the case label variable. -- of the case label variable.
@ -65,7 +69,8 @@ private package Prj.Strt is
-- not been specified. -- not been specified.
procedure Parse_Choice_List 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. -- Get the label for a choice list.
-- Report an error if -- Report an error if
-- - a case label is not a literal string -- - 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 -- - the same case label is repeated in the same case construction
procedure Parse_Expression 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_Project : Project_Node_Id;
Current_Package : Project_Node_Id; Current_Package : Project_Node_Id;
Optional_Index : Boolean); Optional_Index : Boolean);
@ -85,7 +91,8 @@ private package Prj.Strt is
-- been parsed. -- been parsed.
procedure Parse_Variable_Reference 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_Project : Project_Node_Id;
Current_Package : Project_Node_Id); Current_Package : Project_Node_Id);
-- Parse a variable or attribute reference. -- 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 -- -- 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 -- -- 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- -- -- 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 -- 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 Prj.Attr; use Prj.Attr;
with Table; use Table;
with Types; use Types; with Types; use Types;
package Prj.Tree is 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_Initial : constant := 1_000;
Project_Nodes_Increment : constant := 100; Project_Nodes_Increment : constant := 100;
-- Allocation parameters for initializing and extending number -- 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 -- For the signification of the fields in each node of a
-- Project_Node_Kind, look at package Tree_Private_Part. -- 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 -- Initialize the Project File tree: empty the Project_Nodes table
-- and reset the Projects_Htable. -- and reset the Projects_Htable.
function Default_Project_Node 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; And_Expr_Kind : Variable_Kind := Undefined) return Project_Node_Id;
-- Returns a Project_Node_Record with the specified Kind and -- Returns a Project_Node_Record with the specified Kind and
-- Expr_Kind; all the other components have default nil values. -- Expr_Kind; all the other components have default nil values.
@ -100,6 +106,7 @@ package Prj.Tree is
function Imported_Or_Extended_Project_Of function Imported_Or_Extended_Project_Of
(Project : Project_Node_Id; (Project : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref;
With_Name : Name_Id) return Project_Node_Id; With_Name : Name_Id) return Project_Node_Id;
-- Return the node of a project imported or extended by project Project and -- 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. -- 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"); Table_Name => "Prj.Tree.Comments");
-- A table to store the comments that may be stored is the tree -- 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 -- Scan the tokens and accumulate comments
type Comment_Location is type Comment_Location is
(Before, After, Before_End, After_End, End_Of_Line); (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 -- Add comments to this node
---------------------- ----------------------
@ -186,287 +196,360 @@ package Prj.Tree is
-- The following query functions are part of the abstract interface -- The following query functions are part of the abstract interface
-- of the Project File tree -- 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); pragma Inline (Name_Of);
-- Valid for all non empty nodes. May return No_Name for nodes that have -- Valid for all non empty nodes. May return No_Name for nodes that have
-- no names. -- 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); pragma Inline (Kind_Of);
-- Valid for all non empty nodes -- 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); pragma Inline (Location_Of);
-- Valid for all non empty nodes -- Valid for all non empty nodes
function First_Comment_After 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 -- Valid only for N_Comment_Zones nodes
function First_Comment_After_End 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 -- Valid only for N_Comment_Zones nodes
function First_Comment_Before 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 -- Valid only for N_Comment_Zones nodes
function First_Comment_Before_End 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 -- 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 -- 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 -- 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 -- 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 -- Valid only for N_Comment nodes
function Project_File_Includes_Unkept_Comments function Project_File_Includes_Unkept_Comments
(Node : Project_Node_Id) (Node : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref)
return Boolean; return Boolean;
-- Valid only for N_Project nodes -- 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); pragma Inline (Directory_Of);
-- Only valid for N_Project nodes -- 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); pragma Inline (Expression_Kind_Of);
-- Only valid for N_Literal_String, N_Attribute_Declaration, -- Only valid for N_Literal_String, N_Attribute_Declaration,
-- N_Variable_Declaration, N_Typed_Variable_Declaration, N_Expression, -- N_Variable_Declaration, N_Typed_Variable_Declaration, N_Expression,
-- N_Term, N_Variable_Reference or N_Attribute_Reference nodes. -- 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); pragma Inline (Is_Extending_All);
-- Only valid for N_Project and N_With_Clause -- Only valid for N_Project and N_With_Clause
function First_Variable_Of 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); pragma Inline (First_Variable_Of);
-- Only valid for N_Project or N_Package_Declaration nodes -- Only valid for N_Project or N_Package_Declaration nodes
function First_Package_Of 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); pragma Inline (First_Package_Of);
-- Only valid for N_Project nodes -- 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); pragma Inline (Package_Id_Of);
-- Only valid for N_Package_Declaration nodes -- 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); pragma Inline (Path_Name_Of);
-- Only valid for N_Project and N_With_Clause nodes -- 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); pragma Inline (String_Value_Of);
-- Only valid for N_With_Clause, N_Literal_String nodes or N_Comment -- 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); pragma Inline (Source_Index_Of);
-- Only valid for N_Literal_String and N_Attribute_Declaration nodes -- Only valid for N_Literal_String and N_Attribute_Declaration nodes
function First_With_Clause_Of 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); pragma Inline (First_With_Clause_Of);
-- Only valid for N_Project nodes -- Only valid for N_Project nodes
function Project_Declaration_Of 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); pragma Inline (Project_Declaration_Of);
-- Only valid for N_Project nodes -- Only valid for N_Project nodes
function Extending_Project_Of 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); pragma Inline (Extending_Project_Of);
-- Only valid for N_Project_Declaration nodes -- Only valid for N_Project_Declaration nodes
function First_String_Type_Of 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); pragma Inline (First_String_Type_Of);
-- Only valid for N_Project nodes -- Only valid for N_Project nodes
function Extended_Project_Path_Of 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); pragma Inline (Extended_Project_Path_Of);
-- Only valid for N_With_Clause nodes -- Only valid for N_With_Clause nodes
function Project_Node_Of 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); pragma Inline (Project_Node_Of);
-- Only valid for N_With_Clause, N_Variable_Reference and -- Only valid for N_With_Clause, N_Variable_Reference and
-- N_Attribute_Reference nodes. -- N_Attribute_Reference nodes.
function Non_Limited_Project_Node_Of 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); pragma Inline (Non_Limited_Project_Node_Of);
-- Only valid for N_With_Clause nodes. Returns Empty_Node for limited -- Only valid for N_With_Clause nodes. Returns Empty_Node for limited
-- imported project files, otherwise returns the same result as -- imported project files, otherwise returns the same result as
-- Project_Node_Of. -- Project_Node_Of.
function Next_With_Clause_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); pragma Inline (Next_With_Clause_Of);
-- Only valid for N_With_Clause nodes -- Only valid for N_With_Clause nodes
function First_Declarative_Item_Of 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); pragma Inline (First_Declarative_Item_Of);
-- Only valid for N_With_Clause nodes -- Only valid for N_With_Clause nodes
function Extended_Project_Of 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); pragma Inline (Extended_Project_Of);
-- Only valid for N_Project_Declaration nodes -- Only valid for N_Project_Declaration nodes
function Current_Item_Node 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); pragma Inline (Current_Item_Node);
-- Only valid for N_Declarative_Item nodes -- Only valid for N_Declarative_Item nodes
function Next_Declarative_Item 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); pragma Inline (Next_Declarative_Item);
-- Only valid for N_Declarative_Item node -- Only valid for N_Declarative_Item node
function Project_Of_Renamed_Package_Of 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); pragma Inline (Project_Of_Renamed_Package_Of);
-- Only valid for N_Package_Declaration nodes. -- Only valid for N_Package_Declaration nodes.
-- May return Empty_Node. -- May return Empty_Node.
function Next_Package_In_Project 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); pragma Inline (Next_Package_In_Project);
-- Only valid for N_Package_Declaration nodes -- Only valid for N_Package_Declaration nodes
function First_Literal_String 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); pragma Inline (First_Literal_String);
-- Only valid for N_String_Type_Declaration nodes -- Only valid for N_String_Type_Declaration nodes
function Next_String_Type 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); pragma Inline (Next_String_Type);
-- Only valid for N_String_Type_Declaration nodes -- Only valid for N_String_Type_Declaration nodes
function Next_Literal_String 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); pragma Inline (Next_Literal_String);
-- Only valid for N_Literal_String nodes -- Only valid for N_Literal_String nodes
function Expression_Of 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); pragma Inline (Expression_Of);
-- Only valid for N_Attribute_Declaration, N_Typed_Variable_Declaration -- Only valid for N_Attribute_Declaration, N_Typed_Variable_Declaration
-- or N_Variable_Declaration nodes -- or N_Variable_Declaration nodes
function Associative_Project_Of function Associative_Project_Of
(Node : Project_Node_Id) (Node : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref)
return Project_Node_Id; return Project_Node_Id;
pragma Inline (Associative_Project_Of); pragma Inline (Associative_Project_Of);
-- Only valid for N_Attribute_Declaration nodes -- Only valid for N_Attribute_Declaration nodes
function Associative_Package_Of function Associative_Package_Of
(Node : Project_Node_Id) (Node : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref)
return Project_Node_Id; return Project_Node_Id;
pragma Inline (Associative_Package_Of); pragma Inline (Associative_Package_Of);
-- Only valid for N_Attribute_Declaration nodes -- Only valid for N_Attribute_Declaration nodes
function Value_Is_Valid function Value_Is_Valid
(For_Typed_Variable : Project_Node_Id; (For_Typed_Variable : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref;
Value : Name_Id) return Boolean; Value : Name_Id) return Boolean;
pragma Inline (Value_Is_Valid); pragma Inline (Value_Is_Valid);
-- Only valid for N_Typed_Variable_Declaration. Returns True if Value is -- Only valid for N_Typed_Variable_Declaration. Returns True if Value is
-- in the list of allowed strings for For_Typed_Variable. False otherwise. -- in the list of allowed strings for For_Typed_Variable. False otherwise.
function Associative_Array_Index_Of 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); pragma Inline (Associative_Array_Index_Of);
-- Only valid for N_Attribute_Declaration and N_Attribute_Reference. -- Only valid for N_Attribute_Declaration and N_Attribute_Reference.
-- Returns No_String for non associative array attributes. -- Returns No_String for non associative array attributes.
function Next_Variable 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); pragma Inline (Next_Variable);
-- Only valid for N_Typed_Variable_Declaration or N_Variable_Declaration -- Only valid for N_Typed_Variable_Declaration or N_Variable_Declaration
-- nodes. -- nodes.
function First_Term 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); pragma Inline (First_Term);
-- Only valid for N_Expression nodes -- Only valid for N_Expression nodes
function Next_Expression_In_List 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); pragma Inline (Next_Expression_In_List);
-- Only valid for N_Expression nodes -- Only valid for N_Expression nodes
function Current_Term 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); pragma Inline (Current_Term);
-- Only valid for N_Term nodes -- Only valid for N_Term nodes
function Next_Term 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); pragma Inline (Next_Term);
-- Only valid for N_Term nodes -- Only valid for N_Term nodes
function First_Expression_In_List 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); pragma Inline (First_Expression_In_List);
-- Only valid for N_Literal_String_List nodes -- Only valid for N_Literal_String_List nodes
function Package_Node_Of 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); pragma Inline (Package_Node_Of);
-- Only valid for N_Variable_Reference or N_Attribute_Reference nodes. -- Only valid for N_Variable_Reference or N_Attribute_Reference nodes.
-- May return Empty_Node. -- May return Empty_Node.
function String_Type_Of 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); pragma Inline (String_Type_Of);
-- Only valid for N_Variable_Reference or N_Typed_Variable_Declaration -- Only valid for N_Variable_Reference or N_Typed_Variable_Declaration
-- nodes. -- nodes.
function External_Reference_Of 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); pragma Inline (External_Reference_Of);
-- Only valid for N_External_Value nodes -- Only valid for N_External_Value nodes
function External_Default_Of 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); pragma Inline (External_Default_Of);
-- Only valid for N_External_Value nodes -- Only valid for N_External_Value nodes
function Case_Variable_Reference_Of 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); pragma Inline (Case_Variable_Reference_Of);
-- Only valid for N_Case_Construction nodes -- Only valid for N_Case_Construction nodes
function First_Case_Item_Of 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); pragma Inline (First_Case_Item_Of);
-- Only valid for N_Case_Construction nodes -- Only valid for N_Case_Construction nodes
function First_Choice_Of 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); pragma Inline (First_Choice_Of);
-- Return the first choice in a N_Case_Item, or Empty_Node if -- Return the first choice in a N_Case_Item, or Empty_Node if
-- this is when others. -- this is when others.
function Next_Case_Item 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); pragma Inline (Next_Case_Item);
-- Only valid for N_Case_Item nodes -- 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 -- 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. -- nodes as the corresponding query function above.
procedure Set_Name_Of procedure Set_Name_Of
(Node : Project_Node_Id; (Node : Project_Node_Id;
To : Name_Id); In_Tree : Project_Node_Tree_Ref;
To : Name_Id);
pragma Inline (Set_Name_Of); pragma Inline (Set_Name_Of);
procedure Set_Kind_Of procedure Set_Kind_Of
(Node : Project_Node_Id; (Node : Project_Node_Id;
To : Project_Node_Kind); In_Tree : Project_Node_Tree_Ref;
To : Project_Node_Kind);
pragma Inline (Set_Kind_Of); pragma Inline (Set_Kind_Of);
procedure Set_Location_Of procedure Set_Location_Of
(Node : Project_Node_Id; (Node : Project_Node_Id;
To : Source_Ptr); In_Tree : Project_Node_Tree_Ref;
To : Source_Ptr);
pragma Inline (Set_Location_Of); pragma Inline (Set_Location_Of);
procedure Set_First_Comment_After procedure Set_First_Comment_After
(Node : Project_Node_Id; (Node : Project_Node_Id;
To : Project_Node_Id); In_Tree : Project_Node_Tree_Ref;
To : Project_Node_Id);
pragma Inline (Set_First_Comment_After); pragma Inline (Set_First_Comment_After);
procedure Set_First_Comment_After_End procedure Set_First_Comment_After_End
(Node : Project_Node_Id; (Node : Project_Node_Id;
To : Project_Node_Id); In_Tree : Project_Node_Tree_Ref;
To : Project_Node_Id);
pragma Inline (Set_First_Comment_After_End); pragma Inline (Set_First_Comment_After_End);
procedure Set_First_Comment_Before procedure Set_First_Comment_Before
(Node : Project_Node_Id; (Node : Project_Node_Id;
To : Project_Node_Id); In_Tree : Project_Node_Tree_Ref;
To : Project_Node_Id);
pragma Inline (Set_First_Comment_Before); pragma Inline (Set_First_Comment_Before);
procedure Set_First_Comment_Before_End procedure Set_First_Comment_Before_End
(Node : Project_Node_Id; (Node : Project_Node_Id;
To : Project_Node_Id); In_Tree : Project_Node_Tree_Ref;
To : Project_Node_Id);
pragma Inline (Set_First_Comment_Before_End); pragma Inline (Set_First_Comment_Before_End);
procedure Set_Next_Comment procedure Set_Next_Comment
(Node : Project_Node_Id; (Node : Project_Node_Id;
To : Project_Node_Id); In_Tree : Project_Node_Tree_Ref;
To : Project_Node_Id);
pragma Inline (Set_Next_Comment); pragma Inline (Set_Next_Comment);
procedure Set_Project_File_Includes_Unkept_Comments procedure Set_Project_File_Includes_Unkept_Comments
(Node : Project_Node_Id; (Node : Project_Node_Id;
To : Boolean); In_Tree : Project_Node_Tree_Ref;
To : Boolean);
procedure Set_Directory_Of procedure Set_Directory_Of
(Node : Project_Node_Id; (Node : Project_Node_Id;
To : Name_Id); In_Tree : Project_Node_Tree_Ref;
To : Name_Id);
pragma Inline (Set_Directory_Of); pragma Inline (Set_Directory_Of);
procedure Set_Expression_Kind_Of procedure Set_Expression_Kind_Of
(Node : Project_Node_Id; (Node : Project_Node_Id;
To : Variable_Kind); In_Tree : Project_Node_Tree_Ref;
To : Variable_Kind);
pragma Inline (Set_Expression_Kind_Of); 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); pragma Inline (Set_Is_Extending_All);
procedure Set_First_Variable_Of procedure Set_First_Variable_Of
(Node : Project_Node_Id; (Node : Project_Node_Id;
To : Variable_Node_Id); In_Tree : Project_Node_Tree_Ref;
To : Variable_Node_Id);
pragma Inline (Set_First_Variable_Of); pragma Inline (Set_First_Variable_Of);
procedure Set_First_Package_Of procedure Set_First_Package_Of
(Node : Project_Node_Id; (Node : Project_Node_Id;
To : Package_Declaration_Id); In_Tree : Project_Node_Tree_Ref;
To : Package_Declaration_Id);
pragma Inline (Set_First_Package_Of); pragma Inline (Set_First_Package_Of);
procedure Set_Package_Id_Of procedure Set_Package_Id_Of
(Node : Project_Node_Id; (Node : Project_Node_Id;
To : Package_Node_Id); In_Tree : Project_Node_Tree_Ref;
To : Package_Node_Id);
pragma Inline (Set_Package_Id_Of); pragma Inline (Set_Package_Id_Of);
procedure Set_Path_Name_Of procedure Set_Path_Name_Of
(Node : Project_Node_Id; (Node : Project_Node_Id;
To : Name_Id); In_Tree : Project_Node_Tree_Ref;
To : Name_Id);
pragma Inline (Set_Path_Name_Of); pragma Inline (Set_Path_Name_Of);
procedure Set_String_Value_Of procedure Set_String_Value_Of
(Node : Project_Node_Id; (Node : Project_Node_Id;
To : Name_Id); In_Tree : Project_Node_Tree_Ref;
To : Name_Id);
pragma Inline (Set_String_Value_Of); pragma Inline (Set_String_Value_Of);
procedure Set_First_With_Clause_Of procedure Set_First_With_Clause_Of
(Node : Project_Node_Id; (Node : Project_Node_Id;
To : Project_Node_Id); In_Tree : Project_Node_Tree_Ref;
To : Project_Node_Id);
pragma Inline (Set_First_With_Clause_Of); pragma Inline (Set_First_With_Clause_Of);
procedure Set_Project_Declaration_Of procedure Set_Project_Declaration_Of
(Node : Project_Node_Id; (Node : Project_Node_Id;
To : Project_Node_Id); In_Tree : Project_Node_Tree_Ref;
To : Project_Node_Id);
pragma Inline (Set_Project_Declaration_Of); pragma Inline (Set_Project_Declaration_Of);
procedure Set_Extending_Project_Of procedure Set_Extending_Project_Of
(Node : Project_Node_Id; (Node : Project_Node_Id;
To : Project_Node_Id); In_Tree : Project_Node_Tree_Ref;
To : Project_Node_Id);
pragma Inline (Set_Extending_Project_Of); pragma Inline (Set_Extending_Project_Of);
procedure Set_First_String_Type_Of procedure Set_First_String_Type_Of
(Node : Project_Node_Id; (Node : Project_Node_Id;
To : Project_Node_Id); In_Tree : Project_Node_Tree_Ref;
To : Project_Node_Id);
pragma Inline (Set_First_String_Type_Of); pragma Inline (Set_First_String_Type_Of);
procedure Set_Extended_Project_Path_Of procedure Set_Extended_Project_Path_Of
(Node : Project_Node_Id; (Node : Project_Node_Id;
To : Name_Id); In_Tree : Project_Node_Tree_Ref;
To : Name_Id);
pragma Inline (Set_Extended_Project_Path_Of); pragma Inline (Set_Extended_Project_Path_Of);
procedure Set_Project_Node_Of procedure Set_Project_Node_Of
(Node : Project_Node_Id; (Node : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref;
To : Project_Node_Id; To : Project_Node_Id;
Limited_With : Boolean := False); Limited_With : Boolean := False);
pragma Inline (Set_Project_Node_Of); pragma Inline (Set_Project_Node_Of);
procedure Set_Next_With_Clause_Of procedure Set_Next_With_Clause_Of
(Node : Project_Node_Id; (Node : Project_Node_Id;
To : Project_Node_Id); In_Tree : Project_Node_Tree_Ref;
To : Project_Node_Id);
pragma Inline (Set_Next_With_Clause_Of); pragma Inline (Set_Next_With_Clause_Of);
procedure Set_First_Declarative_Item_Of procedure Set_First_Declarative_Item_Of
(Node : Project_Node_Id; (Node : Project_Node_Id;
To : Project_Node_Id); In_Tree : Project_Node_Tree_Ref;
To : Project_Node_Id);
pragma Inline (Set_First_Declarative_Item_Of); pragma Inline (Set_First_Declarative_Item_Of);
procedure Set_Extended_Project_Of procedure Set_Extended_Project_Of
(Node : Project_Node_Id; (Node : Project_Node_Id;
To : Project_Node_Id); In_Tree : Project_Node_Tree_Ref;
To : Project_Node_Id);
pragma Inline (Set_Extended_Project_Of); pragma Inline (Set_Extended_Project_Of);
procedure Set_Current_Item_Node procedure Set_Current_Item_Node
(Node : Project_Node_Id; (Node : Project_Node_Id;
To : Project_Node_Id); In_Tree : Project_Node_Tree_Ref;
To : Project_Node_Id);
pragma Inline (Set_Current_Item_Node); pragma Inline (Set_Current_Item_Node);
procedure Set_Next_Declarative_Item procedure Set_Next_Declarative_Item
(Node : Project_Node_Id; (Node : Project_Node_Id;
To : Project_Node_Id); In_Tree : Project_Node_Tree_Ref;
To : Project_Node_Id);
pragma Inline (Set_Next_Declarative_Item); pragma Inline (Set_Next_Declarative_Item);
procedure Set_Project_Of_Renamed_Package_Of procedure Set_Project_Of_Renamed_Package_Of
(Node : Project_Node_Id; (Node : Project_Node_Id;
To : Project_Node_Id); In_Tree : Project_Node_Tree_Ref;
To : Project_Node_Id);
pragma Inline (Set_Project_Of_Renamed_Package_Of); pragma Inline (Set_Project_Of_Renamed_Package_Of);
procedure Set_Next_Package_In_Project procedure Set_Next_Package_In_Project
(Node : Project_Node_Id; (Node : Project_Node_Id;
To : Project_Node_Id); In_Tree : Project_Node_Tree_Ref;
To : Project_Node_Id);
pragma Inline (Set_Next_Package_In_Project); pragma Inline (Set_Next_Package_In_Project);
procedure Set_First_Literal_String procedure Set_First_Literal_String
(Node : Project_Node_Id; (Node : Project_Node_Id;
To : Project_Node_Id); In_Tree : Project_Node_Tree_Ref;
To : Project_Node_Id);
pragma Inline (Set_First_Literal_String); pragma Inline (Set_First_Literal_String);
procedure Set_Next_String_Type procedure Set_Next_String_Type
(Node : Project_Node_Id; (Node : Project_Node_Id;
To : Project_Node_Id); In_Tree : Project_Node_Tree_Ref;
To : Project_Node_Id);
pragma Inline (Set_Next_String_Type); pragma Inline (Set_Next_String_Type);
procedure Set_Next_Literal_String procedure Set_Next_Literal_String
(Node : Project_Node_Id; (Node : Project_Node_Id;
To : Project_Node_Id); In_Tree : Project_Node_Tree_Ref;
To : Project_Node_Id);
pragma Inline (Set_Next_Literal_String); pragma Inline (Set_Next_Literal_String);
procedure Set_Expression_Of procedure Set_Expression_Of
(Node : Project_Node_Id; (Node : Project_Node_Id;
To : Project_Node_Id); In_Tree : Project_Node_Tree_Ref;
To : Project_Node_Id);
pragma Inline (Set_Expression_Of); pragma Inline (Set_Expression_Of);
procedure Set_Associative_Project_Of procedure Set_Associative_Project_Of
(Node : Project_Node_Id; (Node : Project_Node_Id;
To : Project_Node_Id); In_Tree : Project_Node_Tree_Ref;
To : Project_Node_Id);
pragma Inline (Set_Associative_Project_Of); pragma Inline (Set_Associative_Project_Of);
procedure Set_Associative_Package_Of procedure Set_Associative_Package_Of
(Node : Project_Node_Id; (Node : Project_Node_Id;
To : Project_Node_Id); In_Tree : Project_Node_Tree_Ref;
To : Project_Node_Id);
pragma Inline (Set_Associative_Package_Of); pragma Inline (Set_Associative_Package_Of);
procedure Set_Associative_Array_Index_Of procedure Set_Associative_Array_Index_Of
(Node : Project_Node_Id; (Node : Project_Node_Id;
To : Name_Id); In_Tree : Project_Node_Tree_Ref;
To : Name_Id);
pragma Inline (Set_Associative_Array_Index_Of); pragma Inline (Set_Associative_Array_Index_Of);
procedure Set_Next_Variable procedure Set_Next_Variable
(Node : Project_Node_Id; (Node : Project_Node_Id;
To : Project_Node_Id); In_Tree : Project_Node_Tree_Ref;
To : Project_Node_Id);
pragma Inline (Set_Next_Variable); pragma Inline (Set_Next_Variable);
procedure Set_First_Term procedure Set_First_Term
(Node : Project_Node_Id; (Node : Project_Node_Id;
To : Project_Node_Id); In_Tree : Project_Node_Tree_Ref;
To : Project_Node_Id);
pragma Inline (Set_First_Term); pragma Inline (Set_First_Term);
procedure Set_Next_Expression_In_List procedure Set_Next_Expression_In_List
(Node : Project_Node_Id; (Node : Project_Node_Id;
To : Project_Node_Id); In_Tree : Project_Node_Tree_Ref;
To : Project_Node_Id);
pragma Inline (Set_Next_Expression_In_List); pragma Inline (Set_Next_Expression_In_List);
procedure Set_Current_Term procedure Set_Current_Term
(Node : Project_Node_Id; (Node : Project_Node_Id;
To : Project_Node_Id); In_Tree : Project_Node_Tree_Ref;
To : Project_Node_Id);
pragma Inline (Set_Current_Term); pragma Inline (Set_Current_Term);
procedure Set_Next_Term procedure Set_Next_Term
(Node : Project_Node_Id; (Node : Project_Node_Id;
To : Project_Node_Id); In_Tree : Project_Node_Tree_Ref;
To : Project_Node_Id);
pragma Inline (Set_Next_Term); pragma Inline (Set_Next_Term);
procedure Set_First_Expression_In_List procedure Set_First_Expression_In_List
(Node : Project_Node_Id; (Node : Project_Node_Id;
To : Project_Node_Id); In_Tree : Project_Node_Tree_Ref;
To : Project_Node_Id);
pragma Inline (Set_First_Expression_In_List); pragma Inline (Set_First_Expression_In_List);
procedure Set_Package_Node_Of procedure Set_Package_Node_Of
(Node : Project_Node_Id; (Node : Project_Node_Id;
To : Project_Node_Id); In_Tree : Project_Node_Tree_Ref;
To : Project_Node_Id);
pragma Inline (Set_Package_Node_Of); pragma Inline (Set_Package_Node_Of);
procedure Set_Source_Index_Of procedure Set_Source_Index_Of
(Node : Project_Node_Id; (Node : Project_Node_Id;
To : Int); In_Tree : Project_Node_Tree_Ref;
To : Int);
pragma Inline (Set_Source_Index_Of); pragma Inline (Set_Source_Index_Of);
procedure Set_String_Type_Of procedure Set_String_Type_Of
(Node : Project_Node_Id; (Node : Project_Node_Id;
To : Project_Node_Id); In_Tree : Project_Node_Tree_Ref;
To : Project_Node_Id);
pragma Inline (Set_String_Type_Of); pragma Inline (Set_String_Type_Of);
procedure Set_External_Reference_Of procedure Set_External_Reference_Of
(Node : Project_Node_Id; (Node : Project_Node_Id;
To : Project_Node_Id); In_Tree : Project_Node_Tree_Ref;
To : Project_Node_Id);
pragma Inline (Set_External_Reference_Of); pragma Inline (Set_External_Reference_Of);
procedure Set_External_Default_Of procedure Set_External_Default_Of
(Node : Project_Node_Id; (Node : Project_Node_Id;
To : Project_Node_Id); In_Tree : Project_Node_Tree_Ref;
To : Project_Node_Id);
pragma Inline (Set_External_Default_Of); pragma Inline (Set_External_Default_Of);
procedure Set_Case_Variable_Reference_Of procedure Set_Case_Variable_Reference_Of
(Node : Project_Node_Id; (Node : Project_Node_Id;
To : Project_Node_Id); In_Tree : Project_Node_Tree_Ref;
To : Project_Node_Id);
pragma Inline (Set_Case_Variable_Reference_Of); pragma Inline (Set_Case_Variable_Reference_Of);
procedure Set_First_Case_Item_Of procedure Set_First_Case_Item_Of
(Node : Project_Node_Id; (Node : Project_Node_Id;
To : Project_Node_Id); In_Tree : Project_Node_Tree_Ref;
To : Project_Node_Id);
pragma Inline (Set_First_Case_Item_Of); pragma Inline (Set_First_Case_Item_Of);
procedure Set_First_Choice_Of procedure Set_First_Choice_Of
(Node : Project_Node_Id; (Node : Project_Node_Id;
To : Project_Node_Id); In_Tree : Project_Node_Tree_Ref;
To : Project_Node_Id);
pragma Inline (Set_First_Choice_Of); pragma Inline (Set_First_Choice_Of);
procedure Set_Next_Case_Item procedure Set_Next_Case_Item
(Node : Project_Node_Id; (Node : Project_Node_Id;
To : Project_Node_Id); In_Tree : Project_Node_Tree_Ref;
To : Project_Node_Id);
pragma Inline (Set_Next_Case_Item); pragma Inline (Set_Next_Case_Item);
procedure Set_Case_Insensitive procedure Set_Case_Insensitive
(Node : Project_Node_Id; (Node : Project_Node_Id;
To : Boolean); In_Tree : Project_Node_Tree_Ref;
To : Boolean);
------------------------------- -------------------------------
-- Restricted Access Section -- -- Restricted Access Section --
@ -1028,13 +1165,13 @@ package Prj.Tree is
-- -- Flag2: comment is followed by an empty line -- -- Flag2: comment is followed by an empty line
-- -- Comments: next comment -- -- Comments: next comment
package Project_Nodes is package Project_Node_Table is
new Table.Table (Table_Component_Type => Project_Node_Record, new GNAT.Dynamic_Tables
Table_Index_Type => Project_Node_Id, (Table_Component_Type => Project_Node_Record,
Table_Low_Bound => First_Node_Id, Table_Index_Type => Project_Node_Id,
Table_Initial => Project_Nodes_Initial, Table_Low_Bound => First_Node_Id,
Table_Increment => Project_Nodes_Increment, Table_Initial => Project_Nodes_Initial,
Table_Name => "Project_Nodes"); Table_Increment => Project_Nodes_Increment);
-- This table contains the syntactic tree of project data -- This table contains the syntactic tree of project data
-- from project files. -- from project files.
@ -1058,7 +1195,7 @@ package Prj.Tree is
Canonical_Path => No_Name, Canonical_Path => No_Name,
Extended => True); 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, (Header_Num => Header_Num,
Element => Project_Name_And_Node, Element => Project_Name_And_Node,
No_Element => No_Project_Name_And_Node, No_Element => No_Project_Name_And_Node,
@ -1073,6 +1210,12 @@ package Prj.Tree is
end Tree_Private_Part; 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 private
type Comment_Array is array (Positive range <>) of Comment_Data; type Comment_Array is array (Positive range <>) of Comment_Data;
type Comments_Ptr is access Comment_Array; type Comments_Ptr is access Comment_Array;

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

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

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

@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
@ -34,6 +34,7 @@ package Prj.Util is
function Executable_Of function Executable_Of
(Project : Project_Id; (Project : Project_Id;
In_Tree : Project_Tree_Ref;
Main : Name_Id; Main : Name_Id;
Index : Int; Index : Int;
Ada_Main : Boolean := True) return Name_Id; Ada_Main : Boolean := True) return Name_Id;
@ -51,7 +52,8 @@ package Prj.Util is
function Value_Of function Value_Of
(Index : Name_Id; (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 -- 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 -- component Index, if In_Array is null, or if the component is a String
-- list. Depending on the attribute (only attributes may be associative -- list. Depending on the attribute (only attributes may be associative
@ -62,7 +64,8 @@ package Prj.Util is
function Value_Of function Value_Of
(Index : Name_Id; (Index : Name_Id;
Src_Index : Int := 0; 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). -- Get a string array component (single String or String list).
-- Returns Nil_Variable_Value if there is no component Index -- Returns Nil_Variable_Value if there is no component Index
-- or if In_Array is null. -- or if In_Array is null.
@ -76,7 +79,8 @@ package Prj.Util is
(Name : Name_Id; (Name : Name_Id;
Index : Int := 0; Index : Int := 0;
Attribute_Or_Array_Name : Name_Id; 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, -- In a specific package,
-- - if there exists an array Attribute_Or_Array_Name with an index -- - if there exists an array Attribute_Or_Array_Name with an index
-- Name, returns the corresponding component (depending on the -- Name, returns the corresponding component (depending on the
@ -90,28 +94,32 @@ package Prj.Util is
function Value_Of function Value_Of
(Index : Name_Id; (Index : Name_Id;
In_Array : 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. -- 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 -- 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. -- In_Array is not found in In_Arrays or if the component is a String list.
function Value_Of function Value_Of
(Name : Name_Id; (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 -- 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 -- 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. -- In_Arrays. The caller must ensure that Name is in lower case.
function Value_Of function Value_Of
(Name : Name_Id; (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 -- 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 -- 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. -- Package_List. The caller must ensure that Name is in lower case.
function Value_Of function Value_Of
(Variable_Name : Name_Id; (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 -- 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 -- 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. -- 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 -- -- 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 -- -- 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- -- -- 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 Output; use Output;
with Osint; use Osint; with Osint; use Osint;
with Prj.Attr; with Prj.Attr;
with Prj.Com;
with Prj.Env; with Prj.Env;
with Prj.Err; use Prj.Err; with Prj.Err; use Prj.Err;
with Scans; use Scans; with Scans; use Scans;
@ -42,10 +41,18 @@ with GNAT.OS_Lib; use GNAT.OS_Lib;
package body Prj is package body Prj is
Initial_Buffer_Size : constant := 100;
-- Initial size for extensible buffer used in Add_To_Buffer
The_Empty_String : Name_Id; The_Empty_String : Name_Id;
Name_C_Plus_Plus : 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; subtype Known_Casing is Casing_Type range All_Upper_Case .. Mixed_Case;
The_Casing_Images : constant array (Known_Casing) of String_Access := The_Casing_Images : constant array (Known_Casing) of String_Access :=
@ -77,7 +84,7 @@ package body Prj is
Specification_Exceptions => No_Array_Element, Specification_Exceptions => No_Array_Element,
Implementation_Exceptions => No_Array_Element); Implementation_Exceptions => No_Array_Element);
Project_Empty : constant Project_Data := Project_Empty : Project_Data :=
(Externally_Built => False, (Externally_Built => False,
Languages => No_Languages, Languages => No_Languages,
Supp_Languages => No_Supp_Language_Index, Supp_Languages => No_Supp_Language_Index,
@ -157,26 +164,53 @@ package body Prj is
-- Add_To_Buffer -- -- 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 begin
-- If Buffer is too small, double its size if To = null then
To := new String (1 .. Initial_Buffer_Size);
if Buffer_Last + S'Length > Buffer'Last then Last := 0;
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;
end if; end if;
Buffer (Buffer_Last + 1 .. Buffer_Last + S'Length) := S; -- If Buffer is too small, double its size
Buffer_Last := Buffer_Last + S'Length;
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; 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 -- -- Display_Language_Name --
--------------------------- ---------------------------
@ -192,10 +226,12 @@ package body Prj is
-- Empty_Project -- -- 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 begin
Prj.Initialize; Prj.Initialize (Tree => No_Project_Tree);
return Project_Empty; Value.Naming := Tree.Private_Part.Default_Naming;
return Value;
end Empty_Project; end Empty_Project;
------------------ ------------------
@ -224,41 +260,45 @@ package body Prj is
procedure For_Every_Project_Imported procedure For_Every_Project_Imported
(By : Project_Id; (By : Project_Id;
In_Tree : Project_Tree_Ref;
With_State : in out State) With_State : in out State)
is 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 -- Check if a project has already been seen. If not seen, mark it as
-- Seen, Call Action, and check all its imported projects. -- 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; List : Project_List;
begin begin
if not Projects.Table (Project).Seen then if not In_Tree.Projects.Table (Project).Seen then
Projects.Table (Project).Seen := True; In_Tree.Projects.Table (Project).Seen := True;
Action (Project, With_State); Action (Project, With_State);
List := Projects.Table (Project).Imported_Projects; List :=
In_Tree.Projects.Table (Project).Imported_Projects;
while List /= Empty_Project_List loop while List /= Empty_Project_List loop
Check (Project_Lists.Table (List).Project); Recursive_Check (In_Tree.Project_Lists.Table (List).Project);
List := Project_Lists.Table (List).Next; List := In_Tree.Project_Lists.Table (List).Next;
end loop; end loop;
end if; end if;
end Check; end Recursive_Check;
-- Start of procecessing for For_Every_Project_Imported -- Start of processing for For_Every_Project_Imported
begin begin
for Project in Projects.First .. Projects.Last loop for Project in Project_Table.First ..
Projects.Table (Project).Seen := False; Project_Table.Last (In_Tree.Projects)
loop
In_Tree.Projects.Table (Project).Seen := False;
end loop; end loop;
Check (Project => By); Recursive_Check (Project => By);
end For_Every_Project_Imported; end For_Every_Project_Imported;
---------- ----------
@ -283,7 +323,7 @@ package body Prj is
-- Initialize -- -- Initialize --
---------------- ----------------
procedure Initialize is procedure Initialize (Tree : Project_Tree_Ref) is
begin begin
if not Initialized then if not Initialized then
Initialized := True; Initialized := True;
@ -293,24 +333,21 @@ package body Prj is
Empty_Name := The_Empty_String; Empty_Name := The_Empty_String;
Name_Len := 4; Name_Len := 4;
Name_Buffer (1 .. 4) := ".ads"; Name_Buffer (1 .. 4) := ".ads";
Default_Ada_Spec_Suffix := Name_Find; Default_Ada_Spec_Suffix_Id := Name_Find;
Name_Len := 4; Name_Len := 4;
Name_Buffer (1 .. 4) := ".adb"; Name_Buffer (1 .. 4) := ".adb";
Default_Ada_Body_Suffix := Name_Find; Default_Ada_Body_Suffix_Id := Name_Find;
Name_Len := 1; Name_Len := 1;
Name_Buffer (1) := '/'; Name_Buffer (1) := '/';
Slash := Name_Find; Slash_Id := Name_Find;
Name_Len := 3; Name_Len := 3;
Name_Buffer (1 .. 3) := "c++"; Name_Buffer (1 .. 3) := "c++";
Name_C_Plus_Plus := Name_Find; Name_C_Plus_Plus := Name_Find;
Std_Naming_Data.Ada_Spec_Suffix := Default_Ada_Spec_Suffix; Std_Naming_Data.Ada_Spec_Suffix := Default_Ada_Spec_Suffix;
Std_Naming_Data.Ada_Body_Suffix := Default_Ada_Body_Suffix; Std_Naming_Data.Ada_Body_Suffix := Default_Ada_Body_Suffix;
Std_Naming_Data.Separate_Suffix := Default_Ada_Body_Suffix; Std_Naming_Data.Separate_Suffix := Default_Ada_Body_Suffix;
Register_Default_Naming_Scheme Project_Empty.Naming := Std_Naming_Data;
(Language => Name_Ada,
Default_Spec_Suffix => Default_Ada_Spec_Suffix,
Default_Body_Suffix => Default_Ada_Body_Suffix);
Prj.Env.Initialize; Prj.Env.Initialize;
Prj.Attr.Initialize; Prj.Attr.Initialize;
Set_Name_Table_Byte (Name_Project, Token_Type'Pos (Tok_Project)); 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);
Add_Language_Name (Name_C_Plus_Plus); Add_Language_Name (Name_C_Plus_Plus);
end if; end if;
if Tree /= No_Project_Tree then
Reset (Tree);
end if;
end Initialize; end Initialize;
---------------- ----------------
@ -332,7 +373,8 @@ package body Prj is
function Is_Present function Is_Present
(Language : Language_Index; (Language : Language_Index;
In_Project : Project_Data) return Boolean In_Project : Project_Data;
In_Tree : Project_Tree_Ref) return Boolean
is is
begin begin
case Language is case Language is
@ -349,7 +391,7 @@ package body Prj is
begin begin
while Supp_Index /= No_Supp_Language_Index loop 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 if Supp.Index = Language then
return Supp.Present; return Supp.Present;
@ -369,7 +411,8 @@ package body Prj is
function Language_Processing_Data_Of function Language_Processing_Data_Of
(Language : Language_Index; (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 is
begin begin
case Language is case Language is
@ -387,7 +430,7 @@ package body Prj is
begin begin
while Supp_Index /= No_Supp_Language_Index loop 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 if Supp.Index = Language then
return Supp.Data; return Supp.Data;
@ -408,7 +451,8 @@ package body Prj is
procedure Register_Default_Naming_Scheme procedure Register_Default_Naming_Scheme
(Language : Name_Id; (Language : Name_Id;
Default_Spec_Suffix : Name_Id; Default_Spec_Suffix : Name_Id;
Default_Body_Suffix : Name_Id) Default_Body_Suffix : Name_Id;
In_Tree : Project_Tree_Ref)
is is
Lang : Name_Id; Lang : Name_Id;
Suffix : Array_Element_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)); Name_Buffer (1 .. Name_Len) := To_Lower (Name_Buffer (1 .. Name_Len));
Lang := Name_Find; Lang := Name_Find;
Suffix := Std_Naming_Data.Spec_Suffix; Suffix := In_Tree.Private_Part.Default_Naming.Spec_Suffix;
Found := False; Found := False;
-- Look for an element of the spec sufix array indexed by the language -- Look for an element of the spec sufix array indexed by the language
-- name. If one is found, put the default value. -- name. If one is found, put the default value.
while Suffix /= No_Array_Element and then not Found loop 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 if Element.Index = Lang then
Found := True; Found := True;
Element.Value.Value := Default_Spec_Suffix; Element.Value.Value := Default_Spec_Suffix;
Array_Elements.Table (Suffix) := Element; In_Tree.Array_Elements.Table (Suffix) := Element;
else else
Suffix := Element.Next; Suffix := Element.Next;
@ -454,25 +498,28 @@ package body Prj is
Default => False, Default => False,
Value => Default_Spec_Suffix, Value => Default_Spec_Suffix,
Index => 0), Index => 0),
Next => Std_Naming_Data.Spec_Suffix); Next => In_Tree.Private_Part.Default_Naming.Spec_Suffix);
Array_Elements.Increment_Last; Array_Element_Table.Increment_Last (In_Tree.Array_Elements);
Array_Elements.Table (Array_Elements.Last) := Element; In_Tree.Array_Elements.Table
Std_Naming_Data.Spec_Suffix := Array_Elements.Last; (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; end if;
Suffix := Std_Naming_Data.Body_Suffix; Suffix := In_Tree.Private_Part.Default_Naming.Body_Suffix;
Found := False; Found := False;
-- Look for an element of the body sufix array indexed by the language -- Look for an element of the body sufix array indexed by the language
-- name. If one is found, put the default value. -- name. If one is found, put the default value.
while Suffix /= No_Array_Element and then not Found loop 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 if Element.Index = Lang then
Found := True; Found := True;
Element.Value.Value := Default_Body_Suffix; Element.Value.Value := Default_Body_Suffix;
Array_Elements.Table (Suffix) := Element; In_Tree.Array_Elements.Table (Suffix) := Element;
else else
Suffix := Element.Next; Suffix := Element.Next;
@ -492,10 +539,14 @@ package body Prj is
Default => False, Default => False,
Value => Default_Body_Suffix, Value => Default_Body_Suffix,
Index => 0), Index => 0),
Next => Std_Naming_Data.Body_Suffix); Next => In_Tree.Private_Part.Default_Naming.Body_Suffix);
Array_Elements.Increment_Last; Array_Element_Table.Increment_Last
Array_Elements.Table (Array_Elements.Last) := Element; (In_Tree.Array_Elements);
Std_Naming_Data.Body_Suffix := Array_Elements.Last; 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 if;
end Register_Default_Naming_Scheme; end Register_Default_Naming_Scheme;
@ -503,17 +554,34 @@ package body Prj is
-- Reset -- -- Reset --
----------- -----------
procedure Reset is procedure Reset (Tree : Project_Tree_Ref) is
begin begin
Projects.Init; Prj.Env.Initialize;
Project_Lists.Init; Present_Language_Table.Init (Tree.Present_Languages);
Packages.Init; Supp_Suffix_Table.Init (Tree.Supp_Suffixes);
Arrays.Init; Name_List_Table.Init (Tree.Name_Lists);
Variable_Elements.Init; Supp_Language_Table.Init (Tree.Supp_Languages);
String_Elements.Init; Other_Source_Table.Init (Tree.Other_Sources);
Prj.Com.Units.Init; String_Element_Table.Init (Tree.String_Elements);
Prj.Com.Units_Htable.Reset; Variable_Element_Table.Init (Tree.Variable_Elements);
Prj.Com.Files_Htable.Reset; 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; end Reset;
------------------------ ------------------------
@ -538,7 +606,8 @@ package body Prj is
procedure Set procedure Set
(Language : Language_Index; (Language : Language_Index;
Present : Boolean; Present : Boolean;
In_Project : in out Project_Data) In_Project : in out Project_Data;
In_Tree : Project_Tree_Ref)
is is
begin begin
case Language is case Language is
@ -555,10 +624,12 @@ package body Prj is
begin begin
while Supp_Index /= No_Supp_Language_Index loop 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 if Supp.Index = Language then
Present_Languages.Table (Supp_Index).Present := Present; In_Tree.Present_Languages.Table
(Supp_Index).Present := Present;
return; return;
end if; end if;
@ -567,9 +638,12 @@ package body Prj is
Supp := (Index => Language, Present => Present, Supp := (Index => Language, Present => Present,
Next => In_Project.Supp_Languages); Next => In_Project.Supp_Languages);
Present_Languages.Increment_Last; Present_Language_Table.Increment_Last
Supp_Index := Present_Languages.Last; (In_Tree.Present_Languages);
Present_Languages.Table (Supp_Index) := Supp; Supp_Index := Present_Language_Table.Last
(In_Tree.Present_Languages);
In_Tree.Present_Languages.Table (Supp_Index) :=
Supp;
In_Project.Supp_Languages := Supp_Index; In_Project.Supp_Languages := Supp_Index;
end; end;
end case; end case;
@ -578,7 +652,8 @@ package body Prj is
procedure Set procedure Set
(Language_Processing : in Language_Processing_Data; (Language_Processing : in Language_Processing_Data;
For_Language : Language_Index; For_Language : Language_Index;
In_Project : in out Project_Data) In_Project : in out Project_Data;
In_Tree : Project_Tree_Ref)
is is
begin begin
case For_Language is case For_Language is
@ -597,11 +672,12 @@ package body Prj is
begin begin
while Supp_Index /= No_Supp_Language_Index loop 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 if Supp.Index = For_Language then
Supp_Languages.Table (Supp_Index).Data := In_Tree.Supp_Languages.Table
Language_Processing; (Supp_Index).Data := Language_Processing;
return; return;
end if; end if;
@ -610,9 +686,11 @@ package body Prj is
Supp := (Index => For_Language, Data => Language_Processing, Supp := (Index => For_Language, Data => Language_Processing,
Next => In_Project.Supp_Language_Processing); Next => In_Project.Supp_Language_Processing);
Supp_Languages.Increment_Last; Supp_Language_Table.Increment_Last
Supp_Index := Supp_Languages.Last; (In_Tree.Supp_Languages);
Supp_Languages.Table (Supp_Index) := Supp; 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; In_Project.Supp_Language_Processing := Supp_Index;
end; end;
end case; end case;
@ -621,7 +699,8 @@ package body Prj is
procedure Set procedure Set
(Suffix : Name_Id; (Suffix : Name_Id;
For_Language : Language_Index; For_Language : Language_Index;
In_Project : in out Project_Data) In_Project : in out Project_Data;
In_Tree : Project_Tree_Ref)
is is
begin begin
case For_Language is case For_Language is
@ -639,10 +718,12 @@ package body Prj is
begin begin
while Supp_Index /= No_Supp_Language_Index loop 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 if Supp.Index = For_Language then
Supp_Suffix_Table.Table (Supp_Index).Suffix := Suffix; In_Tree.Supp_Suffixes.Table
(Supp_Index).Suffix := Suffix;
return; return;
end if; end if;
@ -651,23 +732,40 @@ package body Prj is
Supp := (Index => For_Language, Suffix => Suffix, Supp := (Index => For_Language, Suffix => Suffix,
Next => In_Project.Naming.Supp_Suffixes); Next => In_Project.Naming.Supp_Suffixes);
Supp_Suffix_Table.Increment_Last; Supp_Suffix_Table.Increment_Last
Supp_Index := Supp_Suffix_Table.Last; (In_Tree.Supp_Suffixes);
Supp_Suffix_Table.Table (Supp_Index) := Supp; 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; In_Project.Naming.Supp_Suffixes := Supp_Index;
end; end;
end case; end case;
end Set; end Set;
-----------
-- Slash --
-----------
function Slash return Name_Id is
begin
return Slash_Id;
end Slash;
-------------------------- --------------------------
-- Standard_Naming_Data -- -- 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 begin
Prj.Initialize; if Tree = No_Project_Tree then
return Std_Naming_Data; Prj.Initialize (Tree => No_Project_Tree);
return Std_Naming_Data;
else
return Tree.Private_Part.Default_Naming;
end if;
end Standard_Naming_Data; end Standard_Naming_Data;
--------------- ---------------
@ -676,7 +774,8 @@ package body Prj is
function Suffix_Of function Suffix_Of
(Language : Language_Index; (Language : Language_Index;
In_Project : Project_Data) return Name_Id In_Project : Project_Data;
In_Tree : Project_Tree_Ref) return Name_Id
is is
begin begin
case Language is case Language is
@ -694,7 +793,8 @@ package body Prj is
begin begin
while Supp_Index /= No_Supp_Language_Index loop 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 if Supp.Index = Language then
return Supp.Suffix; return Supp.Suffix;

401
gcc/ada/prj.ads
View File

@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
@ -35,38 +35,46 @@ with Scans; use Scans;
with Table; with Table;
with Types; use Types; 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 package Prj is
Empty_Name : Name_Id; All_Packages : constant String_List_Access;
-- Name_Id for an empty name (no characters). Initialized by the call
-- to procedure Initialize.
All_Packages : constant String_List_Access := null;
-- Default value of parameter Packages of procedures Parse, in Prj.Pars and -- Default value of parameter Packages of procedures Parse, in Prj.Pars and
-- Prj.Part, indicating that all packages should be checked. -- Prj.Part, indicating that all packages should be checked.
Virtual_Prefix : constant String := "v$"; type Project_Tree_Data;
-- The prefix for virtual extending projects. Because of the '$', which is type Project_Tree_Ref is access all Project_Tree_Data;
-- normally forbidden for project names, there cannot be any name clash. -- 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"; Project_File_Extension : String := ".gpr";
-- The standard project file name extension. It is not a constant, because -- 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. -- 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 -- Multi-language stuff that will be modified soon --
-- 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
type Language_Index is new Nat; type Language_Index is new Nat;
@ -129,13 +137,12 @@ package Prj is
Next : Supp_Language_Index := No_Supp_Language_Index; Next : Supp_Language_Index := No_Supp_Language_Index;
end record; end record;
package Present_Languages is new Table.Table package Present_Language_Table is new GNAT.Dynamic_Tables
(Table_Component_Type => Supp_Language, (Table_Component_Type => Supp_Language,
Table_Index_Type => Supp_Language_Index, Table_Index_Type => Supp_Language_Index,
Table_Low_Bound => 1, Table_Low_Bound => 1,
Table_Initial => 4, Table_Initial => 4,
Table_Increment => 100, Table_Increment => 100);
Table_Name => "Prj.Present_Languages");
-- The table for the presence of languages with an index that is outside -- The table for the presence of languages with an index that is outside
-- of First_Language_Indexes. -- of First_Language_Indexes.
@ -152,13 +159,12 @@ package Prj is
Next : Supp_Language_Index := No_Supp_Language_Index; Next : Supp_Language_Index := No_Supp_Language_Index;
end record; 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_Component_Type => Supp_Suffix,
Table_Index_Type => Supp_Language_Index, Table_Index_Type => Supp_Language_Index,
Table_Low_Bound => 1, Table_Low_Bound => 1,
Table_Initial => 4, Table_Initial => 4,
Table_Increment => 100, Table_Increment => 100);
Table_Name => "Prj.Supp_Suffix_Table");
-- The table for the presence of languages with an index that is outside -- The table for the presence of languages with an index that is outside
-- of First_Language_Indexes. -- of First_Language_Indexes.
@ -172,13 +178,12 @@ package Prj is
Next : Name_List_Index := No_Name_List; Next : Name_List_Index := No_Name_List;
end record; end record;
package Name_Lists is new Table.Table package Name_List_Table is new GNAT.Dynamic_Tables
(Table_Component_Type => Name_Node, (Table_Component_Type => Name_Node,
Table_Index_Type => Name_List_Index, Table_Index_Type => Name_List_Index,
Table_Low_Bound => 1, Table_Low_Bound => 1,
Table_Initial => 10, Table_Initial => 10,
Table_Increment => 100, Table_Increment => 100);
Table_Name => "Prj.Name_Lists");
-- The table for lists of names used in package Language_Processing -- The table for lists of names used in package Language_Processing
type Language_Processing_Data is record type Language_Processing_Data is record
@ -206,8 +211,9 @@ package Prj is
type First_Language_Processing_Data is type First_Language_Processing_Data is
array (First_Language_Indexes) of Language_Processing_Data; array (First_Language_Indexes) of Language_Processing_Data;
Default_First_Language_Processing_Data : First_Language_Processing_Data := Default_First_Language_Processing_Data :
(others => Default_Language_Processing_Data); constant First_Language_Processing_Data :=
(others => Default_Language_Processing_Data);
type Supp_Language_Data is record type Supp_Language_Data is record
Index : Language_Index := No_Language_Index; Index : Language_Index := No_Language_Index;
@ -215,13 +221,12 @@ package Prj is
Next : Supp_Language_Index := No_Supp_Language_Index; Next : Supp_Language_Index := No_Supp_Language_Index;
end record; 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_Component_Type => Supp_Language_Data,
Table_Index_Type => Supp_Language_Index, Table_Index_Type => Supp_Language_Index,
Table_Low_Bound => 1, Table_Low_Bound => 1,
Table_Initial => 4, Table_Initial => 4,
Table_Increment => 100, Table_Increment => 100);
Table_Name => "Prj.Supp_Languages");
-- The table for language data when there are more languages than -- The table for language data when there are more languages than
-- in First_Language_Indexes. -- in First_Language_Indexes.
@ -243,21 +248,27 @@ package Prj is
end record; end record;
-- Data for a source in a language other than Ada -- 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_Component_Type => Other_Source,
Table_Index_Type => Other_Source_Id, Table_Index_Type => Other_Source_Id,
Table_Low_Bound => 1, Table_Low_Bound => 1,
Table_Initial => 200, Table_Initial => 200,
Table_Increment => 100, Table_Increment => 100);
Table_Name => "Prj.Other_Sources");
-- The table for sources of languages other than Ada -- The table for sources of languages other than Ada
----------------------------------
-- End of multi-language stuff --
----------------------------------
type Verbosity is (Default, Medium, High); type Verbosity is (Default, Medium, High);
-- Verbosity when parsing GNAT Project Files -- Verbosity when parsing GNAT Project Files
-- Default is default (very quiet, if no errors). -- Default is default (very quiet, if no errors).
-- Medium is more verbose. -- Medium is more verbose.
-- High is extremely 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 Lib_Kind is (Static, Dynamic, Relocatable);
type Policy is (Autonomous, Compliant, Controlled, Restricted); type Policy is (Autonomous, Compliant, Controlled, Restricted);
-- Type to specify the symbol policy, when symbol control is supported. -- Type to specify the symbol policy, when symbol control is supported.
@ -274,7 +285,7 @@ package Prj is
end record; end record;
-- Type to keep the symbol data to be used when building a shared library -- 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, (Symbol_File => No_Name,
Reference => No_Name, Reference => No_Name,
Symbol_Policy => Autonomous); Symbol_Policy => Autonomous);
@ -301,13 +312,12 @@ package Prj is
-- Component Flag may be used for various purposes. For source -- Component Flag may be used for various purposes. For source
-- directories, it indicates if the directory contains Ada source(s). -- 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_Component_Type => String_Element,
Table_Index_Type => String_List_Id, Table_Index_Type => String_List_Id,
Table_Low_Bound => 1, Table_Low_Bound => 1,
Table_Initial => 200, Table_Initial => 200,
Table_Increment => 100, Table_Increment => 100);
Table_Name => "Prj.String_Elements");
-- The table for string elements in string lists -- The table for string elements in string lists
type Variable_Kind is (Undefined, List, Single); type Variable_Kind is (Undefined, List, Single);
@ -316,7 +326,7 @@ package Prj is
subtype Defined_Variable_Kind is Variable_Kind range List .. Single; subtype Defined_Variable_Kind is Variable_Kind range List .. Single;
-- The defined kinds of variables -- The defined kinds of variables
Ignored : constant Variable_Kind := Single; Ignored : constant Variable_Kind;
-- Used to indicate that a package declaration must be ignored -- Used to indicate that a package declaration must be ignored
-- while processing the project tree (unknown package name). -- 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 -- Values for variables and array elements. Default is True if the
-- current value is the default one for the variable -- current value is the default one for the variable
Nil_Variable_Value : constant Variable_Value := Nil_Variable_Value : constant Variable_Value;
(Project => No_Project,
Kind => Undefined,
Location => No_Location,
Default => False);
-- Value of a non existing variable or array element -- Value of a non existing variable or array element
type Variable_Id is new Nat; type Variable_Id is new Nat;
@ -353,13 +359,12 @@ package Prj is
end record; end record;
-- To hold the list of variables in a project file and in packages -- 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_Component_Type => Variable,
Table_Index_Type => Variable_Id, Table_Index_Type => Variable_Id,
Table_Low_Bound => 1, Table_Low_Bound => 1,
Table_Initial => 200, Table_Initial => 200,
Table_Increment => 100, Table_Increment => 100);
Table_Name => "Prj.Variable_Elements");
-- The table of variable in list of variables -- The table of variable in list of variables
type Array_Element_Id is new Nat; 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) -- Each Array_Element represents an array element and is linked (Next)
-- to the next array element, if any, in the array. -- 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_Component_Type => Array_Element,
Table_Index_Type => Array_Element_Id, Table_Index_Type => Array_Element_Id,
Table_Low_Bound => 1, Table_Low_Bound => 1,
Table_Initial => 200, Table_Initial => 200,
Table_Increment => 100, Table_Increment => 100);
Table_Name => "Prj.Array_Elements");
-- The table that contains all array elements -- The table that contains all array elements
type Array_Id is new Nat; type Array_Id is new Nat;
@ -394,13 +398,12 @@ package Prj is
-- Value is the id of the first element. -- Value is the id of the first element.
-- Next is the id of the next array in the project file or package. -- 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_Component_Type => Array_Data,
Table_Index_Type => Array_Id, Table_Index_Type => Array_Id,
Table_Low_Bound => 1, Table_Low_Bound => 1,
Table_Initial => 200, Table_Initial => 200,
Table_Increment => 100, Table_Increment => 100);
Table_Name => "Prj.Arrays");
-- The table that contains all arrays -- The table that contains all arrays
type Package_Id is new Nat; type Package_Id is new Nat;
@ -429,13 +432,12 @@ package Prj is
end record; end record;
-- A package. Includes declarations that may include other packages. -- 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_Component_Type => Package_Element,
Table_Index_Type => Package_Id, Table_Index_Type => Package_Id,
Table_Low_Bound => 1, Table_Low_Bound => 1,
Table_Initial => 100, Table_Initial => 100,
Table_Increment => 100, Table_Increment => 100);
Table_Name => "Prj.Packages");
-- The table that contains all packages. -- The table that contains all packages.
function Image (Casing : Casing_Type) return String; function Image (Casing : Casing_Type) return String;
@ -511,9 +513,12 @@ package Prj is
end record; 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); 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 function Same_Naming_Scheme
(Left, Right : Naming_Data) return Boolean; (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 -- Element in a list of project files. Next is the id of the next
-- project file in the list. -- 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_Component_Type => Project_Element,
Table_Index_Type => Project_List, Table_Index_Type => Project_List,
Table_Low_Bound => 1, Table_Low_Bound => 1,
Table_Initial => 100, Table_Initial => 100,
Table_Increment => 100, Table_Increment => 100);
Table_Name => "Prj.Project_Lists");
-- The table that contains the lists of project files -- The table that contains the lists of project files
-- The following record describes a project file representation -- The following record describes a project file representation
@ -782,80 +786,126 @@ package Prj is
end record; end record;
function Is_Present function Empty_Project (Tree : Project_Tree_Ref) return Project_Data;
(Language : Language_Index; -- Return the representation of an empty project in project Tree tree.
In_Project : Project_Data) return Boolean; -- The project tree Tree must have been Initialized and/or Reset.
-- 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
Project_Error : exception; Project_Error : exception;
-- Raised by some subprograms in Prj.Attr. -- Raised by some subprograms in Prj.Attr.
function Empty_Project return Project_Data; package Project_Table is new GNAT.Dynamic_Tables (
-- Return the representation of an empty project
package Projects is new Table.Table (
Table_Component_Type => Project_Data, Table_Component_Type => Project_Data,
Table_Index_Type => Project_Id, Table_Index_Type => Project_Id,
Table_Low_Bound => 1, Table_Low_Bound => 1,
Table_Initial => 100, Table_Initial => 100,
Table_Increment => 100, Table_Increment => 100);
Table_Name => "Prj.Projects");
-- The set of all project files -- 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 type Put_Line_Access is access procedure
(Line : String; (Line : String;
Project : Project_Id); Project : Project_Id;
In_Tree : Project_Tree_Ref);
-- Use to customize error reporting in Prj.Proc and Prj.Nmsc -- Use to customize error reporting in Prj.Proc and Prj.Nmsc
procedure Expect (The_Token : Token_Type; Token_Image : String); procedure Expect (The_Token : Token_Type; Token_Image : String);
-- Check that the current token is The_Token. If it is not, then -- Check that the current token is The_Token. If it is not, then
-- output an error message. -- output an error message.
procedure Initialize; procedure Initialize (Tree : Project_Tree_Ref);
-- This procedure must be called before using any services from the Prj -- This procedure must be called before using any services from the Prj
-- hierarchy. Namet.Initialize must be called before Prj.Initialize. -- 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 -- This procedure resets all the tables that are used when processing a
-- project file tree. Initialize must be called before the call to Reset. -- project file tree. Initialize must be called before the call to Reset.
procedure Register_Default_Naming_Scheme procedure Register_Default_Naming_Scheme
(Language : Name_Id; (Language : Name_Id;
Default_Spec_Suffix : 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 -- Register the default suffixes for a given language. These extensions
-- will be ignored if the user has specified a new naming scheme in a -- will be ignored if the user has specified a new naming scheme in a
-- project file. -- project file.
@ -870,29 +920,132 @@ package Prj is
With_State : in out State); With_State : in out State);
procedure For_Every_Project_Imported procedure For_Every_Project_Imported
(By : Project_Id; (By : Project_Id;
In_Tree : Project_Tree_Ref;
With_State : in out State); With_State : in out State);
-- Call Action for each project imported directly or indirectly by project -- Call Action for each project imported directly or indirectly by project
-- By. Action is called according to the order of importation: if A -- By. Action is called according to the order of importation: if A
-- imports B, directly or indirectly, Action will be called for A before -- 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 -- it is called for B. If two projects import each other directly or
-- behavior or to report some global result. -- 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 private
Initial_Buffer_Size : constant := 100; All_Packages : constant String_List_Access := null;
-- Initial size for extensible buffer used below
Buffer : String_Access := new String (1 .. Initial_Buffer_Size); No_Project_Tree : constant Project_Tree_Ref := null;
-- An extensible character buffer to store names. Used in Prj.Part and
-- Prj.Strt.
Buffer_Last : Natural := 0; Ignored : constant Variable_Kind := Single;
-- The index of the last character in the Buffer
Current_Packages_To_Check : String_List_Access := All_Packages; Nil_Variable_Value : constant Variable_Value :=
-- Global variable, set by Prj.Part.Parse, used by Prj.Dect. (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 -- 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; end Prj;