Skip to content

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

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
parent 3e582869
Showing with 139 additions and 78 deletions
gcc/ada/ChangeLog
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> 2011-08-03 Gary Dismukes <dismukes@adacore.com>
* sem_ch3.adb (Build_Derived_Record_Type): Test the Derive_Subps formal * sem_ch3.adb (Build_Derived_Record_Type): Test the Derive_Subps formal
......
gcc/ada/clean.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- --
...@@ -1400,6 +1400,9 @@ package body Clean is ...@@ -1400,6 +1400,9 @@ 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,
......
gcc/ada/gnatcmd.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- --
...@@ -1365,6 +1365,9 @@ begin ...@@ -1365,6 +1365,9 @@ begin
Snames.Initialize; Snames.Initialize;
Project_Node_Tree := new Project_Node_Tree_Data; 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.Tree.Initialize (Project_Node_Tree);
Prj.Initialize (Project_Tree); Prj.Initialize (Project_Tree);
......
gcc/ada/make.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- --
...@@ -6636,6 +6636,9 @@ package body Make is ...@@ -6636,6 +6636,9 @@ package body Make is
-- the command line switches -- the command line switches
Project_Node_Tree := new Project_Node_Tree_Data; 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.Tree.Initialize (Project_Node_Tree);
-- Override default initialization of Check_Object_Consistency since -- Override default initialization of Check_Object_Consistency since
......
gcc/ada/prj-conf.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- --
...@@ -1061,6 +1061,8 @@ package body Prj.Conf is ...@@ -1061,6 +1061,8 @@ package body Prj.Conf is
Config_Project_Node : Project_Node_Id := Empty_Node; Config_Project_Node : Project_Node_Id := Empty_Node;
begin begin
pragma Assert (Prj.Env.Is_Initialized (Project_Node_Tree.Project_Path));
Free (Config_File_Path); Free (Config_File_Path);
Config := No_Project; Config := No_Project;
...@@ -1121,8 +1123,7 @@ package body Prj.Conf is ...@@ -1121,8 +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, Flags => Flags);
Target_Name => Target_Name);
else else
Config_Project_Node := Empty_Node; Config_Project_Node := Empty_Node;
end if; end if;
...@@ -1198,6 +1199,8 @@ package body Prj.Conf is ...@@ -1198,6 +1199,8 @@ package body Prj.Conf is
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));
-- Parse the user project tree -- Parse the user project tree
Prj.Initialize (Project_Tree); Prj.Initialize (Project_Tree);
...@@ -1213,8 +1216,7 @@ package body Prj.Conf is ...@@ -1213,8 +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, Flags => Flags);
Target_Name => Target_Name);
if User_Project_Node = Empty_Node then if User_Project_Node = Empty_Node then
User_Project_Node := Empty_Node; User_Project_Node := Empty_Node;
......
gcc/ada/prj-env.adb
...@@ -110,12 +110,6 @@ package body Prj.Env is ...@@ -110,12 +110,6 @@ package body Prj.Env is
-- Return a project that is either Project or an extended ancestor of -- Return a project that is either Project or an extended ancestor of
-- Project that itself is not extended. -- 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 -- -- Ada_Include_Path --
---------------------- ----------------------
...@@ -1782,13 +1776,33 @@ package body Prj.Env is ...@@ -1782,13 +1776,33 @@ package body Prj.Env is
end if; end if;
end Add_Directories; 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 procedure Initialize_Empty (Self : in out Project_Search_Path) is
(Self : in out Project_Search_Path; begin
Target_Name : String) 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 is
Add_Default_Dir : Boolean := True; Add_Default_Dir : Boolean := True;
First : Positive; First : Positive;
...@@ -1808,11 +1822,7 @@ package body Prj.Env is ...@@ -1808,11 +1822,7 @@ package body Prj.Env is
-- May be empty. -- May be empty.
begin begin
-- If already initialized, nothing else to do if Is_Initialized (Self) then
if Self.Path /= null
and then Self.Path (Self.Path'First) /= '#'
then
return; return;
end if; end if;
...@@ -1968,19 +1978,17 @@ package body Prj.Env is ...@@ -1968,19 +1978,17 @@ package body Prj.Env is
if Self.Path = null then if Self.Path = null then
Self.Path := new String'(Name_Buffer (1 .. Name_Len)); Self.Path := new String'(Name_Buffer (1 .. Name_Len));
end if; end if;
end Initialize_Project_Path; end Initialize_Default_Project_Path;
-------------- --------------
-- Get_Path -- -- Get_Path --
-------------- --------------
procedure Get_Path procedure Get_Path
(Self : in out Project_Search_Path; (Self : Project_Search_Path;
Path : out String_Access; Path : out String_Access) is
Target_Name : String := "")
is
begin begin
Initialize_Project_Path (Self, Target_Name); pragma Assert (Is_Initialized (Self));
Path := Self.Path; Path := Self.Path;
end Get_Path; end Get_Path;
...@@ -2004,8 +2012,7 @@ package body Prj.Env is ...@@ -2004,8 +2012,7 @@ package body Prj.Env is
(Self : in out Project_Search_Path; (Self : in out Project_Search_Path;
Project_File_Name : String; Project_File_Name : String;
Directory : String; Directory : String;
Path : out Namet.Path_Name_Type; Path : out Namet.Path_Name_Type)
Target_Name : String)
is is
File : constant String := Project_File_Name; File : constant String := Project_File_Name;
-- Have to do a copy, in case the parameter is Name_Buffer, which we -- Have to do a copy, in case the parameter is Name_Buffer, which we
...@@ -2092,7 +2099,7 @@ package body Prj.Env is ...@@ -2092,7 +2099,7 @@ package body Prj.Env is
-- Start of processing for Find_Project -- Start of processing for Find_Project
begin begin
Initialize_Project_Path (Self, Target_Name); pragma Assert (Is_Initialized (Self));
if Current_Verbosity = High then if Current_Verbosity = High then
Debug_Increase_Indent Debug_Increase_Indent
......
gcc/ada/prj-env.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- --
...@@ -162,6 +162,21 @@ package Prj.Env is ...@@ -162,6 +162,21 @@ package Prj.Env is
-- to search for projects on the path (and caches the results to improve -- to search for projects on the path (and caches the results to improve
-- efficiency). -- 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); procedure Free (Self : in out Project_Search_Path);
-- Free the memory used by Self -- Free the memory used by Self
...@@ -177,13 +192,13 @@ package Prj.Env is ...@@ -177,13 +192,13 @@ package Prj.Env is
-- Find_Project below, or PATH will be added at the end of the search path. -- Find_Project below, or PATH will be added at the end of the search path.
procedure Get_Path procedure Get_Path
(Self : in out Project_Search_Path; (Self : Project_Search_Path;
Path : out String_Access; Path : out String_Access);
Target_Name : String := "");
-- Return the current value of the project path, either the value set -- Return the current value of the project path, either the value set
-- during elaboration of the package or, if procedure Set_Project_Path has -- 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 -- been called, the value set by the last call to Set_Project_Path. The
-- returned value must not be modified. -- returned value must not be modified.
-- Self must have been initialized first.
procedure Set_Path procedure Set_Path
(Self : in out Project_Search_Path; Path : String); (Self : in out Project_Search_Path; Path : String);
...@@ -194,12 +209,13 @@ package Prj.Env is ...@@ -194,12 +209,13 @@ package Prj.Env is
(Self : in out Project_Search_Path; (Self : in out Project_Search_Path;
Project_File_Name : String; Project_File_Name : String;
Directory : String; Directory : String;
Path : out Namet.Path_Name_Type; Path : out Namet.Path_Name_Type);
Target_Name : String);
-- Search for a project with the given name either in Directory (which -- Search for a project with the given name either in Directory (which
-- often will be the directory contain the project we are currently parsing -- 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 -- 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 -- Project_File_Name can optionally contain directories, and the extension
-- (.gpr) for the file name is optional. -- (.gpr) for the file name is optional.
......
gcc/ada/prj-makr.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- --
...@@ -29,6 +29,7 @@ with Output; ...@@ -29,6 +29,7 @@ with Output;
with Osint; use Osint; with Osint; use Osint;
with Prj; use Prj; with Prj; use Prj;
with Prj.Com; with Prj.Com;
with Prj.Env;
with Prj.Part; with Prj.Part;
with Prj.PP; with Prj.PP;
with Prj.Tree; use Prj.Tree; with Prj.Tree; use Prj.Tree;
...@@ -796,6 +797,8 @@ package body Prj.Makr is ...@@ -796,6 +797,8 @@ package body Prj.Makr is
Snames.Initialize; Snames.Initialize;
Prj.Initialize (No_Project_Tree); Prj.Initialize (No_Project_Tree);
Prj.Tree.Initialize (Tree); Prj.Tree.Initialize (Tree);
Prj.Env.Initialize_Default_Project_Path
(Tree.Project_Path, Target_Name => "");
Sources.Set_Last (0); Sources.Set_Last (0);
Source_Directories.Set_Last (0); Source_Directories.Set_Last (0);
...@@ -865,8 +868,7 @@ package body Prj.Makr is ...@@ -865,8 +868,7 @@ package body Prj.Makr is
Is_Config_File => False, Is_Config_File => False,
Flags => Flags, Flags => Flags,
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);
Target_Name => "");
-- Fail if parsing was not successful -- Fail if parsing was not successful
......
gcc/ada/prj-nmsc.adb
...@@ -28,6 +28,7 @@ with Opt; use Opt; ...@@ -28,6 +28,7 @@ with Opt; use Opt;
with Osint; use Osint; with Osint; use Osint;
with Output; use Output; with Output; use Output;
with Prj.Com; with Prj.Com;
with Prj.Env; use Prj.Env;
with Prj.Err; use Prj.Err; with Prj.Err; use Prj.Err;
with Prj.Util; use Prj.Util; with Prj.Util; use Prj.Util;
with Sinput.P; with Sinput.P;
...@@ -936,6 +937,8 @@ package body Prj.Nmsc is ...@@ -936,6 +937,8 @@ package body Prj.Nmsc is
Project.Decl.Attributes, Project.Decl.Attributes,
Data.Tree); Data.Tree);
Project_Path_For_Aggregate : Prj.Env.Project_Search_Path;
procedure Found_Project_File (Path : Path_Information; Rank : Natural); procedure Found_Project_File (Path : Path_Information; Rank : Natural);
-- Called for each project file aggregated by Project -- Called for each project file aggregated by Project
...@@ -951,9 +954,23 @@ package body Prj.Nmsc is ...@@ -951,9 +954,23 @@ package body Prj.Nmsc is
procedure Found_Project_File (Path : Path_Information; Rank : Natural) is procedure Found_Project_File (Path : Path_Information; Rank : Natural) is
pragma Unreferenced (Rank); pragma Unreferenced (Rank);
Full_Path : Path_Name_Type;
begin begin
Debug_Output ("Aggregates: ", Name_Id (Path.Display_Name)); 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; end Found_Project_File;
-- Start of processing for Check_Aggregate_Project -- Start of processing for Check_Aggregate_Project
...@@ -968,6 +985,8 @@ package body Prj.Nmsc is ...@@ -968,6 +985,8 @@ package body Prj.Nmsc is
return; return;
end if; end if;
Initialize_Empty (Project_Path_For_Aggregate);
-- Look for aggregated projects. For similarity with source files and -- Look for aggregated projects. For similarity with source files and
-- dirs, the aggregated project files are not searched for on the -- dirs, the aggregated project files are not searched for on the
-- project path, and are only found through the path specified in -- project path, and are only found through the path specified in
...@@ -980,6 +999,8 @@ package body Prj.Nmsc is ...@@ -980,6 +999,8 @@ package body Prj.Nmsc is
Ignore => Nil_String, Ignore => Nil_String,
Search_For => Search_Files, Search_For => Search_Files,
Resolve_Links => Opt.Follow_Links_For_Files); Resolve_Links => Opt.Follow_Links_For_Files);
Free (Project_Path_For_Aggregate);
end Check_Aggregate_Project; end Check_Aggregate_Project;
---------------------------- ----------------------------
......
gcc/ada/prj-pars.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- --
...@@ -28,6 +28,7 @@ with GNAT.Directory_Operations; use GNAT.Directory_Operations; ...@@ -28,6 +28,7 @@ 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;
...@@ -60,6 +61,8 @@ package body Prj.Pars is ...@@ -60,6 +61,8 @@ 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
...@@ -73,8 +76,7 @@ package body Prj.Pars is ...@@ -73,8 +76,7 @@ package body Prj.Pars is
Packages_To_Check => Packages_To_Check, Packages_To_Check => Packages_To_Check,
Current_Directory => Current_Dir, Current_Directory => Current_Dir,
Flags => Flags, Flags => Flags,
Is_Config_File => False, Is_Config_File => False);
Target_Name => "");
-- If there were no error, process the tree -- If there were no error, process the tree
......
gcc/ada/prj-part.adb
...@@ -185,8 +185,7 @@ package body Prj.Part is ...@@ -185,8 +185,7 @@ package body Prj.Part is
Depth : Natural; Depth : Natural;
Current_Dir : String; Current_Dir : String;
Is_Config_File : Boolean; Is_Config_File : Boolean;
Flags : Processing_Flags; Flags : Processing_Flags);
Target_Name : String);
-- Parse a project file. This is a recursive procedure: it calls itself for -- 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 -- 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 -- project has already been parsed and is an extended project A, return the
...@@ -221,8 +220,7 @@ package body Prj.Part is ...@@ -221,8 +220,7 @@ package body Prj.Part is
Depth : Natural; Depth : Natural;
Current_Dir : String; Current_Dir : String;
Is_Config_File : Boolean; Is_Config_File : Boolean;
Flags : Processing_Flags; Flags : Processing_Flags);
Target_Name : String);
-- Parse the imported projects that have been stored in table Withs, if -- 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. -- 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 -- When In_Limited is True, the importing path includes at least one
...@@ -451,7 +449,7 @@ package body Prj.Part is ...@@ -451,7 +449,7 @@ package body Prj.Part is
Current_Directory : String := ""; Current_Directory : String := "";
Is_Config_File : Boolean; Is_Config_File : Boolean;
Flags : Processing_Flags; Flags : Processing_Flags;
Target_Name : String) Target_Name : String := "")
is is
Dummy : Boolean; Dummy : Boolean;
pragma Warnings (Off, Dummy); pragma Warnings (Off, Dummy);
...@@ -462,6 +460,11 @@ package body Prj.Part is ...@@ -462,6 +460,11 @@ package body Prj.Part is
Path_Name_Id : Path_Name_Type; Path_Name_Id : Path_Name_Type;
begin 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 if Real_Project_File_Name = null then
Real_Project_File_Name := new String'(Project_File_Name); Real_Project_File_Name := new String'(Project_File_Name);
end if; end if;
...@@ -471,8 +474,7 @@ package body Prj.Part is ...@@ -471,8 +474,7 @@ package body Prj.Part is
Find_Project (In_Tree.Project_Path, Find_Project (In_Tree.Project_Path,
Project_File_Name => Real_Project_File_Name.all, Project_File_Name => Real_Project_File_Name.all,
Directory => Current_Directory, Directory => Current_Directory,
Path => Path_Name_Id, Path => Path_Name_Id);
Target_Name => Target_Name);
Free (Real_Project_File_Name); Free (Real_Project_File_Name);
Prj.Err.Initialize; Prj.Err.Initialize;
...@@ -483,10 +485,7 @@ package body Prj.Part is ...@@ -483,10 +485,7 @@ package body Prj.Part is
declare declare
P : String_Access; P : String_Access;
begin begin
Get_Path Get_Path (In_Tree.Project_Path, Path => P);
(In_Tree.Project_Path,
Path => P,
Target_Name => Target_Name);
Prj.Com.Fail Prj.Com.Fail
("project file """ ("project file """
...@@ -513,8 +512,7 @@ package body Prj.Part is ...@@ -513,8 +512,7 @@ package body Prj.Part is
Depth => 0, Depth => 0,
Current_Dir => Current_Directory, Current_Dir => Current_Directory,
Is_Config_File => Is_Config_File, Is_Config_File => Is_Config_File,
Flags => Flags, Flags => Flags);
Target_Name => Target_Name);
exception exception
when Types.Unrecoverable_Error => when Types.Unrecoverable_Error =>
...@@ -745,8 +743,7 @@ package body Prj.Part is ...@@ -745,8 +743,7 @@ package body Prj.Part is
Depth : Natural; Depth : Natural;
Current_Dir : String; Current_Dir : String;
Is_Config_File : Boolean; Is_Config_File : Boolean;
Flags : Processing_Flags; Flags : Processing_Flags)
Target_Name : String)
is is
Current_With_Clause : With_Id := Context_Clause; Current_With_Clause : With_Id := Context_Clause;
...@@ -782,8 +779,7 @@ package body Prj.Part is ...@@ -782,8 +779,7 @@ package body Prj.Part is
(In_Tree.Project_Path, (In_Tree.Project_Path,
Project_File_Name => Get_Name_String (Current_With.Path), Project_File_Name => Get_Name_String (Current_With.Path),
Directory => Project_Directory_Path, Directory => Project_Directory_Path,
Path => Imported_Path_Name_Id, Path => Imported_Path_Name_Id);
Target_Name => Target_Name);
if Imported_Path_Name_Id = No_Path then if Imported_Path_Name_Id = No_Path then
...@@ -887,8 +883,7 @@ package body Prj.Part is ...@@ -887,8 +883,7 @@ package body Prj.Part is
Depth => Depth, Depth => Depth,
Current_Dir => Current_Dir, Current_Dir => Current_Dir,
Is_Config_File => Is_Config_File, Is_Config_File => Is_Config_File,
Flags => Flags, Flags => Flags);
Target_Name => Target_Name);
else else
Extends_All := Is_Extending_All (Withed_Project, In_Tree); Extends_All := Is_Extending_All (Withed_Project, In_Tree);
...@@ -1131,8 +1126,7 @@ package body Prj.Part is ...@@ -1131,8 +1126,7 @@ package body Prj.Part is
Depth : Natural; Depth : Natural;
Current_Dir : String; Current_Dir : String;
Is_Config_File : Boolean; Is_Config_File : Boolean;
Flags : Processing_Flags; Flags : Processing_Flags)
Target_Name : String)
is is
Path_Name : constant String := Get_Name_String (Path_Name_Id); Path_Name : constant String := Get_Name_String (Path_Name_Id);
...@@ -1495,8 +1489,7 @@ package body Prj.Part is ...@@ -1495,8 +1489,7 @@ package body Prj.Part is
Depth => Depth + 1, Depth => Depth + 1,
Current_Dir => Current_Dir, Current_Dir => Current_Dir,
Is_Config_File => Is_Config_File, Is_Config_File => Is_Config_File,
Flags => Flags, Flags => Flags);
Target_Name => Target_Name);
Set_First_With_Clause_Of (Project, In_Tree, Imported_Projects); Set_First_With_Clause_Of (Project, In_Tree, Imported_Projects);
end; end;
...@@ -1557,8 +1550,7 @@ package body Prj.Part is ...@@ -1557,8 +1550,7 @@ package body Prj.Part is
(In_Tree.Project_Path, (In_Tree.Project_Path,
Project_File_Name => Original_Path_Name, Project_File_Name => Original_Path_Name,
Directory => Get_Name_String (Project_Directory), Directory => Get_Name_String (Project_Directory),
Path => Extended_Project_Path_Name_Id, Path => Extended_Project_Path_Name_Id);
Target_Name => Target_Name);
if Extended_Project_Path_Name_Id = No_Path then if Extended_Project_Path_Name_Id = No_Path then
...@@ -1605,8 +1597,7 @@ package body Prj.Part is ...@@ -1605,8 +1597,7 @@ package body Prj.Part is
Depth => Depth + 1, Depth => Depth + 1,
Current_Dir => Current_Dir, Current_Dir => Current_Dir,
Is_Config_File => Is_Config_File, Is_Config_File => Is_Config_File,
Flags => Flags, Flags => Flags);
Target_Name => Target_Name);
end; end;
if Present (Extended_Project) then if Present (Extended_Project) then
...@@ -1856,8 +1847,7 @@ package body Prj.Part is ...@@ -1856,8 +1847,7 @@ package body Prj.Part is
Depth => Depth + 1, Depth => Depth + 1,
Current_Dir => Current_Dir, Current_Dir => Current_Dir,
Is_Config_File => Is_Config_File, Is_Config_File => Is_Config_File,
Flags => Flags, Flags => Flags);
Target_Name => Target_Name);
Set_First_With_Clause_Of (Project, In_Tree, Imported_Projects); Set_First_With_Clause_Of (Project, In_Tree, Imported_Projects);
end; end;
......
gcc/ada/prj-part.ads
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- 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 -- -- 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 @@ package Prj.Part is ...@@ -39,7 +39,7 @@ package Prj.Part is
Current_Directory : String := ""; Current_Directory : String := "";
Is_Config_File : Boolean; Is_Config_File : Boolean;
Flags : Processing_Flags; Flags : Processing_Flags;
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
-- Always_Errout_Finalize is True, Errout.Finalize is called in all cases, -- Always_Errout_Finalize is True, Errout.Finalize is called in all cases,
...@@ -54,5 +54,9 @@ package Prj.Part is ...@@ -54,5 +54,9 @@ package Prj.Part is
-- --
-- Is_Config_File should be set to True if the project represents a config -- Is_Config_File should be set to True if the project represents a config
-- file (.cgpr) since some specific checks apply. -- 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; end Prj.Part;
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