Skip to content

R
riscv-gcc-1
Commit 4437a530 by Emmanuel Briot Committed by Arnaud Charlet
Options

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
parent 804fe3c4
Showing with 143 additions and 153 deletions
gcc/ada/ChangeLog
2011-08-03 Emmanuel Briot <briot@adacore.com> 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-proc.adb, prj.ads, makeutl.adb, makeutl.ads, prj-conf.adb,
prj-tree.adb, prj-tree.ads (Environment): new type. prj-tree.adb, prj-tree.ads (Environment): new type.
......
gcc/ada/clean.adb
...@@ -93,6 +93,8 @@ package body Clean is ...@@ -93,6 +93,8 @@ package body Clean is
Project_Node_Tree : Project_Node_Tree_Ref; Project_Node_Tree : Project_Node_Tree_Ref;
Root_Environment : Prj.Tree.Environment;
Main_Project : Prj.Project_Id := Prj.No_Project; Main_Project : Prj.Project_Id := Prj.No_Project;
All_Projects : Boolean := False; All_Projects : Boolean := False;
...@@ -1400,15 +1402,12 @@ package body Clean is ...@@ -1400,15 +1402,12 @@ package body Clean is
-- Parse the project file. If there is an error, Main_Project -- Parse the project file. If there is an error, Main_Project
-- will still be No_Project. -- will still be No_Project.
Prj.Env.Initialize_Default_Project_Path
(Project_Node_Tree.Project_Path, Target_Name => "");
Prj.Pars.Parse Prj.Pars.Parse
(Project => Main_Project, (Project => Main_Project,
In_Tree => Project_Tree, In_Tree => Project_Tree,
In_Node_Tree => Project_Node_Tree, In_Node_Tree => Project_Node_Tree,
Project_File_Name => Project_File_Name.all, Project_File_Name => Project_File_Name.all,
Flags => Gnatmake_Flags, Env => Root_Environment,
Packages_To_Check => Packages_To_Check_By_Gnatmake); Packages_To_Check => Packages_To_Check_By_Gnatmake);
if Main_Project = No_Project then if Main_Project = No_Project then
...@@ -1561,6 +1560,10 @@ package body Clean is ...@@ -1561,6 +1560,10 @@ package body Clean is
Csets.Initialize; Csets.Initialize;
Snames.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; Project_Node_Tree := new Project_Node_Tree_Data;
Prj.Tree.Initialize (Project_Node_Tree); Prj.Tree.Initialize (Project_Node_Tree);
...@@ -1696,7 +1699,7 @@ package body Clean is ...@@ -1696,7 +1699,7 @@ package body Clean is
elsif Arg (3) = 'P' then elsif Arg (3) = 'P' then
Prj.Env.Add_Directories Prj.Env.Add_Directories
(Project_Node_Tree.Project_Path, (Root_Environment.Project_Path,
Arg (4 .. Arg'Last)); Arg (4 .. Arg'Last));
else else
...@@ -1858,7 +1861,6 @@ package body Clean is ...@@ -1858,7 +1861,6 @@ package body Clean is
Ext_Asgn : constant String := Arg (3 .. Arg'Last); Ext_Asgn : constant String := Arg (3 .. Arg'Last);
Start : Positive := Ext_Asgn'First; Start : Positive := Ext_Asgn'First;
Stop : Natural := Ext_Asgn'Last; Stop : Natural := Ext_Asgn'Last;
Equal_Pos : Natural;
OK : Boolean := True; OK : Boolean := True;
begin begin
...@@ -1872,27 +1874,11 @@ package body Clean is ...@@ -1872,27 +1874,11 @@ package body Clean is
end if; end if;
end if; end if;
Equal_Pos := Start; if not OK
or else not Prj.Ext.Check
while Equal_Pos <= Stop (Root_Environment.External,
and then Ext_Asgn (Equal_Pos) /= '=' Ext_Asgn (Start .. Stop))
loop then
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
Fail Fail
("illegal external assignment '" ("illegal external assignment '"
& Ext_Asgn & Ext_Asgn
......
gcc/ada/gnatcmd.adb
...@@ -58,6 +58,7 @@ with GNAT.OS_Lib; use GNAT.OS_Lib; ...@@ -58,6 +58,7 @@ with GNAT.OS_Lib; use GNAT.OS_Lib;
procedure GNATCmd is procedure GNATCmd is
Project_Node_Tree : Project_Node_Tree_Ref; Project_Node_Tree : Project_Node_Tree_Ref;
Root_Environment : Prj.Tree.Environment;
Project_File : String_Access; Project_File : String_Access;
Project : Prj.Project_Id; Project : Prj.Project_Id;
Current_Verbosity : Prj.Verbosity := Prj.Default; Current_Verbosity : Prj.Verbosity := Prj.Default;
...@@ -246,9 +247,6 @@ procedure GNATCmd is ...@@ -246,9 +247,6 @@ procedure GNATCmd is
-- Get the sources in the closure of the ASIS_Main and add them to the -- Get the sources in the closure of the ASIS_Main and add them to the
-- list of arguments. -- 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; procedure Non_VMS_Usage;
-- Display usage for platforms other than VMS -- Display usage for platforms other than VMS
...@@ -922,21 +920,6 @@ procedure GNATCmd is ...@@ -922,21 +920,6 @@ procedure GNATCmd is
end if; end if;
end Get_Closure; 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 -- -- Mapping_File --
------------------ ------------------
...@@ -1364,10 +1347,11 @@ begin ...@@ -1364,10 +1347,11 @@ begin
Csets.Initialize; Csets.Initialize;
Snames.Initialize; Snames.Initialize;
Project_Node_Tree := new Project_Node_Tree_Data; Prj.Tree.Initialize (Root_Environment, Gnatmake_Flags);
Prj.Env.Initialize_Default_Project_Path 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.Tree.Initialize (Project_Node_Tree);
Prj.Initialize (Project_Tree); Prj.Initialize (Project_Tree);
...@@ -1725,7 +1709,7 @@ begin ...@@ -1725,7 +1709,7 @@ begin
and then Argv (Argv'First + 1 .. Argv'First + 2) = "aP" and then Argv (Argv'First + 1 .. Argv'First + 2) = "aP"
then then
Prj.Env.Add_Directories Prj.Env.Add_Directories
(Project_Node_Tree.Project_Path, (Root_Environment.Project_Path,
Argv (Argv'First + 3 .. Argv'Last)); Argv (Argv'First + 3 .. Argv'Last));
Remove_Switch (Arg_Num); Remove_Switch (Arg_Num);
...@@ -1813,25 +1797,12 @@ begin ...@@ -1813,25 +1797,12 @@ begin
elsif Argv'Length >= 5 elsif Argv'Length >= 5
and then Argv (Argv'First + 1) = 'X' and then Argv (Argv'First + 1) = 'X'
then then
declare if not Check (Root_Environment.External,
Equal_Pos : constant Natural := Argv (Argv'First + 2 .. Argv'Last))
Index then
('=', Fail (Argv.all
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
& " is not a valid external assignment."); & " is not a valid external assignment.");
end if; end if;
end;
Remove_Switch (Arg_Num); Remove_Switch (Arg_Num);
...@@ -1884,7 +1855,7 @@ begin ...@@ -1884,7 +1855,7 @@ begin
In_Tree => Project_Tree, In_Tree => Project_Tree,
In_Node_Tree => Project_Node_Tree, In_Node_Tree => Project_Node_Tree,
Project_File_Name => Project_File.all, Project_File_Name => Project_File.all,
Flags => Gnatmake_Flags, Env => Root_Environment,
Packages_To_Check => Packages_To_Check); Packages_To_Check => Packages_To_Check);
if Project = Prj.No_Project then if Project = Prj.No_Project then
......
gcc/ada/prj-conf.adb
...@@ -573,7 +573,7 @@ package body Prj.Conf is ...@@ -573,7 +573,7 @@ package body Prj.Conf is
(Project : Project_Id; (Project : Project_Id;
Project_Tree : Project_Tree_Ref; Project_Tree : Project_Tree_Ref;
Project_Node_Tree : Prj.Tree.Project_Node_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; Allow_Automatic_Generation : Boolean;
Config_File_Name : String := ""; Config_File_Name : String := "";
Autoconf_Specified : Boolean; Autoconf_Specified : Boolean;
...@@ -583,7 +583,6 @@ package body Prj.Conf is ...@@ -583,7 +583,6 @@ package body Prj.Conf is
Config : out Prj.Project_Id; Config : out Prj.Project_Id;
Config_File_Path : out String_Access; Config_File_Path : out String_Access;
Automatically_Generated : out Boolean; Automatically_Generated : out Boolean;
Flags : Processing_Flags;
On_Load_Config : Config_File_Hook := null) On_Load_Config : Config_File_Hook := null)
is is
...@@ -933,13 +932,13 @@ package body Prj.Conf is ...@@ -933,13 +932,13 @@ package body Prj.Conf is
end if; end if;
if not Is_Directory (Obj_Dir) then if not Is_Directory (Obj_Dir) then
case Flags.Require_Obj_Dirs is case Env.Flags.Require_Obj_Dirs is
when Error => when Error =>
Raise_Invalid_Config Raise_Invalid_Config
("object directory " & Obj_Dir & " does not exist"); ("object directory " & Obj_Dir & " does not exist");
when Warning => when Warning =>
Prj.Err.Error_Msg Prj.Err.Error_Msg
(Flags, (Env.Flags,
"?object directory " & Obj_Dir & " does not exist"); "?object directory " & Obj_Dir & " does not exist");
Obj_Dir_Exists := False; Obj_Dir_Exists := False;
when Silent => when Silent =>
...@@ -1124,7 +1123,7 @@ package body Prj.Conf is ...@@ -1124,7 +1123,7 @@ package body Prj.Conf is
Packages_To_Check => Packages_To_Check, Packages_To_Check => Packages_To_Check,
Current_Directory => Current_Directory, Current_Directory => Current_Directory,
Is_Config_File => True, Is_Config_File => True,
Flags => Flags); Env => Env);
else else
Config_Project_Node := Empty_Node; Config_Project_Node := Empty_Node;
end if; end if;
...@@ -1136,7 +1135,7 @@ package body Prj.Conf is ...@@ -1136,7 +1135,7 @@ package body Prj.Conf is
Success => Success, Success => Success,
From_Project_Node => Config_Project_Node, From_Project_Node => Config_Project_Node,
From_Project_Node_Tree => Project_Node_Tree, From_Project_Node_Tree => Project_Node_Tree,
Flags => Flags, Env => Env,
Reset_Tree => False); Reset_Tree => False);
end if; end if;
...@@ -1190,17 +1189,17 @@ package body Prj.Conf is ...@@ -1190,17 +1189,17 @@ package body Prj.Conf is
Project_File_Name : String; Project_File_Name : String;
Project_Tree : Prj.Project_Tree_Ref; Project_Tree : Prj.Project_Tree_Ref;
Project_Node_Tree : Prj.Tree.Project_Node_Tree_Ref; Project_Node_Tree : Prj.Tree.Project_Node_Tree_Ref;
Env : in out Prj.Tree.Environment;
Packages_To_Check : String_List_Access; Packages_To_Check : String_List_Access;
Allow_Automatic_Generation : Boolean := True; Allow_Automatic_Generation : Boolean := True;
Automatically_Generated : out Boolean; Automatically_Generated : out Boolean;
Config_File_Path : out String_Access; Config_File_Path : out String_Access;
Target_Name : String := ""; Target_Name : String := "";
Normalized_Hostname : String; Normalized_Hostname : String;
Flags : Processing_Flags;
On_Load_Config : Config_File_Hook := null) On_Load_Config : Config_File_Hook := null)
is is
begin 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 -- Parse the user project tree
...@@ -1217,7 +1216,7 @@ package body Prj.Conf is ...@@ -1217,7 +1216,7 @@ package body Prj.Conf is
Packages_To_Check => Packages_To_Check, Packages_To_Check => Packages_To_Check,
Current_Directory => Current_Directory, Current_Directory => Current_Directory,
Is_Config_File => False, Is_Config_File => False,
Flags => Flags); Env => Env);
if User_Project_Node = Empty_Node then if User_Project_Node = Empty_Node then
User_Project_Node := Empty_Node; User_Project_Node := Empty_Node;
...@@ -1231,13 +1230,13 @@ package body Prj.Conf is ...@@ -1231,13 +1230,13 @@ package body Prj.Conf is
Autoconf_Specified => Autoconf_Specified, Autoconf_Specified => Autoconf_Specified,
Project_Tree => Project_Tree, Project_Tree => Project_Tree,
Project_Node_Tree => Project_Node_Tree, Project_Node_Tree => Project_Node_Tree,
Env => Env,
Packages_To_Check => Packages_To_Check, Packages_To_Check => Packages_To_Check,
Allow_Automatic_Generation => Allow_Automatic_Generation, Allow_Automatic_Generation => Allow_Automatic_Generation,
Automatically_Generated => Automatically_Generated, Automatically_Generated => Automatically_Generated,
Config_File_Path => Config_File_Path, Config_File_Path => Config_File_Path,
Target_Name => Target_Name, Target_Name => Target_Name,
Normalized_Hostname => Normalized_Hostname, Normalized_Hostname => Normalized_Hostname,
Flags => Flags,
On_Load_Config => On_Load_Config); On_Load_Config => On_Load_Config);
end Parse_Project_And_Apply_Config; end Parse_Project_And_Apply_Config;
...@@ -1252,13 +1251,13 @@ package body Prj.Conf is ...@@ -1252,13 +1251,13 @@ package body Prj.Conf is
Autoconf_Specified : Boolean; Autoconf_Specified : Boolean;
Project_Tree : Prj.Project_Tree_Ref; Project_Tree : Prj.Project_Tree_Ref;
Project_Node_Tree : Prj.Tree.Project_Node_Tree_Ref; Project_Node_Tree : Prj.Tree.Project_Node_Tree_Ref;
Env : in out Prj.Tree.Environment;
Packages_To_Check : String_List_Access; Packages_To_Check : String_List_Access;
Allow_Automatic_Generation : Boolean := True; Allow_Automatic_Generation : Boolean := True;
Automatically_Generated : out Boolean; Automatically_Generated : out Boolean;
Config_File_Path : out String_Access; Config_File_Path : out String_Access;
Target_Name : String := ""; Target_Name : String := "";
Normalized_Hostname : String; Normalized_Hostname : String;
Flags : Processing_Flags;
On_Load_Config : Config_File_Hook := null; On_Load_Config : Config_File_Hook := null;
Reset_Tree : Boolean := True) Reset_Tree : Boolean := True)
is is
...@@ -1275,7 +1274,7 @@ package body Prj.Conf is ...@@ -1275,7 +1274,7 @@ package body Prj.Conf is
Success => Success, Success => Success,
From_Project_Node => User_Project_Node, From_Project_Node => User_Project_Node,
From_Project_Node_Tree => Project_Node_Tree, From_Project_Node_Tree => Project_Node_Tree,
Flags => Flags, Env => Env,
Reset_Tree => Reset_Tree); Reset_Tree => Reset_Tree);
if not Success then if not Success then
...@@ -1326,6 +1325,7 @@ package body Prj.Conf is ...@@ -1326,6 +1325,7 @@ package body Prj.Conf is
Project => Main_Project, Project => Main_Project,
Project_Tree => Project_Tree, Project_Tree => Project_Tree,
Project_Node_Tree => Project_Node_Tree, Project_Node_Tree => Project_Node_Tree,
Env => Env,
Allow_Automatic_Generation => Allow_Automatic_Generation, Allow_Automatic_Generation => Allow_Automatic_Generation,
Config_File_Name => Config_File_Name, Config_File_Name => Config_File_Name,
Autoconf_Specified => Autoconf_Specified, Autoconf_Specified => Autoconf_Specified,
...@@ -1334,7 +1334,6 @@ package body Prj.Conf is ...@@ -1334,7 +1334,6 @@ package body Prj.Conf is
Packages_To_Check => Packages_To_Check, Packages_To_Check => Packages_To_Check,
Config_File_Path => Config_File_Path, Config_File_Path => Config_File_Path,
Automatically_Generated => Automatically_Generated, Automatically_Generated => Automatically_Generated,
Flags => Flags,
On_Load_Config => On_Load_Config); On_Load_Config => On_Load_Config);
Apply_Config_File (Main_Config_Project, Project_Tree); Apply_Config_File (Main_Config_Project, Project_Tree);
...@@ -1347,7 +1346,7 @@ package body Prj.Conf is ...@@ -1347,7 +1346,7 @@ package body Prj.Conf is
Success => Success, Success => Success,
From_Project_Node => User_Project_Node, From_Project_Node => User_Project_Node,
From_Project_Node_Tree => Project_Node_Tree, From_Project_Node_Tree => Project_Node_Tree,
Flags => Flags); Env => Env);
if Success then if Success then
if Project_Tree.Source_Info_File_Name /= null and then if Project_Tree.Source_Info_File_Name /= null and then
......
gcc/ada/prj-conf.ads
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- 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 -- -- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -48,13 +48,13 @@ package Prj.Conf is ...@@ -48,13 +48,13 @@ package Prj.Conf is
Project_File_Name : String; Project_File_Name : String;
Project_Tree : Prj.Project_Tree_Ref; Project_Tree : Prj.Project_Tree_Ref;
Project_Node_Tree : Prj.Tree.Project_Node_Tree_Ref; Project_Node_Tree : Prj.Tree.Project_Node_Tree_Ref;
Env : in out Prj.Tree.Environment;
Packages_To_Check : String_List_Access; Packages_To_Check : String_List_Access;
Allow_Automatic_Generation : Boolean := True; Allow_Automatic_Generation : Boolean := True;
Automatically_Generated : out Boolean; Automatically_Generated : out Boolean;
Config_File_Path : out String_Access; Config_File_Path : out String_Access;
Target_Name : String := ""; Target_Name : String := "";
Normalized_Hostname : String; Normalized_Hostname : String;
Flags : Processing_Flags;
On_Load_Config : Config_File_Hook := null); On_Load_Config : Config_File_Hook := null);
-- Find the main configuration project and parse the project tree rooted at -- Find the main configuration project and parse the project tree rooted at
-- this configuration project. -- this configuration project.
...@@ -93,13 +93,13 @@ package Prj.Conf is ...@@ -93,13 +93,13 @@ package Prj.Conf is
Autoconf_Specified : Boolean; Autoconf_Specified : Boolean;
Project_Tree : Prj.Project_Tree_Ref; Project_Tree : Prj.Project_Tree_Ref;
Project_Node_Tree : Prj.Tree.Project_Node_Tree_Ref; Project_Node_Tree : Prj.Tree.Project_Node_Tree_Ref;
Env : in out Prj.Tree.Environment;
Packages_To_Check : String_List_Access; Packages_To_Check : String_List_Access;
Allow_Automatic_Generation : Boolean := True; Allow_Automatic_Generation : Boolean := True;
Automatically_Generated : out Boolean; Automatically_Generated : out Boolean;
Config_File_Path : out String_Access; Config_File_Path : out String_Access;
Target_Name : String := ""; Target_Name : String := "";
Normalized_Hostname : String; Normalized_Hostname : String;
Flags : Processing_Flags;
On_Load_Config : Config_File_Hook := null; On_Load_Config : Config_File_Hook := null;
Reset_Tree : Boolean := True); Reset_Tree : Boolean := True);
-- Same as above, except the project must already have been parsed through -- Same as above, except the project must already have been parsed through
...@@ -121,6 +121,7 @@ package Prj.Conf is ...@@ -121,6 +121,7 @@ package Prj.Conf is
(Project : Prj.Project_Id; (Project : Prj.Project_Id;
Project_Tree : Prj.Project_Tree_Ref; Project_Tree : Prj.Project_Tree_Ref;
Project_Node_Tree : Prj.Tree.Project_Node_Tree_Ref; Project_Node_Tree : Prj.Tree.Project_Node_Tree_Ref;
Env : in out Prj.Tree.Environment;
Allow_Automatic_Generation : Boolean; Allow_Automatic_Generation : Boolean;
Config_File_Name : String := ""; Config_File_Name : String := "";
Autoconf_Specified : Boolean; Autoconf_Specified : Boolean;
...@@ -130,7 +131,6 @@ package Prj.Conf is ...@@ -130,7 +131,6 @@ package Prj.Conf is
Config : out Prj.Project_Id; Config : out Prj.Project_Id;
Config_File_Path : out String_Access; Config_File_Path : out String_Access;
Automatically_Generated : out Boolean; Automatically_Generated : out Boolean;
Flags : Processing_Flags;
On_Load_Config : Config_File_Hook := null); On_Load_Config : Config_File_Hook := null);
-- Compute the name of the configuration file that should be used. If no -- Compute the name of the configuration file that should be used. If no
-- default configuration file is found, a new one will be automatically -- default configuration file is found, a new one will be automatically
......
gcc/ada/prj-makr.adb
...@@ -61,6 +61,8 @@ package body Prj.Makr is ...@@ -61,6 +61,8 @@ package body Prj.Makr is
Tree : constant Project_Node_Tree_Ref := new Project_Node_Tree_Data; Tree : constant Project_Node_Tree_Ref := new Project_Node_Tree_Data;
-- The project tree where the project file is parsed -- The project tree where the project file is parsed
Root_Environment : Prj.Tree.Environment;
Args : Argument_List_Access; Args : Argument_List_Access;
-- The list of arguments for calls to the compiler to get the unit names -- The list of arguments for calls to the compiler to get the unit names
-- and kinds (spec or body) in the Ada sources. -- and kinds (spec or body) in the Ada sources.
...@@ -795,10 +797,14 @@ package body Prj.Makr is ...@@ -795,10 +797,14 @@ package body Prj.Makr is
Csets.Initialize; Csets.Initialize;
Snames.Initialize; Snames.Initialize;
Prj.Initialize (No_Project_Tree); Prj.Initialize (No_Project_Tree);
Prj.Tree.Initialize (Tree);
Prj.Tree.Initialize (Root_Environment, Flags);
Prj.Env.Initialize_Default_Project_Path 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); Sources.Set_Last (0);
Source_Directories.Set_Last (0); Source_Directories.Set_Last (0);
...@@ -866,7 +872,7 @@ package body Prj.Makr is ...@@ -866,7 +872,7 @@ package body Prj.Makr is
Errout_Handling => Part.Finalize_If_Error, Errout_Handling => Part.Finalize_If_Error,
Store_Comments => True, Store_Comments => True,
Is_Config_File => False, Is_Config_File => False,
Flags => Flags, Env => Root_Environment,
Current_Directory => Get_Current_Dir, Current_Directory => Get_Current_Dir,
Packages_To_Check => Packages_To_Check_By_Gnatname); Packages_To_Check => Packages_To_Check_By_Gnatname);
......
gcc/ada/prj-pars.adb
...@@ -28,7 +28,6 @@ with GNAT.Directory_Operations; use GNAT.Directory_Operations; ...@@ -28,7 +28,6 @@ with GNAT.Directory_Operations; use GNAT.Directory_Operations;
with Output; use Output; with Output; use Output;
with Prj.Conf; use Prj.Conf; with Prj.Conf; use Prj.Conf;
with Prj.Env;
with Prj.Err; use Prj.Err; with Prj.Err; use Prj.Err;
with Prj.Part; with Prj.Part;
with Prj.Tree; use Prj.Tree; with Prj.Tree; use Prj.Tree;
...@@ -45,9 +44,9 @@ package body Prj.Pars is ...@@ -45,9 +44,9 @@ package body Prj.Pars is
Project : out Project_Id; Project : out Project_Id;
Project_File_Name : String; Project_File_Name : String;
Packages_To_Check : String_List_Access := All_Packages; Packages_To_Check : String_List_Access := All_Packages;
Flags : Processing_Flags;
Reset_Tree : Boolean := True; 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 is
Project_Node : Project_Node_Id := Empty_Node; Project_Node : Project_Node_Id := Empty_Node;
The_Project : Project_Id := No_Project; The_Project : Project_Id := No_Project;
...@@ -61,8 +60,6 @@ package body Prj.Pars is ...@@ -61,8 +60,6 @@ package body Prj.Pars is
if Project_Node_Tree = null then if Project_Node_Tree = null then
Project_Node_Tree := new Project_Node_Tree_Data; Project_Node_Tree := new Project_Node_Tree_Data;
Prj.Tree.Initialize (Project_Node_Tree); Prj.Tree.Initialize (Project_Node_Tree);
Prj.Env.Initialize_Default_Project_Path
(Project_Node_Tree.Project_Path, Target_Name => "");
end if; end if;
-- Parse the main project file into a tree -- Parse the main project file into a tree
...@@ -75,7 +72,7 @@ package body Prj.Pars is ...@@ -75,7 +72,7 @@ package body Prj.Pars is
Errout_Handling => Prj.Part.Finalize_If_Error, Errout_Handling => Prj.Part.Finalize_If_Error,
Packages_To_Check => Packages_To_Check, Packages_To_Check => Packages_To_Check,
Current_Directory => Current_Dir, Current_Directory => Current_Dir,
Flags => Flags, Env => Env,
Is_Config_File => False); Is_Config_File => False);
-- If there were no error, process the tree -- If there were no error, process the tree
...@@ -97,7 +94,7 @@ package body Prj.Pars is ...@@ -97,7 +94,7 @@ package body Prj.Pars is
Allow_Automatic_Generation => False, Allow_Automatic_Generation => False,
Automatically_Generated => Automatically_Generated, Automatically_Generated => Automatically_Generated,
Config_File_Path => Config_File_Path, Config_File_Path => Config_File_Path,
Flags => Flags, Env => Env,
Normalized_Hostname => "", Normalized_Hostname => "",
On_Load_Config => On_Load_Config =>
Add_Default_GNAT_Naming_Scheme'Access, Add_Default_GNAT_Naming_Scheme'Access,
......
gcc/ada/prj-pars.ads
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- 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 -- -- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -37,9 +37,9 @@ package Prj.Pars is ...@@ -37,9 +37,9 @@ package Prj.Pars is
Project : out Project_Id; Project : out Project_Id;
Project_File_Name : String; Project_File_Name : String;
Packages_To_Check : String_List_Access := All_Packages; Packages_To_Check : String_List_Access := All_Packages;
Flags : Processing_Flags;
Reset_Tree : Boolean := True; 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 -- Parse and process a project files and all its imported project files, in
-- the project tree In_Tree. -- the project tree In_Tree.
-- All the project files are parsed (through Prj.Tree) to create a tree in -- All the project files are parsed (through Prj.Tree) to create a tree in
......
gcc/ada/prj-part.ads
...@@ -46,7 +46,7 @@ package Prj.Part is ...@@ -46,7 +46,7 @@ package Prj.Part is
Store_Comments : Boolean := False; Store_Comments : Boolean := False;
Current_Directory : String := ""; Current_Directory : String := "";
Is_Config_File : Boolean; Is_Config_File : Boolean;
Flags : Processing_Flags; Env : in out Prj.Tree.Environment;
Target_Name : String := ""); Target_Name : String := "");
-- Parse project file and all its imported project files and create a tree. -- 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 -- Return the node for the project (or Empty_Node if parsing failed). If
......
gcc/ada/prj-proc.ads
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- 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 -- -- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -37,7 +37,7 @@ package Prj.Proc is ...@@ -37,7 +37,7 @@ package Prj.Proc is
Success : out Boolean; Success : out Boolean;
From_Project_Node : Project_Node_Id; From_Project_Node : Project_Node_Id;
From_Project_Node_Tree : Project_Node_Tree_Ref; From_Project_Node_Tree : Project_Node_Tree_Ref;
Flags : Prj.Processing_Flags; Env : in out Prj.Tree.Environment;
Reset_Tree : Boolean := True); Reset_Tree : Boolean := True);
-- Process a project tree (ie the direct resulting of parsing a .gpr file) -- Process a project tree (ie the direct resulting of parsing a .gpr file)
-- based on the current external references. -- based on the current external references.
...@@ -57,7 +57,7 @@ package Prj.Proc is ...@@ -57,7 +57,7 @@ package Prj.Proc is
Success : out Boolean; Success : out Boolean;
From_Project_Node : Project_Node_Id; From_Project_Node : Project_Node_Id;
From_Project_Node_Tree : Project_Node_Tree_Ref; 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 -- Perform the second phase of the processing, filling the rest of the
-- project with the information extracted from the project tree. This phase -- project with the information extracted from the project tree. This phase
-- requires that the configuration file has already been parsed (in fact -- requires that the configuration file has already been parsed (in fact
...@@ -71,7 +71,7 @@ package Prj.Proc is ...@@ -71,7 +71,7 @@ package Prj.Proc is
Success : out Boolean; Success : out Boolean;
From_Project_Node : Project_Node_Id; From_Project_Node : Project_Node_Id;
From_Project_Node_Tree : Project_Node_Tree_Ref; From_Project_Node_Tree : Project_Node_Tree_Ref;
Flags : Processing_Flags; Env : in out Prj.Tree.Environment;
Reset_Tree : Boolean := True); Reset_Tree : Boolean := True);
-- Performs the two phases of the processing -- Performs the two phases of the processing
......
gcc/ada/prj-tree.adb
...@@ -982,19 +982,28 @@ package body Prj.Tree is ...@@ -982,19 +982,28 @@ package body Prj.Tree is
-- Initialize -- -- Initialize --
---------------- ----------------
procedure Initialize procedure Initialize (Tree : Project_Node_Tree_Ref) is
(Tree : Project_Node_Tree_Ref; Env : in out Environment) is
begin begin
Project_Node_Table.Init (Tree.Project_Nodes); Project_Node_Table.Init (Tree.Project_Nodes);
Projects_Htable.Reset (Tree.Projects_HT); Projects_Htable.Reset (Tree.Projects_HT);
Initialize (Env);
end Initialize; end Initialize;
--------------------
-- Override_Flags --
--------------------
procedure Override_Flags
(Self : in out Environment; Flags : Prj.Processing_Flags) is
begin
Self.Flags := Flags;
end Override_Flags;
---------------- ----------------
-- Initialize -- -- Initialize --
---------------- ----------------
procedure Initialize (Self : in out Environment) is procedure Initialize
(Self : in out Environment; Flags : Processing_Flags) is
begin begin
-- Do not reset the external references, in case we are reloading a -- Do not reset the external references, in case we are reloading a
-- project, since we want to preserve the current environment. -- project, since we want to preserve the current environment.
...@@ -1003,6 +1012,8 @@ package body Prj.Tree is ...@@ -1003,6 +1012,8 @@ package body Prj.Tree is
Prj.Ext.Initialize (Self.External); Prj.Ext.Initialize (Self.External);
-- Prj.Ext.Reset (Tree.External); -- Prj.Ext.Reset (Tree.External);
Self.Flags := Flags;
end Initialize; end Initialize;
---------- ----------
...@@ -1019,10 +1030,7 @@ package body Prj.Tree is ...@@ -1019,10 +1030,7 @@ package body Prj.Tree is
-- Free -- -- Free --
---------- ----------
procedure Free procedure Free (Proj : in out Project_Node_Tree_Ref) is
(Proj : in out Project_Node_Tree_Ref;
Env : in out Environment)
is
procedure Unchecked_Free is new Ada.Unchecked_Deallocation procedure Unchecked_Free is new Ada.Unchecked_Deallocation
(Project_Node_Tree_Data, Project_Node_Tree_Ref); (Project_Node_Tree_Data, Project_Node_Tree_Ref);
begin begin
...@@ -1031,7 +1039,6 @@ package body Prj.Tree is ...@@ -1031,7 +1039,6 @@ package body Prj.Tree is
Projects_Htable.Reset (Proj.Projects_HT); Projects_Htable.Reset (Proj.Projects_HT);
Unchecked_Free (Proj); Unchecked_Free (Proj);
end if; end if;
Free (Env);
end Free; end Free;
------------------------------- -------------------------------
......
gcc/ada/prj-tree.ads
...@@ -41,7 +41,7 @@ package Prj.Tree is ...@@ -41,7 +41,7 @@ package Prj.Tree is
----------------- -----------------
type Environment is record type Environment is record
External : Prj.Ext.External_References; External : Prj.Ext.External_References;
-- External references are stored in this hash table (and manipulated -- External references are stored in this hash table (and manipulated
-- through subprograms in prj-ext.ads). External references are -- through subprograms in prj-ext.ads). External references are
-- project-tree specific so that one can load the same tree twice but -- project-tree specific so that one can load the same tree twice but
...@@ -52,16 +52,26 @@ package Prj.Tree is ...@@ -52,16 +52,26 @@ package Prj.Tree is
-- simultaneously multiple projects, each with its own search path, in -- simultaneously multiple projects, each with its own search path, in
-- particular when using different compilers with different default -- particular when using different compilers with different default
-- search directories. -- search directories.
Flags : Prj.Processing_Flags;
-- Configure errors and warnings
end record; end record;
-- This record contains the context in which projects are parsed and -- This record contains the context in which projects are parsed and
-- processed (finding importing project, resolving external values,...) -- 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 -- Initialize a new environment
procedure Free (Self : in out Environment); procedure Free (Self : in out Environment);
-- Free the memory used by Self -- 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 -- -- Project nodes --
------------------- -------------------
...@@ -130,8 +140,7 @@ package Prj.Tree is ...@@ -130,8 +140,7 @@ package Prj.Tree is
pragma Inline (No); pragma Inline (No);
-- Return True if Node = Empty_Node -- Return True if Node = Empty_Node
procedure Initialize (Tree : Project_Node_Tree_Ref; procedure Initialize (Tree : Project_Node_Tree_Ref);
Env : in out Environment);
-- Initialize the Project File tree: empty the Project_Nodes table -- Initialize the Project File tree: empty the Project_Nodes table
-- and reset the Projects_Htable. -- and reset the Projects_Htable.
...@@ -1490,8 +1499,7 @@ package Prj.Tree is ...@@ -1490,8 +1499,7 @@ package Prj.Tree is
Projects_HT : Tree_Private_Part.Projects_Htable.Instance; Projects_HT : Tree_Private_Part.Projects_Htable.Instance;
end record; end record;
procedure Free (Proj : in out Project_Node_Tree_Ref; procedure Free (Proj : in out Project_Node_Tree_Ref);
Env : in out Environment);
-- Free memory used by Prj -- Free memory used by Prj
private private
......
gcc/ada/switch-m.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -602,7 +602,7 @@ package body Switch.M is ...@@ -602,7 +602,7 @@ package body Switch.M is
------------------------ ------------------------
procedure Scan_Make_Switches procedure Scan_Make_Switches
(Project_Node_Tree : Prj.Tree.Project_Node_Tree_Ref; (Env : in out Prj.Tree.Environment;
Switch_Chars : String; Switch_Chars : String;
Success : out Boolean) Success : out Boolean)
is is
...@@ -667,7 +667,7 @@ package body Switch.M is ...@@ -667,7 +667,7 @@ package body Switch.M is
and then Switch_Chars (Ptr .. Ptr + 1) = "aP" and then Switch_Chars (Ptr .. Ptr + 1) = "aP"
then then
Add_Directories Add_Directories
(Project_Node_Tree.Project_Path, (Env.Project_Path,
Switch_Chars (Ptr + 2 .. Switch_Chars'Last)); Switch_Chars (Ptr + 2 .. Switch_Chars'Last));
elsif C = 'v' and then Switch_Chars'Length = 3 then elsif C = 'v' and then Switch_Chars'Length = 3 then
......
gcc/ada/switch-m.ads
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- 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 -- -- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -39,7 +39,7 @@ with Prj.Tree; ...@@ -39,7 +39,7 @@ with Prj.Tree;
package Switch.M is package Switch.M is
procedure Scan_Make_Switches procedure Scan_Make_Switches
(Project_Node_Tree : Prj.Tree.Project_Node_Tree_Ref; (Env : in out Prj.Tree.Environment;
Switch_Chars : String; Switch_Chars : String;
Success : out Boolean); Success : out Boolean);
-- Scan a gnatmake switch and act accordingly. For switches that are -- Scan a gnatmake switch and act accordingly. For switches that are
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment