Skip to content

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

gnatcmd.adb, [...] (Project_Search_Path): New type. 

2010-10-05  Emmanuel Briot  <briot@adacore.com>

	* gnatcmd.adb, prj-proc.adb, prj-part.adb, prj-ext.adb, prj-ext.ads,
	switch-m.adb, clean.adb, prj-nmsc.adb, prj-nmsc.ads, prj-env.adb,
	prj-env.ads, prj-tree.adb, prj-tree.ads (Project_Search_Path): New type.

From-SVN: r164969
parent 9d9f5f49
Showing with 735 additions and 668 deletions
gcc/ada/ChangeLog
2010-10-05 Emmanuel Briot <briot@adacore.com>
* gnatcmd.adb, prj-proc.adb, prj-part.adb, prj-ext.adb, prj-ext.ads,
switch-m.adb, clean.adb, prj-nmsc.adb, prj-nmsc.ads, prj-env.adb,
prj-env.ads, prj-tree.adb, prj-tree.ads (Project_Search_Path): New type.
2010-10-05 Eric Botcazou <ebotcazou@adacore.com>
* exp_ch5.adb (Make_Field_Expr): Revert previous change (removed).
......
gcc/ada/clean.adb
......@@ -1692,8 +1692,9 @@ package body Clean is
Add_Lib_Search_Dir (Arg (4 .. Arg'Last));
elsif Arg (3) = 'P' then
Prj.Ext.Add_Search_Project_Directory
(Project_Node_Tree, Arg (4 .. Arg'Last));
Prj.Env.Add_Directories
(Project_Node_Tree.Project_Path,
Arg (4 .. Arg'Last));
else
Bad_Argument;
......
gcc/ada/gnatcmd.adb
......@@ -1668,8 +1668,9 @@ begin
elsif Argv'Length > 3
and then Argv (Argv'First + 1 .. Argv'First + 2) = "aP"
then
Add_Search_Project_Directory
(Project_Node_Tree, Argv (Argv'First + 3 .. Argv'Last));
Prj.Env.Add_Directories
(Project_Node_Tree.Project_Path,
Argv (Argv'First + 3 .. Argv'Last));
Remove_Switch (Arg_Num);
......
gcc/ada/prj-env.adb
......@@ -24,10 +24,14 @@
------------------------------------------------------------------------------
with Fmap;
with GNAT.Directory_Operations; use GNAT.Directory_Operations;
with Hostparm;
with Makeutl; use Makeutl;
with Opt;
with Osint; use Osint;
with Output; use Output;
with Prj.Com; use Prj.Com;
with Osint; use Osint;
with Output; use Output;
with Prj.Com; use Prj.Com;
with Sdefault;
with Tempdir;
package body Prj.Env is
......@@ -35,6 +39,14 @@ package body Prj.Env is
Buffer_Initial : constant := 1_000;
-- Initial size of Buffer
Uninitialized_Prefix : constant String := '#' & Path_Separator;
-- Prefix to indicate that the project path has not been initilized yet.
-- Must be two characters long
No_Project_Default_Dir : constant String := "-";
-- Indicator in the project path to indicate that the default search
-- directories should not be added to the path
-----------------------
-- Local Subprograms --
-----------------------
......@@ -97,6 +109,11 @@ 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 --
----------------------
......@@ -1739,4 +1756,435 @@ package body Prj.Env is
return Result;
end Ultimate_Extension_Of;
---------------------
-- Add_Directories --
---------------------
procedure Add_Directories
(Self : in out Project_Search_Path;
Path : String)
is
Tmp : String_Access;
begin
if Self.Path = null then
Self.Path := new String'(Uninitialized_Prefix & Path);
else
Tmp := Self.Path;
Self.Path := new String'(Tmp.all & Path_Separator & Path);
Free (Tmp);
end if;
end Add_Directories;
-----------------------------
-- Initialize_Project_Path --
-----------------------------
procedure Initialize_Project_Path
(Self : in out Project_Search_Path; Target_Name : String)
is
Add_Default_Dir : Boolean := True;
First : Positive;
Last : Positive;
New_Len : Positive;
New_Last : Positive;
Ada_Project_Path : constant String := "ADA_PROJECT_PATH";
Gpr_Project_Path : constant String := "GPR_PROJECT_PATH";
-- Name of alternate env. variable that contain path name(s) of
-- directories where project files may reside. GPR_PROJECT_PATH has
-- precedence over ADA_PROJECT_PATH.
Gpr_Prj_Path : String_Access;
Ada_Prj_Path : String_Access;
-- The path name(s) of directories where project files may reside.
-- May be empty.
begin
-- If already initialized, nothing else to do
if Self.Path /= null
and then Self.Path (Self.Path'First) /= '#'
then
return;
end if;
-- The current directory is always first in the search path. Since the
-- Project_Path currently starts with '#:' as a sign that it isn't
-- initialized, we simply replace '#' with '.'
if Self.Path = null then
Self.Path := new String'('.' & Path_Separator);
else
Self.Path (Self.Path'First) := '.';
end if;
-- Then the reset of the project path (if any) currently contains the
-- directories added through Add_Search_Project_Directory
-- If environment variables are defined and not empty, add their content
Gpr_Prj_Path := Getenv (Gpr_Project_Path);
Ada_Prj_Path := Getenv (Ada_Project_Path);
if Gpr_Prj_Path.all /= "" then
Add_Directories (Self, Gpr_Prj_Path.all);
end if;
Free (Gpr_Prj_Path);
if Ada_Prj_Path.all /= "" then
Add_Directories (Self, Ada_Prj_Path.all);
end if;
Free (Ada_Prj_Path);
-- Copy to Name_Buffer, since we will need to manipulate the path
Name_Len := Self.Path'Length;
Name_Buffer (1 .. Name_Len) := Self.Path.all;
-- Scan the directory path to see if "-" is one of the directories.
-- Remove each occurrence of "-" and set Add_Default_Dir to False.
-- Also resolve relative paths and symbolic links.
First := 3;
loop
while First <= Name_Len
and then (Name_Buffer (First) = Path_Separator)
loop
First := First + 1;
end loop;
exit when First > Name_Len;
Last := First;
while Last < Name_Len
and then Name_Buffer (Last + 1) /= Path_Separator
loop
Last := Last + 1;
end loop;
-- If the directory is "-", set Add_Default_Dir to False and
-- remove from path.
if Name_Buffer (First .. Last) = No_Project_Default_Dir then
Add_Default_Dir := False;
for J in Last + 1 .. Name_Len loop
Name_Buffer (J - No_Project_Default_Dir'Length - 1) :=
Name_Buffer (J);
end loop;
Name_Len := Name_Len - No_Project_Default_Dir'Length - 1;
-- After removing the '-', go back one character to get the next
-- directory correctly.
Last := Last - 1;
elsif not Hostparm.OpenVMS
or else not Is_Absolute_Path (Name_Buffer (First .. Last))
then
-- On VMS, only expand relative path names, as absolute paths
-- may correspond to multi-valued VMS logical names.
declare
New_Dir : constant String :=
Normalize_Pathname
(Name_Buffer (First .. Last),
Resolve_Links => Opt.Follow_Links_For_Dirs);
begin
-- If the absolute path was resolved and is different from
-- the original, replace original with the resolved path.
if New_Dir /= Name_Buffer (First .. Last)
and then New_Dir'Length /= 0
then
New_Len := Name_Len + New_Dir'Length - (Last - First + 1);
New_Last := First + New_Dir'Length - 1;
Name_Buffer (New_Last + 1 .. New_Len) :=
Name_Buffer (Last + 1 .. Name_Len);
Name_Buffer (First .. New_Last) := New_Dir;
Name_Len := New_Len;
Last := New_Last;
end if;
end;
end if;
First := Last + 1;
end loop;
Free (Self.Path);
-- Set the initial value of Current_Project_Path
if Add_Default_Dir then
declare
Prefix : String_Ptr := Sdefault.Search_Dir_Prefix;
begin
if Prefix = null then
Prefix := new String'(Executable_Prefix_Path);
if Prefix.all /= "" then
if Target_Name /= "" then
Add_Str_To_Name_Buffer
(Path_Separator & Prefix.all &
"lib" & Directory_Separator & "gpr" &
Directory_Separator & Target_Name);
end if;
Add_Str_To_Name_Buffer
(Path_Separator & Prefix.all &
"share" & Directory_Separator & "gpr");
Add_Str_To_Name_Buffer
(Path_Separator & Prefix.all &
"lib" & Directory_Separator & "gnat");
end if;
else
Self.Path :=
new String'(Name_Buffer (1 .. Name_Len) & Path_Separator &
Prefix.all &
".." & Directory_Separator &
".." & Directory_Separator &
".." & Directory_Separator & "gnat");
end if;
Free (Prefix);
end;
end if;
if Self.Path = null then
Self.Path := new String'(Name_Buffer (1 .. Name_Len));
end if;
end Initialize_Project_Path;
--------------
-- Get_Path --
--------------
procedure Get_Path
(Self : in out Project_Search_Path;
Path : out String_Access)
is
begin
Initialize_Project_Path (Self, ""); -- ??? Target_Name unspecified
Path := Self.Path;
end Get_Path;
---------------
-- Deep_Copy --
---------------
function Deep_Copy
(Self : Project_Search_Path) return Project_Search_Path is
begin
if Self.Path = null then
return Project_Search_Path'
(Path => null, Cache => Projects_Paths.Nil);
else
return Project_Search_Path'
(Path => new String'(Self.Path.all),
Cache => Projects_Paths.Nil);
end if;
end Deep_Copy;
------------------
-- Find_Project --
------------------
procedure Find_Project
(Self : in out Project_Search_Path;
Project_File_Name : String;
Directory : 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
-- modify below
function Try_Path_Name (Path : String) return String_Access;
pragma Inline (Try_Path_Name);
-- Try the specified Path
-------------------
-- Try_Path_Name --
-------------------
function Try_Path_Name (Path : String) return String_Access is
First : Natural;
Last : Natural;
Result : String_Access := null;
begin
if Current_Verbosity = High then
Write_Str (" Trying ");
Write_Line (Path);
end if;
if Is_Absolute_Path (Path) then
if Is_Regular_File (Path) then
Result := new String'(Path);
end if;
else
-- Because we don't want to resolve symbolic links, we cannot use
-- Locate_Regular_File. So, we try each possible path
-- successively.
First := Self.Path'First;
while First <= Self.Path'Last loop
while First <= Self.Path'Last
and then Self.Path (First) = Path_Separator
loop
First := First + 1;
end loop;
exit when First > Self.Path'Last;
Last := First;
while Last < Self.Path'Last
and then Self.Path (Last + 1) /= Path_Separator
loop
Last := Last + 1;
end loop;
Name_Len := 0;
if not Is_Absolute_Path (Self.Path (First .. Last)) then
Add_Str_To_Name_Buffer (Get_Current_Dir); -- ??? System call
Add_Char_To_Name_Buffer (Directory_Separator);
end if;
Add_Str_To_Name_Buffer (Self.Path (First .. Last));
Add_Char_To_Name_Buffer (Directory_Separator);
Add_Str_To_Name_Buffer (Path);
if Current_Verbosity = High then
Write_Str (" Testing file ");
Write_Line (Name_Buffer (1 .. Name_Len));
end if;
if Is_Regular_File (Name_Buffer (1 .. Name_Len)) then
Result := new String'(Name_Buffer (1 .. Name_Len));
exit;
end if;
First := Last + 1;
end loop;
end if;
return Result;
end Try_Path_Name;
-- Local Declarations
Result : String_Access;
Has_Dot : Boolean := False;
Key : Name_Id;
-- Start of processing for Project_Path_Name_Of
begin
Initialize_Project_Path (Self, "");
if Current_Verbosity = High then
Write_Str ("Searching for project (""");
Write_Str (File);
Write_Str (""", """);
Write_Str (Directory);
Write_Line (""");");
end if;
-- Check the project cache
Name_Len := File'Length;
Name_Buffer (1 .. Name_Len) := File;
Key := Name_Find;
Path := Projects_Paths.Get (Self.Cache, Key);
if Path /= No_Path then
return;
end if;
-- Check if File contains an extension (a dot before a
-- directory separator). If it is the case we do not try project file
-- with an added extension as it is not possible to have multiple dots
-- on a project file name.
Check_Dot : for K in reverse File'Range loop
if File (K) = '.' then
Has_Dot := True;
exit Check_Dot;
end if;
exit Check_Dot when File (K) = Directory_Separator
or else File (K) = '/';
end loop Check_Dot;
if not Is_Absolute_Path (File) then
-- First we try <directory>/<file_name>.<extension>
if not Has_Dot then
Result := Try_Path_Name
(Directory & Directory_Separator &
File & Project_File_Extension);
end if;
-- Then we try <directory>/<file_name>
if Result = null then
Result := Try_Path_Name (Directory & Directory_Separator & File);
end if;
end if;
-- Then we try <file_name>.<extension>
if Result = null and then not Has_Dot then
Result := Try_Path_Name (File & Project_File_Extension);
end if;
-- Then we try <file_name>
if Result = null then
Result := Try_Path_Name (File);
end if;
-- If we cannot find the project file, we return an empty string
if Result = null then
Path := Namet.No_Path;
return;
else
declare
Final_Result : constant String :=
GNAT.OS_Lib.Normalize_Pathname
(Result.all,
Directory => Directory,
Resolve_Links => Opt.Follow_Links_For_Files,
Case_Sensitive => True);
begin
Free (Result);
Name_Len := Final_Result'Length;
Name_Buffer (1 .. Name_Len) := Final_Result;
Path := Name_Find;
Projects_Paths.Set (Self.Cache, Key, Path);
end;
end if;
end Find_Project;
----------
-- Free --
----------
procedure Free (Self : in out Project_Search_Path) is
begin
Free (Self.Path);
Projects_Paths.Reset (Self.Cache);
end Free;
end Prj.Env;
gcc/ada/prj-env.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2001-2009, Free Software Foundation, Inc. --
-- Copyright (C) 2001-2010, 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- --
......@@ -26,6 +26,9 @@
-- This package implements services for Project-aware tools, mostly related
-- to the environment (configuration pragma files, path files, mapping files).
with GNAT.Dynamic_HTables;
with System.OS_Lib;
package Prj.Env is
procedure Initialize (In_Tree : Project_Tree_Ref);
......@@ -152,4 +155,72 @@ package Prj.Env is
-- Iterate through all the object directories of a project, including
-- those of imported or modified projects.
------------------
-- Project Path --
------------------
type Project_Search_Path is private;
-- An abstraction of the project path. This object provides subprograms to
-- search for projects on the path (and caches the results for more
-- efficiency).
procedure Free (Self : in out Project_Search_Path);
-- Free the memory used by Self
procedure Add_Directories
(Self : in out Project_Search_Path;
Path : String);
-- Add one or more directories to the path.
-- Directories added with this procedure are added in order after the
-- current directory and before the path given by the environment variable
-- GPR_PROJECT_PATH. A value of "-" will remove the default project
-- directory from the project path.
--
-- Calls to this subprogram must be performed before the first call to
-- 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);
-- 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.
procedure Find_Project
(Self : in out Project_Search_Path;
Project_File_Name : String;
Directory : String;
Path : out Namet.Path_Name_Type);
-- Search for a the 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.
-- Project_File_Name can optionally contain directories, and the extension
-- (.gpr) for the file name is optional.
-- Returns No_Name if no such project was found.
function Deep_Copy (Self : Project_Search_Path) return Project_Search_Path;
-- Return a deep copy of Self. The result can be modified independently of
-- Self, and must be freed by the caller
private
package Projects_Paths is new GNAT.Dynamic_HTables.Simple_HTable
(Header_Num => Header_Num,
Element => Path_Name_Type,
No_Element => No_Path,
Key => Name_Id,
Hash => Hash,
Equal => "=");
type Project_Search_Path is record
Path : System.OS_Lib.String_Access;
-- As a special case, if the first character is '#:" or this variable is
-- unset, this means that the PATH has not been fully initialized yet
-- (although subprograms above will properly take care of that).
Cache : Projects_Paths.Instance;
end record;
end Prj.Env;
gcc/ada/prj-ext.adb
......@@ -23,26 +23,11 @@
-- --
------------------------------------------------------------------------------
with Hostparm;
with Makeutl; use Makeutl;
with Opt;
with Osint; use Osint;
with Prj.Tree; use Prj.Tree;
with Sdefault;
package body Prj.Ext is
No_Project_Default_Dir : constant String := "-";
-- Indicator in the project path to indicate that the default search
-- directories should not be added to the path
Uninitialized_Prefix : constant String := '#' & Path_Separator;
-- Prefix to indicate that the project path has not been initilized yet.
-- Must be two characters long
procedure Initialize_Project_Path (Tree : Prj.Tree.Project_Node_Tree_Ref);
-- Initialize Current_Project_Path
---------
-- Add --
---------
......@@ -65,25 +50,6 @@ package body Prj.Ext is
Name_To_Name_HTable.Set (Tree.External_References, The_Key, The_Value);
end Add;
----------------------------------
-- Add_Search_Project_Directory --
----------------------------------
procedure Add_Search_Project_Directory
(Tree : Prj.Tree.Project_Node_Tree_Ref;
Path : String)
is
Tmp : String_Access;
begin
if Tree.Project_Path = null then
Tree.Project_Path := new String'(Uninitialized_Prefix & Path);
else
Tmp := Tree.Project_Path;
Tree.Project_Path := new String'(Tmp.all & Path_Separator & Path);
Free (Tmp);
end if;
end Add_Search_Project_Directory;
-----------
-- Check --
-----------
......@@ -109,197 +75,6 @@ package body Prj.Ext is
return False;
end Check;
-----------------------------
-- Initialize_Project_Path --
-----------------------------
procedure Initialize_Project_Path (Tree : Prj.Tree.Project_Node_Tree_Ref) is
Add_Default_Dir : Boolean := True;
First : Positive;
Last : Positive;
New_Len : Positive;
New_Last : Positive;
Ada_Project_Path : constant String := "ADA_PROJECT_PATH";
Gpr_Project_Path : constant String := "GPR_PROJECT_PATH";
-- Name of alternate env. variable that contain path name(s) of
-- directories where project files may reside. GPR_PROJECT_PATH has
-- precedence over ADA_PROJECT_PATH.
Gpr_Prj_Path : String_Access := Getenv (Gpr_Project_Path);
Ada_Prj_Path : String_Access := Getenv (Ada_Project_Path);
-- The path name(s) of directories where project files may reside.
-- May be empty.
begin
-- The current directory is always first in the search path. Since the
-- Project_Path currently starts with '#:' as a sign that it isn't
-- initialized, we simply replace '#' with '.'
if Tree.Project_Path = null then
Tree.Project_Path := new String'('.' & Path_Separator);
else
Tree.Project_Path (Tree.Project_Path'First) := '.';
end if;
-- Then the reset of the project path (if any) currently contains the
-- directories added through Add_Search_Project_Directory
-- If environment variables are defined and not empty, add their content
if Gpr_Prj_Path.all /= "" then
Add_Search_Project_Directory (Tree, Gpr_Prj_Path.all);
end if;
Free (Gpr_Prj_Path);
if Ada_Prj_Path.all /= "" then
Add_Search_Project_Directory (Tree, Ada_Prj_Path.all);
end if;
Free (Ada_Prj_Path);
-- Copy to Name_Buffer, since we will need to manipulate the path
Name_Len := Tree.Project_Path'Length;
Name_Buffer (1 .. Name_Len) := Tree.Project_Path.all;
-- Scan the directory path to see if "-" is one of the directories.
-- Remove each occurrence of "-" and set Add_Default_Dir to False.
-- Also resolve relative paths and symbolic links.
First := 3;
loop
while First <= Name_Len
and then (Name_Buffer (First) = Path_Separator)
loop
First := First + 1;
end loop;
exit when First > Name_Len;
Last := First;
while Last < Name_Len
and then Name_Buffer (Last + 1) /= Path_Separator
loop
Last := Last + 1;
end loop;
-- If the directory is "-", set Add_Default_Dir to False and
-- remove from path.
if Name_Buffer (First .. Last) = No_Project_Default_Dir then
Add_Default_Dir := False;
for J in Last + 1 .. Name_Len loop
Name_Buffer (J - No_Project_Default_Dir'Length - 1) :=
Name_Buffer (J);
end loop;
Name_Len := Name_Len - No_Project_Default_Dir'Length - 1;
-- After removing the '-', go back one character to get the next
-- directory correctly.
Last := Last - 1;
elsif not Hostparm.OpenVMS
or else not Is_Absolute_Path (Name_Buffer (First .. Last))
then
-- On VMS, only expand relative path names, as absolute paths
-- may correspond to multi-valued VMS logical names.
declare
New_Dir : constant String :=
Normalize_Pathname
(Name_Buffer (First .. Last),
Resolve_Links => Opt.Follow_Links_For_Dirs);
begin
-- If the absolute path was resolved and is different from
-- the original, replace original with the resolved path.
if New_Dir /= Name_Buffer (First .. Last)
and then New_Dir'Length /= 0
then
New_Len := Name_Len + New_Dir'Length - (Last - First + 1);
New_Last := First + New_Dir'Length - 1;
Name_Buffer (New_Last + 1 .. New_Len) :=
Name_Buffer (Last + 1 .. Name_Len);
Name_Buffer (First .. New_Last) := New_Dir;
Name_Len := New_Len;
Last := New_Last;
end if;
end;
end if;
First := Last + 1;
end loop;
Free (Tree.Project_Path);
-- Set the initial value of Current_Project_Path
if Add_Default_Dir then
declare
Prefix : String_Ptr := Sdefault.Search_Dir_Prefix;
begin
if Prefix = null then
Prefix := new String'(Executable_Prefix_Path);
if Prefix.all /= "" then
if Tree.Target_Name /= null
and then Tree.Target_Name.all /= ""
then
Add_Str_To_Name_Buffer
(Path_Separator & Prefix.all &
"lib" & Directory_Separator & "gpr" &
Directory_Separator & Tree.Target_Name.all);
end if;
Add_Str_To_Name_Buffer
(Path_Separator & Prefix.all &
"share" & Directory_Separator & "gpr");
Add_Str_To_Name_Buffer
(Path_Separator & Prefix.all &
"lib" & Directory_Separator & "gnat");
end if;
else
Tree.Project_Path :=
new String'(Name_Buffer (1 .. Name_Len) & Path_Separator &
Prefix.all &
".." & Directory_Separator &
".." & Directory_Separator &
".." & Directory_Separator & "gnat");
end if;
Free (Prefix);
end;
end if;
if Tree.Project_Path = null then
Tree.Project_Path := new String'(Name_Buffer (1 .. Name_Len));
end if;
end Initialize_Project_Path;
------------------
-- Project_Path --
------------------
function Project_Path (Tree : Project_Node_Tree_Ref) return String is
begin
if Tree.Project_Path = null
or else Tree.Project_Path (Tree.Project_Path'First) = '#'
then
Initialize_Project_Path (Tree);
end if;
return Tree.Project_Path.all;
end Project_Path;
-----------
-- Reset --
-----------
......@@ -309,18 +84,6 @@ package body Prj.Ext is
Name_To_Name_HTable.Reset (Tree.External_References);
end Reset;
----------------------
-- Set_Project_Path --
----------------------
procedure Set_Project_Path
(Tree : Project_Node_Tree_Ref;
New_Path : String) is
begin
Free (Tree.Project_Path);
Tree.Project_Path := new String'(New_Path);
end Set_Project_Path;
--------------
-- Value_Of --
--------------
......
gcc/ada/prj-ext.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2000-2009, Free Software Foundation, Inc. --
-- Copyright (C) 2000-2010, 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- --
......@@ -30,34 +30,6 @@ with Prj.Tree;
package Prj.Ext is
------------------
-- Project Path --
------------------
procedure Add_Search_Project_Directory
(Tree : Prj.Tree.Project_Node_Tree_Ref;
Path : String);
-- Add a directory to the project path. Directories added with this
-- procedure are added in order after the current directory and before
-- the path given by the environment variable GPR_PROJECT_PATH. A value
-- of "-" will remove the default project directory from the project path.
--
-- Calls to this subprogram must be performed before the first call to
-- Project_Path below, or PATH will be added at the end of the search
-- path.
function Project_Path (Tree : Prj.Tree.Project_Node_Tree_Ref) return String;
-- 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.
procedure Set_Project_Path
(Tree : Prj.Tree.Project_Node_Tree_Ref;
New_Path : String);
-- Give a new value to the project path. The new value New_Path should
-- always start with the current directory (".") and the path separators
-- should be the correct ones for the platform.
-------------------------
-- External References --
-------------------------
......
gcc/ada/prj-nmsc.adb
......@@ -149,6 +149,7 @@ package body Prj.Nmsc is
type Tree_Processing_Data is record
Tree : Project_Tree_Ref;
Node_Tree : Prj.Tree.Project_Node_Tree_Ref;
File_To_Source : Files_Htable.Instance;
Flags : Prj.Processing_Flags;
end record;
......@@ -173,9 +174,10 @@ package body Prj.Nmsc is
-- projects do not have the same library names.
procedure Initialize
(Data : out Tree_Processing_Data;
Tree : Project_Tree_Ref;
Flags : Prj.Processing_Flags);
(Data : out Tree_Processing_Data;
Tree : Project_Tree_Ref;
Node_Tree : Prj.Tree.Project_Node_Tree_Ref;
Flags : Prj.Processing_Flags);
-- Initialize Data
procedure Free (Data : in out Tree_Processing_Data);
......@@ -6574,14 +6576,16 @@ package body Prj.Nmsc is
----------------
procedure Initialize
(Data : out Tree_Processing_Data;
Tree : Project_Tree_Ref;
Flags : Prj.Processing_Flags)
(Data : out Tree_Processing_Data;
Tree : Project_Tree_Ref;
Node_Tree : Prj.Tree.Project_Node_Tree_Ref;
Flags : Prj.Processing_Flags)
is
begin
Files_Htable.Reset (Data.File_To_Source);
Data.Tree := Tree;
Data.Flags := Flags;
Data.Tree := Tree;
Data.Node_Tree := Node_Tree;
Data.Flags := Flags;
end Initialize;
----------
......@@ -7611,6 +7615,7 @@ package body Prj.Nmsc is
procedure Process_Naming_Scheme
(Tree : Project_Tree_Ref;
Root_Project : Project_Id;
Node_Tree : Prj.Tree.Project_Node_Tree_Ref;
Flags : Processing_Flags)
is
procedure Recursive_Check
......@@ -7644,7 +7649,7 @@ package body Prj.Nmsc is
-- Start of processing for Process_Naming_Scheme
begin
Lib_Data_Table.Init;
Initialize (Data, Tree => Tree, Flags => Flags);
Initialize (Data, Tree => Tree, Node_Tree => Node_Tree, Flags => Flags);
Check_All_Projects (Root_Project, Data, Imported_First => True);
Free (Data);
......
gcc/ada/prj-nmsc.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2000-2009, Free Software Foundation, Inc. --
-- Copyright (C) 2000-2010, 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- --
......@@ -25,11 +25,14 @@
-- Find source dirs and source files for a project
with Prj.Tree;
private package Prj.Nmsc is
procedure Process_Naming_Scheme
(Tree : Project_Tree_Ref;
Root_Project : Project_Id;
Node_Tree : Prj.Tree.Project_Node_Tree_Ref;
Flags : Processing_Flags);
-- Perform consistency and semantic checks on all the projects in the tree.
-- This procedure interprets the various case statements in the project
......
gcc/ada/prj-part.adb
......@@ -29,8 +29,8 @@ with Osint; use Osint;
with Output; use Output;
with Prj.Com; use Prj.Com;
with Prj.Dect;
with Prj.Env; use Prj.Env;
with Prj.Err; use Prj.Err;
with Prj.Ext; use Prj.Ext;
with Sinput; use Sinput;
with Sinput.P; use Sinput.P;
with Snames;
......@@ -39,7 +39,6 @@ with Table;
with Ada.Characters.Handling; use Ada.Characters.Handling;
with Ada.Exceptions; use Ada.Exceptions;
with GNAT.Directory_Operations; use GNAT.Directory_Operations;
with GNAT.HTable; use GNAT.HTable;
package body Prj.Part is
......@@ -118,14 +117,6 @@ package body Prj.Part is
-- need to have a virtual extending project, to avoid processing the same
-- project twice.
package Projects_Paths is new GNAT.HTable.Simple_HTable
(Header_Num => Header_Num,
Element => Path_Name_Type,
No_Element => No_Path,
Key => Name_Id,
Hash => Hash,
Equal => "=");
function Has_Circular_Dependencies
(Flags : Processing_Flags;
Normed_Path_Name : Path_Name_Type;
......@@ -186,7 +177,7 @@ package body Prj.Part is
(In_Tree : Project_Node_Tree_Ref;
Project : out Project_Node_Id;
Extends_All : out Boolean;
Path_Name : String;
Path_Name_Id : Path_Name_Type;
Extended : Boolean;
From_Extended : Extension_Origin;
In_Limited : Boolean;
......@@ -239,13 +230,6 @@ package body Prj.Part is
-- Is_Config_File should be set to True if the project represents a config
-- file (.cgpr) since some specific checks apply.
function Project_Path_Name_Of
(In_Tree : Project_Node_Tree_Ref;
Project_File_Name : String;
Directory : String) return String;
-- Returns the path name of a project file. Returns an empty string
-- if project file cannot be found.
function Project_Name_From
(Path_Name : String;
Is_Config_File : Boolean) return Name_Id;
......@@ -472,6 +456,7 @@ package body Prj.Part is
Real_Project_File_Name : String_Access :=
Osint.To_Canonical_File_Spec
(Project_File_Name);
Path_Name_Id : Path_Name_Type;
begin
if Real_Project_File_Name = null then
......@@ -480,153 +465,146 @@ package body Prj.Part is
Project := Empty_Node;
Projects_Paths.Reset;
if Current_Verbosity >= Medium then
Write_Str ("GPR_PROJECT_PATH=""");
Write_Str (Project_Path (In_Tree));
Write_Line ("""");
end if;
declare
Path_Name : constant String :=
Project_Path_Name_Of (In_Tree,
Real_Project_File_Name.all,
Directory => Current_Directory);
Find_Project (In_Tree.Project_Path,
Project_File_Name => Real_Project_File_Name.all,
Directory => Current_Directory,
Path => Path_Name_Id);
Free (Real_Project_File_Name);
begin
Free (Real_Project_File_Name);
Prj.Err.Initialize;
Prj.Err.Scanner.Set_Comment_As_Token (Store_Comments);
Prj.Err.Scanner.Set_End_Of_Line_As_Token (Store_Comments);
Prj.Err.Initialize;
Prj.Err.Scanner.Set_Comment_As_Token (Store_Comments);
Prj.Err.Scanner.Set_End_Of_Line_As_Token (Store_Comments);
-- Parse the main project file
if Path_Name = "" then
if Path_Name_Id = No_Path then
declare
P : String_Access;
begin
Get_Path (In_Tree.Project_Path, Path => P);
Prj.Com.Fail
("project file """
& Project_File_Name
& """ not found in "
& Project_Path (In_Tree));
& P.all);
Project := Empty_Node;
return;
end if;
end;
end if;
begin
Parse_Single_Project
(In_Tree => In_Tree,
Project => Project,
Extends_All => Dummy,
Path_Name => Path_Name,
Extended => False,
From_Extended => None,
In_Limited => False,
Packages_To_Check => Packages_To_Check,
Depth => 0,
Current_Dir => Current_Directory,
Is_Config_File => Is_Config_File,
Flags => Flags);
-- Parse the main project file
exception
when Types.Unrecoverable_Error =>
-- Unrecoverable_Error is raised when a line is too long.
-- A meaningful error message will be displayed later.
Project := Empty_Node;
end;
begin
Parse_Single_Project
(In_Tree => In_Tree,
Project => Project,
Extends_All => Dummy,
Path_Name_Id => Path_Name_Id,
Extended => False,
From_Extended => None,
In_Limited => False,
Packages_To_Check => Packages_To_Check,
Depth => 0,
Current_Dir => Current_Directory,
Is_Config_File => Is_Config_File,
Flags => Flags);
-- If Project is an extending-all project, create the eventual
-- virtual extending projects and check that there are no illegally
-- imported projects.
exception
when Types.Unrecoverable_Error =>
-- Unrecoverable_Error is raised when a line is too long.
-- A meaningful error message will be displayed later.
Project := Empty_Node;
end;
if Present (Project)
and then Is_Extending_All (Project, In_Tree)
then
-- First look for projects that potentially need a virtual
-- extending project.
-- If Project is an extending-all project, create the eventual
-- virtual extending projects and check that there are no illegally
-- imported projects.
Virtual_Hash.Reset;
Processed_Hash.Reset;
if Present (Project)
and then Is_Extending_All (Project, In_Tree)
then
-- First look for projects that potentially need a virtual
-- extending project.
-- Mark the extending all project as processed, to avoid checking
-- the imported projects in case of a "limited with" on this
-- extending all project.
Virtual_Hash.Reset;
Processed_Hash.Reset;
Processed_Hash.Set (Project, True);
-- Mark the extending all project as processed, to avoid checking
-- the imported projects in case of a "limited with" on this
-- extending all project.
declare
Declaration : constant Project_Node_Id :=
Project_Declaration_Of (Project, In_Tree);
begin
Look_For_Virtual_Projects_For
(Extended_Project_Of (Declaration, In_Tree), In_Tree,
Potentially_Virtual => False);
end;
Processed_Hash.Set (Project, True);
-- Now, check the projects directly imported by the main project.
-- Remove from the potentially virtual any project extended by one
-- of these imported projects. For non extending imported
-- projects, check that they do not belong to the project tree of
-- the project being "extended-all" by the main project.
declare
Declaration : constant Project_Node_Id :=
Project_Declaration_Of (Project, In_Tree);
begin
Look_For_Virtual_Projects_For
(Extended_Project_Of (Declaration, In_Tree), In_Tree,
Potentially_Virtual => False);
end;
declare
With_Clause : Project_Node_Id;
Imported : Project_Node_Id := Empty_Node;
Declaration : Project_Node_Id := Empty_Node;
-- Now, check the projects directly imported by the main project.
-- Remove from the potentially virtual any project extended by one
-- of these imported projects. For non extending imported
-- projects, check that they do not belong to the project tree of
-- the project being "extended-all" by the main project.
begin
With_Clause := First_With_Clause_Of (Project, In_Tree);
while Present (With_Clause) loop
Imported := Project_Node_Of (With_Clause, In_Tree);
declare
With_Clause : Project_Node_Id;
Imported : Project_Node_Id := Empty_Node;
Declaration : Project_Node_Id := Empty_Node;
if Present (Imported) then
Declaration := Project_Declaration_Of (Imported, In_Tree);
begin
With_Clause := First_With_Clause_Of (Project, In_Tree);
while Present (With_Clause) loop
Imported := Project_Node_Of (With_Clause, In_Tree);
if Extended_Project_Of (Declaration, In_Tree) /=
Empty_Node
then
loop
Imported :=
Extended_Project_Of (Declaration, In_Tree);
exit when No (Imported);
Virtual_Hash.Remove (Imported);
Declaration :=
Project_Declaration_Of (Imported, In_Tree);
end loop;
end if;
if Present (Imported) then
Declaration := Project_Declaration_Of (Imported, In_Tree);
if Extended_Project_Of (Declaration, In_Tree) /=
Empty_Node
then
loop
Imported :=
Extended_Project_Of (Declaration, In_Tree);
exit when No (Imported);
Virtual_Hash.Remove (Imported);
Declaration :=
Project_Declaration_Of (Imported, In_Tree);
end loop;
end if;
end if;
With_Clause := Next_With_Clause_Of (With_Clause, In_Tree);
end loop;
end;
With_Clause := Next_With_Clause_Of (With_Clause, In_Tree);
end loop;
end;
-- Now create all the virtual extending projects
-- Now create all the virtual extending projects
declare
Proj : Project_Node_Id := Virtual_Hash.Get_First;
begin
while Present (Proj) loop
Create_Virtual_Extending_Project (Proj, Project, In_Tree);
Proj := Virtual_Hash.Get_Next;
end loop;
end;
end if;
declare
Proj : Project_Node_Id := Virtual_Hash.Get_First;
begin
while Present (Proj) loop
Create_Virtual_Extending_Project (Proj, Project, In_Tree);
Proj := Virtual_Hash.Get_Next;
end loop;
end;
end if;
-- If there were any kind of error during the parsing, serious
-- or not, then the parsing fails.
-- If there were any kind of error during the parsing, serious
-- or not, then the parsing fails.
if Err_Vars.Total_Errors_Detected > 0 then
Project := Empty_Node;
end if;
if Err_Vars.Total_Errors_Detected > 0 then
Project := Empty_Node;
end if;
if No (Project) or else Always_Errout_Finalize then
Prj.Err.Finalize;
if No (Project) or else Always_Errout_Finalize then
Prj.Err.Finalize;
-- Reinitialize to avoid duplicate warnings later on
-- Reinitialize to avoid duplicate warnings later on
Prj.Err.Initialize;
end if;
end;
Prj.Err.Initialize;
end if;
exception
when X : others =>
......@@ -769,6 +747,7 @@ package body Prj.Part is
Current_With : With_Record;
Extends_All : Boolean := False;
Imported_Path_Name_Id : Path_Name_Type;
begin
-- Set Current_Project to the last project in the current list, if the
......@@ -787,51 +766,48 @@ package body Prj.Part is
Current_With_Clause := Current_With.Next;
if Limited_Withs = Current_With.Limited_With then
declare
Original_Path : constant String :=
Get_Name_String (Current_With.Path);
Find_Project
(In_Tree.Project_Path,
Project_File_Name => Get_Name_String (Current_With.Path),
Directory => Project_Directory_Path,
Path => Imported_Path_Name_Id);
Imported_Path_Name : constant String :=
Project_Path_Name_Of
(In_Tree,
Original_Path,
Project_Directory_Path);
Resolved_Path : constant String :=
Normalize_Pathname
(Imported_Path_Name,
Directory => Current_Dir,
Resolve_Links =>
Opt.Follow_Links_For_Files,
Case_Sensitive => True);
if Imported_Path_Name_Id = No_Path then
Withed_Project : Project_Node_Id := Empty_Node;
-- The project file cannot be found
begin
if Imported_Path_Name = "" then
Error_Msg_File_1 := File_Name_Type (Current_With.Path);
Error_Msg
(Flags, "unknown project file: {", Current_With.Location);
-- The project file cannot be found
-- If this is not imported by the main project file, display
-- the import path.
Error_Msg_File_1 := File_Name_Type (Current_With.Path);
Error_Msg
(Flags, "unknown project file: {", Current_With.Location);
if Project_Stack.Last > 1 then
for Index in reverse 1 .. Project_Stack.Last loop
Error_Msg_File_1 :=
File_Name_Type
(Project_Stack.Table (Index).Path_Name);
Error_Msg
(Flags, "\imported by {", Current_With.Location);
end loop;
end if;
-- If this is not imported by the main project file, display
-- the import path.
else
-- New with clause
if Project_Stack.Last > 1 then
for Index in reverse 1 .. Project_Stack.Last loop
Error_Msg_File_1 :=
File_Name_Type
(Project_Stack.Table (Index).Path_Name);
Error_Msg
(Flags, "\imported by {", Current_With.Location);
end loop;
end if;
declare
Resolved_Path : constant String :=
Normalize_Pathname
(Get_Name_String (Imported_Path_Name_Id),
Directory => Current_Dir,
Resolve_Links =>
Opt.Follow_Links_For_Files,
Case_Sensitive => True);
else
-- New with clause
Withed_Project : Project_Node_Id := Empty_Node;
begin
Previous_Project := Current_Project;
if No (Current_Project) then
......@@ -890,7 +866,7 @@ package body Prj.Part is
(In_Tree => In_Tree,
Project => Withed_Project,
Extends_All => Extends_All,
Path_Name => Imported_Path_Name,
Path_Name_Id => Imported_Path_Name_Id,
Extended => False,
From_Extended => From_Extended,
In_Limited => Limited_Withs,
......@@ -939,8 +915,8 @@ package body Prj.Part is
Set_Is_Extending_All (Current_Project, In_Tree);
end if;
end if;
end if;
end;
end;
end if;
end if;
end loop;
end Post_Parse_Context_Clause;
......@@ -1132,7 +1108,7 @@ package body Prj.Part is
(In_Tree : Project_Node_Tree_Ref;
Project : out Project_Node_Id;
Extends_All : out Boolean;
Path_Name : String;
Path_Name_Id : Path_Name_Type;
Extended : Boolean;
From_Extended : Extension_Origin;
In_Limited : Boolean;
......@@ -1142,6 +1118,8 @@ package body Prj.Part is
Is_Config_File : Boolean;
Flags : Processing_Flags)
is
Path_Name : constant String := Get_Name_String (Path_Name_Id);
Normed_Path_Name : Path_Name_Type;
Canonical_Path_Name : Path_Name_Type;
Project_Directory : Path_Name_Type;
......@@ -1397,7 +1375,7 @@ package body Prj.Part is
-- Make sure that gnatmake will use mapping files
Create_Mapping_File := True;
Opt.Create_Mapping_File := True;
-- We are extending another project
......@@ -1557,16 +1535,15 @@ package body Prj.Part is
declare
Original_Path_Name : constant String :=
Get_Name_String (Token_Name);
Extended_Project_Path_Name : constant String :=
Project_Path_Name_Of
(In_Tree,
Original_Path_Name,
Get_Name_String
(Project_Directory));
Extended_Project_Path_Name_Id : Path_Name_Type;
begin
if Extended_Project_Path_Name = "" then
Find_Project
(In_Tree.Project_Path,
Project_File_Name => Original_Path_Name,
Directory => Get_Name_String (Project_Directory),
Path => Extended_Project_Path_Name_Id);
if Extended_Project_Path_Name_Id = No_Path then
-- We could not find the project file to extend
......@@ -1604,7 +1581,7 @@ package body Prj.Part is
(In_Tree => In_Tree,
Project => Extended_Project,
Extends_All => Extends_All,
Path_Name => Extended_Project_Path_Name,
Path_Name_Id => Extended_Project_Path_Name_Id,
Extended => True,
From_Extended => From_Ext,
In_Limited => In_Limited,
......@@ -2010,183 +1987,4 @@ package body Prj.Part is
end loop;
end Project_Name_From;
--------------------------
-- Project_Path_Name_Of --
--------------------------
function Project_Path_Name_Of
(In_Tree : Project_Node_Tree_Ref;
Project_File_Name : String;
Directory : String) return String
is
function Try_Path_Name (Path : String) return String_Access;
pragma Inline (Try_Path_Name);
-- Try the specified Path
-------------------
-- Try_Path_Name --
-------------------
function Try_Path_Name (Path : String) return String_Access is
Prj_Path : constant String := Project_Path (In_Tree);
First : Natural;
Last : Natural;
Result : String_Access := null;
begin
if Current_Verbosity = High then
Write_Str (" Trying ");
Write_Line (Path);
end if;
if Is_Absolute_Path (Path) then
if Is_Regular_File (Path) then
Result := new String'(Path);
end if;
else
-- Because we don't want to resolve symbolic links, we cannot use
-- Locate_Regular_File. So, we try each possible path
-- successively.
First := Prj_Path'First;
while First <= Prj_Path'Last loop
while First <= Prj_Path'Last
and then Prj_Path (First) = Path_Separator
loop
First := First + 1;
end loop;
exit when First > Prj_Path'Last;
Last := First;
while Last < Prj_Path'Last
and then Prj_Path (Last + 1) /= Path_Separator
loop
Last := Last + 1;
end loop;
Name_Len := 0;
if not Is_Absolute_Path (Prj_Path (First .. Last)) then
Add_Str_To_Name_Buffer (Get_Current_Dir);
Add_Char_To_Name_Buffer (Directory_Separator);
end if;
Add_Str_To_Name_Buffer (Prj_Path (First .. Last));
Add_Char_To_Name_Buffer (Directory_Separator);
Add_Str_To_Name_Buffer (Path);
if Is_Regular_File (Name_Buffer (1 .. Name_Len)) then
Result := new String'(Name_Buffer (1 .. Name_Len));
exit;
end if;
First := Last + 1;
end loop;
end if;
return Result;
end Try_Path_Name;
-- Local Declarations
Result : String_Access;
Result_Id : Path_Name_Type;
Has_Dot : Boolean := False;
Key : Name_Id;
-- Start of processing for Project_Path_Name_Of
begin
if Current_Verbosity = High then
Write_Str ("Project_Path_Name_Of (""");
Write_Str (Project_File_Name);
Write_Str (""", """);
Write_Str (Directory);
Write_Line (""");");
end if;
-- Check the project cache
Name_Len := Project_File_Name'Length;
Name_Buffer (1 .. Name_Len) := Project_File_Name;
Key := Name_Find;
Result_Id := Projects_Paths.Get (Key);
if Result_Id /= No_Path then
return Get_Name_String (Result_Id);
end if;
-- Check if Project_File_Name contains an extension (a dot before a
-- directory separator). If it is the case we do not try project file
-- with an added extension as it is not possible to have multiple dots
-- on a project file name.
Check_Dot : for K in reverse Project_File_Name'Range loop
if Project_File_Name (K) = '.' then
Has_Dot := True;
exit Check_Dot;
end if;
exit Check_Dot when Project_File_Name (K) = Directory_Separator
or else Project_File_Name (K) = '/';
end loop Check_Dot;
if not Is_Absolute_Path (Project_File_Name) then
-- First we try <directory>/<file_name>.<extension>
if not Has_Dot then
Result := Try_Path_Name
(Directory & Directory_Separator &
Project_File_Name & Project_File_Extension);
end if;
-- Then we try <directory>/<file_name>
if Result = null then
Result := Try_Path_Name
(Directory & Directory_Separator & Project_File_Name);
end if;
end if;
-- Then we try <file_name>.<extension>
if Result = null and then not Has_Dot then
Result := Try_Path_Name (Project_File_Name & Project_File_Extension);
end if;
-- Then we try <file_name>
if Result = null then
Result := Try_Path_Name (Project_File_Name);
end if;
-- If we cannot find the project file, we return an empty string
if Result = null then
return "";
else
declare
Final_Result : constant String :=
GNAT.OS_Lib.Normalize_Pathname
(Result.all,
Directory => Directory,
Resolve_Links => Opt.Follow_Links_For_Files,
Case_Sensitive => True);
begin
Free (Result);
Name_Len := Final_Result'Length;
Name_Buffer (1 .. Name_Len) := Final_Result;
Result_Id := Name_Find;
Projects_Paths.Set (Key, Result_Id);
return Final_Result;
end;
end if;
end Project_Path_Name_Of;
end Prj.Part;
gcc/ada/prj-proc.adb
......@@ -76,9 +76,10 @@ package body Prj.Proc is
-- the package or project with declarations Decl.
procedure Check
(In_Tree : Project_Tree_Ref;
Project : Project_Id;
Flags : Processing_Flags);
(In_Tree : Project_Tree_Ref;
Project : Project_Id;
Node_Tree : Prj.Tree.Project_Node_Tree_Ref;
Flags : Processing_Flags);
-- Set all projects to not checked, then call Recursive_Check for the
-- main project Project. Project is set to No_Project if errors occurred.
-- Current_Dir is for optimization purposes, avoiding extra system calls.
......@@ -270,12 +271,13 @@ package body Prj.Proc is
-----------
procedure Check
(In_Tree : Project_Tree_Ref;
Project : Project_Id;
Flags : Processing_Flags)
(In_Tree : Project_Tree_Ref;
Project : Project_Id;
Node_Tree : Prj.Tree.Project_Node_Tree_Ref;
Flags : Processing_Flags)
is
begin
Process_Naming_Scheme (In_Tree, Project, Flags);
Process_Naming_Scheme (In_Tree, Project, Node_Tree, Flags);
-- Set the Other_Part field for the units
......@@ -2316,7 +2318,7 @@ package body Prj.Proc is
Success := True;
if Project /= No_Project then
Check (In_Tree, Project, Flags);
Check (In_Tree, Project, From_Project_Node_Tree, Flags);
end if;
-- If main project is an extending all project, set object directory of
......
gcc/ada/prj-tree.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2001-2009, Free Software Foundation, Inc. --
-- Copyright (C) 2001-2010, 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- --
......@@ -24,6 +24,7 @@
------------------------------------------------------------------------------
with Osint; use Osint;
with Prj.Env; use Prj.Env;
with Prj.Err;
with Ada.Unchecked_Deallocation;
......
gcc/ada/prj-tree.ads
......@@ -31,6 +31,7 @@ with GNAT.Dynamic_Tables;
with Table;
with Prj.Attr; use Prj.Attr;
with Prj.Env;
package Prj.Tree is
......@@ -1474,12 +1475,7 @@ package Prj.Tree is
-- The target name, if any, specified with the gprbuild or gprclean
-- switch --target=.
Project_Path : String_Access := null;
-- The project path, manipulated through subprograms in prj-ext.ads.
-- As a special case, if the first character is '#:" or this variable is
-- unset, this means that the PATH has not been fully initialized yet
-- (although subprograms prj-ext.ads will properly take care of that).
--
Project_Path : Prj.Env.Project_Search_Path;
-- The project path is tree specific, since we might want to load
-- simultaneously multiple projects, each with its own search path, in
-- particular when using different compilers with different default
......
gcc/ada/switch-m.adb
......@@ -28,7 +28,7 @@ with Makeutl; use Makeutl;
with Osint; use Osint;
with Opt; use Opt;
with Prj; use Prj;
with Prj.Ext; use Prj.Ext;
with Prj.Env; use Prj.Env;
with Table;
package body Switch.M is
......@@ -664,8 +664,8 @@ package body Switch.M is
elsif Switch_Chars'Length > 3
and then Switch_Chars (Ptr .. Ptr + 1) = "aP"
then
Add_Search_Project_Directory
(Project_Node_Tree,
Add_Directories
(Project_Node_Tree.Project_Path,
Switch_Chars (Ptr + 2 .. Switch_Chars'Last));
elsif C = 'v' and then Switch_Chars'Length = 3 then
......@@ -813,7 +813,7 @@ package body Switch.M is
-- Processing for C switch
when 'C' =>
Create_Mapping_File := True;
Opt.Create_Mapping_File := True;
-- Processing for D switch
......
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