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 282 additions and 241 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.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- --
...@@ -24,7 +24,6 @@ ...@@ -24,7 +24,6 @@
-- -- -- --
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
with Namet; use Namet;
with Opt; with Opt;
with Osint; use Osint; with Osint; use Osint;
with Output; use Output; with Output; use Output;
...@@ -35,17 +34,16 @@ with GNAT.Directory_Operations; use GNAT.Directory_Operations; ...@@ -35,17 +34,16 @@ with GNAT.Directory_Operations; use GNAT.Directory_Operations;
package body Prj.Env is package body Prj.Env is
Current_Source_Path_File : Name_Id := No_Name; Current_Source_Path_File : Path_Name_Type := No_Path;
-- Current value of project source path file env var. -- Current value of project source path file env var. Used to avoid setting
-- Used to avoid setting the env var to the same value. -- the env var to the same value.
Current_Object_Path_File : Name_Id := No_Name; Current_Object_Path_File : Path_Name_Type := No_Path;
-- Current value of project object path file env var. -- Current value of project object path file env var. Used to avoid setting
-- Used to avoid setting the env var to the same value. -- the env var to the same value.
Ada_Path_Buffer : String_Access := new String (1 .. 1024); Ada_Path_Buffer : String_Access := new String (1 .. 1024);
-- A buffer where values for ADA_INCLUDE_PATH -- buffer where values for ADA_INCLUDE_PATH and ADA_OBJECTS_PATH are stored
-- and ADA_OBJECTS_PATH are stored.
Ada_Path_Length : Natural := 0; Ada_Path_Length : Natural := 0;
-- Index of the last valid character in Ada_Path_Buffer -- Index of the last valid character in Ada_Path_Buffer
...@@ -90,31 +88,29 @@ package body Prj.Env is ...@@ -90,31 +88,29 @@ package body Prj.Env is
procedure Add_To_Path (Dir : String); procedure Add_To_Path (Dir : String);
-- If Dir is not already in the global variable Ada_Path_Buffer, add it. -- If Dir is not already in the global variable Ada_Path_Buffer, add it.
-- Increment Ada_Path_Length. -- Increment Ada_Path_Length. If Ada_Path_Length /= 0, prepend a
-- If Ada_Path_Length /= 0, prepend a Path_Separator character to -- Path_Separator character to Path.
-- Path.
procedure Add_To_Source_Path procedure Add_To_Source_Path
(Source_Dirs : String_List_Id; In_Tree : Project_Tree_Ref); (Source_Dirs : String_List_Id; In_Tree : Project_Tree_Ref);
-- Add to Ada_Path_B all the source directories in string list -- Add to Ada_Path_B all the source directories in string list Source_Dirs,
-- Source_Dirs, if any. Increment Ada_Path_Length. -- if any. Increment Ada_Path_Length.
procedure Add_To_Object_Path procedure Add_To_Object_Path
(Object_Dir : Name_Id; (Object_Dir : Path_Name_Type;
In_Tree : Project_Tree_Ref); In_Tree : Project_Tree_Ref);
-- Add Object_Dir to object path table. Make sure it is not duplicate -- Add Object_Dir to object path table. Make sure it is not duplicate
-- and it is the last one in the current table. -- 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 -- Return True if there is at least one ALI file in the directory Dir
procedure Create_New_Path_File procedure Create_New_Path_File
(In_Tree : Project_Tree_Ref; (In_Tree : Project_Tree_Ref;
Path_FD : out File_Descriptor; Path_FD : out File_Descriptor;
Path_Name : out Name_Id); Path_Name : out Path_Name_Type);
-- Create a new temporary path file. Get the file name in Path_Name. -- Create a new temporary path file. Get the file name in Path_Name. The
-- The name is normally obtained by increasing the number in -- name is normally obtained by increasing Temp_Path_File_Name by 1.
-- Temp_Path_File_Name by 1.
procedure Set_Path_File_Var (Name : String; Value : String); procedure Set_Path_File_Var (Name : String; Value : String);
-- Call Setenv, after calling To_Host_File_Spec -- Call Setenv, after calling To_Host_File_Spec
...@@ -260,7 +256,7 @@ package body Prj.Env is ...@@ -260,7 +256,7 @@ package body Prj.Env is
if (Data.Library and then Including_Libraries) if (Data.Library and then Including_Libraries)
or else or else
(Data.Object_Directory /= No_Name (Data.Object_Directory /= No_Path
and then and then
(not Including_Libraries or else not Data.Library)) (not Including_Libraries or else not Data.Library))
then then
...@@ -269,7 +265,7 @@ package body Prj.Env is ...@@ -269,7 +265,7 @@ package body Prj.Env is
-- files; otherwise add the object directory. -- files; otherwise add the object directory.
if Data.Library then if Data.Library then
if Data.Object_Directory = No_Name if Data.Object_Directory = No_Path
or else or else
Contains_ALI_Files (Data.Library_ALI_Dir) Contains_ALI_Files (Data.Library_ALI_Dir)
then then
...@@ -333,7 +329,8 @@ package body Prj.Env is ...@@ -333,7 +329,8 @@ package body Prj.Env is
------------------------ ------------------------
procedure Add_To_Object_Path 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 is
begin begin
-- Check if the directory is already in the table -- Check if the directory is already in the table
...@@ -494,7 +491,7 @@ package body Prj.Env is ...@@ -494,7 +491,7 @@ package body Prj.Env is
-- If it is already, no need to add it -- If it is already, no need to add it
if In_Tree.Private_Part.Source_Paths.Table (Index) = if In_Tree.Private_Part.Source_Paths.Table (Index) =
Source_Dir.Value File_Name_Type (Source_Dir.Value)
then then
Add_It := False; Add_It := False;
exit; exit;
...@@ -506,7 +503,7 @@ package body Prj.Env is ...@@ -506,7 +503,7 @@ package body Prj.Env is
(In_Tree.Private_Part.Source_Paths); (In_Tree.Private_Part.Source_Paths);
In_Tree.Private_Part.Source_Paths.Table In_Tree.Private_Part.Source_Paths.Table
(Source_Path_Table.Last (In_Tree.Private_Part.Source_Paths)) := (Source_Path_Table.Last (In_Tree.Private_Part.Source_Paths)) :=
Source_Dir.Value; File_Name_Type (Source_Dir.Value);
end if; end if;
-- Next source directory -- Next source directory
...@@ -528,7 +525,7 @@ package body Prj.Env is ...@@ -528,7 +525,7 @@ package body Prj.Env is
-- If we don't know the path name of the body of this unit, -- If we don't know the path name of the body of this unit,
-- we compute it, and we store it. -- 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 declare
Current_Source : String_List_Id := Current_Source : String_List_Id :=
In_Tree.Projects.Table In_Tree.Projects.Table
...@@ -581,10 +578,10 @@ package body Prj.Env is ...@@ -581,10 +578,10 @@ package body Prj.Env is
-- Contains_ALI_Files -- -- 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); Dir_Name : constant String := Get_Name_String (Dir);
Direct : Dir_Type; Direct : Dir_Type;
Name : String (1 .. 1_000); Name : String (1 .. 1_000); -- what is this magic constant 1000 ???
Last : Natural; Last : Natural;
Result : Boolean := False; Result : Boolean := False;
...@@ -629,7 +626,7 @@ package body Prj.Env is ...@@ -629,7 +626,7 @@ package body Prj.Env is
pragma Unreferenced (Main_Project); pragma Unreferenced (Main_Project);
pragma Unreferenced (Include_Config_Files); pragma Unreferenced (Include_Config_Files);
File_Name : Name_Id := No_Name; File_Name : Path_Name_Type := No_Path;
File : File_Descriptor := Invalid_FD; File : File_Descriptor := Invalid_FD;
Current_Unit : Unit_Id := Unit_Table.First; Current_Unit : Unit_Id := Unit_Table.First;
...@@ -654,7 +651,7 @@ package body Prj.Env is ...@@ -654,7 +651,7 @@ package body Prj.Env is
procedure Put procedure Put
(Unit_Name : Name_Id; (Unit_Name : Name_Id;
File_Name : Name_Id; File_Name : File_Name_Type;
Unit_Kind : Spec_Or_Body; Unit_Kind : Spec_Or_Body;
Index : Int); Index : Int);
-- Put an SFN pragma in the temporary file -- Put an SFN pragma in the temporary file
...@@ -827,7 +824,7 @@ package body Prj.Env is ...@@ -827,7 +824,7 @@ package body Prj.Env is
procedure Put procedure Put
(Unit_Name : Name_Id; (Unit_Name : Name_Id;
File_Name : Name_Id; File_Name : File_Name_Type;
Unit_Kind : Spec_Or_Body; Unit_Kind : Spec_Or_Body;
Index : Int) Index : Int)
is is
...@@ -993,7 +990,7 @@ package body Prj.Env is ...@@ -993,7 +990,7 @@ package body 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)
is is
File : File_Descriptor := Invalid_FD; File : File_Descriptor := Invalid_FD;
The_Unit_Data : Unit_Data; The_Unit_Data : Unit_Data;
...@@ -1141,7 +1138,7 @@ package body Prj.Env is ...@@ -1141,7 +1138,7 @@ package body Prj.Env is
-- If there is a spec, put it mapping in the file if it is -- If there is a spec, put it mapping in the file if it is
-- from a project in the closure of Project. -- 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); Put_Data (Spec => True);
end if; end if;
...@@ -1150,7 +1147,7 @@ package body Prj.Env is ...@@ -1150,7 +1147,7 @@ package body Prj.Env is
-- If there is a body (or subunit) put its mapping in the file -- 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 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); Put_Data (Spec => False);
end if; end if;
...@@ -1172,12 +1169,12 @@ package body Prj.Env is ...@@ -1172,12 +1169,12 @@ package body Prj.Env is
procedure Create_New_Path_File procedure Create_New_Path_File
(In_Tree : Project_Tree_Ref; (In_Tree : Project_Tree_Ref;
Path_FD : out File_Descriptor; Path_FD : out File_Descriptor;
Path_Name : out Name_Id) Path_Name : out Path_Name_Type)
is is
begin begin
Tempdir.Create_Temp_File (Path_FD, Path_Name); 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 -- Record the name, so that the temp path file will be deleted
-- at the end of the program. -- at the end of the program.
...@@ -1200,7 +1197,7 @@ package body Prj.Env is ...@@ -1200,7 +1197,7 @@ package body Prj.Env is
for Index in Path_File_Table.First .. for Index in Path_File_Table.First ..
Path_File_Table.Last (In_Tree.Private_Part.Path_Files) Path_File_Table.Last (In_Tree.Private_Part.Path_Files)
loop 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 Delete_File
(Get_Name_String (Get_Name_String
(In_Tree.Private_Part.Path_Files.Table (Index)), (In_Tree.Private_Part.Path_Files.Table (Index)),
...@@ -1249,9 +1246,9 @@ package body Prj.Env is ...@@ -1249,9 +1246,9 @@ package body Prj.Env is
Unit : Unit_Data; Unit : Unit_Data;
The_Original_Name : Name_Id; The_Original_Name : File_Name_Type;
The_Spec_Name : Name_Id; The_Spec_Name : File_Name_Type;
The_Body_Name : Name_Id; The_Body_Name : File_Name_Type;
begin begin
Canonical_Case_File_Name (Original_Name); Canonical_Case_File_Name (Original_Name);
...@@ -1303,13 +1300,13 @@ package body Prj.Env is ...@@ -1303,13 +1300,13 @@ package body Prj.Env is
or else Unit.File_Names (Body_Part).Project = The_Project or else Unit.File_Names (Body_Part).Project = The_Project
then then
declare declare
Current_Name : constant Name_Id := Current_Name : constant File_Name_Type :=
Unit.File_Names (Body_Part).Name; Unit.File_Names (Body_Part).Name;
begin begin
-- Case of a body present -- Case of a body present
if Current_Name /= No_Name then if Current_Name /= No_File then
if Current_Verbosity = High then if Current_Verbosity = High then
Write_Str (" Comparing with """); Write_Str (" Comparing with """);
Write_Str (Get_Name_String (Current_Name)); Write_Str (Get_Name_String (Current_Name));
...@@ -1317,10 +1314,11 @@ package body Prj.Env is ...@@ -1317,10 +1314,11 @@ package body Prj.Env is
Write_Eol; Write_Eol;
end if; end if;
-- If it has the name of the original name, -- If it has the name of the original name, return the
-- return the original name -- 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 or else Current_Name = The_Original_Name
then then
if Current_Verbosity = High then if Current_Verbosity = High then
...@@ -1366,13 +1364,13 @@ package body Prj.Env is ...@@ -1366,13 +1364,13 @@ package body Prj.Env is
or else Unit.File_Names (Specification).Project = The_Project or else Unit.File_Names (Specification).Project = The_Project
then then
declare declare
Current_Name : constant Name_Id := Current_Name : constant File_Name_Type :=
Unit.File_Names (Specification).Name; Unit.File_Names (Specification).Name;
begin begin
-- Case of spec present -- Case of spec present
if Current_Name /= No_Name then if Current_Name /= No_File then
if Current_Verbosity = High then if Current_Verbosity = High then
Write_Str (" Comparing with """); Write_Str (" Comparing with """);
Write_Str (Get_Name_String (Current_Name)); Write_Str (Get_Name_String (Current_Name));
...@@ -1382,7 +1380,8 @@ package body Prj.Env is ...@@ -1382,7 +1380,8 @@ package body Prj.Env is
-- If name same as original name, return original name -- 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 or else Current_Name = The_Original_Name
then then
if Current_Verbosity = High then if Current_Verbosity = High then
...@@ -1498,8 +1497,7 @@ package body Prj.Env is ...@@ -1498,8 +1497,7 @@ package body Prj.Env is
-- This project has never been visited, add it -- This project has never been visited, add it
-- to the list. -- to the list.
Project_List_Table.Increment_Last Project_List_Table.Increment_Last (In_Tree.Project_Lists);
(In_Tree.Project_Lists);
In_Tree.Project_Lists.Table (Current).Next := In_Tree.Project_Lists.Table (Current).Next :=
Project_List_Table.Last (In_Tree.Project_Lists); Project_List_Table.Last (In_Tree.Project_Lists);
In_Tree.Project_Lists.Table In_Tree.Project_Lists.Table
...@@ -1512,8 +1510,8 @@ package body Prj.Env is ...@@ -1512,8 +1510,8 @@ package body Prj.Env is
-- If there is an object directory, call Action -- If there is an object directory, call Action
-- with its name -- with its name
if Data.Object_Directory /= No_Name then if Data.Object_Directory /= No_Path then
Get_Name_String (Data.Object_Directory); Get_Name_String (Data.Display_Object_Dir);
Action (Name_Buffer (1 .. Name_Len)); Action (Name_Buffer (1 .. Name_Len));
end if; end if;
...@@ -1560,8 +1558,7 @@ package body Prj.Env is ...@@ -1560,8 +1558,7 @@ package body Prj.Env is
--------- ---------
procedure Add (Project : Project_Id) is procedure Add (Project : Project_Id) is
Data : constant Project_Data := Data : constant Project_Data := In_Tree.Projects.Table (Project);
In_Tree.Projects.Table (Project);
List : Project_List := Data.Imported_Projects; List : Project_List := Data.Imported_Projects;
begin begin
...@@ -1569,10 +1566,8 @@ package body Prj.Env is ...@@ -1569,10 +1566,8 @@ package body Prj.Env is
-- for sure we never visited this project. -- for sure we never visited this project.
if Seen = Empty_Project_List then if Seen = Empty_Project_List then
Project_List_Table.Increment_Last Project_List_Table.Increment_Last (In_Tree.Project_Lists);
(In_Tree.Project_Lists); Seen := Project_List_Table.Last (In_Tree.Project_Lists);
Seen := Project_List_Table.Last
(In_Tree.Project_Lists);
In_Tree.Project_Lists.Table (Seen) := In_Tree.Project_Lists.Table (Seen) :=
(Project => Project, Next => Empty_Project_List); (Project => Project, Next => Empty_Project_List);
...@@ -1595,20 +1590,18 @@ package body Prj.Env is ...@@ -1595,20 +1590,18 @@ package body Prj.Env is
exit when exit when
In_Tree.Project_Lists.Table (Current).Next = In_Tree.Project_Lists.Table (Current).Next =
Empty_Project_List; Empty_Project_List;
Current :=
In_Tree.Project_Lists.Table (Current).Next; Current := In_Tree.Project_Lists.Table (Current).Next;
end loop; end loop;
-- This project has never been visited, add it -- This project has never been visited, add it
-- to the list. -- to the list.
Project_List_Table.Increment_Last Project_List_Table.Increment_Last (In_Tree.Project_Lists);
(In_Tree.Project_Lists);
In_Tree.Project_Lists.Table (Current).Next := In_Tree.Project_Lists.Table (Current).Next :=
Project_List_Table.Last (In_Tree.Project_Lists); Project_List_Table.Last (In_Tree.Project_Lists);
In_Tree.Project_Lists.Table In_Tree.Project_Lists.Table
(Project_List_Table.Last (Project_List_Table.Last (In_Tree.Project_Lists)) :=
(In_Tree.Project_Lists)) :=
(Project => Project, Next => Empty_Project_List); (Project => Project, Next => Empty_Project_List);
end; end;
end if; end if;
...@@ -1621,13 +1614,10 @@ package body Prj.Env is ...@@ -1621,13 +1614,10 @@ package body Prj.Env is
-- If there are Ada sources, call action with the name of every -- If there are Ada sources, call action with the name of every
-- source directory. -- source directory.
if if In_Tree.Projects.Table (Project).Ada_Sources_Present then
In_Tree.Projects.Table (Project).Ada_Sources_Present
then
while Current /= Nil_String loop while Current /= Nil_String loop
The_String := The_String := In_Tree.String_Elements.Table (Current);
In_Tree.String_Elements.Table (Current); Action (Get_Name_String (The_String.Display_Value));
Action (Get_Name_String (The_String.Value));
Current := The_String.Next; Current := The_String.Next;
end loop; end loop;
end if; end if;
...@@ -1663,7 +1653,7 @@ package body Prj.Env is ...@@ -1663,7 +1653,7 @@ package body 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)
is is
begin begin
-- Body below could use some comments ??? -- Body below could use some comments ???
...@@ -1686,14 +1676,14 @@ package body Prj.Env is ...@@ -1686,14 +1676,14 @@ package body Prj.Env is
loop loop
Unit := In_Tree.Units.Table (Id); Unit := In_Tree.Units.Table (Id);
if (Unit.File_Names (Specification).Name /= No_Name if (Unit.File_Names (Specification).Name /= No_File
and then and then
Namet.Get_Name_String Namet.Get_Name_String
(Unit.File_Names (Specification).Name) = Original_Name) (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 and then
Namet.Get_Name_String Namet.Get_Name_String
(Unit.File_Names (Specification).Path) = (Unit.File_Names (Specification).Path) =
Original_Name) Original_Name)
then then
Project := Ultimate_Extension_Of Project := Ultimate_Extension_Of
...@@ -1708,11 +1698,11 @@ package body Prj.Env is ...@@ -1708,11 +1698,11 @@ package body Prj.Env is
return; return;
elsif (Unit.File_Names (Body_Part).Name /= No_Name elsif (Unit.File_Names (Body_Part).Name /= No_File
and then and then
Namet.Get_Name_String Namet.Get_Name_String
(Unit.File_Names (Body_Part).Name) = Original_Name) (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 and then Namet.Get_Name_String
(Unit.File_Names (Body_Part).Path) = (Unit.File_Names (Body_Part).Path) =
Original_Name) Original_Name)
...@@ -1733,7 +1723,7 @@ package body Prj.Env is ...@@ -1733,7 +1723,7 @@ package body Prj.Env is
end; end;
Project := No_Project; Project := No_Project;
Path := No_Name; Path := No_File;
if Current_Verbosity > Default then if Current_Verbosity > Default then
Write_Str ("Cannot be found."); Write_Str ("Cannot be found.");
...@@ -1772,7 +1762,7 @@ package body Prj.Env is ...@@ -1772,7 +1762,7 @@ package body Prj.Env is
Name & Namet.Get_Name_String Name & Namet.Get_Name_String
(Data.Naming.Ada_Body_Suffix); (Data.Naming.Ada_Body_Suffix);
First : Unit_Id := Unit_Table.First; First : Unit_Id;
Current : Unit_Id; Current : Unit_Id;
Unit : Unit_Data; Unit : Unit_Data;
...@@ -1796,6 +1786,7 @@ package body Prj.Env is ...@@ -1796,6 +1786,7 @@ package body Prj.Env is
Write_Eol; Write_Eol;
end if; end if;
First := Unit_Table.First;
while First <= Unit_Table.Last (In_Tree.Units) while First <= Unit_Table.Last (In_Tree.Units)
and then In_Tree.Units.Table and then In_Tree.Units.Table
(First).File_Names (Body_Part).Project /= Project (First).File_Names (Body_Part).Project /= Project
...@@ -1808,7 +1799,7 @@ package body Prj.Env is ...@@ -1808,7 +1799,7 @@ package body Prj.Env is
Unit := In_Tree.Units.Table (Current); Unit := In_Tree.Units.Table (Current);
if Unit.File_Names (Body_Part).Project = Project 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 then
declare declare
Current_Name : constant String := Current_Name : constant String :=
...@@ -1842,7 +1833,7 @@ package body Prj.Env is ...@@ -1842,7 +1833,7 @@ package body Prj.Env is
end if; end if;
end; end;
elsif Unit.File_Names (Specification).Name /= No_Name then elsif Unit.File_Names (Specification).Name /= No_File then
declare declare
Current_Name : constant String := Current_Name : constant String :=
Namet.Get_Name_String Namet.Get_Name_String
...@@ -1902,7 +1893,7 @@ package body Prj.Env is ...@@ -1902,7 +1893,7 @@ package body Prj.Env is
Write_Str (" "); Write_Str (" ");
Write_Line (Namet.Get_Name_String (Unit.Name)); 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 if Unit.File_Names (Specification).Project = No_Project then
Write_Line (" No project"); Write_Line (" No project");
...@@ -1920,7 +1911,7 @@ package body Prj.Env is ...@@ -1920,7 +1911,7 @@ package body Prj.Env is
(Unit.File_Names (Specification).Name)); (Unit.File_Names (Specification).Name));
end if; 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 if Unit.File_Names (Body_Part).Project = No_Project then
Write_Line (" No project"); Write_Line (" No project");
...@@ -1956,7 +1947,7 @@ package body Prj.Env is ...@@ -1956,7 +1947,7 @@ package body Prj.Env is
Original_Name : String := Name; Original_Name : String := Name;
Data : constant Project_Data := Data : constant Project_Data :=
In_Tree.Projects.Table (Main_Project); In_Tree.Projects.Table (Main_Project);
Extended_Spec_Name : String := Extended_Spec_Name : String :=
Name & Namet.Get_Name_String Name & Namet.Get_Name_String
...@@ -1967,11 +1958,12 @@ package body Prj.Env is ...@@ -1967,11 +1958,12 @@ package body Prj.Env is
Unit : Unit_Data; 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; -- Confusion here between unit names/file names, See ??? comments below
The_Spec_Name : Name_Id;
The_Body_Name : Name_Id;
begin begin
Canonical_Case_File_Name (Original_Name); Canonical_Case_File_Name (Original_Name);
...@@ -2000,12 +1992,12 @@ package body Prj.Env is ...@@ -2000,12 +1992,12 @@ package body Prj.Env is
-- Case of a body present -- 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, -- If it has the name of the original name or the body name,
-- we have found the project. -- 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_Original_Name
or else Current_Name = The_Body_Name or else Current_Name = The_Body_Name
then then
...@@ -2018,12 +2010,12 @@ package body Prj.Env is ...@@ -2018,12 +2010,12 @@ package body Prj.Env is
Current_Name := Unit.File_Names (Specification).Name; 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 -- If name same as the original name, or the spec name, we have
-- found the project. -- 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_Original_Name
or else Current_Name = The_Spec_Name or else Current_Name = The_Spec_Name
then then
...@@ -2118,17 +2110,17 @@ package body Prj.Env is ...@@ -2118,17 +2110,17 @@ package body Prj.Env is
if (Data.Library and then Including_Libraries) if (Data.Library and then Including_Libraries)
or else or else
(Data.Object_Directory /= No_Name (Data.Object_Directory /= No_Path
and then and then
(not Including_Libraries or else not Data.Library)) (not Including_Libraries or else not Data.Library))
then then
-- For a library project, add the library ALI -- For a library project, add library ALI directory if
-- directory if there is no object directory or -- there is no object directory or if the library ALI
-- if the library ALI directory contains ALI files; -- directory contains ALI files, otherwise add the
-- otherwise add the object directory. -- object directory.
if Data.Library then 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) or else Contains_ALI_Files (Data.Library_ALI_Dir)
then then
Add_To_Object_Path Add_To_Object_Path
...@@ -2151,10 +2143,9 @@ package body Prj.Env is ...@@ -2151,10 +2143,9 @@ package body Prj.Env is
or else or else
(Data.Extends /= No_Project (Data.Extends /= No_Project
and then and then
Data.Object_Directory /= No_Name)) Data.Object_Directory /= No_Path))
then then
Add_To_Object_Path Add_To_Object_Path (Data.Object_Directory, In_Tree);
(Data.Object_Directory, In_Tree);
end if; end if;
end if; end if;
end if; end if;
...@@ -2197,9 +2188,7 @@ package body Prj.Env is ...@@ -2197,9 +2188,7 @@ package body Prj.Env is
-- If it is the first time we call this procedure for -- If it is the first time we call this procedure for
-- this project, compute the source path and/or the object path. -- this project, compute the source path and/or the object path.
if In_Tree.Projects.Table (Project).Include_Path_File = if In_Tree.Projects.Table (Project).Include_Path_File = No_Path then
No_Name
then
Process_Source_Dirs := True; Process_Source_Dirs := True;
Create_New_Path_File Create_New_Path_File
(In_Tree, Source_FD, (In_Tree, Source_FD,
...@@ -2211,7 +2200,7 @@ package body Prj.Env is ...@@ -2211,7 +2200,7 @@ package body Prj.Env is
if Including_Libraries then if Including_Libraries then
if In_Tree.Projects.Table if In_Tree.Projects.Table
(Project).Objects_Path_File_With_Libs = No_Name (Project).Objects_Path_File_With_Libs = No_Path
then then
Process_Object_Dirs := True; Process_Object_Dirs := True;
Create_New_Path_File Create_New_Path_File
...@@ -2221,7 +2210,7 @@ package body Prj.Env is ...@@ -2221,7 +2210,7 @@ package body Prj.Env is
else else
if In_Tree.Projects.Table if In_Tree.Projects.Table
(Project).Objects_Path_File_Without_Libs = No_Name (Project).Objects_Path_File_Without_Libs = No_Path
then then
Process_Object_Dirs := True; Process_Object_Dirs := True;
Create_New_Path_File Create_New_Path_File
...@@ -2363,7 +2352,7 @@ package body Prj.Env is ...@@ -2363,7 +2352,7 @@ package body Prj.Env is
Data : Unit_Data := In_Tree.Units.Table (Unit); Data : Unit_Data := In_Tree.Units.Table (Unit);
begin begin
if Data.File_Names (Specification).Path = No_Name then if Data.File_Names (Specification).Path = No_File then
declare declare
Current_Source : String_List_Id := Current_Source : String_List_Id :=
In_Tree.Projects.Table In_Tree.Projects.Table
......
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
......
gcc/ada/prj.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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 Ada.Characters.Handling; use Ada.Characters.Handling; with Ada.Characters.Handling; use Ada.Characters.Handling;
with Namet; use Namet;
with Output; use Output; with Output; use Output;
with Osint; use Osint; with Osint; use Osint;
with Prj.Attr; with Prj.Attr;
...@@ -46,9 +45,9 @@ package body Prj is ...@@ -46,9 +45,9 @@ package body Prj is
Name_C_Plus_Plus : Name_Id; Name_C_Plus_Plus : Name_Id;
Default_Ada_Spec_Suffix_Id : Name_Id; Default_Ada_Spec_Suffix_Id : File_Name_Type;
Default_Ada_Body_Suffix_Id : Name_Id; Default_Ada_Body_Suffix_Id : File_Name_Type;
Slash_Id : Name_Id; Slash_Id : File_Name_Type;
-- Initialized in Prj.Initialized, then never modified -- Initialized in Prj.Initialized, then never modified
subtype Known_Casing is Casing_Type range All_Upper_Case .. Mixed_Case; subtype Known_Casing is Casing_Type range All_Upper_Case .. Mixed_Case;
...@@ -60,22 +59,23 @@ package body Prj is ...@@ -60,22 +59,23 @@ package body Prj is
Initialized : Boolean := False; Initialized : Boolean := False;
Standard_Dot_Replacement : constant Name_Id := Standard_Dot_Replacement : constant File_Name_Type :=
First_Name_Id + Character'Pos ('-'); File_Name_Type
(First_Name_Id + Character'Pos ('-'));
Std_Naming_Data : Naming_Data := Std_Naming_Data : Naming_Data :=
(Dot_Replacement => Standard_Dot_Replacement, (Dot_Replacement => Standard_Dot_Replacement,
Dot_Repl_Loc => No_Location, Dot_Repl_Loc => No_Location,
Casing => All_Lower_Case, Casing => All_Lower_Case,
Spec_Suffix => No_Array_Element, Spec_Suffix => No_Array_Element,
Ada_Spec_Suffix => No_Name, Ada_Spec_Suffix => No_File,
Spec_Suffix_Loc => No_Location, Spec_Suffix_Loc => No_Location,
Impl_Suffixes => No_Impl_Suffixes, Impl_Suffixes => No_Impl_Suffixes,
Supp_Suffixes => No_Supp_Language_Index, Supp_Suffixes => No_Supp_Language_Index,
Body_Suffix => No_Array_Element, Body_Suffix => No_Array_Element,
Ada_Body_Suffix => No_Name, Ada_Body_Suffix => No_File,
Body_Suffix_Loc => No_Location, Body_Suffix_Loc => No_Location,
Separate_Suffix => No_Name, Separate_Suffix => No_File,
Sep_Suffix_Loc => No_Location, Sep_Suffix_Loc => No_Location,
Specs => No_Array_Element, Specs => No_Array_Element,
Bodies => No_Array_Element, Bodies => No_Array_Element,
...@@ -89,27 +89,28 @@ package body Prj is ...@@ -89,27 +89,28 @@ package body Prj is
First_Referred_By => No_Project, First_Referred_By => No_Project,
Name => No_Name, Name => No_Name,
Display_Name => No_Name, Display_Name => No_Name,
Path_Name => No_Name, Path_Name => No_Path,
Display_Path_Name => No_Name, Display_Path_Name => No_Path,
Virtual => False, Virtual => False,
Location => No_Location, Location => No_Location,
Mains => Nil_String, Mains => Nil_String,
Directory => No_Name, Directory => No_Path,
Display_Directory => No_Name, Display_Directory => No_Path,
Dir_Path => null, Dir_Path => null,
Library => False, Library => False,
Library_Dir => No_Name, Library_Dir => No_Path,
Display_Library_Dir => No_Name, Display_Library_Dir => No_Path,
Library_Src_Dir => No_Name, Library_Src_Dir => No_Path,
Display_Library_Src_Dir => No_Name, Display_Library_Src_Dir => No_Path,
Library_ALI_Dir => No_Name, Library_ALI_Dir => No_Path,
Display_Library_ALI_Dir => No_Name, Display_Library_ALI_Dir => No_Path,
Library_Name => No_Name, Library_Name => No_File,
Library_Kind => Static, Library_Kind => Static,
Lib_Internal_Name => No_Name, Lib_Internal_Name => No_File,
Standalone_Library => False, Standalone_Library => False,
Lib_Interface_ALIs => Nil_String, Lib_Interface_ALIs => Nil_String,
Lib_Auto_Init => False, Lib_Auto_Init => False,
Libgnarl_Needed => Unknown,
Symbol_Data => No_Symbols, Symbol_Data => No_Symbols,
Ada_Sources_Present => True, Ada_Sources_Present => True,
Other_Sources_Present => True, Other_Sources_Present => True,
...@@ -121,27 +122,27 @@ package body Prj is ...@@ -121,27 +122,27 @@ package body Prj is
Include_Data_Set => False, Include_Data_Set => False,
Source_Dirs => Nil_String, Source_Dirs => Nil_String,
Known_Order_Of_Source_Dirs => True, Known_Order_Of_Source_Dirs => True,
Object_Directory => No_Name, Object_Directory => No_Path,
Display_Object_Dir => No_Name, Display_Object_Dir => No_Path,
Library_TS => Empty_Time_Stamp, Library_TS => Empty_Time_Stamp,
Exec_Directory => No_Name, Exec_Directory => No_Path,
Display_Exec_Dir => No_Name, Display_Exec_Dir => No_Path,
Extends => No_Project, Extends => No_Project,
Extended_By => No_Project, Extended_By => No_Project,
Naming => Std_Naming_Data, Naming => Std_Naming_Data,
First_Language_Processing => Default_First_Language_Processing_Data, First_Language_Processing => Default_First_Language_Processing_Data,
Supp_Language_Processing => No_Supp_Language_Index, Supp_Language_Processing => No_Supp_Language_Index,
Default_Linker => No_Name, Default_Linker => No_File,
Default_Linker_Path => No_Name, Default_Linker_Path => No_Path,
Decl => No_Declarations, Decl => No_Declarations,
Imported_Projects => Empty_Project_List, Imported_Projects => Empty_Project_List,
All_Imported_Projects => Empty_Project_List, All_Imported_Projects => Empty_Project_List,
Ada_Include_Path => null, Ada_Include_Path => null,
Ada_Objects_Path => null, Ada_Objects_Path => null,
Include_Path_File => No_Name, Include_Path_File => No_Path,
Objects_Path_File_With_Libs => No_Name, Objects_Path_File_With_Libs => No_Path,
Objects_Path_File_Without_Libs => No_Name, Objects_Path_File_Without_Libs => No_Path,
Config_File_Name => No_Name, Config_File_Name => No_Path,
Config_File_Temp => False, Config_File_Temp => False,
Config_Checked => False, Config_Checked => False,
Language_Independent_Checked => False, Language_Independent_Checked => False,
...@@ -182,8 +183,7 @@ package body Prj is ...@@ -182,8 +183,7 @@ package body Prj is
while Last + S'Length > To'Last loop while Last + S'Length > To'Last loop
declare declare
New_Buffer : constant String_Access := New_Buffer : constant String_Access := new String (1 .. 2 * Last);
new String (1 .. 2 * Last);
begin begin
New_Buffer (1 .. Last) := To (1 .. Last); New_Buffer (1 .. Last) := To (1 .. Last);
...@@ -200,7 +200,7 @@ package body Prj is ...@@ -200,7 +200,7 @@ package body Prj is
-- Default_Ada_Body_Suffix -- -- Default_Ada_Body_Suffix --
----------------------------- -----------------------------
function Default_Ada_Body_Suffix return Name_Id is function Default_Ada_Body_Suffix return File_Name_Type is
begin begin
return Default_Ada_Body_Suffix_Id; return Default_Ada_Body_Suffix_Id;
end Default_Ada_Body_Suffix; end Default_Ada_Body_Suffix;
...@@ -209,7 +209,7 @@ package body Prj is ...@@ -209,7 +209,7 @@ package body Prj is
-- Default_Ada_Spec_Suffix -- -- Default_Ada_Spec_Suffix --
----------------------------- -----------------------------
function Default_Ada_Spec_Suffix return Name_Id is function Default_Ada_Spec_Suffix return File_Name_Type is
begin begin
return Default_Ada_Spec_Suffix_Id; return Default_Ada_Spec_Suffix_Id;
end Default_Ada_Spec_Suffix; end Default_Ada_Spec_Suffix;
...@@ -314,6 +314,11 @@ package body Prj is ...@@ -314,6 +314,11 @@ package body Prj is
return Hash (Get_Name_String (Name)); return Hash (Get_Name_String (Name));
end Hash; end Hash;
function Hash (Name : File_Name_Type) return Header_Num is
begin
return Hash (Get_Name_String (Name));
end Hash;
----------- -----------
-- Image -- -- Image --
----------- -----------
...@@ -454,13 +459,13 @@ package body Prj is ...@@ -454,13 +459,13 @@ package body Prj is
procedure Register_Default_Naming_Scheme procedure Register_Default_Naming_Scheme
(Language : Name_Id; (Language : Name_Id;
Default_Spec_Suffix : Name_Id; Default_Spec_Suffix : File_Name_Type;
Default_Body_Suffix : Name_Id; Default_Body_Suffix : File_Name_Type;
In_Tree : Project_Tree_Ref) In_Tree : Project_Tree_Ref)
is is
Lang : Name_Id; Lang : Name_Id;
Suffix : Array_Element_Id; Suffix : Array_Element_Id;
Found : Boolean := False; Found : Boolean := False;
Element : Array_Element; Element : Array_Element;
begin begin
...@@ -481,7 +486,7 @@ package body Prj is ...@@ -481,7 +486,7 @@ package body Prj is
if Element.Index = Lang then if Element.Index = Lang then
Found := True; Found := True;
Element.Value.Value := Default_Spec_Suffix; Element.Value.Value := Name_Id (Default_Spec_Suffix);
In_Tree.Array_Elements.Table (Suffix) := Element; In_Tree.Array_Elements.Table (Suffix) := Element;
else else
...@@ -500,13 +505,15 @@ package body Prj is ...@@ -500,13 +505,15 @@ package body Prj is
Kind => Single, Kind => Single,
Location => No_Location, Location => No_Location,
Default => False, Default => False,
Value => Default_Spec_Suffix, Value => Name_Id (Default_Spec_Suffix),
Index => 0), Index => 0),
Next => In_Tree.Private_Part.Default_Naming.Spec_Suffix); Next => In_Tree.Private_Part.Default_Naming.Spec_Suffix);
Array_Element_Table.Increment_Last (In_Tree.Array_Elements); Array_Element_Table.Increment_Last (In_Tree.Array_Elements);
In_Tree.Array_Elements.Table In_Tree.Array_Elements.Table
(Array_Element_Table.Last (In_Tree.Array_Elements)) := (Array_Element_Table.Last (In_Tree.Array_Elements)) := Element;
Element;
In_Tree.Private_Part.Default_Naming.Spec_Suffix := In_Tree.Private_Part.Default_Naming.Spec_Suffix :=
Array_Element_Table.Last (In_Tree.Array_Elements); Array_Element_Table.Last (In_Tree.Array_Elements);
end if; end if;
...@@ -522,7 +529,7 @@ package body Prj is ...@@ -522,7 +529,7 @@ package body Prj is
if Element.Index = Lang then if Element.Index = Lang then
Found := True; Found := True;
Element.Value.Value := Default_Body_Suffix; Element.Value.Value := Name_Id (Default_Body_Suffix);
In_Tree.Array_Elements.Table (Suffix) := Element; In_Tree.Array_Elements.Table (Suffix) := Element;
else else
...@@ -541,7 +548,7 @@ package body Prj is ...@@ -541,7 +548,7 @@ package body Prj is
Kind => Single, Kind => Single,
Location => No_Location, Location => No_Location,
Default => False, Default => False,
Value => Default_Body_Suffix, Value => Name_Id (Default_Body_Suffix),
Index => 0), Index => 0),
Next => In_Tree.Private_Part.Default_Naming.Body_Suffix); Next => In_Tree.Private_Part.Default_Naming.Body_Suffix);
Array_Element_Table.Increment_Last Array_Element_Table.Increment_Last
...@@ -703,7 +710,7 @@ package body Prj is ...@@ -703,7 +710,7 @@ package body Prj is
end Set; end Set;
procedure Set procedure Set
(Suffix : Name_Id; (Suffix : File_Name_Type;
For_Language : Language_Index; For_Language : Language_Index;
In_Project : in out Project_Data; In_Project : in out Project_Data;
In_Tree : Project_Tree_Ref) In_Tree : Project_Tree_Ref)
...@@ -752,7 +759,7 @@ package body Prj is ...@@ -752,7 +759,7 @@ package body Prj is
-- Slash -- -- Slash --
----------- -----------
function Slash return Name_Id is function Slash return File_Name_Type is
begin begin
return Slash_Id; return Slash_Id;
end Slash; end Slash;
...@@ -781,12 +788,12 @@ package body Prj is ...@@ -781,12 +788,12 @@ package body Prj is
function Suffix_Of function Suffix_Of
(Language : Language_Index; (Language : Language_Index;
In_Project : Project_Data; In_Project : Project_Data;
In_Tree : Project_Tree_Ref) return Name_Id In_Tree : Project_Tree_Ref) return File_Name_Type
is is
begin begin
case Language is case Language is
when No_Language_Index => when No_Language_Index =>
return No_Name; return No_File;
when First_Language_Indexes => when First_Language_Indexes =>
return In_Project.Naming.Impl_Suffixes (Language); return In_Project.Naming.Impl_Suffixes (Language);
...@@ -808,7 +815,7 @@ package body Prj is ...@@ -808,7 +815,7 @@ package body Prj is
Supp_Index := Supp.Next; Supp_Index := Supp.Next;
end loop; end loop;
return No_Name; return No_File;
end; end;
end case; end case;
end Suffix_Of; end Suffix_Of;
......
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