+2011-08-03 Emmanuel Briot <briot@adacore.com>
+
+ * gnatcmd.adb, make.adb, prj-part.adb, prj-part.ads, prj-makr.adb,
+ clean.adb, prj-nmsc.adb, prj-pars.adb, prj-conf.adb, prj-env.adb,
+ prj-env.ads (Prj.Env.Initialize_Default_Project_Path,
+ Prj.Env.Initialize_Empty): new subprograms
+ (Get_Env, Find_Project): remove parameter Target_Name.
+
2011-08-03 Gary Dismukes <dismukes@adacore.com>
* sem_ch3.adb (Build_Derived_Record_Type): Test the Derive_Subps formal
-- --
-- B o d y --
-- --
--- Copyright (C) 2003-2010, Free Software Foundation, Inc. --
+-- Copyright (C) 2003-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- --
-- 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,
-- --
-- B o d y --
-- --
--- Copyright (C) 1996-2010, Free Software Foundation, Inc. --
+-- Copyright (C) 1996-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- --
Snames.Initialize;
Project_Node_Tree := new Project_Node_Tree_Data;
+ Prj.Env.Initialize_Default_Project_Path
+ (Project_Node_Tree.Project_Path, Target_Name => "");
+
Prj.Tree.Initialize (Project_Node_Tree);
Prj.Initialize (Project_Tree);
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2010, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-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- --
-- the command line switches
Project_Node_Tree := new Project_Node_Tree_Data;
+ Prj.Env.Initialize_Default_Project_Path
+ (Project_Node_Tree.Project_Path, Target_Name => "");
+
Prj.Tree.Initialize (Project_Node_Tree);
-- Override default initialization of Check_Object_Consistency since
-- --
-- B o d y --
-- --
--- Copyright (C) 2006-2010, 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- --
Config_Project_Node : Project_Node_Id := Empty_Node;
begin
+ pragma Assert (Prj.Env.Is_Initialized (Project_Node_Tree.Project_Path));
+
Free (Config_File_Path);
Config := No_Project;
Packages_To_Check => Packages_To_Check,
Current_Directory => Current_Directory,
Is_Config_File => True,
- Flags => Flags,
- Target_Name => Target_Name);
+ Flags => Flags);
else
Config_Project_Node := Empty_Node;
end if;
On_Load_Config : Config_File_Hook := null)
is
begin
+ pragma Assert (Prj.Env.Is_Initialized (Project_Node_Tree.Project_Path));
+
-- Parse the user project tree
Prj.Initialize (Project_Tree);
Packages_To_Check => Packages_To_Check,
Current_Directory => Current_Directory,
Is_Config_File => False,
- Flags => Flags,
- Target_Name => Target_Name);
+ Flags => Flags);
if User_Project_Node = Empty_Node then
User_Project_Node := Empty_Node;
-- Return a project that is either Project or an extended ancestor of
-- Project that itself is not extended.
- procedure Initialize_Project_Path
- (Self : in out Project_Search_Path;
- Target_Name : String);
- -- Initialize Current_Project_Path. Does nothing if the path has already
- -- been initialized properly.
-
----------------------
-- Ada_Include_Path --
----------------------
end if;
end Add_Directories;
- -----------------------------
- -- Initialize_Project_Path --
- -----------------------------
+ --------------------
+ -- Is_Initialized --
+ --------------------
+
+ function Is_Initialized (Self : Project_Search_Path) return Boolean is
+ begin
+ return Self.Path /= null
+ and then (Self.Path'Length = 0
+ or else Self.Path (Self.Path'First) /= '#');
+ end Is_Initialized;
+
+ ----------------------
+ -- Initialize_Empty --
+ ----------------------
- procedure Initialize_Project_Path
- (Self : in out Project_Search_Path;
- Target_Name : String)
+ procedure Initialize_Empty (Self : in out Project_Search_Path) is
+ begin
+ Free (Self.Path);
+ Self.Path := new String'("");
+ end Initialize_Empty;
+
+ -------------------------------------
+ -- Initialize_Default_Project_Path --
+ -------------------------------------
+
+ procedure Initialize_Default_Project_Path
+ (Self : in out Project_Search_Path; Target_Name : String)
is
Add_Default_Dir : Boolean := True;
First : Positive;
-- May be empty.
begin
- -- If already initialized, nothing else to do
-
- if Self.Path /= null
- and then Self.Path (Self.Path'First) /= '#'
- then
+ if Is_Initialized (Self) then
return;
end if;
if Self.Path = null then
Self.Path := new String'(Name_Buffer (1 .. Name_Len));
end if;
- end Initialize_Project_Path;
+ end Initialize_Default_Project_Path;
--------------
-- Get_Path --
--------------
procedure Get_Path
- (Self : in out Project_Search_Path;
- Path : out String_Access;
- Target_Name : String := "")
- is
+ (Self : Project_Search_Path;
+ Path : out String_Access) is
begin
- Initialize_Project_Path (Self, Target_Name);
+ pragma Assert (Is_Initialized (Self));
Path := Self.Path;
end Get_Path;
(Self : in out Project_Search_Path;
Project_File_Name : String;
Directory : String;
- Path : out Namet.Path_Name_Type;
- Target_Name : String)
+ Path : out Namet.Path_Name_Type)
is
File : constant String := Project_File_Name;
-- Have to do a copy, in case the parameter is Name_Buffer, which we
-- Start of processing for Find_Project
begin
- Initialize_Project_Path (Self, Target_Name);
+ pragma Assert (Is_Initialized (Self));
if Current_Verbosity = High then
Debug_Increase_Indent
-- --
-- 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- --
-- to search for projects on the path (and caches the results to improve
-- efficiency).
+ procedure Initialize_Default_Project_Path
+ (Self : in out Project_Search_Path; Target_Name : String);
+ -- Initialize Self.
+ -- It will then contain the default project path on the given target
+ -- (including directories specified by the environment variables
+ -- ADA_PROJECT_PATH and GPR_PROJECT_PATH).
+ -- This does nothing if Self has already been initialized.
+
+ procedure Initialize_Empty (Self : in out Project_Search_Path);
+ -- Initialize self with an empty list of directories.
+ -- If Self had already been set, it is reset.
+
+ function Is_Initialized (Self : Project_Search_Path) return Boolean;
+ -- Whether Self has been initialized
+
procedure Free (Self : in out Project_Search_Path);
-- Free the memory used by Self
-- Find_Project below, or PATH will be added at the end of the search path.
procedure Get_Path
- (Self : in out Project_Search_Path;
- Path : out String_Access;
- Target_Name : String := "");
+ (Self : Project_Search_Path;
+ Path : out String_Access);
-- Return the current value of the project path, either the value set
-- during elaboration of the package or, if procedure Set_Project_Path has
-- been called, the value set by the last call to Set_Project_Path. The
-- returned value must not be modified.
+ -- Self must have been initialized first.
procedure Set_Path
(Self : in out Project_Search_Path; Path : String);
(Self : in out Project_Search_Path;
Project_File_Name : String;
Directory : String;
- Path : out Namet.Path_Name_Type;
- Target_Name : String);
+ Path : out Namet.Path_Name_Type);
-- Search for a project with the given name either in Directory (which
-- often will be the directory contain the project we are currently parsing
-- and which we found a reference to another project), or in the project
- -- path. Extra_Project_Path contains additional directories to search.
+ -- path Self.
+ --
+ -- Self must have been initialized first.
--
-- Project_File_Name can optionally contain directories, and the extension
-- (.gpr) for the file name is optional.
-- --
-- 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- --
with Osint; use Osint;
with Prj; use Prj;
with Prj.Com;
+with Prj.Env;
with Prj.Part;
with Prj.PP;
with Prj.Tree; use Prj.Tree;
Snames.Initialize;
Prj.Initialize (No_Project_Tree);
Prj.Tree.Initialize (Tree);
+ Prj.Env.Initialize_Default_Project_Path
+ (Tree.Project_Path, Target_Name => "");
Sources.Set_Last (0);
Source_Directories.Set_Last (0);
Is_Config_File => False,
Flags => Flags,
Current_Directory => Get_Current_Dir,
- Packages_To_Check => Packages_To_Check_By_Gnatname,
- Target_Name => "");
+ Packages_To_Check => Packages_To_Check_By_Gnatname);
-- Fail if parsing was not successful
with Osint; use Osint;
with Output; use Output;
with Prj.Com;
+with Prj.Env; use Prj.Env;
with Prj.Err; use Prj.Err;
with Prj.Util; use Prj.Util;
with Sinput.P;
Project.Decl.Attributes,
Data.Tree);
+ Project_Path_For_Aggregate : Prj.Env.Project_Search_Path;
+
procedure Found_Project_File (Path : Path_Information; Rank : Natural);
-- Called for each project file aggregated by Project
procedure Found_Project_File (Path : Path_Information; Rank : Natural) is
pragma Unreferenced (Rank);
+ Full_Path : Path_Name_Type;
begin
Debug_Output ("Aggregates: ", Name_Id (Path.Display_Name));
+ -- For usual "with" statement, this phase will have been done when
+ -- parsing the project itself. However, for aggregate projects, we
+ -- can only do this when processing the aggregate project, since the
+ -- exact list of project files or project directories can depend on
+ -- scenario variables.
+ --
+ -- ??? We might already have loaded the project
+
+ Prj.Env.Find_Project
+ (Self => Project_Path_For_Aggregate,
+ Project_File_Name => Get_Name_String (Path.Name),
+ Directory => Get_Name_String (Project.Path.Name),
+ Path => Full_Path);
end Found_Project_File;
-- Start of processing for Check_Aggregate_Project
return;
end if;
+ Initialize_Empty (Project_Path_For_Aggregate);
+
-- Look for aggregated projects. For similarity with source files and
-- dirs, the aggregated project files are not searched for on the
-- project path, and are only found through the path specified in
Ignore => Nil_String,
Search_For => Search_Files,
Resolve_Links => Opt.Follow_Links_For_Files);
+
+ Free (Project_Path_For_Aggregate);
end Check_Aggregate_Project;
----------------------------
-- --
-- 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- --
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;
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
Packages_To_Check => Packages_To_Check,
Current_Directory => Current_Dir,
Flags => Flags,
- Is_Config_File => False,
- Target_Name => "");
+ Is_Config_File => False);
-- If there were no error, process the tree
Depth : Natural;
Current_Dir : String;
Is_Config_File : Boolean;
- Flags : Processing_Flags;
- Target_Name : String);
+ Flags : Processing_Flags);
-- 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
Depth : Natural;
Current_Dir : String;
Is_Config_File : Boolean;
- Flags : Processing_Flags;
- Target_Name : String);
+ Flags : Processing_Flags);
-- 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
Current_Directory : String := "";
Is_Config_File : Boolean;
Flags : Processing_Flags;
- Target_Name : String)
+ Target_Name : String := "")
is
Dummy : Boolean;
pragma Warnings (Off, Dummy);
Path_Name_Id : Path_Name_Type;
begin
+ if not Is_Initialized (In_Tree.Project_Path) then
+ Prj.Env.Initialize_Default_Project_Path
+ (In_Tree.Project_Path, Target_Name);
+ end if;
+
if Real_Project_File_Name = null then
Real_Project_File_Name := new String'(Project_File_Name);
end if;
Find_Project (In_Tree.Project_Path,
Project_File_Name => Real_Project_File_Name.all,
Directory => Current_Directory,
- Path => Path_Name_Id,
- Target_Name => Target_Name);
+ Path => Path_Name_Id);
Free (Real_Project_File_Name);
Prj.Err.Initialize;
declare
P : String_Access;
begin
- Get_Path
- (In_Tree.Project_Path,
- Path => P,
- Target_Name => Target_Name);
+ Get_Path (In_Tree.Project_Path, Path => P);
Prj.Com.Fail
("project file """
Depth => 0,
Current_Dir => Current_Directory,
Is_Config_File => Is_Config_File,
- Flags => Flags,
- Target_Name => Target_Name);
+ Flags => Flags);
exception
when Types.Unrecoverable_Error =>
Depth : Natural;
Current_Dir : String;
Is_Config_File : Boolean;
- Flags : Processing_Flags;
- Target_Name : String)
+ Flags : Processing_Flags)
is
Current_With_Clause : With_Id := Context_Clause;
(In_Tree.Project_Path,
Project_File_Name => Get_Name_String (Current_With.Path),
Directory => Project_Directory_Path,
- Path => Imported_Path_Name_Id,
- Target_Name => Target_Name);
+ Path => Imported_Path_Name_Id);
if Imported_Path_Name_Id = No_Path then
Depth => Depth,
Current_Dir => Current_Dir,
Is_Config_File => Is_Config_File,
- Flags => Flags,
- Target_Name => Target_Name);
+ Flags => Flags);
else
Extends_All := Is_Extending_All (Withed_Project, In_Tree);
Depth : Natural;
Current_Dir : String;
Is_Config_File : Boolean;
- Flags : Processing_Flags;
- Target_Name : String)
+ Flags : Processing_Flags)
is
Path_Name : constant String := Get_Name_String (Path_Name_Id);
Depth => Depth + 1,
Current_Dir => Current_Dir,
Is_Config_File => Is_Config_File,
- Flags => Flags,
- Target_Name => Target_Name);
+ Flags => Flags);
Set_First_With_Clause_Of (Project, In_Tree, Imported_Projects);
end;
(In_Tree.Project_Path,
Project_File_Name => Original_Path_Name,
Directory => Get_Name_String (Project_Directory),
- Path => Extended_Project_Path_Name_Id,
- Target_Name => Target_Name);
+ Path => Extended_Project_Path_Name_Id);
if Extended_Project_Path_Name_Id = No_Path then
Depth => Depth + 1,
Current_Dir => Current_Dir,
Is_Config_File => Is_Config_File,
- Flags => Flags,
- Target_Name => Target_Name);
+ Flags => Flags);
end;
if Present (Extended_Project) then
Depth => Depth + 1,
Current_Dir => Current_Dir,
Is_Config_File => Is_Config_File,
- Flags => Flags,
- Target_Name => Target_Name);
+ Flags => Flags);
Set_First_With_Clause_Of (Project, In_Tree, Imported_Projects);
end;
-- --
-- S p e c --
-- --
--- Copyright (C) 2000-2010, 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- --
Current_Directory : String := "";
Is_Config_File : Boolean;
Flags : Processing_Flags;
- Target_Name : String);
+ 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
-- Always_Errout_Finalize is True, Errout.Finalize is called in all cases,
--
-- Is_Config_File should be set to True if the project represents a config
-- file (.cgpr) since some specific checks apply.
+ --
+ -- Target_Name will be used to initialize the default project path, unless
+ -- In_Tree.Project_Path has already been initialized (which is the
+ -- recommended use).
end Prj.Part;
projects / gcc.git / commitdiff