FreeChainXenon/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

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

Browse source 
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
This commit is contained in:
Vincent Celier 2007-06-06 12:40:57 +02:00 • committed by Arnaud Charlet
parent f95fd3b225
commit 38c2fd0ca9
6 changed files with 290 additions and 249 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

28
gcc/ada/prj-attr.ads
View file

@ -6,7 +6,7 @@
-- --
-- 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 --
-- terms of the GNU General Public License as published by the Free Soft- --
@ -274,12 +274,13 @@ private
-- Data for an attribute
package Attrs is
new Table.Table (Table_Component_Type => Attribute_Record,
Table_Index_Type => Attr_Node_Id,
Table_Low_Bound => First_Attribute,
Table_Initial => Attributes_Initial,
Table_Increment => Attributes_Increment,
Table_Name => "Prj.Attr.Attrs");
new Table.Table
(Table_Component_Type => Attribute_Record,
Table_Index_Type => Attr_Node_Id,
Table_Low_Bound => First_Attribute,
Table_Initial => Attributes_Initial,
Table_Increment => Attributes_Increment,
Table_Name => "Prj.Attr.Attrs");
-- The table of the attributes
--------------
@ -294,12 +295,13 @@ private
-- Data for a package
package Package_Attributes is
new Table.Table (Table_Component_Type => Package_Record,
Table_Index_Type => Pkg_Node_Id,
Table_Low_Bound => First_Package,
Table_Initial => Packages_Initial,
Table_Increment => Packages_Increment,
Table_Name => "Prj.Attr.Packages");
new Table.Table
(Table_Component_Type => Package_Record,
Table_Index_Type => Pkg_Node_Id,
Table_Low_Bound => First_Package,
Table_Initial => Packages_Initial,
Table_Increment => Packages_Increment,
Table_Name => "Prj.Attr.Packages");
-- The table of the packages
end Prj.Attr;

