Skip to content

R
riscv-gcc-1
Commit 2f41ec1a by Vincent Celier Committed by Arnaud Charlet
Options

prj-ext.adb (Initialize_Project_Path): New procedure that initialize the default project path... 

2007-04-06  Vincent Celier  <celier@adacore.com>

	* prj-ext.adb (Initialize_Project_Path): New procedure that initialize
	the default project path, initially done during elaboration of the
	package.
	If the prefix returned by Sdefault is null, get the prefix from a call
	to Executable_Prefix_Path.
	(Project_Path): Call Initialize_Project_Path if Current_Project_Path is
	null.

	* prj-nmsc.adb (Get_Path_Names_And_Record_Sources): Use the non
	canonical directory name to open the directory from which files are
	retrieved.
	(Record_Other_Sources): Idem.
	(Locate_Directory): Add the possibility to create automatically missing
	directories when Setup_Projects is True.
	Call Locate_Directory so that the directory will be created when
	Setup_Projects is True, for object dir, library dir, library ALI dir,
	library source copy dir and exec dir.

	* prj-pp.adb (Max_Line_Length): Set to 255 for compatibility with older
	versions of GNAT.

From-SVN: r123589
parent 874a0341
Showing with 112 additions and 86 deletions
gcc/ada/prj-ext.adb
......@@ -25,6 +25,7 @@
------------------------------------------------------------------------------
with Hostparm;
with Makeutl; use Makeutl;
with Namet; use Namet;
with Output; use Output;
with Osint; use Osint;
......@@ -48,8 +49,11 @@ package body Prj.Ext is
No_Project_Default_Dir : constant String := "-";
Current_Project_Path : String_Access;
-- The project path. Initialized during elaboration of package Contains at
-- least the current working directory.
-- The project path. Initialized by procedure Initialize_Project_Path
-- below.
procedure Initialize_Project_Path;
-- Initialize Current_Project_Path
package Htable is new GNAT.HTable.Simple_HTable
(Header_Num => Header_Num,
......@@ -107,81 +111,11 @@ package body Prj.Ext is
return False;
end Check;
------------------
-- Project_Path --
------------------
function Project_Path return String is
begin
return Current_Project_Path.all;
end Project_Path;
-----------
-- Reset --
-----------
procedure Reset is
begin
Htable.Reset;
end Reset;
----------------------
-- Set_Project_Path --
----------------------
procedure Set_Project_Path (New_Path : String) is
begin
Free (Current_Project_Path);
Current_Project_Path := new String'(New_Path);
end Set_Project_Path;
--------------
-- Value_Of --
--------------
function Value_Of
(External_Name : Name_Id;
With_Default : Name_Id := No_Name)
return Name_Id
is
The_Value : Name_Id;
Name : String := Get_Name_String (External_Name);
begin
Canonical_Case_File_Name (Name);
Name_Len := Name'Length;
Name_Buffer (1 .. Name_Len) := Name;
The_Value := Htable.Get (Name_Find);
-----------------------------
-- Initialize_Project_Path --
-----------------------------
if The_Value /= No_Name then
return The_Value;
end if;
-- Find if it is an environment, if it is, put value in the hash table
declare
Env_Value : String_Access := Getenv (Name);
begin
if Env_Value /= null and then Env_Value'Length > 0 then
Name_Len := Env_Value'Length;
Name_Buffer (1 .. Name_Len) := Env_Value.all;
The_Value := Name_Find;
Htable.Set (External_Name, The_Value);
Free (Env_Value);
return The_Value;
else
Free (Env_Value);
return With_Default;
end if;
end;
end Value_Of;
begin
-- Initialize Current_Project_Path during package elaboration
declare
procedure Initialize_Project_Path is
Add_Default_Dir : Boolean := True;
First : Positive;
Last : Positive;
......@@ -286,13 +220,105 @@ begin
-- Set the initial value of Current_Project_Path
if Add_Default_Dir then
Current_Project_Path :=
new String'(Name_Buffer (1 .. Name_Len) & Path_Separator &
Sdefault.Search_Dir_Prefix.all & ".." &
Directory_Separator & ".." & Directory_Separator &
".." & Directory_Separator & "gnat");
declare
Prefix : String_Ptr := Sdefault.Search_Dir_Prefix;
begin
if Prefix = null then
Prefix := new String'(Executable_Prefix_Path);
if Prefix.all /= "" then
Current_Project_Path :=
new String'(Name_Buffer (1 .. Name_Len) & Path_Separator &
Prefix.all & Directory_Separator & "gnat");
end if;
else
Current_Project_Path :=
new String'(Name_Buffer (1 .. Name_Len) & Path_Separator &
Prefix.all &
".." & Directory_Separator &
".." & Directory_Separator &
".." & Directory_Separator & "gnat");
end if;
end;
else
Current_Project_Path := new String'(Name_Buffer (1 .. Name_Len));
end if;
end;
end Initialize_Project_Path;
------------------
-- Project_Path --
------------------
function Project_Path return String is
begin
if Current_Project_Path = null then
Initialize_Project_Path;
end if;
return Current_Project_Path.all;
end Project_Path;
-----------
-- Reset --
-----------
procedure Reset is
begin
Htable.Reset;
end Reset;
----------------------
-- Set_Project_Path --
----------------------
procedure Set_Project_Path (New_Path : String) is
begin
Free (Current_Project_Path);
Current_Project_Path := new String'(New_Path);
end Set_Project_Path;
--------------
-- Value_Of --
--------------
function Value_Of
(External_Name : Name_Id;
With_Default : Name_Id := No_Name)
return Name_Id
is
The_Value : Name_Id;
Name : String := Get_Name_String (External_Name);
begin
Canonical_Case_File_Name (Name);
Name_Len := Name'Length;
Name_Buffer (1 .. Name_Len) := Name;
The_Value := Htable.Get (Name_Find);
if The_Value /= No_Name then
return The_Value;
end if;
-- Find if it is an environment, if it is, put value in the hash table
declare
Env_Value : String_Access := Getenv (Name);
begin
if Env_Value /= null and then Env_Value'Length > 0 then
Name_Len := Env_Value'Length;
Name_Buffer (1 .. Name_Len) := Env_Value.all;
The_Value := Name_Find;
Htable.Set (External_Name, The_Value);
Free (Env_Value);
return The_Value;
else
Free (Env_Value);
return With_Default;
end if;
end;
end Value_Of;
end Prj.Ext;
gcc/ada/prj-pp.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2001-2005, Free Software Foundation, Inc. --
-- Copyright (C) 2001-2006, 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,7 +26,6 @@
with Ada.Characters.Handling; use Ada.Characters.Handling;
with Hostparm;
with Namet; use Namet;
with Output; use Output;
with Snames;
......@@ -37,8 +36,9 @@ package body Prj.PP is
Not_Tested : array (Project_Node_Kind) of Boolean := (others => True);
Max_Line_Length : constant := Hostparm.Max_Line_Length - 5;
-- Maximum length of a line
Max_Line_Length : constant := 255;
-- Maximum length of a line. This is chosen to be compatible with older
-- versions of GNAT that had a strict limit on the maximum line length.
Column : Natural := 0;
-- Column number of the last character in the line. Used to avoid
......
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