OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

gnatcmd.adb, [...] (Prj.Env.Initialize_Default_Project_Path, [...]): new subprograms 

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.

From-SVN: r177241
This commit is contained in:
Emmanuel Briot 2011-08-03 08:28:47 +00:00 committed by Arnaud Charlet
parent 3e5828693d
commit a96ca6001f
12 changed files with 139 additions and 78 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
gcc/ada/ChangeLog
View File

@ -1,3 +1,11 @@
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

5
gcc/ada/clean.adb
View File

@ -6,7 +6,7 @@
-- --
-- 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- --
@ -1400,6 +1400,9 @@ 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,

5
gcc/ada/gnatcmd.adb
View File

@ -6,7 +6,7 @@
-- --
-- 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- --
@ -1365,6 +1365,9 @@ begin
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);

5
gcc/ada/make.adb
View File

@ -6,7 +6,7 @@
-- --
-- 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- --
@ -6636,6 +6636,9 @@ package body Make is
-- 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

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

@ -6,7 +6,7 @@
-- --
-- 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- --
@ -1061,6 +1061,8 @@ package body Prj.Conf is
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;
@ -1121,8 +1123,7 @@ package body Prj.Conf is
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;
@ -1198,6 +1199,8 @@ package body Prj.Conf is
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);
@ -1213,8 +1216,7 @@ package body Prj.Conf is
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;

59
gcc/ada/prj-env.adb
View File

@ -110,12 +110,6 @@ package body Prj.Env is
-- 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 --
----------------------
@ -1782,13 +1776,33 @@ package body Prj.Env is
end if;
end Add_Directories;
-----------------------------
-- Initialize_Project_Path --
-----------------------------
--------------------
-- Is_Initialized --
--------------------
procedure Initialize_Project_Path
(Self : in out Project_Search_Path;
Target_Name : String)
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_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;
@ -1808,11 +1822,7 @@ package body Prj.Env is
-- 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;
@ -1968,19 +1978,17 @@ package body Prj.Env is
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;
@ -2004,8 +2012,7 @@ package body Prj.Env is
(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
@ -2092,7 +2099,7 @@ package body Prj.Env is
-- 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

30
gcc/ada/prj-env.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2001-2010, Free Software Foundation, Inc. --
-- Copyright (C) 2001-2011, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@ -162,6 +162,21 @@ package Prj.Env is
-- 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
@ -177,13 +192,13 @@ package Prj.Env is
-- 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);
@ -194,12 +209,13 @@ package Prj.Env is
(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.

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

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2001-2010, Free Software Foundation, Inc. --
-- Copyright (C) 2001-2011, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@ -29,6 +29,7 @@ with Output;
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;
@ -796,6 +797,8 @@ package body Prj.Makr is
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);
@ -865,8 +868,7 @@ package body Prj.Makr is
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

21
gcc/ada/prj-nmsc.adb
View File

@ -28,6 +28,7 @@ with Opt; use Opt;
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;
@ -936,6 +937,8 @@ package body Prj.Nmsc is
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
@ -951,9 +954,23 @@ package body Prj.Nmsc is
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
@ -968,6 +985,8 @@ package body Prj.Nmsc is
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
@ -980,6 +999,8 @@ package body Prj.Nmsc is
Ignore => Nil_String,
Search_For => Search_Files,
Resolve_Links => Opt.Follow_Links_For_Files);
Free (Project_Path_For_Aggregate);
end Check_Aggregate_Project;
----------------------------

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

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2001-2010, Free Software Foundation, Inc. --
-- Copyright (C) 2001-2011, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@ -28,6 +28,7 @@ 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;
@ -60,6 +61,8 @@ 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
@ -73,8 +76,7 @@ package body Prj.Pars is
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

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

@ -185,8 +185,7 @@ package body Prj.Part is
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
@ -221,8 +220,7 @@ package body Prj.Part is
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
@ -451,7 +449,7 @@ package body Prj.Part is
Current_Directory : String := "";
Is_Config_File : Boolean;
Flags : Processing_Flags;
Target_Name : String)
Target_Name : String := "")
is
Dummy : Boolean;
pragma Warnings (Off, Dummy);
@ -462,6 +460,11 @@ package body Prj.Part is
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;
@ -471,8 +474,7 @@ package body Prj.Part is
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;
@ -483,10 +485,7 @@ package body Prj.Part is
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 """
@ -513,8 +512,7 @@ package body Prj.Part is
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 =>
@ -745,8 +743,7 @@ package body Prj.Part is
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;
@ -782,8 +779,7 @@ package body Prj.Part is
(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
@ -887,8 +883,7 @@ package body Prj.Part is
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);
@ -1131,8 +1126,7 @@ package body Prj.Part is
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);
@ -1495,8 +1489,7 @@ package body Prj.Part is
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;
@ -1557,8 +1550,7 @@ package body Prj.Part is
(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
@ -1605,8 +1597,7 @@ package body Prj.Part is
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
@ -1856,8 +1847,7 @@ package body Prj.Part is
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;

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

@ -6,7 +6,7 @@
-- --
-- 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- --
@ -39,7 +39,7 @@ package Prj.Part is
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,
@ -54,5 +54,9 @@ package Prj.Part is
--
-- 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;