Commit 1982d5a8 by Pascal Obry Committed by Arnaud Charlet

prj-part.ads, [...] (Parse): Add Target_Name parameter.

2011-08-01  Pascal Obry  <obry@adacore.com>

	* prj-part.ads, prj-part.adb (Parse): Add Target_Name parameter. Pass
	Target_Name to Get_Path call.
	(Parse_Single_Project): Likewise.
	(Post_Parse_Context_Clause): Likewise.
	* prj-env.ads, prj-env.adb (Find_Project): Add Target_Name parameter.
	Call Initialise_Project_Path with the proper Target_Name.
	(Initialize_Project_Path): Add <gnat_root>/<target_name>/lib/gnat
	search path.
	(Get_Path): Add Target_Name parameter. Call Initialise_Project_Path
	with the proper Target_Name.
	* prj-conf.adb (Get_Or_Create_Configuration_File): Pass Target_Name to
	Part.Parse routine.
	(Parse_Project_And_Apply_Config): Likewise.
	* prj-makr.adb (Initialize): Pass empty Target_Name to Parse routine.
	This is fine as this part of the code is supporting only native
	compilation.
	* prj-pars.adb (Parse): Pass empty Target_Name to Parse routine. This
	is fine as this part of the code is supporting only native compilation.

From-SVN: r177054
parent 0d53d36b
2011-08-01 Pascal Obry <obry@adacore.com>
* prj-part.ads, prj-part.adb (Parse): Add Target_Name parameter. Pass
Target_Name to Get_Path call.
(Parse_Single_Project): Likewise.
(Post_Parse_Context_Clause): Likewise.
* prj-env.ads, prj-env.adb (Find_Project): Add Target_Name parameter.
Call Initialise_Project_Path with the proper Target_Name.
(Initialize_Project_Path): Add <gnat_root>/<target_name>/lib/gnat
search path.
(Get_Path): Add Target_Name parameter. Call Initialise_Project_Path
with the proper Target_Name.
* prj-conf.adb (Get_Or_Create_Configuration_File): Pass Target_Name to
Part.Parse routine.
(Parse_Project_And_Apply_Config): Likewise.
* prj-makr.adb (Initialize): Pass empty Target_Name to Parse routine.
This is fine as this part of the code is supporting only native
compilation.
* prj-pars.adb (Parse): Pass empty Target_Name to Parse routine. This
is fine as this part of the code is supporting only native compilation.
2011-08-01 Yannick Moy <moy@adacore.com>
* sem_util.adb (Enter_Name): issue error in formal mode on declaration
......
......@@ -1116,7 +1116,8 @@ package body Prj.Conf is
Packages_To_Check => Packages_To_Check,
Current_Directory => Current_Directory,
Is_Config_File => True,
Flags => Flags);
Flags => Flags,
Target_Name => Target_Name);
else
-- Maybe the user will want to create his own configuration file
Config_Project_Node := Empty_Node;
......@@ -1214,7 +1215,8 @@ package body Prj.Conf is
Packages_To_Check => Packages_To_Check,
Current_Directory => Current_Directory,
Is_Config_File => False,
Flags => Flags);
Flags => Flags,
Target_Name => Target_Name);
if User_Project_Node = Empty_Node then
User_Project_Node := Empty_Node;
......
......@@ -1937,6 +1937,10 @@ package body Prj.Env is
(Path_Separator & Prefix.all &
"lib" & Directory_Separator & "gpr" &
Directory_Separator & Target_Name);
Add_Str_To_Name_Buffer
(Path_Separator & Prefix.all &
Target_Name & Directory_Separator &
"lib" & Directory_Separator & "gnat");
end if;
Add_Str_To_Name_Buffer
......@@ -1970,11 +1974,12 @@ package body Prj.Env is
--------------
procedure Get_Path
(Self : in out Project_Search_Path;
Path : out String_Access)
(Self : in out Project_Search_Path;
Path : out String_Access;
Target_Name : String := "")
is
begin
Initialize_Project_Path (Self, ""); -- ??? Target_Name unspecified
Initialize_Project_Path (Self, Target_Name);
Path := Self.Path;
end Get_Path;
......@@ -1998,7 +2003,8 @@ package body Prj.Env is
(Self : in out Project_Search_Path;
Project_File_Name : String;
Directory : String;
Path : out Namet.Path_Name_Type)
Path : out Namet.Path_Name_Type;
Target_Name : String)
is
File : constant String := Project_File_Name;
-- Have to do a copy, in case the parameter is Name_Buffer, which we
......@@ -2087,7 +2093,7 @@ package body Prj.Env is
-- Start of processing for Find_Project
begin
Initialize_Project_Path (Self, "");
Initialize_Project_Path (Self, Target_Name);
if Current_Verbosity = High then
Write_Str ("Searching for project (""");
......
......@@ -180,8 +180,9 @@ package Prj.Env is
-- path.
procedure Get_Path
(Self : in out Project_Search_Path;
Path : out String_Access);
(Self : in out Project_Search_Path;
Path : out String_Access;
Target_Name : 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.
......@@ -196,7 +197,8 @@ package Prj.Env is
(Self : in out Project_Search_Path;
Project_File_Name : 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
-- 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
......
......@@ -865,7 +865,8 @@ package body Prj.Makr is
Is_Config_File => False,
Flags => Flags,
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
......
......@@ -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- --
......@@ -73,7 +73,8 @@ package body Prj.Pars is
Packages_To_Check => Packages_To_Check,
Current_Directory => Current_Dir,
Flags => Flags,
Is_Config_File => False);
Is_Config_File => False,
Target_Name => "");
-- If there were no error, process the tree
......
......@@ -185,7 +185,8 @@ package body Prj.Part is
Depth : Natural;
Current_Dir : String;
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
-- 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
......@@ -220,7 +221,8 @@ package body Prj.Part is
Depth : Natural;
Current_Dir : String;
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
-- 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
......@@ -448,7 +450,8 @@ package body Prj.Part is
Store_Comments : Boolean := False;
Current_Directory : String := "";
Is_Config_File : Boolean;
Flags : Processing_Flags)
Flags : Processing_Flags;
Target_Name : String)
is
Dummy : Boolean;
pragma Warnings (Off, Dummy);
......@@ -468,7 +471,8 @@ 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);
Path => Path_Name_Id,
Target_Name => Target_Name);
Free (Real_Project_File_Name);
Prj.Err.Initialize;
......@@ -479,7 +483,11 @@ package body Prj.Part is
declare
P : String_Access;
begin
Get_Path (In_Tree.Project_Path, Path => P);
Get_Path
(In_Tree.Project_Path,
Path => P,
Target_Name => Target_Name);
Prj.Com.Fail
("project file """
& Project_File_Name
......@@ -505,7 +513,8 @@ package body Prj.Part is
Depth => 0,
Current_Dir => Current_Directory,
Is_Config_File => Is_Config_File,
Flags => Flags);
Flags => Flags,
Target_Name => Target_Name);
exception
when Types.Unrecoverable_Error =>
......@@ -736,7 +745,8 @@ package body Prj.Part is
Depth : Natural;
Current_Dir : String;
Is_Config_File : Boolean;
Flags : Processing_Flags)
Flags : Processing_Flags;
Target_Name : String)
is
Current_With_Clause : With_Id := Context_Clause;
......@@ -772,7 +782,8 @@ 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);
Path => Imported_Path_Name_Id,
Target_Name => Target_Name);
if Imported_Path_Name_Id = No_Path then
......@@ -876,7 +887,8 @@ package body Prj.Part is
Depth => Depth,
Current_Dir => Current_Dir,
Is_Config_File => Is_Config_File,
Flags => Flags);
Flags => Flags,
Target_Name => Target_Name);
else
Extends_All := Is_Extending_All (Withed_Project, In_Tree);
......@@ -1119,7 +1131,8 @@ package body Prj.Part is
Depth : Natural;
Current_Dir : String;
Is_Config_File : Boolean;
Flags : Processing_Flags)
Flags : Processing_Flags;
Target_Name : String)
is
Path_Name : constant String := Get_Name_String (Path_Name_Id);
......@@ -1485,7 +1498,8 @@ package body Prj.Part is
Depth => Depth + 1,
Current_Dir => Current_Dir,
Is_Config_File => Is_Config_File,
Flags => Flags);
Flags => Flags,
Target_Name => Target_Name);
Set_First_With_Clause_Of (Project, In_Tree, Imported_Projects);
end;
......@@ -1544,7 +1558,8 @@ 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);
Path => Extended_Project_Path_Name_Id,
Target_Name => Target_Name);
if Extended_Project_Path_Name_Id = No_Path then
......@@ -1592,7 +1607,8 @@ package body Prj.Part is
Depth => Depth + 1,
Current_Dir => Current_Dir,
Is_Config_File => Is_Config_File,
Flags => Flags);
Flags => Flags,
Target_Name => Target_Name);
end;
if Present (Extended_Project) then
......@@ -1842,7 +1858,8 @@ package body Prj.Part is
Depth => Depth + 1,
Current_Dir => Current_Dir,
Is_Config_File => Is_Config_File,
Flags => Flags);
Flags => Flags,
Target_Name => Target_Name);
Set_First_With_Clause_Of (Project, In_Tree, Imported_Projects);
end;
......
......@@ -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- --
......@@ -38,7 +38,8 @@ package Prj.Part is
Store_Comments : Boolean := False;
Current_Directory : String := "";
Is_Config_File : Boolean;
Flags : Processing_Flags);
Flags : Processing_Flags;
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,
......
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