git
/
gcc
mirror of git://gcc.gnu.org/git/gcc.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

gnatcmd.adb, [...] (Prj.Tree.Environment): new type. 

2011-08-03  Emmanuel Briot  <briot@adacore.com>

	* gnatcmd.adb, prj-proc.adb, prj-proc.ads, make.adb, prj-part.adb,
	prj-part.ads, switch-m.adb, switch-m.ads, prj-makr.adb, clean.adb,
	prj-pars.adb, prj-pars.ads, prj-conf.adb, prj-conf.ads, prj-tree.adb,
	prj-tree.ads (Prj.Tree.Environment): new type.

From-SVN: r177248
This commit is contained in:
Emmanuel Briot 2011-08-03 09:36:24 +00:00 committed by Arnaud Charlet
parent 804fe3c4e6
commit 4437a53072
17 changed files with 226 additions and 236 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
gcc/ada/ChangeLog
View File

@ -1,3 +1,10 @@
2011-08-03 Emmanuel Briot <briot@adacore.com>
* gnatcmd.adb, prj-proc.adb, prj-proc.ads, make.adb, prj-part.adb,
prj-part.ads, switch-m.adb, switch-m.ads, prj-makr.adb, clean.adb,
prj-pars.adb, prj-pars.ads, prj-conf.adb, prj-conf.ads, prj-tree.adb,
prj-tree.ads (Prj.Tree.Environment): new type.
2011-08-03 Emmanuel Briot <briot@adacore.com>
* prj-proc.adb, prj.ads, makeutl.adb, makeutl.ads, prj-conf.adb,

40
gcc/ada/clean.adb
View File