203
gcc/ada/prj-env.adb
View file

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- 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 --
-- terms of the GNU General Public License as published by the Free Soft- --
@ -24,7 +24,6 @@
-- --
------------------------------------------------------------------------------
with Namet; use Namet;
with Opt;
with Osint; use Osint;
with Output; use Output;
@ -35,17 +34,16 @@ with GNAT.Directory_Operations; use GNAT.Directory_Operations;
package body Prj.Env is
Current_Source_Path_File : Name_Id := No_Name;
-- Current value of project source path file env var.
-- Used to avoid setting the env var to the same value.
Current_Source_Path_File : Path_Name_Type := No_Path;
-- Current value of project source path file env var. Used to avoid setting
-- the env var to the same value.
Current_Object_Path_File : Name_Id := No_Name;
-- Current value of project object path file env var.
-- Used to avoid setting the env var to the same value.
Current_Object_Path_File : Path_Name_Type := No_Path;
-- Current value of project object path file env var. Used to avoid setting
-- the env var to the same value.
Ada_Path_Buffer : String_Access := new String (1 .. 1024);
-- A buffer where values for ADA_INCLUDE_PATH
-- and ADA_OBJECTS_PATH are stored.
-- buffer where values for ADA_INCLUDE_PATH and ADA_OBJECTS_PATH are stored
Ada_Path_Length : Natural := 0;
-- Index of the last valid character in Ada_Path_Buffer
@ -90,31 +88,29 @@ package body Prj.Env is
procedure Add_To_Path (Dir : String);
-- If Dir is not already in the global variable Ada_Path_Buffer, add it.
-- Increment Ada_Path_Length.
-- If Ada_Path_Length /= 0, prepend a Path_Separator character to
-- Path.
-- Increment Ada_Path_Length. If Ada_Path_Length /= 0, prepend a
-- Path_Separator character to Path.
procedure Add_To_Source_Path
(Source_Dirs : String_List_Id; In_Tree : Project_Tree_Ref);
-- Add to Ada_Path_B all the source directories in string list
-- Source_Dirs, if any. Increment Ada_Path_Length.
-- Add to Ada_Path_B all the source directories in string list Source_Dirs,
-- if any. Increment Ada_Path_Length.
procedure Add_To_Object_Path
(Object_Dir : Name_Id;
(Object_Dir : Path_Name_Type;
In_Tree : Project_Tree_Ref);
-- Add Object_Dir to object path table. Make sure it is not duplicate
-- and it is the last one in the current table.
function Contains_ALI_Files (Dir : Name_Id) return Boolean;
function Contains_ALI_Files (Dir : Path_Name_Type) return Boolean;
-- Return True if there is at least one ALI file in the directory Dir
procedure Create_New_Path_File
(In_Tree : Project_Tree_Ref;
Path_FD : out File_Descriptor;
Path_Name : out Name_Id);
-- Create a new temporary path file. Get the file name in Path_Name.
-- The name is normally obtained by increasing the number in
-- Temp_Path_File_Name by 1.
Path_Name : out Path_Name_Type);
-- Create a new temporary path file. Get the file name in Path_Name. The
-- name is normally obtained by increasing Temp_Path_File_Name by 1.
procedure Set_Path_File_Var (Name : String; Value : String);
-- Call Setenv, after calling To_Host_File_Spec
@ -260,7 +256,7 @@ package body Prj.Env is
if (Data.Library and then Including_Libraries)
or else
(Data.Object_Directory /= No_Name
(Data.Object_Directory /= No_Path
and then
(not Including_Libraries or else not Data.Library))
then
@ -269,7 +265,7 @@ package body Prj.Env is
-- files; otherwise add the object directory.
if Data.Library then
if Data.Object_Directory = No_Name
if Data.Object_Directory = No_Path
or else
Contains_ALI_Files (Data.Library_ALI_Dir)
then
@ -333,7 +329,8 @@ package body Prj.Env is
------------------------
procedure Add_To_Object_Path
(Object_Dir : Name_Id; In_Tree : Project_Tree_Ref)
(Object_Dir : Path_Name_Type;
In_Tree : Project_Tree_Ref)
is
begin
-- Check if the directory is already in the table
@ -494,7 +491,7 @@ package body Prj.Env is
-- If it is already, no need to add it
if In_Tree.Private_Part.Source_Paths.Table (Index) =
Source_Dir.Value
File_Name_Type (Source_Dir.Value)
then
Add_It := False;
exit;
@ -506,7 +503,7 @@ package body Prj.Env is
(In_Tree.Private_Part.Source_Paths);
In_Tree.Private_Part.Source_Paths.Table
(Source_Path_Table.Last (In_Tree.Private_Part.Source_Paths)) :=
Source_Dir.Value;
File_Name_Type (Source_Dir.Value);
end if;
-- Next source directory
@ -528,7 +525,7 @@ package body Prj.Env is
-- If we don't know the path name of the body of this unit,
-- we compute it, and we store it.
if Data.File_Names (Body_Part).Path = No_Name then
if Data.File_Names (Body_Part).Path = No_File then
declare
Current_Source : String_List_Id :=
In_Tree.Projects.Table
@ -581,10 +578,10 @@ package body Prj.Env is
-- Contains_ALI_Files --
------------------------
function Contains_ALI_Files (Dir : Name_Id) return Boolean is
function Contains_ALI_Files (Dir : Path_Name_Type) return Boolean is
Dir_Name : constant String := Get_Name_String (Dir);
Direct : Dir_Type;
Name : String (1 .. 1_000);
Name : String (1 .. 1_000); -- what is this magic constant 1000 ???
Last : Natural;
Result : Boolean := False;
@ -629,7 +626,7 @@ package body Prj.Env is
pragma Unreferenced (Main_Project);
pragma Unreferenced (Include_Config_Files);
File_Name : Name_Id := No_Name;
File_Name : Path_Name_Type := No_Path;
File : File_Descriptor := Invalid_FD;
Current_Unit : Unit_Id := Unit_Table.First;
@ -654,7 +651,7 @@ package body Prj.Env is
procedure Put
(Unit_Name : Name_Id;
File_Name : Name_Id;
File_Name : File_Name_Type;
Unit_Kind : Spec_Or_Body;
Index : Int);
-- Put an SFN pragma in the temporary file
@ -827,7 +824,7 @@ package body Prj.Env is
procedure Put
(Unit_Name : Name_Id;
File_Name : Name_Id;
File_Name : File_Name_Type;
Unit_Kind : Spec_Or_Body;
Index : Int)
is
@ -993,7 +990,7 @@ package body Prj.Env is
procedure Create_Mapping_File
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
Name : out Name_Id)
Name : out Path_Name_Type)
is
File : File_Descriptor := Invalid_FD;
The_Unit_Data : Unit_Data;
@ -1141,7 +1138,7 @@ package body Prj.Env is
-- If there is a spec, put it mapping in the file if it is
-- from a project in the closure of Project.
if Data.Name /= No_Name and then Present (Data.Project) then
if Data.Name /= No_File and then Present (Data.Project) then
Put_Data (Spec => True);
end if;
@ -1150,7 +1147,7 @@ package body Prj.Env is
-- If there is a body (or subunit) put its mapping in the file
-- if it is from a project in the closure of Project.
if Data.Name /= No_Name and then Present (Data.Project) then
if Data.Name /= No_File and then Present (Data.Project) then
Put_Data (Spec => False);
end if;
@ -1172,12 +1169,12 @@ package body Prj.Env is
procedure Create_New_Path_File
(In_Tree : Project_Tree_Ref;
Path_FD : out File_Descriptor;
Path_Name : out Name_Id)
Path_Name : out Path_Name_Type)
is
begin
Tempdir.Create_Temp_File (Path_FD, Path_Name);
if Path_Name /= No_Name then
if Path_Name /= No_Path then
-- Record the name, so that the temp path file will be deleted
-- at the end of the program.
@ -1200,7 +1197,7 @@ package body Prj.Env is
for Index in Path_File_Table.First ..
Path_File_Table.Last (In_Tree.Private_Part.Path_Files)
loop
if In_Tree.Private_Part.Path_Files.Table (Index) /= No_Name then
if In_Tree.Private_Part.Path_Files.Table (Index) /= No_Path then
Delete_File
(Get_Name_String
(In_Tree.Private_Part.Path_Files.Table (Index)),
@ -1249,9 +1246,9 @@ package body Prj.Env is
Unit : Unit_Data;
The_Original_Name : Name_Id;
The_Spec_Name : Name_Id;
The_Body_Name : Name_Id;
The_Original_Name : File_Name_Type;
The_Spec_Name : File_Name_Type;
The_Body_Name : File_Name_Type;
begin
Canonical_Case_File_Name (Original_Name);
@ -1303,13 +1300,13 @@ package body Prj.Env is
or else Unit.File_Names (Body_Part).Project = The_Project
then
declare
Current_Name : constant Name_Id :=
Current_Name : constant File_Name_Type :=
Unit.File_Names (Body_Part).Name;
begin
-- Case of a body present
if Current_Name /= No_Name then
if Current_Name /= No_File then
if Current_Verbosity = High then
Write_Str (" Comparing with """);
Write_Str (Get_Name_String (Current_Name));
@ -1317,10 +1314,11 @@ package body Prj.Env is
Write_Eol;
end if;
-- If it has the name of the original name,
-- return the original name
-- If it has the name of the original name, return the
-- original name.
if Unit.Name = The_Original_Name
if Name_Id (Unit.Name) = Name_Id (The_Original_Name)
-- Type confusion in above comparison ???
or else Current_Name = The_Original_Name
then
if Current_Verbosity = High then
@ -1366,13 +1364,13 @@ package body Prj.Env is
or else Unit.File_Names (Specification).Project = The_Project
then
declare
Current_Name : constant Name_Id :=
Current_Name : constant File_Name_Type :=
Unit.File_Names (Specification).Name;
begin
-- Case of spec present
if Current_Name /= No_Name then
if Current_Name /= No_File then
if Current_Verbosity = High then
Write_Str (" Comparing with """);
Write_Str (Get_Name_String (Current_Name));
@ -1382,7 +1380,8 @@ package body Prj.Env is
-- If name same as original name, return original name
if Unit.Name = The_Original_Name
if Name_Id (Unit.Name) = Name_Id (The_Original_Name)
-- Type confusion in the above comparison ???
or else Current_Name = The_Original_Name
then
if Current_Verbosity = High then
@ -1498,8 +1497,7 @@ package body Prj.Env is
-- This project has never been visited, add it
-- to the list.
Project_List_Table.Increment_Last
(In_Tree.Project_Lists);
Project_List_Table.Increment_Last (In_Tree.Project_Lists);
In_Tree.Project_Lists.Table (Current).Next :=
Project_List_Table.Last (In_Tree.Project_Lists);
In_Tree.Project_Lists.Table
@ -1512,8 +1510,8 @@ package body Prj.Env is
-- If there is an object directory, call Action
-- with its name
if Data.Object_Directory /= No_Name then
Get_Name_String (Data.Object_Directory);
if Data.Object_Directory /= No_Path then
Get_Name_String (Data.Display_Object_Dir);
Action (Name_Buffer (1 .. Name_Len));
end if;
@ -1560,8 +1558,7 @@ package body Prj.Env is
---------
procedure Add (Project : Project_Id) is
Data : constant Project_Data :=
In_Tree.Projects.Table (Project);
Data : constant Project_Data := In_Tree.Projects.Table (Project);
List : Project_List := Data.Imported_Projects;
begin
@ -1569,10 +1566,8 @@ package body Prj.Env is
-- for sure we never visited this project.
if Seen = Empty_Project_List then
Project_List_Table.Increment_Last
(In_Tree.Project_Lists);
Seen := Project_List_Table.Last
(In_Tree.Project_Lists);
Project_List_Table.Increment_Last (In_Tree.Project_Lists);
Seen := Project_List_Table.Last (In_Tree.Project_Lists);
In_Tree.Project_Lists.Table (Seen) :=
(Project => Project, Next => Empty_Project_List);
@ -1595,20 +1590,18 @@ package body Prj.Env is
exit when
In_Tree.Project_Lists.Table (Current).Next =
Empty_Project_List;
Current :=
In_Tree.Project_Lists.Table (Current).Next;
Current := In_Tree.Project_Lists.Table (Current).Next;
end loop;
-- This project has never been visited, add it
-- to the list.
Project_List_Table.Increment_Last
(In_Tree.Project_Lists);
Project_List_Table.Increment_Last (In_Tree.Project_Lists);
In_Tree.Project_Lists.Table (Current).Next :=
Project_List_Table.Last (In_Tree.Project_Lists);
In_Tree.Project_Lists.Table
(Project_List_Table.Last
(In_Tree.Project_Lists)) :=
(Project_List_Table.Last (In_Tree.Project_Lists)) :=
(Project => Project, Next => Empty_Project_List);
end;
end if;
@ -1621,13 +1614,10 @@ package body Prj.Env is
-- If there are Ada sources, call action with the name of every
-- source directory.
if
In_Tree.Projects.Table (Project).Ada_Sources_Present
then
if In_Tree.Projects.Table (Project).Ada_Sources_Present then
while Current /= Nil_String loop
The_String :=
In_Tree.String_Elements.Table (Current);
Action (Get_Name_String (The_String.Value));
The_String := In_Tree.String_Elements.Table (Current);
Action (Get_Name_String (The_String.Display_Value));
Current := The_String.Next;
end loop;
end if;
@ -1663,7 +1653,7 @@ package body Prj.Env is
(Source_File_Name : String;
In_Tree : Project_Tree_Ref;
Project : out Project_Id;
Path : out Name_Id)
Path : out File_Name_Type)
is
begin
-- Body below could use some comments ???
@ -1686,14 +1676,14 @@ package body Prj.Env is
loop
Unit := In_Tree.Units.Table (Id);
if (Unit.File_Names (Specification).Name /= No_Name
if (Unit.File_Names (Specification).Name /= No_File
and then
Namet.Get_Name_String
(Unit.File_Names (Specification).Name) = Original_Name)
or else (Unit.File_Names (Specification).Path /= No_Name
or else (Unit.File_Names (Specification).Path /= No_File
and then
Namet.Get_Name_String
(Unit.File_Names (Specification).Path) =
(Unit.File_Names (Specification).Path) =
Original_Name)
then
Project := Ultimate_Extension_Of
@ -1708,11 +1698,11 @@ package body Prj.Env is
return;
elsif (Unit.File_Names (Body_Part).Name /= No_Name
elsif (Unit.File_Names (Body_Part).Name /= No_File
and then
Namet.Get_Name_String
(Unit.File_Names (Body_Part).Name) = Original_Name)
or else (Unit.File_Names (Body_Part).Path /= No_Name
or else (Unit.File_Names (Body_Part).Path /= No_File
and then Namet.Get_Name_String
(Unit.File_Names (Body_Part).Path) =
Original_Name)
@ -1733,7 +1723,7 @@ package body Prj.Env is
end;
Project := No_Project;
Path := No_Name;
Path := No_File;
if Current_Verbosity > Default then
Write_Str ("Cannot be found.");
@ -1772,7 +1762,7 @@ package body Prj.Env is
Name & Namet.Get_Name_String
(Data.Naming.Ada_Body_Suffix);
First : Unit_Id := Unit_Table.First;
First : Unit_Id;
Current : Unit_Id;
Unit : Unit_Data;
@ -1796,6 +1786,7 @@ package body Prj.Env is
Write_Eol;
end if;
First := Unit_Table.First;
while First <= Unit_Table.Last (In_Tree.Units)
and then In_Tree.Units.Table
(First).File_Names (Body_Part).Project /= Project
@ -1808,7 +1799,7 @@ package body Prj.Env is
Unit := In_Tree.Units.Table (Current);
if Unit.File_Names (Body_Part).Project = Project
and then Unit.File_Names (Body_Part).Name /= No_Name
and then Unit.File_Names (Body_Part).Name /= No_File
then
declare
Current_Name : constant String :=
@ -1842,7 +1833,7 @@ package body Prj.Env is
end if;
end;
elsif Unit.File_Names (Specification).Name /= No_Name then
elsif Unit.File_Names (Specification).Name /= No_File then
declare
Current_Name : constant String :=
Namet.Get_Name_String
@ -1902,7 +1893,7 @@ package body Prj.Env is
Write_Str (" ");
Write_Line (Namet.Get_Name_String (Unit.Name));
if Unit.File_Names (Specification).Name /= No_Name then
if Unit.File_Names (Specification).Name /= No_File then
if Unit.File_Names (Specification).Project = No_Project then
Write_Line (" No project");
@ -1920,7 +1911,7 @@ package body Prj.Env is
(Unit.File_Names (Specification).Name));
end if;
if Unit.File_Names (Body_Part).Name /= No_Name then
if Unit.File_Names (Body_Part).Name /= No_File then
if Unit.File_Names (Body_Part).Project = No_Project then
Write_Line (" No project");
@ -1956,7 +1947,7 @@ package body Prj.Env is
Original_Name : String := Name;
Data : constant Project_Data :=
In_Tree.Projects.Table (Main_Project);
In_Tree.Projects.Table (Main_Project);
Extended_Spec_Name : String :=
Name & Namet.Get_Name_String
@ -1967,11 +1958,12 @@ package body Prj.Env is
Unit : Unit_Data;
Current_Name : Name_Id;
Current_Name : File_Name_Type;
The_Original_Name : File_Name_Type;
The_Spec_Name : File_Name_Type;
The_Body_Name : File_Name_Type;
The_Original_Name : Name_Id;
The_Spec_Name : Name_Id;
The_Body_Name : Name_Id;
-- Confusion here between unit names/file names, See ??? comments below
begin
Canonical_Case_File_Name (Original_Name);
@ -2000,12 +1992,12 @@ package body Prj.Env is
-- Case of a body present
if Current_Name /= No_Name then
if Current_Name /= No_File then
-- If it has the name of the original name or the body name,
-- we have found the project.
if Unit.Name = The_Original_Name
if Name_Id (Unit.Name) = Name_Id (The_Original_Name) -- ???
or else Current_Name = The_Original_Name
or else Current_Name = The_Body_Name
then
@ -2018,12 +2010,12 @@ package body Prj.Env is
Current_Name := Unit.File_Names (Specification).Name;
if Current_Name /= No_Name then
if Current_Name /= No_File then
-- If name same as the original name, or the spec name, we have
-- found the project.
if Unit.Name = The_Original_Name
if Name_Id (Unit.Name) = Name_Id (The_Original_Name) -- ???
or else Current_Name = The_Original_Name
or else Current_Name = The_Spec_Name
then
@ -2118,17 +2110,17 @@ package body Prj.Env is
if (Data.Library and then Including_Libraries)
or else
(Data.Object_Directory /= No_Name
(Data.Object_Directory /= No_Path
and then
(not Including_Libraries or else not Data.Library))
then
-- For a library project, add the library ALI
-- directory if there is no object directory or
-- if the library ALI directory contains ALI files;
-- otherwise add the object directory.
-- For a library project, add library ALI directory if
-- there is no object directory or if the library ALI
-- directory contains ALI files, otherwise add the
-- object directory.
if Data.Library then
if Data.Object_Directory = No_Name
if Data.Object_Directory = No_Path
or else Contains_ALI_Files (Data.Library_ALI_Dir)
then
Add_To_Object_Path
@ -2151,10 +2143,9 @@ package body Prj.Env is
or else
(Data.Extends /= No_Project
and then
Data.Object_Directory /= No_Name))
Data.Object_Directory /= No_Path))
then
Add_To_Object_Path
(Data.Object_Directory, In_Tree);
Add_To_Object_Path (Data.Object_Directory, In_Tree);
end if;
end if;
end if;
@ -2197,9 +2188,7 @@ package body Prj.Env is
-- If it is the first time we call this procedure for
-- this project, compute the source path and/or the object path.
if In_Tree.Projects.Table (Project).Include_Path_File =
No_Name
then
if In_Tree.Projects.Table (Project).Include_Path_File = No_Path then
Process_Source_Dirs := True;
Create_New_Path_File
(In_Tree, Source_FD,
@ -2211,7 +2200,7 @@ package body Prj.Env is
if Including_Libraries then
if In_Tree.Projects.Table
(Project).Objects_Path_File_With_Libs = No_Name
(Project).Objects_Path_File_With_Libs = No_Path
then
Process_Object_Dirs := True;
Create_New_Path_File
@ -2221,7 +2210,7 @@ package body Prj.Env is
else
if In_Tree.Projects.Table
(Project).Objects_Path_File_Without_Libs = No_Name
(Project).Objects_Path_File_Without_Libs = No_Path
then
Process_Object_Dirs := True;
Create_New_Path_File
@ -2363,7 +2352,7 @@ package body Prj.Env is
Data : Unit_Data := In_Tree.Units.Table (Unit);
begin
if Data.File_Names (Specification).Path = No_Name then
if Data.File_Names (Specification).Path = No_File then
declare
Current_Source : String_List_Id :=
In_Tree.Projects.Table

6
gcc/ada/prj-env.ads
View file

@ -6,7 +6,7 @@
-- --
-- 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 --
-- terms of the GNU General Public License as published by the Free Soft- --
@ -39,7 +39,7 @@ package Prj.Env is
procedure Create_Mapping_File
(Project : Project_Id;
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
-- 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.
@ -135,7 +135,7 @@ package Prj.Env is
(Source_File_Name : String;
In_Tree : Project_Tree_Ref;
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
generic

183
gcc/ada/prj-ext.adb
View file

@ -6,7 +6,7 @@
-- --
-- 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 --
-- terms of the GNU General Public License as published by the Free Soft- --
@ -26,7 +26,6 @@
with Hostparm;
with Makeutl; use Makeutl;
with Namet; use Namet;
with Output; use Output;
with Osint; use Osint;
with Sdefault;
@ -68,6 +67,15 @@ package body Prj.Ext is
-- first for external reference in this table, before checking the
-- 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 --
---------
@ -89,6 +97,17 @@ package body Prj.Ext is
Htable.Set (The_Key, The_Value);
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 --
-----------
@ -121,10 +140,15 @@ package body Prj.Ext is
Last : Positive;
New_Len : Positive;
New_Last : Positive;
Prj_Path : String_Access := Gpr_Prj_Path;
Prj_Path : String_Access := null;
begin
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
@ -133,8 +157,12 @@ package body Prj.Ext is
Write_Line (" when GPR_PROJECT_PATH is defined");
end if;
else
Prj_Path := Ada_Prj_Path;
elsif Ada_Prj_Path.all /= "" then
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;
-- The current directory is always first
@ -142,81 +170,90 @@ package body Prj.Ext is
Name_Len := 1;
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
if Prj_Path.all /= "" then
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 /= null then
Name_Len := Name_Len + 1;
Name_Buffer (Name_Len) := Path_Separator;
Add_Str_To_Name_Buffer (Prj_Path.all);
-- Scan the directory path to see if "-" is one of the directories.
-- Remove each occurence 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;
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));
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;
end if;
-- Scan the directory path to see if "-" is one of the directories.
-- Remove each occurence 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;
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));
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;
-- Set the initial value of Current_Project_Path
if Add_Default_Dir then

