aboutsummaryrefslogtreecommitdiff
path: root/gcc
diff options
context:
space:
mode:
authorEmmanuel Briot <briot@adacore.com>2011-08-03 09:36:24 +0000
committerArnaud Charlet <charlet@gcc.gnu.org>2011-08-03 11:36:24 +0200
commit4437a53072c556b2a81eb96c842c5448ffafa838 (patch)
tree26be5ac589a2f9898be35b1657335ce04c95f003 /gcc
parent804fe3c4e68b9ab02f60ee33acfc325cfda76591 (diff)
downloadgcc-4437a53072c556b2a81eb96c842c5448ffafa838.zip
gcc-4437a53072c556b2a81eb96c842c5448ffafa838.tar.gz
gcc-4437a53072c556b2a81eb96c842c5448ffafa838.tar.bz2
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
Diffstat (limited to 'gcc')
-rw-r--r--gcc/ada/ChangeLog7
-rw-r--r--gcc/ada/clean.adb40
-rw-r--r--gcc/ada/gnatcmd.adb51
-rw-r--r--gcc/ada/make.adb69
-rw-r--r--gcc/ada/prj-conf.adb27
-rw-r--r--gcc/ada/prj-conf.ads8
-rw-r--r--gcc/ada/prj-makr.adb12
-rw-r--r--gcc/ada/prj-pars.adb11
-rw-r--r--gcc/ada/prj-pars.ads6
-rw-r--r--gcc/ada/prj-part.adb80
-rw-r--r--gcc/ada/prj-part.ads2
-rw-r--r--gcc/ada/prj-proc.adb86
-rw-r--r--gcc/ada/prj-proc.ads8
-rw-r--r--gcc/ada/prj-tree.adb25
-rw-r--r--gcc/ada/prj-tree.ads20
-rw-r--r--gcc/ada/switch-m.adb6
-rw-r--r--gcc/ada/switch-m.ads4
17 files changed, 226 insertions, 236 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index f415e59..4287e95 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,5 +1,12 @@
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,
prj-tree.adb, prj-tree.ads (Environment): new type.
diff --git a/gcc/ada/clean.adb b/gcc/ada/clean.adb
index 16897bf..49cc5cc 100644
--- a/gcc/ada/clean.adb
+++ b/gcc/ada/clean.adb
@@ -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
diff --git a/gcc/ada/gnatcmd.adb b/gcc/ada/gnatcmd.adb
index 09b95488..2f72c8d 100644
--- a/gcc/ada/gnatcmd.adb
+++ b/gcc/ada/gnatcmd.adb
@@ -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
diff --git a/gcc/ada/make.adb b/gcc/ada/make.adb
index 2de96c8..4901928 100644
--- a/gcc/ada/make.adb
+++ b/gcc/ada/make.adb
@@ -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);
diff --git a/gcc/ada/prj-conf.adb b/gcc/ada/prj-conf.adb
index de25dce..978d413 100644
--- a/gcc/ada/prj-conf.adb
+++ b/gcc/ada/prj-conf.adb
@@ -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
diff --git a/gcc/ada/prj-conf.ads b/gcc/ada/prj-conf.ads
index 199e3e8..af33184 100644
--- a/gcc/ada/prj-conf.ads
+++ b/gcc/ada/prj-conf.ads
@@ -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
diff --git a/gcc/ada/prj-makr.adb b/gcc/ada/prj-makr.adb
index 2910a3a..439ac05 100644
--- a/gcc/ada/prj-makr.adb
+++ b/gcc/ada/prj-makr.adb
@@ -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);
diff --git a/gcc/ada/prj-pars.adb b/gcc/ada/prj-pars.adb
index c638d9e..f2d289f 100644
--- a/gcc/ada/prj-pars.adb
+++ b/gcc/ada/prj-pars.adb
@@ -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,
diff --git a/gcc/ada/prj-pars.ads b/gcc/ada/prj-pars.ads
index 4e7d480..fcfde91 100644
--- a/gcc/ada/prj-pars.ads
+++ b/gcc/ada/prj-pars.ads
@@ -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
diff --git a/gcc/ada/prj-part.adb b/gcc/ada/prj-part.adb
index 3438fde..b757167 100644
--- a/gcc/ada/prj-part.adb
+++ b/gcc/ada/prj-part.adb
@@ -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;
diff --git a/gcc/ada/prj-part.ads b/gcc/ada/prj-part.ads
index c4468a4..16b84ab 100644
--- a/gcc/ada/prj-part.ads
+++ b/gcc/ada/prj-part.ads
@@ -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
diff --git a/gcc/ada/prj-proc.adb b/gcc/ada/prj-proc.adb
index 9c9c3b5..6dd3ca7 100644
--- a/gcc/ada/prj-proc.adb
+++ b/gcc/ada/prj-proc.adb
@@ -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));
diff --git a/gcc/ada/prj-proc.ads b/gcc/ada/prj-proc.ads
index 4257c900..4610fdf 100644
--- a/gcc/ada/prj-proc.ads
+++ b/gcc/ada/prj-proc.ads
@@ -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
diff --git a/gcc/ada/prj-tree.adb b/gcc/ada/prj-tree.adb
index 6fa56ce..2d1b556 100644
--- a/gcc/ada/prj-tree.adb
+++ b/gcc/ada/prj-tree.adb
@@ -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;
-------------------------------
diff --git a/gcc/ada/prj-tree.ads b/gcc/ada/prj-tree.ads
index ae0d046..f391e9d 100644
--- a/gcc/ada/prj-tree.ads
+++ b/gcc/ada/prj-tree.ads
@@ -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
diff --git a/gcc/ada/switch-m.adb b/gcc/ada/switch-m.adb
index ab775b5..4d2751c 100644
--- a/gcc/ada/switch-m.adb
+++ b/gcc/ada/switch-m.adb
@@ -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
diff --git a/gcc/ada/switch-m.ads b/gcc/ada/switch-m.ads
index de7ccaf..b1daf14 100644
--- a/gcc/ada/switch-m.ads
+++ b/gcc/ada/switch-m.ads
@@ -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