@ -93,6 +93,8 @@ package body Clean is
Project_Node_Tree : Project_Node_Tree_Ref;
Root_Environment : Prj.Tree.Environment;
Main_Project : Prj.Project_Id := Prj.No_Project;
All_Projects : Boolean := False;
@ -1400,15 +1402,12 @@ package body Clean is
-- Parse the project file. If there is an error, Main_Project
-- will still be No_Project.
Prj.Env.Initialize_Default_Project_Path
(Project_Node_Tree.Project_Path, Target_Name => "");
Prj.Pars.Parse
(Project => Main_Project,
In_Tree => Project_Tree,
In_Node_Tree => Project_Node_Tree,
Project_File_Name => Project_File_Name.all,
Flags => Gnatmake_Flags,
Env => Root_Environment,
Packages_To_Check => Packages_To_Check_By_Gnatmake);
if Main_Project = No_Project then
@ -1561,6 +1560,10 @@ package body Clean is
Csets.Initialize;
Snames.Initialize;
Prj.Tree.Initialize (Root_Environment, Gnatmake_Flags);
Prj.Env.Initialize_Default_Project_Path
(Root_Environment.Project_Path, Target_Name => "");
Project_Node_Tree := new Project_Node_Tree_Data;
Prj.Tree.Initialize (Project_Node_Tree);
@ -1696,7 +1699,7 @@ package body Clean is
elsif Arg (3) = 'P' then
Prj.Env.Add_Directories
(Project_Node_Tree.Project_Path,
(Root_Environment.Project_Path,
Arg (4 .. Arg'Last));
else
@ -1858,7 +1861,6 @@ package body Clean is
Ext_Asgn : constant String := Arg (3 .. Arg'Last);
Start : Positive := Ext_Asgn'First;
Stop : Natural := Ext_Asgn'Last;
Equal_Pos : Natural;
OK : Boolean := True;
begin
@ -1872,27 +1874,11 @@ package body Clean is
end if;
end if;
Equal_Pos := Start;
while Equal_Pos <= Stop
and then Ext_Asgn (Equal_Pos) /= '='
loop
Equal_Pos := Equal_Pos + 1;
end loop;
if Equal_Pos = Start or else Equal_Pos > Stop then
OK := False;
end if;
if OK then
Prj.Ext.Add
(Project_Node_Tree.External,
External_Name =>
Ext_Asgn (Start .. Equal_Pos - 1),
Value =>
Ext_Asgn (Equal_Pos + 1 .. Stop));
else
if not OK
or else not Prj.Ext.Check
(Root_Environment.External,
Ext_Asgn (Start .. Stop))
then
Fail
("illegal external assignment '"
& Ext_Asgn

51
gcc/ada/gnatcmd.adb
View File

@ -58,6 +58,7 @@ with GNAT.OS_Lib; use GNAT.OS_Lib;
procedure GNATCmd is
Project_Node_Tree : Project_Node_Tree_Ref;
Root_Environment : Prj.Tree.Environment;
Project_File : String_Access;
Project : Prj.Project_Id;
Current_Verbosity : Prj.Verbosity := Prj.Default;
@ -246,9 +247,6 @@ procedure GNATCmd is
-- Get the sources in the closure of the ASIS_Main and add them to the
-- list of arguments.
function Index (Char : Character; Str : String) return Natural;
-- Returns first occurrence of Char in Str, returns 0 if Char not in Str
procedure Non_VMS_Usage;
-- Display usage for platforms other than VMS
@ -922,21 +920,6 @@ procedure GNATCmd is
end if;
end Get_Closure;
-----------
-- Index --
-----------
function Index (Char : Character; Str : String) return Natural is
begin
for Index in Str'Range loop
if Str (Index) = Char then
return Index;
end if;
end loop;
return 0;
end Index;
------------------
-- Mapping_File --
------------------
@ -1364,10 +1347,11 @@ begin
Csets.Initialize;
Snames.Initialize;
Project_Node_Tree := new Project_Node_Tree_Data;
Prj.Tree.Initialize (Root_Environment, Gnatmake_Flags);
Prj.Env.Initialize_Default_Project_Path
(Project_Node_Tree.Project_Path, Target_Name => "");
(Root_Environment.Project_Path, Target_Name => "");
Project_Node_Tree := new Project_Node_Tree_Data;
Prj.Tree.Initialize (Project_Node_Tree);
Prj.Initialize (Project_Tree);
@ -1725,7 +1709,7 @@ begin
and then Argv (Argv'First + 1 .. Argv'First + 2) = "aP"
then
Prj.Env.Add_Directories
(Project_Node_Tree.Project_Path,
(Root_Environment.Project_Path,
Argv (Argv'First + 3 .. Argv'Last));
Remove_Switch (Arg_Num);
@ -1813,25 +1797,12 @@ begin
elsif Argv'Length >= 5
and then Argv (Argv'First + 1) = 'X'
then
declare
Equal_Pos : constant Natural :=
Index
('=',
Argv (Argv'First + 2 .. Argv'Last));
begin
if Equal_Pos >= Argv'First + 3
and then Equal_Pos /= Argv'Last
then
Add (Project_Node_Tree.External,
External_Name =>
Argv (Argv'First + 2 .. Equal_Pos - 1),
Value => Argv (Equal_Pos + 1 .. Argv'Last));
else
Fail
(Argv.all
if not Check (Root_Environment.External,
Argv (Argv'First + 2 .. Argv'Last))
then
Fail (Argv.all
& " is not a valid external assignment.");
end if;
end;
end if;
Remove_Switch (Arg_Num);
@ -1884,7 +1855,7 @@ begin
In_Tree => Project_Tree,
In_Node_Tree => Project_Node_Tree,
Project_File_Name => Project_File.all,
Flags => Gnatmake_Flags,
Env => Root_Environment,
Packages_To_Check => Packages_To_Check);
if Project = Prj.No_Project then

69
gcc/ada/make.adb
View File

@ -645,7 +645,7 @@ package body Make is
-- directory of the ultimate extending project. If it is not, we ignore
-- the fact that this ALI file is read-only.
procedure Process_Multilib (Project_Node_Tree : Project_Node_Tree_Ref);
procedure Process_Multilib (Env : in out Prj.Tree.Environment);
-- Add appropriate --RTS argument to handle multilib
----------------------------------------------------
@ -723,7 +723,8 @@ package body Make is
Index : Int;
Program : Make_Program_Type;
Unknown_Switches_To_The_Compiler : Boolean := True;
Project_Node_Tree : Project_Node_Tree_Ref);
Project_Node_Tree : Project_Node_Tree_Ref;
Env : in out Prj.Tree.Environment);
procedure Add_Switch
(S : String_Access;
Program : Make_Program_Type;
@ -1021,7 +1022,9 @@ package body Make is
-- Call the CodePeer globalizer on all the project's object directories,
-- or on the current directory if no projects.
procedure Initialize (Project_Node_Tree : out Project_Node_Tree_Ref);
procedure Initialize
(Project_Node_Tree : out Project_Node_Tree_Ref;
Env : out Prj.Tree.Environment);
-- Performs default and package initialization. Therefore,
-- Compile_Sources can be called by an external unit.
@ -1034,7 +1037,7 @@ package body Make is
-- succeeded or not.
procedure Scan_Make_Arg
(Project_Node_Tree : Project_Node_Tree_Ref;
(Env : in out Prj.Tree.Environment;
Argv : String;
And_Save : Boolean);
-- Scan make arguments. Argv is a single argument to be processed.
@ -1262,7 +1265,8 @@ package body Make is
Index : Int;
Program : Make_Program_Type;
Unknown_Switches_To_The_Compiler : Boolean := True;
Project_Node_Tree : Project_Node_Tree_Ref)
Project_Node_Tree : Project_Node_Tree_Ref;
Env : in out Prj.Tree.Environment)
is
Switches : Variable_Value;
Switch_List : String_List_Id;
@ -1303,8 +1307,7 @@ package body Make is
Write_Line (Argv);
end if;
Scan_Make_Arg
(Project_Node_Tree, Argv, And_Save => False);
Scan_Make_Arg (Env, Argv, And_Save => False);
if not Gnatmake_Switch_Found
and then not Switch_May_Be_Passed_To_The_Compiler
@ -4234,6 +4237,7 @@ package body Make is
-- The path name of the mapping file
Project_Node_Tree : Project_Node_Tree_Ref;
Root_Environment : Prj.Tree.Environment;
Discard : Boolean;
pragma Warnings (Off, Discard);
@ -4397,7 +4401,7 @@ package body Make is
Obsoleted.Reset;
Make.Initialize (Project_Node_Tree);
Make.Initialize (Project_Node_Tree, Root_Environment);
Bind_Shared := No_Shared_Switch'Access;
Link_With_Shared_Libgcc := No_Shared_Libgcc_Switch'Access;
@ -4880,6 +4884,7 @@ package body Make is
Add_Switches
(Project_Node_Tree => Project_Node_Tree,
Env => Root_Environment,
File_Name => Main_Unit_File_Name,
Index => Main_Index,
The_Package => Builder_Package,
@ -4936,6 +4941,7 @@ package body Make is
Add_Switches
(Project_Node_Tree => Project_Node_Tree,
Env => Root_Environment,
File_Name => " ",
Index => 0,
The_Package => Builder_Package,
@ -4953,6 +4959,7 @@ package body Make is
Add_Switches
(Project_Node_Tree => Project_Node_Tree,
Env => Root_Environment,
File_Name => " ",
Index => 0,
The_Package => Builder_Package,
@ -5045,6 +5052,7 @@ package body Make is
Add_Switches
(Project_Node_Tree => Project_Node_Tree,
Env => Root_Environment,
File_Name => Main_Unit_File_Name,
Index => Main_Index,
The_Package => Binder_Package,
@ -5062,6 +5070,7 @@ package body Make is
Add_Switches
(Project_Node_Tree => Project_Node_Tree,
Env => Root_Environment,
File_Name => Main_Unit_File_Name,
Index => Main_Index,
The_Package => Linker_Package,
@ -6401,6 +6410,7 @@ package body Make is
Add_Switches
(Project_Node_Tree => Project_Node_Tree,
Env => Root_Environment,
File_Name => Main_Unit_File_Name,
Index => Main_Index,
The_Package => Binder_Package,
@ -6419,6 +6429,7 @@ package body Make is
Add_Switches
(Project_Node_Tree => Project_Node_Tree,
Env => Root_Environment,
File_Name => Main_Unit_File_Name,
Index => Main_Index,
The_Package => Linker_Package,
@ -6623,8 +6634,10 @@ package body Make is
-- Initialize --
----------------
procedure Initialize (Project_Node_Tree : out Project_Node_Tree_Ref) is
procedure Initialize
(Project_Node_Tree : out Project_Node_Tree_Ref;
Env : out Prj.Tree.Environment)
is
procedure Check_Version_And_Help is
new Check_Version_And_Help_G (Makeusg);
@ -6635,10 +6648,11 @@ package body Make is
-- references, project path and other attributes that can be impacted by
-- the command line switches
Project_Node_Tree := new Project_Node_Tree_Data;
Prj.Tree.Initialize (Env, Gnatmake_Flags);
Prj.Env.Initialize_Default_Project_Path
(Project_Node_Tree.Project_Path, Target_Name => "");
(Env.Project_Path, Target_Name => "");
Project_Node_Tree := new Project_Node_Tree_Data;
Prj.Tree.Initialize (Project_Node_Tree);
-- Override default initialization of Check_Object_Consistency since
@ -6721,12 +6735,11 @@ package body Make is
-- do not include --version or --help.
Scan_Args : for Next_Arg in 1 .. Argument_Count loop
Scan_Make_Arg
(Project_Node_Tree, Argument (Next_Arg), And_Save => True);
Scan_Make_Arg (Env, Argument (Next_Arg), And_Save => True);
end loop Scan_Args;
if N_M_Switch > 0 and RTS_Specified = null then
Process_Multilib (Project_Node_Tree);
Process_Multilib (Env);
end if;
if Commands_To_Stdout then
@ -6811,7 +6824,7 @@ package body Make is
In_Tree => Project_Tree,
Project_File_Name => Project_File_Name.all,
Packages_To_Check => Packages_To_Check_By_Gnatmake,
Flags => Gnatmake_Flags,
Env => Env,
In_Node_Tree => Project_Node_Tree);
-- The parsing of project files may have changed the current output
@ -7347,9 +7360,7 @@ package body Make is
-- Process_Multilib --
----------------------
procedure Process_Multilib
(Project_Node_Tree : Project_Node_Tree_Ref)
is
procedure Process_Multilib (Env : in out Prj.Tree.Environment) is
Output_FD : File_Descriptor;
Output_Name : String_Access;
Arg_Index : Natural := 0;
@ -7450,9 +7461,8 @@ package body Make is
-- Otherwise add -margs --RTS=output
Scan_Make_Arg (Project_Node_Tree, "-margs", And_Save => True);
Scan_Make_Arg
(Project_Node_Tree, "--RTS=" & Line (1 .. N_Read), And_Save => True);
Scan_Make_Arg (Env, "-margs", And_Save => True);
Scan_Make_Arg (Env, "--RTS=" & Line (1 .. N_Read), And_Save => True);
end Process_Multilib;
-----------
@ -7839,7 +7849,7 @@ package body Make is
-------------------
procedure Scan_Make_Arg
(Project_Node_Tree : Project_Node_Tree_Ref;
(Env : in out Prj.Tree.Environment;
Argv : String;
And_Save : Boolean)
is
@ -8129,7 +8139,7 @@ package body Make is
(Argv (Create_Map_File_Switch'Length + 2 .. Argv'Last));
else
Scan_Make_Switches (Project_Node_Tree, Argv, Success);
Scan_Make_Switches (Env, Argv, Success);
end if;
-- If we have seen a regular switch process it
@ -8265,7 +8275,7 @@ package body Make is
("-D cannot be used in conjunction with a project file");
else
Scan_Make_Switches (Project_Node_Tree, Argv, Success);
Scan_Make_Switches (Env, Argv, Success);
end if;
-- -d
@ -8280,13 +8290,13 @@ package body Make is
Make_Failed
("-i cannot be used in conjunction with a project file");
else
Scan_Make_Switches (Project_Node_Tree, Argv, Success);
Scan_Make_Switches (Env, Argv, Success);
end if;
-- -j (need to save the result)
elsif Argv (2) = 'j' then
Scan_Make_Switches (Project_Node_Tree, Argv, Success);
Scan_Make_Switches (Env, Argv, Success);
if And_Save then
Saved_Maximum_Processes := Maximum_Processes;
@ -8371,7 +8381,7 @@ package body Make is
-- -Xext=val (External assignment)
elsif Argv (2) = 'X'
and then Is_External_Assignment (Project_Node_Tree, Argv)
and then Is_External_Assignment (Env, Argv)
then
-- Is_External_Assignment has side effects when it returns True
@ -8419,8 +8429,7 @@ package body Make is
-- is passed to the compiler.
else
Scan_Make_Switches
(Project_Node_Tree, Argv, Gnatmake_Switch_Found);
Scan_Make_Switches (Env, Argv, Gnatmake_Switch_Found);
if not Gnatmake_Switch_Found then
Add_Switch (Argv, Compiler, And_Save => And_Save);

27
gcc/ada/prj-conf.adb
View File

@ -573,7 +573,7 @@ package body Prj.Conf is
(Project : Project_Id;
Project_Tree : Project_Tree_Ref;
Project_Node_Tree : Prj.Tree.Project_Node_Tree_Ref;
Env : Prj.Tree.Environment;
Env : in out Prj.Tree.Environment;
Allow_Automatic_Generation : Boolean;
Config_File_Name : String := "";
Autoconf_Specified : Boolean;
@ -583,7 +583,6 @@ package body Prj.Conf is
Config : out Prj.Project_Id;
Config_File_Path : out String_Access;
Automatically_Generated : out Boolean;
Flags : Processing_Flags;
On_Load_Config : Config_File_Hook := null)
is
@ -933,13 +932,13 @@ package body Prj.Conf is
end if;
if not Is_Directory (Obj_Dir) then
case Flags.Require_Obj_Dirs is
case Env.Flags.Require_Obj_Dirs is
when Error =>
Raise_Invalid_Config
("object directory " & Obj_Dir & " does not exist");
when Warning =>
Prj.Err.Error_Msg
(Flags,
(Env.Flags,
"?object directory " & Obj_Dir & " does not exist");
Obj_Dir_Exists := False;
when Silent =>
@ -1124,7 +1123,7 @@ package body Prj.Conf is
Packages_To_Check => Packages_To_Check,
Current_Directory => Current_Directory,
Is_Config_File => True,
Flags => Flags);
Env => Env);
else
Config_Project_Node := Empty_Node;
end if;
@ -1136,7 +1135,7 @@ package body Prj.Conf is
Success => Success,
From_Project_Node => Config_Project_Node,
From_Project_Node_Tree => Project_Node_Tree,
Flags => Flags,
Env => Env,
Reset_Tree => False);
end if;
@ -1190,17 +1189,17 @@ package body Prj.Conf is
Project_File_Name : String;
Project_Tree : Prj.Project_Tree_Ref;
Project_Node_Tree : Prj.Tree.Project_Node_Tree_Ref;
Env : in out Prj.Tree.Environment;
Packages_To_Check : String_List_Access;
Allow_Automatic_Generation : Boolean := True;
Automatically_Generated : out Boolean;
Config_File_Path : out String_Access;
Target_Name : String := "";
Normalized_Hostname : String;
Flags : Processing_Flags;
On_Load_Config : Config_File_Hook := null)
is
begin
pragma Assert (Prj.Env.Is_Initialized (Project_Node_Tree.Project_Path));
pragma Assert (Prj.Env.Is_Initialized (Env.Project_Path));
-- Parse the user project tree
@ -1217,7 +1216,7 @@ package body Prj.Conf is
Packages_To_Check => Packages_To_Check,
Current_Directory => Current_Directory,
Is_Config_File => False,
Flags => Flags);
Env => Env);
if User_Project_Node = Empty_Node then
User_Project_Node := Empty_Node;
@ -1231,13 +1230,13 @@ package body Prj.Conf is
Autoconf_Specified => Autoconf_Specified,
Project_Tree => Project_Tree,
Project_Node_Tree => Project_Node_Tree,
Env => Env,
Packages_To_Check => Packages_To_Check,
Allow_Automatic_Generation => Allow_Automatic_Generation,
Automatically_Generated => Automatically_Generated,
Config_File_Path => Config_File_Path,
Target_Name => Target_Name,
Normalized_Hostname => Normalized_Hostname,
Flags => Flags,
On_Load_Config => On_Load_Config);
end Parse_Project_And_Apply_Config;
@ -1252,13 +1251,13 @@ package body Prj.Conf is
Autoconf_Specified : Boolean;
Project_Tree : Prj.Project_Tree_Ref;
Project_Node_Tree : Prj.Tree.Project_Node_Tree_Ref;
Env : in out Prj.Tree.Environment;
Packages_To_Check : String_List_Access;
Allow_Automatic_Generation : Boolean := True;
Automatically_Generated : out Boolean;
Config_File_Path : out String_Access;
Target_Name : String := "";
Normalized_Hostname : String;
Flags : Processing_Flags;
On_Load_Config : Config_File_Hook := null;
Reset_Tree : Boolean := True)
is
@ -1275,7 +1274,7 @@ package body Prj.Conf is
Success => Success,
From_Project_Node => User_Project_Node,
From_Project_Node_Tree => Project_Node_Tree,
Flags => Flags,
Env => Env,
Reset_Tree => Reset_Tree);
if not Success then
@ -1326,6 +1325,7 @@ package body Prj.Conf is
Project => Main_Project,
Project_Tree => Project_Tree,
Project_Node_Tree => Project_Node_Tree,
Env => Env,
Allow_Automatic_Generation => Allow_Automatic_Generation,
Config_File_Name => Config_File_Name,
Autoconf_Specified => Autoconf_Specified,
@ -1334,7 +1334,6 @@ package body Prj.Conf is
Packages_To_Check => Packages_To_Check,
Config_File_Path => Config_File_Path,
Automatically_Generated => Automatically_Generated,
Flags => Flags,
On_Load_Config => On_Load_Config);
Apply_Config_File (Main_Config_Project, Project_Tree);
@ -1347,7 +1346,7 @@ package body Prj.Conf is
Success => Success,
From_Project_Node => User_Project_Node,
From_Project_Node_Tree => Project_Node_Tree,
Flags => Flags);
Env => Env);
if Success then
if Project_Tree.Source_Info_File_Name /= null and then

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

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2006-2009, Free Software Foundation, Inc. --
-- Copyright (C) 2006-2011, 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- --
@ -48,13 +48,13 @@ package Prj.Conf is
Project_File_Name : String;
Project_Tree : Prj.Project_Tree_Ref;
Project_Node_Tree : Prj.Tree.Project_Node_Tree_Ref;
Env : in out Prj.Tree.Environment;
Packages_To_Check : String_List_Access;
Allow_Automatic_Generation : Boolean := True;
Automatically_Generated : out Boolean;
Config_File_Path : out String_Access;
Target_Name : String := "";
Normalized_Hostname : String;
Flags : Processing_Flags;
On_Load_Config : Config_File_Hook := null);
-- Find the main configuration project and parse the project tree rooted at
-- this configuration project.
@ -93,13 +93,13 @@ package Prj.Conf is
Autoconf_Specified : Boolean;
Project_Tree : Prj.Project_Tree_Ref;
Project_Node_Tree : Prj.Tree.Project_Node_Tree_Ref;
Env : in out Prj.Tree.Environment;
Packages_To_Check : String_List_Access;
Allow_Automatic_Generation : Boolean := True;
Automatically_Generated : out Boolean;
Config_File_Path : out String_Access;
Target_Name : String := "";
Normalized_Hostname : String;
Flags : Processing_Flags;
On_Load_Config : Config_File_Hook := null;
Reset_Tree : Boolean := True);
-- Same as above, except the project must already have been parsed through
@ -121,6 +121,7 @@ package Prj.Conf is
(Project : Prj.Project_Id;
Project_Tree : Prj.Project_Tree_Ref;
Project_Node_Tree : Prj.Tree.Project_Node_Tree_Ref;
Env : in out Prj.Tree.Environment;
Allow_Automatic_Generation : Boolean;
Config_File_Name : String := "";
Autoconf_Specified : Boolean;
@ -130,7 +131,6 @@ package Prj.Conf is
Config : out Prj.Project_Id;
Config_File_Path : out String_Access;
Automatically_Generated : out Boolean;
Flags : Processing_Flags;
On_Load_Config : Config_File_Hook := null);
-- Compute the name of the configuration file that should be used. If no
-- default configuration file is found, a new one will be automatically

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

@ -61,6 +61,8 @@ package body Prj.Makr is
Tree : constant Project_Node_Tree_Ref := new Project_Node_Tree_Data;
-- The project tree where the project file is parsed
Root_Environment : Prj.Tree.Environment;
Args : Argument_List_Access;
-- The list of arguments for calls to the compiler to get the unit names
-- and kinds (spec or body) in the Ada sources.
@ -795,10 +797,14 @@ package body Prj.Makr is
Csets.Initialize;
Snames.Initialize;
Prj.Initialize (No_Project_Tree);
Prj.Tree.Initialize (Tree);
Prj.Tree.Initialize (Root_Environment, Flags);
Prj.Env.Initialize_Default_Project_Path
(Tree.Project_Path, Target_Name => "");
(Root_Environment.Project_Path, Target_Name => "");
Prj.Tree.Initialize (Tree);
Sources.Set_Last (0);
Source_Directories.Set_Last (0);
@ -866,7 +872,7 @@ package body Prj.Makr is
Errout_Handling => Part.Finalize_If_Error,
Store_Comments => True,
Is_Config_File => False,
Flags => Flags,
Env => Root_Environment,
Current_Directory => Get_Current_Dir,
Packages_To_Check => Packages_To_Check_By_Gnatname);

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

@ -28,7 +28,6 @@ with GNAT.Directory_Operations; use GNAT.Directory_Operations;
with Output; use Output;
with Prj.Conf; use Prj.Conf;
with Prj.Env;
with Prj.Err; use Prj.Err;
with Prj.Part;
with Prj.Tree; use Prj.Tree;
@ -45,9 +44,9 @@ package body Prj.Pars is
Project : out Project_Id;
Project_File_Name : String;
Packages_To_Check : String_List_Access := All_Packages;
Flags : Processing_Flags;
Reset_Tree : Boolean := True;
In_Node_Tree : Prj.Tree.Project_Node_Tree_Ref := null)
In_Node_Tree : Prj.Tree.Project_Node_Tree_Ref := null;
Env : in out Prj.Tree.Environment)
is
Project_Node : Project_Node_Id := Empty_Node;
The_Project : Project_Id := No_Project;
@ -61,8 +60,6 @@ package body Prj.Pars is
if Project_Node_Tree = null then
Project_Node_Tree := new Project_Node_Tree_Data;
Prj.Tree.Initialize (Project_Node_Tree);
Prj.Env.Initialize_Default_Project_Path
(Project_Node_Tree.Project_Path, Target_Name => "");
end if;
-- Parse the main project file into a tree
@ -75,7 +72,7 @@ package body Prj.Pars is
Errout_Handling => Prj.Part.Finalize_If_Error,
Packages_To_Check => Packages_To_Check,
Current_Directory => Current_Dir,
Flags => Flags,
Env => Env,
Is_Config_File => False);
-- If there were no error, process the tree
@ -97,7 +94,7 @@ package body Prj.Pars is
Allow_Automatic_Generation => False,
Automatically_Generated => Automatically_Generated,
Config_File_Path => Config_File_Path,
Flags => Flags,
Env => Env,
Normalized_Hostname => "",
On_Load_Config =>
Add_Default_GNAT_Naming_Scheme'Access,

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

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2000-2009, Free Software Foundation, Inc. --
-- Copyright (C) 2000-2011, 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- --
@ -37,9 +37,9 @@ package Prj.Pars is
Project : out Project_Id;
Project_File_Name : String;
Packages_To_Check : String_List_Access := All_Packages;
Flags : Processing_Flags;
Reset_Tree : Boolean := True;
In_Node_Tree : Prj.Tree.Project_Node_Tree_Ref := null);
In_Node_Tree : Prj.Tree.Project_Node_Tree_Ref := null;
Env : in out Prj.Tree.Environment);
-- Parse and process a project files and all its imported project files, in
-- the project tree In_Tree.
-- All the project files are parsed (through Prj.Tree) to create a tree in

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