8
gcc/ada/prj-ext.ads
View file

@ -6,7 +6,7 @@
-- --
-- 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 --
-- terms of the GNU General Public License as published by the Free Soft- --
@ -29,6 +29,12 @@
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;
-- Return the current value of the project path, either the value set
-- during elaboration of the package or, if procedure Set_Project_Path has

111
gcc/ada/prj.adb
View file

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- 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 --
-- 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 Namet; use Namet;
with Output; use Output;
with Osint; use Osint;
with Prj.Attr;
@ -46,9 +45,9 @@ package body Prj is
Name_C_Plus_Plus : Name_Id;
Default_Ada_Spec_Suffix_Id : Name_Id;
Default_Ada_Body_Suffix_Id : Name_Id;
Slash_Id : Name_Id;
Default_Ada_Spec_Suffix_Id : File_Name_Type;
Default_Ada_Body_Suffix_Id : File_Name_Type;
Slash_Id : File_Name_Type;
-- Initialized in Prj.Initialized, then never modified
subtype Known_Casing is Casing_Type range All_Upper_Case .. Mixed_Case;
@ -60,22 +59,23 @@ package body Prj is
Initialized : Boolean := False;
Standard_Dot_Replacement : constant Name_Id :=
First_Name_Id + Character'Pos ('-');
Standard_Dot_Replacement : constant File_Name_Type :=
File_Name_Type
(First_Name_Id + Character'Pos ('-'));
Std_Naming_Data : Naming_Data :=
(Dot_Replacement => Standard_Dot_Replacement,
Dot_Repl_Loc => No_Location,
Casing => All_Lower_Case,
Spec_Suffix => No_Array_Element,
Ada_Spec_Suffix => No_Name,
Ada_Spec_Suffix => No_File,
Spec_Suffix_Loc => No_Location,
Impl_Suffixes => No_Impl_Suffixes,
Supp_Suffixes => No_Supp_Language_Index,
Body_Suffix => No_Array_Element,
Ada_Body_Suffix => No_Name,
Ada_Body_Suffix => No_File,
Body_Suffix_Loc => No_Location,
Separate_Suffix => No_Name,
Separate_Suffix => No_File,
Sep_Suffix_Loc => No_Location,
Specs => No_Array_Element,
Bodies => No_Array_Element,
@ -89,27 +89,28 @@ package body Prj is
First_Referred_By => No_Project,
Name => No_Name,
Display_Name => No_Name,
Path_Name => No_Name,
Display_Path_Name => No_Name,
Path_Name => No_Path,
Display_Path_Name => No_Path,
Virtual => False,
Location => No_Location,
Mains => Nil_String,
Directory => No_Name,
Display_Directory => No_Name,
Directory => No_Path,
Display_Directory => No_Path,
Dir_Path => null,
Library => False,
Library_Dir => No_Name,
Display_Library_Dir => No_Name,
Library_Src_Dir => No_Name,
Display_Library_Src_Dir => No_Name,
Library_ALI_Dir => No_Name,
Display_Library_ALI_Dir => No_Name,
Library_Name => No_Name,
Library_Dir => No_Path,
Display_Library_Dir => No_Path,
Library_Src_Dir => No_Path,
Display_Library_Src_Dir => No_Path,
Library_ALI_Dir => No_Path,
Display_Library_ALI_Dir => No_Path,
Library_Name => No_File,
Library_Kind => Static,
Lib_Internal_Name => No_Name,
Lib_Internal_Name => No_File,
Standalone_Library => False,
Lib_Interface_ALIs => Nil_String,
Lib_Auto_Init => False,
Libgnarl_Needed => Unknown,
Symbol_Data => No_Symbols,
Ada_Sources_Present => True,
Other_Sources_Present => True,
@ -121,27 +122,27 @@ package body Prj is
Include_Data_Set => False,
Source_Dirs => Nil_String,
Known_Order_Of_Source_Dirs => True,
Object_Directory => No_Name,
Display_Object_Dir => No_Name,
Object_Directory => No_Path,
Display_Object_Dir => No_Path,
Library_TS => Empty_Time_Stamp,
Exec_Directory => No_Name,
Display_Exec_Dir => No_Name,
Exec_Directory => No_Path,
Display_Exec_Dir => No_Path,
Extends => No_Project,
Extended_By => No_Project,
Naming => Std_Naming_Data,
First_Language_Processing => Default_First_Language_Processing_Data,
Supp_Language_Processing => No_Supp_Language_Index,
Default_Linker => No_Name,
Default_Linker_Path => No_Name,
Default_Linker => No_File,
Default_Linker_Path => No_Path,
Decl => No_Declarations,
Imported_Projects => Empty_Project_List,
All_Imported_Projects => Empty_Project_List,
Ada_Include_Path => null,
Ada_Objects_Path => null,
Include_Path_File => No_Name,
Objects_Path_File_With_Libs => No_Name,
Objects_Path_File_Without_Libs => No_Name,
Config_File_Name => No_Name,
Include_Path_File => No_Path,
Objects_Path_File_With_Libs => No_Path,
Objects_Path_File_Without_Libs => No_Path,
Config_File_Name => No_Path,
Config_File_Temp => False,
Config_Checked => False,
Language_Independent_Checked => False,
@ -182,8 +183,7 @@ package body Prj is
while Last + S'Length > To'Last loop
declare
New_Buffer : constant String_Access :=
new String (1 .. 2 * Last);
New_Buffer : constant String_Access := new String (1 .. 2 * Last);
begin
New_Buffer (1 .. Last) := To (1 .. Last);
@ -200,7 +200,7 @@ package body Prj is
-- Default_Ada_Body_Suffix --
-----------------------------
function Default_Ada_Body_Suffix return Name_Id is
function Default_Ada_Body_Suffix return File_Name_Type is
begin
return Default_Ada_Body_Suffix_Id;
end Default_Ada_Body_Suffix;
@ -209,7 +209,7 @@ package body Prj is
-- Default_Ada_Spec_Suffix --
-----------------------------
function Default_Ada_Spec_Suffix return Name_Id is
function Default_Ada_Spec_Suffix return File_Name_Type is
begin
return Default_Ada_Spec_Suffix_Id;
end Default_Ada_Spec_Suffix;
@ -314,6 +314,11 @@ package body Prj is
return Hash (Get_Name_String (Name));
end Hash;
function Hash (Name : File_Name_Type) return Header_Num is
begin
return Hash (Get_Name_String (Name));
end Hash;
-----------
-- Image --
-----------
@ -454,13 +459,13 @@ package body Prj is
procedure Register_Default_Naming_Scheme
(Language : Name_Id;
Default_Spec_Suffix : Name_Id;
Default_Body_Suffix : Name_Id;
Default_Spec_Suffix : File_Name_Type;
Default_Body_Suffix : File_Name_Type;
In_Tree : Project_Tree_Ref)
is
Lang : Name_Id;
Suffix : Array_Element_Id;
Found : Boolean := False;
Lang : Name_Id;
Suffix : Array_Element_Id;
Found : Boolean := False;
Element : Array_Element;
begin
@ -481,7 +486,7 @@ package body Prj is
if Element.Index = Lang then
Found := True;
Element.Value.Value := Default_Spec_Suffix;
Element.Value.Value := Name_Id (Default_Spec_Suffix);
In_Tree.Array_Elements.Table (Suffix) := Element;
else
@ -500,13 +505,15 @@ package body Prj is
Kind => Single,
Location => No_Location,
Default => False,
Value => Default_Spec_Suffix,
Value => Name_Id (Default_Spec_Suffix),
Index => 0),
Next => In_Tree.Private_Part.Default_Naming.Spec_Suffix);
Array_Element_Table.Increment_Last (In_Tree.Array_Elements);
In_Tree.Array_Elements.Table
(Array_Element_Table.Last (In_Tree.Array_Elements)) :=
Element;
(Array_Element_Table.Last (In_Tree.Array_Elements)) := Element;
In_Tree.Private_Part.Default_Naming.Spec_Suffix :=
Array_Element_Table.Last (In_Tree.Array_Elements);
end if;
@ -522,7 +529,7 @@ package body Prj is
if Element.Index = Lang then
Found := True;
Element.Value.Value := Default_Body_Suffix;
Element.Value.Value := Name_Id (Default_Body_Suffix);
In_Tree.Array_Elements.Table (Suffix) := Element;
else
@ -541,7 +548,7 @@ package body Prj is
Kind => Single,
Location => No_Location,
Default => False,
Value => Default_Body_Suffix,
Value => Name_Id (Default_Body_Suffix),
Index => 0),
Next => In_Tree.Private_Part.Default_Naming.Body_Suffix);
Array_Element_Table.Increment_Last
@ -703,7 +710,7 @@ package body Prj is
end Set;
procedure Set
(Suffix : Name_Id;
(Suffix : File_Name_Type;
For_Language : Language_Index;
In_Project : in out Project_Data;
In_Tree : Project_Tree_Ref)
@ -752,7 +759,7 @@ package body Prj is
-- Slash --
-----------
function Slash return Name_Id is
function Slash return File_Name_Type is
begin
return Slash_Id;
end Slash;
@ -781,12 +788,12 @@ package body Prj is
function Suffix_Of
(Language : Language_Index;
In_Project : Project_Data;
In_Tree : Project_Tree_Ref) return Name_Id
In_Tree : Project_Tree_Ref) return File_Name_Type
is
begin
case Language is
when No_Language_Index =>
return No_Name;
return No_File;
when First_Language_Indexes =>
return In_Project.Naming.Impl_Suffixes (Language);
@ -808,7 +815,7 @@ package body Prj is
Supp_Index := Supp.Next;
end loop;
return No_Name;
return No_File;
end;
end case;
end Suffix_Of;