-- --
-- 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- --
-- 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
--------------
-- 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;
-- --
-- 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- --
-- --
------------------------------------------------------------------------------
-with Namet; use Namet;
with Opt;
with Osint; use Osint;
with Output; use Output;
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
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
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
-- 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
------------------------
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
-- 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;
(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
-- 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
-- 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;
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;
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
procedure Put
(Unit_Name : Name_Id;
- File_Name : Name_Id;
+ File_Name : File_Name_Type;
Unit_Kind : Spec_Or_Body;
Index : Int)
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;
-- 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;
-- 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;
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.
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)),
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);
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));
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
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));
-- 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
-- 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
-- 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;
---------
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
-- 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);
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;
-- 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;
(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 ???
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
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)
end;
Project := No_Project;
- Path := No_Name;
+ Path := No_File;
if Current_Verbosity > Default then
Write_Str ("Cannot be found.");
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;
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
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 :=
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
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");
(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");
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
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);
-- 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
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
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
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;
-- 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,
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
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
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
-- --
-- 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- --
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.
(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
-- --
-- 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- --
with Hostparm;
with Makeutl; use Makeutl;
-with Namet; use Namet;
with Output; use Output;
with Osint; use Osint;
with Sdefault;
-- 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 --
---------
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 --
-----------
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
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
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
+
+ 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_Buffer (Name_Len) := Path_Separator;
Add_Str_To_Name_Buffer (Prj_Path.all);
+ 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.
+ -- 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;
+ First := 3;
+ loop
+ while First <= Name_Len
+ and then (Name_Buffer (First) = Path_Separator)
loop
- while First <= Name_Len
- and then (Name_Buffer (First) = Path_Separator)
- loop
- First := First + 1;
- end 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;
- 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
- and then Name_Buffer (Last + 1) /= Path_Separator
- loop
- Last := Last + 1;
+ for J in Last + 1 .. Name_Len loop
+ Name_Buffer (J - No_Project_Default_Dir'Length - 1) :=
+ Name_Buffer (J);
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;
+ 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;
+ First := Last + 1;
+ end loop;
-- Set the initial value of Current_Project_Path
-- --
-- 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- --
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
-- --
-- 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- --
with Ada.Characters.Handling; use Ada.Characters.Handling;
-with Namet; use Namet;
with Output; use Output;
with Osint; use Osint;
with Prj.Attr;
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;
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,
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,
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,
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);
-- 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;
-- 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;
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 --
-----------
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
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
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;
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
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
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)
-- Slash --
-----------
- function Slash return Name_Id is
+ function Slash return File_Name_Type is
begin
return Slash_Id;
end Slash;
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);
Supp_Index := Supp.Next;
end loop;
- return No_Name;
+ return No_File;
end;
end case;
end Suffix_Of;
projects / gcc.git / commitdiff