@ -185,7 +185,7 @@ package body Prj.Part is
Depth : Natural;
Current_Dir : String;
Is_Config_File : Boolean;
Flags : Processing_Flags);
Env : in out Environment);
-- Parse a project file. This is a recursive procedure: it calls itself for
-- imported and extended projects. When From_Extended is not None, if the
-- project has already been parsed and is an extended project A, return the
@ -220,7 +220,7 @@ package body Prj.Part is
Depth : Natural;
Current_Dir : String;
Is_Config_File : Boolean;
Flags : Processing_Flags);
Env : in out Environment);
-- Parse the imported projects that have been stored in table Withs, if
-- any. From_Extended is used for the call to Parse_Single_Project below.
-- When In_Limited is True, the importing path includes at least one
@ -448,7 +448,7 @@ package body Prj.Part is
Store_Comments : Boolean := False;
Current_Directory : String := "";
Is_Config_File : Boolean;
Flags : Processing_Flags;
Env : in out Prj.Tree.Environment;
Target_Name : String := "")
is
Dummy : Boolean;
@ -460,9 +460,9 @@ package body Prj.Part is
Path_Name_Id : Path_Name_Type;
begin
if not Is_Initialized (In_Tree.Project_Path) then
if not Is_Initialized (Env.Project_Path) then
Prj.Env.Initialize_Default_Project_Path
(In_Tree.Project_Path, Target_Name);
(Env.Project_Path, Target_Name);
end if;
if Real_Project_File_Name = null then
@ -471,7 +471,7 @@ package body Prj.Part is
Project := Empty_Node;
Find_Project (In_Tree.Project_Path,
Find_Project (Env.Project_Path,
Project_File_Name => Real_Project_File_Name.all,
Directory => Current_Directory,
Path => Path_Name_Id);
@ -488,7 +488,7 @@ package body Prj.Part is
declare
P : String_Access;
begin
Get_Path (In_Tree.Project_Path, Path => P);
Get_Path (Env.Project_Path, Path => P);
Prj.Com.Fail
("project file """
@ -515,7 +515,7 @@ package body Prj.Part is
Depth => 0,
Current_Dir => Current_Directory,
Is_Config_File => Is_Config_File,
Flags => Flags);
Env => Env);
exception
when Types.Unrecoverable_Error =>
@ -755,7 +755,7 @@ package body Prj.Part is
Depth : Natural;
Current_Dir : String;
Is_Config_File : Boolean;
Flags : Processing_Flags)
Env : in out Environment)
is
Current_With_Clause : With_Id := Context_Clause;
@ -788,7 +788,7 @@ package body Prj.Part is
if Limited_Withs = Current_With.Limited_With then
Find_Project
(In_Tree.Project_Path,
(Env.Project_Path,
Project_File_Name => Get_Name_String (Current_With.Path),
Directory => Project_Directory_Path,
Path => Imported_Path_Name_Id);
@ -799,7 +799,7 @@ package body Prj.Part is
Error_Msg_File_1 := File_Name_Type (Current_With.Path);
Error_Msg
(Flags, "unknown project file: {", Current_With.Location);
(Env.Flags, "unknown project file: {", Current_With.Location);
-- If this is not imported by the main project file, display
-- the import path.
@ -810,7 +810,7 @@ package body Prj.Part is
File_Name_Type
(Project_Stack.Table (Index).Path_Name);
Error_Msg
(Flags, "\imported by {", Current_With.Location);
(Env.Flags, "\imported by {", Current_With.Location);
end loop;
end if;
@ -895,7 +895,7 @@ package body Prj.Part is
Depth => Depth,
Current_Dir => Current_Dir,
Is_Config_File => Is_Config_File,
Flags => Flags);
Env => Env);
else
Extends_All := Is_Extending_All (Withed_Project, In_Tree);
@ -1138,7 +1138,7 @@ package body Prj.Part is
Depth : Natural;
Current_Dir : String;
Is_Config_File : Boolean;
Flags : Processing_Flags)
Env : in out Environment)
is
Path_Name : constant String := Get_Name_String (Path_Name_Id);
@ -1196,7 +1196,7 @@ package body Prj.Part is
end;
if Has_Circular_Dependencies
(Flags, Normed_Path_Name, Canonical_Path_Name)
(Env.Flags, Normed_Path_Name, Canonical_Path_Name)
then
Project := Empty_Node;
return;
@ -1221,13 +1221,13 @@ package body Prj.Part is
if A_Project_Name_And_Node.Extended then
if A_Project_Name_And_Node.Proj_Qualifier /= Dry then
Error_Msg
(Flags,
(Env.Flags,
"cannot extend the same project file several times",
Token_Ptr);
end if;
else
Error_Msg
(Flags,
(Env.Flags,
"cannot extend an already imported project file",
Token_Ptr);
end if;
@ -1268,7 +1268,7 @@ package body Prj.Part is
end;
else
Error_Msg
(Flags,
(Env.Flags,
"cannot import an already extended project file",
Token_Ptr);
end if;
@ -1308,7 +1308,7 @@ package body Prj.Part is
-- following Ada identifier's syntax).
Error_Msg_File_1 := File_Name_Type (Canonical_Path_Name);
Error_Msg (Flags,
Error_Msg (Env.Flags,
"?{ is not a valid path name for a project file",
Token_Ptr);
end if;
@ -1326,7 +1326,7 @@ package body Prj.Part is
(In_Tree => In_Tree,
Is_Config_File => Is_Config_File,
Context_Clause => First_With,
Flags => Flags);
Flags => Env.Flags);
Project := Default_Project_Node
(Of_Kind => N_Project, In_Tree => In_Tree);
@ -1335,7 +1335,7 @@ package body Prj.Part is
Set_Path_Name_Of (Project, In_Tree, Normed_Path_Name);
Read_Project_Qualifier
(Flags, In_Tree, Is_Config_File, Qualifier_Location, Project);
(Env.Flags, In_Tree, Is_Config_File, Qualifier_Location, Project);
Set_Location_Of (Project, In_Tree, Token_Ptr);
@ -1388,7 +1388,7 @@ package body Prj.Part is
if Is_Config_File then
Error_Msg
(Flags,
(Env.Flags,
"extending configuration project not allowed", Token_Ptr);
end if;
@ -1451,7 +1451,7 @@ package body Prj.Part is
end if;
Error_Msg
(Flags,
(Env.Flags,
"?file name does not match project name, should be `%%"
& Extension.all & "`",
Token_Ptr);
@ -1501,7 +1501,7 @@ package body Prj.Part is
Depth => Depth + 1,
Current_Dir => Current_Dir,
Is_Config_File => Is_Config_File,
Flags => Flags);
Env => Env);
Set_First_With_Clause_Of (Project, In_Tree, Imported_Projects);
end;
@ -1530,12 +1530,13 @@ package body Prj.Part is
Duplicated := True;
Error_Msg_Name_1 := Project_Name;
Error_Msg
(Flags, "duplicate project name %%",
(Env.Flags, "duplicate project name %%",
Location_Of (Project, In_Tree));
Error_Msg_Name_1 :=
Name_Id (Path_Name_Of (Name_And_Node.Node, In_Tree));
Error_Msg
(Flags, "\already in %%", Location_Of (Project, In_Tree));
(Env.Flags,
"\already in %%", Location_Of (Project, In_Tree));
end if;
end;
end if;
@ -1559,7 +1560,7 @@ package body Prj.Part is
begin
Find_Project
(In_Tree.Project_Path,
(Env.Project_Path,
Project_File_Name => Original_Path_Name,
Directory => Get_Name_String (Project_Directory),
Path => Extended_Project_Path_Name_Id);
@ -1570,7 +1571,7 @@ package body Prj.Part is
Error_Msg_Name_1 := Token_Name;
Error_Msg (Flags, "unknown project file: %%", Token_Ptr);
Error_Msg (Env.Flags, "unknown project file: %%", Token_Ptr);
-- If not in the main project file, display the import path
@ -1578,13 +1579,13 @@ package body Prj.Part is
Error_Msg_Name_1 :=
Name_Id
(Project_Stack.Table (Project_Stack.Last).Path_Name);
Error_Msg (Flags, "\extended by %%", Token_Ptr);
Error_Msg (Env.Flags, "\extended by %%", Token_Ptr);
for Index in reverse 1 .. Project_Stack.Last - 1 loop
Error_Msg_Name_1 :=
Name_Id
(Project_Stack.Table (Index).Path_Name);
Error_Msg (Flags, "\imported by %%", Token_Ptr);
Error_Msg (Env.Flags, "\imported by %%", Token_Ptr);
end loop;
end if;
@ -1609,7 +1610,7 @@ package body Prj.Part is
Depth => Depth + 1,
Current_Dir => Current_Dir,
Is_Config_File => Is_Config_File,
Flags => Flags);
Env => Env);
end;
if Present (Extended_Project) then
@ -1630,7 +1631,7 @@ package body Prj.Part is
Project_Qualifier_Of (Extended_Project, In_Tree) /= Dry
then
Error_Msg
(Flags, "an abstract project can only extend " &
(Env.Flags, "an abstract project can only extend " &
"another abstract project",
Qualifier_Location);
end if;
@ -1642,8 +1643,8 @@ package body Prj.Part is
end if;
end if;
Check_Extending_All_Imports (Flags, In_Tree, Project);
Check_Aggregate_Imports (Flags, In_Tree, Project);
Check_Extending_All_Imports (Env.Flags, In_Tree, Project);
Check_Aggregate_Imports (Env.Flags, In_Tree, Project);
-- Check that a project with a name including a dot either imports
-- or extends the project whose name precedes the last dot.
@ -1710,7 +1711,7 @@ package body Prj.Part is
Error_Msg_Name_1 := Name_Of_Project;
Error_Msg_Name_2 := Parent_Name;
Error_Msg (Flags,
Error_Msg (Env.Flags,
"project %% does not import or extend project %%",
Location_Of (Project, In_Tree));
end if;
@ -1735,7 +1736,7 @@ package body Prj.Part is
Extends => Extended_Project,
Packages_To_Check => Packages_To_Check,
Is_Config_File => Is_Config_File,
Flags => Flags);
Flags => Env.Flags);
Set_Project_Declaration_Of (Project, In_Tree, Project_Declaration);
if Present (Extended_Project)
@ -1794,7 +1795,7 @@ package body Prj.Part is
then
-- Invalid name: report an error
Error_Msg (Flags, "expected """ &
Error_Msg (Env.Flags, "expected """ &
Get_Name_String (Name_Of (Project, In_Tree)) & """",
Token_Ptr);
end if;
@ -1811,7 +1812,8 @@ package body Prj.Part is
if Token /= Tok_EOF then
Error_Msg
(Flags, "unexpected text following end of project", Token_Ptr);
(Env.Flags,
"unexpected text following end of project", Token_Ptr);
end if;
end if;
@ -1859,7 +1861,7 @@ package body Prj.Part is
Depth => Depth + 1,
Current_Dir => Current_Dir,
Is_Config_File => Is_Config_File,
Flags => Flags);
Env => Env);
Set_First_With_Clause_Of (Project, In_Tree, Imported_Projects);
end;

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

@ -46,7 +46,7 @@ package Prj.Part is
Store_Comments : Boolean := False;
Current_Directory : String := "";
Is_Config_File : Boolean;
Flags : Processing_Flags;
Env : in out Prj.Tree.Environment;
Target_Name : String := "");
-- Parse project file and all its imported project files and create a tree.
-- Return the node for the project (or Empty_Node if parsing failed). If

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

@ -104,9 +104,9 @@ package body Prj.Proc is
function Expression
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
Flags : Processing_Flags;
From_Project_Node : Project_Node_Id;
From_Project_Node_Tree : Project_Node_Tree_Ref;
Env : Prj.Tree.Environment;
Pkg : Package_Id;
First_Term : Project_Node_Id;
Kind : Variable_Kind) return Variable_Value;
@ -127,9 +127,9 @@ package body Prj.Proc is
procedure Process_Declarative_Items
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
Flags : Processing_Flags;
From_Project_Node : Project_Node_Id;
Node_Tree : Project_Node_Tree_Ref;
Env : Prj.Tree.Environment;
Pkg : Package_Id;
Item : Project_Node_Id);
-- Process declarative items starting with From_Project_Node, and put them
@ -139,9 +139,9 @@ package body Prj.Proc is
procedure Recursive_Process
(In_Tree : Project_Tree_Ref;
Project : out Project_Id;
Flags : Processing_Flags;
From_Project_Node : Project_Node_Id;
From_Project_Node_Tree : Project_Node_Tree_Ref;
Env : in out Prj.Tree.Environment;
Extended_By : Project_Id);
-- Process project with node From_Project_Node in the tree. Do nothing if
-- From_Project_Node is Empty_Node. If project has already been processed,
@ -502,9 +502,9 @@ package body Prj.Proc is
function Expression
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
Flags : Processing_Flags;
From_Project_Node : Project_Node_Id;
From_Project_Node_Tree : Project_Node_Tree_Ref;
Env : Prj.Tree.Environment;
Pkg : Package_Id;
First_Term : Project_Node_Id;
Kind : Variable_Kind) return Variable_Value
@ -607,9 +607,9 @@ package body Prj.Proc is
Value := Expression
(Project => Project,
In_Tree => In_Tree,
Flags => Flags,
From_Project_Node => From_Project_Node,
From_Project_Node_Tree => From_Project_Node_Tree,
Env => Env,
Pkg => Pkg,
First_Term =>
Tree.First_Term
@ -657,9 +657,9 @@ package body Prj.Proc is
Expression
(Project => Project,
In_Tree => In_Tree,
Flags => Flags,
From_Project_Node => From_Project_Node,
From_Project_Node_Tree => From_Project_Node_Tree,
Env => Env,
Pkg => Pkg,
First_Term =>
Tree.First_Term
@ -1044,9 +1044,9 @@ package body Prj.Proc is
Def_Var := Expression
(Project => Project,
In_Tree => In_Tree,
Flags => Flags,
From_Project_Node => From_Project_Node,
From_Project_Node_Tree => From_Project_Node_Tree,
Env => Env,
Pkg => Pkg,
First_Term =>
Tree.First_Term
@ -1063,9 +1063,7 @@ package body Prj.Proc is
From_Project_Node_Tree) = List;
if Ext_List then
Value :=
Prj.Ext.Value_Of
(From_Project_Node_Tree.External, Name, No_Name);
Value := Prj.Ext.Value_Of (Env.External, Name, No_Name);
if Value /= No_Name then
declare
@ -1169,14 +1167,12 @@ package body Prj.Proc is
else
-- Get the value
Value :=
Prj.Ext.Value_Of
(From_Project_Node_Tree.External, Name, Default);
Value := Prj.Ext.Value_Of (Env.External, Name, Default);
if Value = No_Name then
if not Quiet_Output then
Error_Msg
(Flags, "?undefined external reference",
(Env.Flags, "?undefined external reference",
Location_Of
(The_Current_Term, From_Project_Node_Tree),
Project);
@ -1387,7 +1383,7 @@ package body Prj.Proc is
Success : out Boolean;
From_Project_Node : Project_Node_Id;
From_Project_Node_Tree : Project_Node_Tree_Ref;
Flags : Processing_Flags;
Env : in out Prj.Tree.Environment;
Reset_Tree : Boolean := True)
is
begin
@ -1397,7 +1393,7 @@ package body Prj.Proc is
Success => Success,
From_Project_Node => From_Project_Node,
From_Project_Node_Tree => From_Project_Node_Tree,
Flags => Flags,
Env => Env,
Reset_Tree => Reset_Tree);
if Project_Qualifier_Of (From_Project_Node, From_Project_Node_Tree) /=
@ -1409,7 +1405,7 @@ package body Prj.Proc is
Success => Success,
From_Project_Node => From_Project_Node,
From_Project_Node_Tree => From_Project_Node_Tree,
Flags => Flags);
Env => Env);
end if;
end Process;
@ -1420,9 +1416,9 @@ package body Prj.Proc is
procedure Process_Declarative_Items
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
Flags : Processing_Flags;
From_Project_Node : Project_Node_Id;
Node_Tree : Project_Node_Tree_Ref;
Node_Tree : Project_Node_Tree_Ref;
Env : Prj.Tree.Environment;
Pkg : Package_Id;
Item : Project_Node_Id)
is
@ -1470,12 +1466,14 @@ package body Prj.Proc is
if Value.Value = Empty_String then
Error_Msg_Name_1 := Name_Of (Declaration, Node_Tree);
case Flags.Allow_Invalid_External is
case Env.Flags.Allow_Invalid_External is
when Error =>
Error_Msg (Flags, "no value defined for %%", Loc, Project);
Error_Msg
(Env.Flags, "no value defined for %%", Loc, Project);
when Warning =>
Reset_Value := True;
Error_Msg (Flags, "?no value defined for %%", Loc, Project);
Error_Msg
(Env.Flags, "?no value defined for %%", Loc, Project);
when Silent =>
Reset_Value := True;
end case;
@ -1501,14 +1499,14 @@ package body Prj.Proc is
Error_Msg_Name_1 := Value.Value;
Error_Msg_Name_2 := Name_Of (Declaration, Node_Tree);
case Flags.Allow_Invalid_External is
case Env.Flags.Allow_Invalid_External is
when Error =>
Error_Msg
(Flags, "value %% is illegal for typed string %%",
(Env.Flags, "value %% is illegal for typed string %%",
Loc, Project);
when Warning =>
Error_Msg
(Flags, "?value %% is illegal for typed string %%",
(Env.Flags, "?value %% is illegal for typed string %%",
Loc, Project);
Reset_Value := True;
when Silent =>
@ -1618,9 +1616,9 @@ package body Prj.Proc is
Process_Declarative_Items
(Project => Project,
In_Tree => In_Tree,
Flags => Flags,
From_Project_Node => From_Project_Node,
Node_Tree => Node_Tree,
Node_Tree => Node_Tree,
Env => Env,
Pkg => New_Pkg,
Item =>
First_Declarative_Item_Of (Current_Item, Node_Tree));
@ -1778,7 +1776,7 @@ package body Prj.Proc is
if Orig_Array = No_Array then
Error_Msg
(Flags,
(Env.Flags,
"associative array value not found",
Location_Of (Current_Item, Node_Tree),
Project);
@ -2085,9 +2083,9 @@ package body Prj.Proc is
Expression
(Project => Project,
In_Tree => In_Tree,
Flags => Flags,
From_Project_Node => From_Project_Node,
From_Project_Node_Tree => Node_Tree,
Env => Env,
Pkg => Pkg,
First_Term =>
Tree.First_Term
@ -2275,9 +2273,9 @@ package body Prj.Proc is
Process_Declarative_Items
(Project => Project,
In_Tree => In_Tree,
Flags => Flags,
From_Project_Node => From_Project_Node,
Node_Tree => Node_Tree,
Env => Env,
Pkg => Pkg,
Item => Decl_Item);
end if;
@ -2330,7 +2328,7 @@ package body Prj.Proc is
Success : out Boolean;
From_Project_Node : Project_Node_Id;
From_Project_Node_Tree : Project_Node_Tree_Ref;
Flags : Processing_Flags;
Env : in out Prj.Tree.Environment;
Reset_Tree : Boolean := True)
is
begin
@ -2351,9 +2349,9 @@ package body Prj.Proc is
Recursive_Process
(Project => Project,
In_Tree => In_Tree,
Flags => Flags,
From_Project_Node => From_Project_Node,
From_Project_Node_Tree => From_Project_Node_Tree,
Env => Env,
Extended_By => No_Project);
Success :=
@ -2377,7 +2375,7 @@ package body Prj.Proc is
Success : out Boolean;
From_Project_Node : Project_Node_Id;
From_Project_Node_Tree : Project_Node_Tree_Ref;
Flags : Processing_Flags)
Env : Environment)
is
Obj_Dir : Path_Name_Type;
Extending : Project_Id;
@ -2392,7 +2390,7 @@ package body Prj.Proc is
Debug_Increase_Indent ("Process tree, phase 2");
if Project /= No_Project then
Check (In_Tree, Project, From_Project_Node_Tree, Flags);
Check (In_Tree, Project, From_Project_Node_Tree, Env.Flags);
end if;
-- If main project is an extending all project, set object directory of
@ -2441,7 +2439,7 @@ package body Prj.Proc is
if Extending2.Virtual then
Error_Msg_Name_1 := Prj.Project.Display_Name;
Error_Msg
(Flags,
(Env.Flags,
"project %% cannot be extended by a virtual" &
" project with the same object directory",
Prj.Project.Location, Project);
@ -2450,11 +2448,11 @@ package body Prj.Proc is
Error_Msg_Name_1 := Extending2.Display_Name;
Error_Msg_Name_2 := Prj.Project.Display_Name;
Error_Msg
(Flags,
(Env.Flags,
"project %% cannot extend project %%",
Extending2.Location, Project);
Error_Msg
(Flags,
(Env.Flags,
"\they share the same object directory",
Extending2.Location, Project);
end if;
@ -2485,9 +2483,9 @@ package body Prj.Proc is
procedure Recursive_Process
(In_Tree : Project_Tree_Ref;
Project : out Project_Id;
Flags : Processing_Flags;
From_Project_Node : Project_Node_Id;
From_Project_Node_Tree : Project_Node_Tree_Ref;
Env : in out Prj.Tree.Environment;
Extended_By : Project_Id)
is
procedure Process_Imported_Projects
@ -2537,11 +2535,11 @@ package body Prj.Proc is
Recursive_Process
(In_Tree => In_Tree,
Project => New_Project,
Flags => Flags,
From_Project_Node =>
Project_Node_Of
(With_Clause, From_Project_Node_Tree),
From_Project_Node_Tree => From_Project_Node_Tree,
Env => Env,
Extended_By => No_Project);
-- Imported is the id of the last imported project. If
@ -2585,7 +2583,7 @@ package body Prj.Proc is
(Tree => In_Tree,
Project => Project,
Node_Tree => From_Project_Node_Tree,
Flags => Flags);
Flags => Env.Flags);
List := Project.Aggregated_Projects;
while Success and then List /= null loop
@ -2596,7 +2594,7 @@ package body Prj.Proc is
Errout_Handling => Prj.Part.Never_Finalize,
Current_Directory => Get_Name_String (Project.Directory.Name),
Is_Config_File => False,
Flags => Flags);
Env => Env);
Success := not Prj.Tree.No (Loaded_Tree);
@ -2604,9 +2602,9 @@ package body Prj.Proc is
Recursive_Process
(In_Tree => In_Tree,
Project => List.Project,
Flags => Flags,
From_Project_Node => Loaded_Tree,
From_Project_Node_Tree => From_Project_Node_Tree,
Env => Env,
Extended_By => No_Project);
else
Debug_Output ("Failed to parse", Name_Id (List.Path));
@ -2812,18 +2810,18 @@ package body Prj.Proc is
Recursive_Process
(In_Tree => In_Tree,
Project => Project.Extends,
Flags => Flags,
From_Project_Node => Extended_Project_Of
(Declaration_Node, From_Project_Node_Tree),
From_Project_Node_Tree => From_Project_Node_Tree,
Env => Env,
Extended_By => Project);
Process_Declarative_Items
(Project => Project,
In_Tree => In_Tree,
Flags => Flags,
From_Project_Node => From_Project_Node,
Node_Tree => From_Project_Node_Tree,
Env => Env,
Pkg => No_Package,
Item => First_Declarative_Item_Of
(Declaration_Node, From_Project_Node_Tree));

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

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2001-2009, Free Software Foundation, Inc. --
-- Copyright (C) 2001-2011, 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- --
@ -37,7 +37,7 @@ package Prj.Proc is
Success : out Boolean;
From_Project_Node : Project_Node_Id;
From_Project_Node_Tree : Project_Node_Tree_Ref;
Flags : Prj.Processing_Flags;
Env : in out Prj.Tree.Environment;
Reset_Tree : Boolean := True);
-- Process a project tree (ie the direct resulting of parsing a .gpr file)
-- based on the current external references.
@ -57,7 +57,7 @@ package Prj.Proc is
Success : out Boolean;
From_Project_Node : Project_Node_Id;
From_Project_Node_Tree : Project_Node_Tree_Ref;
Flags : Processing_Flags);
Env : Prj.Tree.Environment);
-- Perform the second phase of the processing, filling the rest of the
-- project with the information extracted from the project tree. This phase
-- requires that the configuration file has already been parsed (in fact
@ -71,7 +71,7 @@ package Prj.Proc is
Success : out Boolean;
From_Project_Node : Project_Node_Id;
From_Project_Node_Tree : Project_Node_Tree_Ref;
Flags : Processing_Flags;
Env : in out Prj.Tree.Environment;
Reset_Tree : Boolean := True);
-- Performs the two phases of the processing

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

@ -982,19 +982,28 @@ package body Prj.Tree is
-- Initialize --
----------------
procedure Initialize
(Tree : Project_Node_Tree_Ref; Env : in out Environment) is
procedure Initialize (Tree : Project_Node_Tree_Ref) is
begin
Project_Node_Table.Init (Tree.Project_Nodes);
Projects_Htable.Reset (Tree.Projects_HT);
Initialize (Env);
end Initialize;
--------------------
-- Override_Flags --
--------------------
procedure Override_Flags
(Self : in out Environment; Flags : Prj.Processing_Flags) is
begin
Self.Flags := Flags;
end Override_Flags;
----------------
-- Initialize --
----------------
procedure Initialize (Self : in out Environment) is
procedure Initialize
(Self : in out Environment; Flags : Processing_Flags) is
begin
-- Do not reset the external references, in case we are reloading a
-- project, since we want to preserve the current environment.
@ -1003,6 +1012,8 @@ package body Prj.Tree is
Prj.Ext.Initialize (Self.External);
-- Prj.Ext.Reset (Tree.External);
Self.Flags := Flags;
end Initialize;
----------
@ -1019,10 +1030,7 @@ package body Prj.Tree is
-- Free --
----------
procedure Free
(Proj : in out Project_Node_Tree_Ref;
Env : in out Environment)
is
procedure Free (Proj : in out Project_Node_Tree_Ref) is
procedure Unchecked_Free is new Ada.Unchecked_Deallocation
(Project_Node_Tree_Data, Project_Node_Tree_Ref);
begin
@ -1031,7 +1039,6 @@ package body Prj.Tree is
Projects_Htable.Reset (Proj.Projects_HT);
Unchecked_Free (Proj);
end if;
Free (Env);
end Free;
-------------------------------

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

@ -41,7 +41,7 @@ package Prj.Tree is
-----------------
type Environment is record
External : Prj.Ext.External_References;
External : Prj.Ext.External_References;
-- External references are stored in this hash table (and manipulated
-- through subprograms in prj-ext.ads). External references are
-- project-tree specific so that one can load the same tree twice but
@ -52,16 +52,26 @@ package Prj.Tree is
-- simultaneously multiple projects, each with its own search path, in
-- particular when using different compilers with different default
-- search directories.
Flags : Prj.Processing_Flags;
-- Configure errors and warnings
end record;
-- This record contains the context in which projects are parsed and
-- processed (finding importing project, resolving external values,...)
procedure Initialize (Self : in out Environment);
procedure Initialize (Self : in out Environment; Flags : Processing_Flags);
-- Initialize a new environment
procedure Free (Self : in out Environment);
-- Free the memory used by Self
procedure Override_Flags
(Self : in out Environment; Flags : Prj.Processing_Flags);
-- Override the subprogram called in case there are parsing errors. This
-- is needed in applications that do their own error handling, since the
-- error handler is likely to be a local subprogram in this case (which
-- can't be stored when the flags are created).
-------------------
-- Project nodes --
-------------------
@ -130,8 +140,7 @@ package Prj.Tree is
pragma Inline (No);
-- Return True if Node = Empty_Node
procedure Initialize (Tree : Project_Node_Tree_Ref;
Env : in out Environment);
procedure Initialize (Tree : Project_Node_Tree_Ref);
-- Initialize the Project File tree: empty the Project_Nodes table
-- and reset the Projects_Htable.
@ -1490,8 +1499,7 @@ package Prj.Tree is
Projects_HT : Tree_Private_Part.Projects_Htable.Instance;
end record;
procedure Free (Proj : in out Project_Node_Tree_Ref;
Env : in out Environment);
procedure Free (Proj : in out Project_Node_Tree_Ref);
-- Free memory used by Prj
private

6
gcc/ada/switch-m.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2001-2010, Free Software Foundation, Inc. --
-- Copyright (C) 2001-2011, 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- --
@ -602,7 +602,7 @@ package body Switch.M is
------------------------
procedure Scan_Make_Switches
(Project_Node_Tree : Prj.Tree.Project_Node_Tree_Ref;
(Env : in out Prj.Tree.Environment;
Switch_Chars : String;
Success : out Boolean)
is
@ -667,7 +667,7 @@ package body Switch.M is
and then Switch_Chars (Ptr .. Ptr + 1) = "aP"
then
Add_Directories
(Project_Node_Tree.Project_Path,
(Env.Project_Path,
Switch_Chars (Ptr + 2 .. Switch_Chars'Last));
elsif C = 'v' and then Switch_Chars'Length = 3 then

4
gcc/ada/switch-m.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2001-2010, Free Software Foundation, Inc. --
-- Copyright (C) 2001-2011, 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- --
@ -39,7 +39,7 @@ with Prj.Tree;
package Switch.M is
procedure Scan_Make_Switches
(Project_Node_Tree : Prj.Tree.Project_Node_Tree_Ref;
(Env : in out Prj.Tree.Environment;
Switch_Chars : String;
Success : out Boolean);
-- Scan a gnatmake switch and act accordingly. For switches that are