Skip to content

R
riscv-gcc-1
Commit 38c2fd0c by Vincent Celier Committed by Arnaud Charlet
Options

prj.adb (Project_Empty): Gives default value for new component Libgnarl_Needed 

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

	* prj.adb (Project_Empty): Gives default value for new component
	Libgnarl_Needed

	* prj-attr.ads: Minor reformatting

	* prj-env.ads, prj-env.adb (For_All_Object_Dirs): Register object
	directory using the untouched casing.
	(For_All_Source_Dirs): Idem.

	* prj-ext.ads, prj-ext.adb (Search_Directories): New table to record
	directories specified with switches -aP.
	(Add_Search_Project_Directory): New procedure
	(Initialize_Project_Path): Put the directories in table
	Search_Directories in the project search path.
	(Initialize_Project_Path): For VMS, transform into canonical form the
	project path.

From-SVN: r125442
parent f95fd3b2
Showing with 127 additions and 82 deletions
gcc/ada/prj-attr.ads
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 2001-2006, Free Software Foundation, Inc. -- -- Copyright (C) 2001-2007, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -274,12 +274,13 @@ private ...@@ -274,12 +274,13 @@ private
-- Data for an attribute -- Data for an attribute
package Attrs is package Attrs is
new Table.Table (Table_Component_Type => Attribute_Record, new Table.Table
Table_Index_Type => Attr_Node_Id, (Table_Component_Type => Attribute_Record,
Table_Low_Bound => First_Attribute, Table_Index_Type => Attr_Node_Id,
Table_Initial => Attributes_Initial, Table_Low_Bound => First_Attribute,
Table_Increment => Attributes_Increment, Table_Initial => Attributes_Initial,
Table_Name => "Prj.Attr.Attrs"); Table_Increment => Attributes_Increment,
Table_Name => "Prj.Attr.Attrs");
-- The table of the attributes -- The table of the attributes
-------------- --------------
...@@ -294,12 +295,13 @@ private ...@@ -294,12 +295,13 @@ private
-- Data for a package -- Data for a package
package Package_Attributes is package Package_Attributes is
new Table.Table (Table_Component_Type => Package_Record, new Table.Table
Table_Index_Type => Pkg_Node_Id, (Table_Component_Type => Package_Record,
Table_Low_Bound => First_Package, Table_Index_Type => Pkg_Node_Id,
Table_Initial => Packages_Initial, Table_Low_Bound => First_Package,
Table_Increment => Packages_Increment, Table_Initial => Packages_Initial,
Table_Name => "Prj.Attr.Packages"); Table_Increment => Packages_Increment,
Table_Name => "Prj.Attr.Packages");
-- The table of the packages -- The table of the packages
end Prj.Attr; end Prj.Attr;
gcc/ada/prj-env.ads
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 2001-2005, Free Software Foundation, Inc -- -- Copyright (C) 2001-2007, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -39,7 +39,7 @@ package Prj.Env is ...@@ -39,7 +39,7 @@ package Prj.Env is
procedure Create_Mapping_File procedure Create_Mapping_File
(Project : Project_Id; (Project : Project_Id;
In_Tree : Project_Tree_Ref; In_Tree : Project_Tree_Ref;
Name : out Name_Id); Name : out Path_Name_Type);
-- Create a temporary mapping file for project Project. For each unit -- Create a temporary mapping file for project Project. For each unit
-- in the closure of immediate sources of Project, put the mapping of -- in the closure of immediate sources of Project, put the mapping of
-- its spec and or body to its file name and path name in this file. -- its spec and or body to its file name and path name in this file.
...@@ -135,7 +135,7 @@ package Prj.Env is ...@@ -135,7 +135,7 @@ package Prj.Env is
(Source_File_Name : String; (Source_File_Name : String;
In_Tree : Project_Tree_Ref; In_Tree : Project_Tree_Ref;
Project : out Project_Id; Project : out Project_Id;
Path : out Name_Id); Path : out File_Name_Type);
-- Returns the project of a source and its path in displayable form -- Returns the project of a source and its path in displayable form
generic generic
......
gcc/ada/prj-ext.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 2000-2006, Free Software Foundation, Inc. -- -- Copyright (C) 2000-2007, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -26,7 +26,6 @@ ...@@ -26,7 +26,6 @@
with Hostparm; with Hostparm;
with Makeutl; use Makeutl; with Makeutl; use Makeutl;
with Namet; use Namet;
with Output; use Output; with Output; use Output;
with Osint; use Osint; with Osint; use Osint;
with Sdefault; with Sdefault;
...@@ -68,6 +67,15 @@ package body Prj.Ext is ...@@ -68,6 +67,15 @@ package body Prj.Ext is
-- first for external reference in this table, before checking the -- first for external reference in this table, before checking the
-- environment. Htable is emptied (reset) by procedure Reset. -- environment. Htable is emptied (reset) by procedure Reset.
package Search_Directories is new Table.Table
(Table_Component_Type => Name_Id,
Table_Index_Type => Natural,
Table_Low_Bound => 1,
Table_Initial => 4,
Table_Increment => 100,
Table_Name => "Prj.Ext.Search_Directories");
-- The table for the directories specified with -aP switches
--------- ---------
-- Add -- -- Add --
--------- ---------
...@@ -89,6 +97,17 @@ package body Prj.Ext is ...@@ -89,6 +97,17 @@ package body Prj.Ext is
Htable.Set (The_Key, The_Value); Htable.Set (The_Key, The_Value);
end Add; end Add;
----------------------------------
-- Add_Search_Project_Directory --
----------------------------------
procedure Add_Search_Project_Directory (Path : String) is
begin
Name_Len := 0;
Add_Str_To_Name_Buffer (Path);
Search_Directories.Append (Name_Find);
end Add_Search_Project_Directory;
----------- -----------
-- Check -- -- Check --
----------- -----------
...@@ -121,10 +140,15 @@ package body Prj.Ext is ...@@ -121,10 +140,15 @@ package body Prj.Ext is
Last : Positive; Last : Positive;
New_Len : Positive; New_Len : Positive;
New_Last : Positive; New_Last : Positive;
Prj_Path : String_Access := Gpr_Prj_Path; Prj_Path : String_Access := null;
begin begin
if Gpr_Prj_Path.all /= "" then if Gpr_Prj_Path.all /= "" then
if Hostparm.OpenVMS then
Prj_Path := To_Canonical_Path_Spec ("GPR_PROJECT_PATH:");
else
Prj_Path := To_Canonical_Path_Spec (Gpr_Prj_Path.all);
end if;
-- Warn if both environment variables are defined -- Warn if both environment variables are defined
...@@ -133,8 +157,12 @@ package body Prj.Ext is ...@@ -133,8 +157,12 @@ package body Prj.Ext is
Write_Line (" when GPR_PROJECT_PATH is defined"); Write_Line (" when GPR_PROJECT_PATH is defined");
end if; end if;
else elsif Ada_Prj_Path.all /= "" then
Prj_Path := Ada_Prj_Path; if Hostparm.OpenVMS then
Prj_Path := To_Canonical_Path_Spec ("ADA_PROJECT_PATH:");
else
Prj_Path := To_Canonical_Path_Spec (Ada_Prj_Path.all);
end if;
end if; end if;
-- The current directory is always first -- The current directory is always first
...@@ -142,80 +170,89 @@ package body Prj.Ext is ...@@ -142,80 +170,89 @@ package body Prj.Ext is
Name_Len := 1; Name_Len := 1;
Name_Buffer (Name_Len) := '.'; Name_Buffer (Name_Len) := '.';
-- If environment variable is defined and not empty, add its content -- If there are directories in the Search_Directories table, add them
for J in 1 .. Search_Directories.Last loop
Name_Len := Name_Len + 1;
Name_Buffer (Name_Len) := Path_Separator;
Add_Str_To_Name_Buffer
(Get_Name_String (Search_Directories.Table (J)));
end loop;
-- If environment variable is defined, add its content
if Prj_Path.all /= "" then if Prj_Path /= null then
Name_Len := Name_Len + 1; Name_Len := Name_Len + 1;
Name_Buffer (Name_Len) := Path_Separator; Name_Buffer (Name_Len) := Path_Separator;
Add_Str_To_Name_Buffer (Prj_Path.all); Add_Str_To_Name_Buffer (Prj_Path.all);
end if;
-- Scan the directory path to see if "-" is one of the directories. -- Scan the directory path to see if "-" is one of the directories.
-- Remove each occurence of "-" and set Add_Default_Dir to False. -- Remove each occurence of "-" and set Add_Default_Dir to False.
-- Also resolve relative paths and symbolic links. -- Also resolve relative paths and symbolic links.
First := 3; First := 3;
loop
while First <= Name_Len
and then (Name_Buffer (First) = Path_Separator)
loop loop
while First <= Name_Len First := First + 1;
and then (Name_Buffer (First) = Path_Separator) end loop;
loop
First := First + 1; exit when First > Name_Len;
end loop;
Last := First;
while Last < Name_Len
and then Name_Buffer (Last + 1) /= Path_Separator
loop
Last := Last + 1;
end loop;
exit when First > Name_Len; -- If the directory is "-", set Add_Default_Dir to False and
-- remove from path.
Last := First; if Name_Buffer (First .. Last) = No_Project_Default_Dir then
Add_Default_Dir := False;
while Last < Name_Len for J in Last + 1 .. Name_Len loop
and then Name_Buffer (Last + 1) /= Path_Separator Name_Buffer (J - No_Project_Default_Dir'Length - 1) :=
loop Name_Buffer (J);
Last := Last + 1;
end loop; end loop;
-- If the directory is "-", set Add_Default_Dir to False and Name_Len := Name_Len - No_Project_Default_Dir'Length - 1;
-- remove from path.
elsif not Hostparm.OpenVMS
if Name_Buffer (First .. Last) = No_Project_Default_Dir then or else not Is_Absolute_Path (Name_Buffer (First .. Last))
Add_Default_Dir := False; then
-- On VMS, only expand relative path names, as absolute paths
for J in Last + 1 .. Name_Len loop -- may correspond to multi-valued VMS logical names.
Name_Buffer (J - No_Project_Default_Dir'Length - 1) :=
Name_Buffer (J); declare
end loop; New_Dir : constant String :=
Normalize_Pathname (Name_Buffer (First .. Last));
Name_Len := Name_Len - No_Project_Default_Dir'Length - 1;
begin
elsif not Hostparm.OpenVMS -- If the absolute path was resolved and is different from
or else not Is_Absolute_Path (Name_Buffer (First .. Last)) -- the original, replace original with the resolved path.
then
-- On VMS, only expand relative path names, as absolute paths if New_Dir /= Name_Buffer (First .. Last)
-- may correspond to multi-valued VMS logical names. and then New_Dir'Length /= 0
then
declare New_Len := Name_Len + New_Dir'Length - (Last - First + 1);
New_Dir : constant String := New_Last := First + New_Dir'Length - 1;
Normalize_Pathname (Name_Buffer (First .. Last)); Name_Buffer (New_Last + 1 .. New_Len) :=
Name_Buffer (Last + 1 .. Name_Len);
begin Name_Buffer (First .. New_Last) := New_Dir;
-- If the absolute path was resolved and is different from Name_Len := New_Len;
-- the original, replace original with the resolved path. Last := New_Last;
end if;
if New_Dir /= Name_Buffer (First .. Last) end;
and then New_Dir'Length /= 0 end if;
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; First := Last + 1;
end loop; end loop;
end if;
-- Set the initial value of Current_Project_Path -- Set the initial value of Current_Project_Path
......
gcc/ada/prj-ext.ads
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 2000-2005, Free Software Foundation, Inc. -- -- Copyright (C) 2000-2007, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -29,6 +29,12 @@ ...@@ -29,6 +29,12 @@
package Prj.Ext is package Prj.Ext is
procedure Add_Search_Project_Directory (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.
function Project_Path return String; function Project_Path return String;
-- Return the current value of the project path, either the value set -- Return the current value of the project path, either the value set
-- during elaboration of the package or, if procedure Set_Project_Path has -- during elaboration of the package or, if procedure Set_Project_Path has
......
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