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