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 121 additions and 300 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.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-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