aboutsummaryrefslogtreecommitdiff
path: root/gcc
diff options
context:
space:
mode:
authorEmmanuel Briot <briot@adacore.com>2007-12-13 11:28:39 +0100
committerArnaud Charlet <charlet@gcc.gnu.org>2007-12-13 11:28:39 +0100
commit6c1f47ee4b24ebae655517ad3ea934856aae662d (patch)
treef34d6aa77881e7af268ea3a8628eb9fef5c872a7 /gcc
parent800621e062382ae60c7416a2c24544d566d0f3b8 (diff)
downloadgcc-6c1f47ee4b24ebae655517ad3ea934856aae662d.zip
gcc-6c1f47ee4b24ebae655517ad3ea934856aae662d.tar.gz
gcc-6c1f47ee4b24ebae655517ad3ea934856aae662d.tar.bz2
prj.ads, prj.adb (Is_A_Language): Now takes a Name_Id instead of a string
2007-12-06 Emmanuel Briot <briot@adacore.com> Vincent Celier <celier@adacore.com> * prj.ads, prj.adb (Is_A_Language): Now takes a Name_Id instead of a string (Must_Check_Configuration, Default_Language_Is_Ada): new flags in prj.ads (Hash): Move instantiation of System.HTable.Hash from spec to body (prj-nmsc.adb): Optimize calls to Name_Find when on case sensitive systems, since we do not need to recompute the Name_Id for the canonical file name. (Body_Suffix_Id_Of, Spec_Suffix_Id_Of): new version that takes a name_id as a parameter. This parameter is in fact always "ada" in all calls, and we were doing 160560 extra calls to Name_Find to convert it to Name_Ada while loading a project with 40000 files * prj-attr.adb: Fix name of attribute Dependency_Driver Change the kind of indexing for attribute Root * prj-dect.adb (Parse_Declarative_Items): Allow redeclarations of variables already declared, in case constructions. * prj-env.adb (Initialize): Reset Current_Source_Path_File and Current_Object_Path_File to No_Path. * prj-ext.adb (Initialize_Project_Path): In multi language mode, use ADA_PROJECT_PATH if value of GPR_PROJECT_PATH is empty. * prj-makr.adb: new parameter Current_Dir * prj-nmsc.ads, prj-nmsc.adb (Find_Explicit_Sources): Do not look for Ada sources when language is not Ada. Change Opt.Follow_Links to Opt.Follow_Links_For_Files. (Find_Excluded_Sources, Find_Explicit_Sources): new subprograms (Must_Check_Configuration, Default_Language_Is_Ada): new flags. (Locate_Directory): Always resolve links when computing Canonical_Path (Look_For_Sources): Make sure that Name_Buffer contains the file name in Source_Files before checking for the presence of a directory separator. Optimize calls to Name_Find when on case sensitive systems. (Body_Suffix_Id_Of, Spec_Suffix_Id_Of): new version that takes a name_id as a parameter. (Prj.Nmsc.Check): new parameter Current_Dir (Check_Ada_Naming_Schemes): Restrictions on suffixes are relaxed. They cannot be empty and the spec suffix cannot be the same as the body or separate suffix. (Get_Unit): When a file name can be of several unit kinds (spec, body or subunit), always consider the longest suffix. (Check_Configuration): Do not issue an error if there is no compiler for a language. Just issue a warning and ignore the sources for the language. (Check_Library_Attributes): Only check Library_Dir if Library_Name is not empty. (Check_Naming_Schemes.Maked_Unit): Only output message if high verbosity (Unit_Exceptions): New hash table (Check_Naming_Schemes): Check if a file that could be a unit because of the naming scheme is not in fact a source because there is an exception for the unit. (Look_For_Sources): Put the unit exceptions in hash table Unit_Exceptions (Get_Unit_Exceptions): Give initial value No_Source to local variable Other_Part to avoid exception when code is compiled with validity checking. (Get_Sources_From_File): Check that there is no directory information in the file names. (Look_For_Sources): Check that there is no directory information in the list of file names in Source_Files. (Look_For_Sources): In multi-language mode, do not allow exception file names that are excluded. (Excluded_Sources_Htable): New hash table (Search_Directories.Check_File): New procedure to simplify Search_Directories. (Search_Directories): Do not consider excluded sources (Look_For_Sources): Populate Excluded_Sources_Htable before calling Search_Directories. (Get_Exceptions): Set component Lang_Kind of Source_Data (Get_Unit_Exceptions): Ditto (Search_Directories): Ditto * prj-pars.adb: new parameter Current_Dir * prj-part.ads, prj-part.adb: Change Opt.Follow_Links to Opt.Follow_Links_For_Files. (Opt.Follow_Links_For_Dirs): New flag (Project_Path_Name_Of): Cache information returned by this routine as Locate_Regular_File is a costly routine. The code to output a log information and the effective call to Locate_Regular_File is now factorized into a routine (code clean-up). (Parse, Parse_Single_Project): new parameter Current_Dir When main project file cannot be found, indicate in the error message the project path that was used to do the search. * prj-proc.ads, prj-proc.adb (Opt.Follow_Links_For_Dirs): New flag (Prj.Proc.Process*): new parameter Current_Dir * switch-m.adb: Change Opt.Follow_Links to Opt.Follow_Links_For_Files From-SVN: r130846
Diffstat (limited to 'gcc')
-rw-r--r--gcc/ada/prj-attr.adb4
-rw-r--r--gcc/ada/prj-dect.adb39
-rw-r--r--gcc/ada/prj-env.adb25
-rw-r--r--gcc/ada/prj-ext.adb22
-rw-r--r--gcc/ada/prj-makr.adb1
-rw-r--r--gcc/ada/prj-nmsc.adb3796
-rw-r--r--gcc/ada/prj-nmsc.ads9
-rw-r--r--gcc/ada/prj-pars.adb10
-rw-r--r--gcc/ada/prj-part.adb210
-rw-r--r--gcc/ada/prj-part.ads9
-rw-r--r--gcc/ada/prj-proc.adb36
-rw-r--r--gcc/ada/prj-proc.ads13
-rw-r--r--gcc/ada/prj.adb153
-rw-r--r--gcc/ada/prj.ads338
-rw-r--r--gcc/ada/switch-m.adb2
15 files changed, 2576 insertions, 2091 deletions
diff --git a/gcc/ada/prj-attr.adb b/gcc/ada/prj-attr.adb
index 41bd6c4..bb5cfb4 100644
--- a/gcc/ada/prj-attr.adb
+++ b/gcc/ada/prj-attr.adb
@@ -66,7 +66,7 @@ package body Prj.Attr is
"lVmain#" &
"LVlanguages#" &
"SVmain_language#" &
- "Laroots#" &
+ "Lbroots#" &
"SVexternally_built#" &
-- Directories
@@ -178,7 +178,7 @@ package body Prj.Attr is
-- Configuration - Dependencies
"Ladependency_switches#" &
- "Lacompute_dependency#" &
+ "Ladependency_driver#" &
-- Configuration - Search paths
diff --git a/gcc/ada/prj-dect.adb b/gcc/ada/prj-dect.adb
index 6a31f56..7e367a7 100644
--- a/gcc/ada/prj-dect.adb
+++ b/gcc/ada/prj-dect.adb
@@ -790,9 +790,8 @@ package body Prj.Dect is
Declarations := Empty_Node;
loop
- -- We are always positioned at the token that precedes
- -- the first token of the declarative element.
- -- Scan past it
+ -- We are always positioned at the token that precedes the first
+ -- token of the declarative element. Scan past it.
Scan (In_Tree);
@@ -802,8 +801,38 @@ package body Prj.Dect is
when Tok_Identifier =>
if In_Zone = In_Case_Construction then
- Error_Msg ("a variable cannot be declared here",
- Token_Ptr);
+
+ -- Check if the variable has already been declared
+
+ declare
+ The_Variable : Project_Node_Id := Empty_Node;
+
+ begin
+ if Current_Package /= Empty_Node then
+ The_Variable :=
+ First_Variable_Of (Current_Package, In_Tree);
+ elsif Current_Project /= Empty_Node then
+ The_Variable :=
+ First_Variable_Of (Current_Project, In_Tree);
+ end if;
+
+ while The_Variable /= Empty_Node
+ and then Name_Of (The_Variable, In_Tree) /=
+ Token_Name
+ loop
+ The_Variable := Next_Variable (The_Variable, In_Tree);
+ end loop;
+
+ -- It is an error to declare a variable in a case
+ -- construction for the first time.
+
+ if The_Variable = Empty_Node then
+ Error_Msg
+ ("a variable cannot be declared " &
+ "for the first time here",
+ Token_Ptr);
+ end if;
+ end;
end if;
Parse_Variable_Declaration
diff --git a/gcc/ada/prj-env.adb b/gcc/ada/prj-env.adb
index f5259b1..0ddbf9b 100644
--- a/gcc/ada/prj-env.adb
+++ b/gcc/ada/prj-env.adb
@@ -1331,21 +1331,22 @@ package body Prj.Env is
while Source /= No_Source loop
Src_Data := In_Tree.Sources.Table (Source);
- if Src_Data.Language_Name = Language and then
- (not Src_Data.Locally_Removed) and then
- Src_Data.Replaced_By = No_Source and then
- Src_Data.Path /= No_Path
+ if Src_Data.Language_Name = Language
+ and then not Src_Data.Locally_Removed
+ and then Src_Data.Replaced_By = No_Source
+ and then Src_Data.Path /= No_Path
then
if Src_Data.Unit /= No_Name then
Get_Name_String (Src_Data.Unit);
if Src_Data.Kind = Spec then
- Suffix := In_Tree.Languages_Data.Table
- (Src_Data.Language).Config.Mapping_Spec_Suffix;
-
+ Suffix :=
+ In_Tree.Languages_Data.Table
+ (Src_Data.Language).Config.Mapping_Spec_Suffix;
else
- Suffix := In_Tree.Languages_Data.Table
- (Src_Data.Language).Config.Mapping_Body_Suffix;
+ Suffix :=
+ In_Tree.Languages_Data.Table
+ (Src_Data.Language).Config.Mapping_Body_Suffix;
end if;
if Suffix /= No_File then
@@ -1956,6 +1957,8 @@ package body Prj.Env is
procedure Initialize is
begin
Fill_Mapping_File := True;
+ Current_Source_Path_File := No_Path;
+ Current_Object_Path_File := No_Path;
end Initialize;
------------------------------------
@@ -2323,10 +2326,10 @@ package body Prj.Env is
-- except if we don't include library project and this
-- is a library project.
- if (Data.Library and then Including_Libraries)
+ if (Data.Library and Including_Libraries)
or else
(Data.Object_Directory /= No_Path
- and then
+ and then
(not Including_Libraries or else not Data.Library))
then
-- For a library project, add the library ALI
diff --git a/gcc/ada/prj-ext.adb b/gcc/ada/prj-ext.adb
index 37c8fc1..686ca51 100644
--- a/gcc/ada/prj-ext.adb
+++ b/gcc/ada/prj-ext.adb
@@ -66,7 +66,6 @@ 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,
@@ -76,6 +75,7 @@ package body Prj.Ext is
Table_Name => "Prj.Ext.Search_Directories");
-- The table for the directories specified with -aP switches
+ ---------
-- Add --
---------
@@ -142,20 +142,18 @@ package body Prj.Ext is
Prj_Path : String_Access := Gpr_Prj_Path;
begin
- if Get_Mode = Ada_Only then
- if Gpr_Prj_Path.all /= "" then
-
- -- Warn if both environment variables are defined
+ if Gpr_Prj_Path.all /= "" then
- if Ada_Prj_Path.all /= "" then
- Write_Line
- ("Warning: ADA_PROJECT_PATH is not taken into account");
- Write_Line (" when GPR_PROJECT_PATH is defined");
- end if;
+ -- In Ada only mode, warn if both environment variables are defined
- else
- Prj_Path := Ada_Prj_Path;
+ if Get_Mode = Ada_Only and then Ada_Prj_Path.all /= "" then
+ Write_Line
+ ("Warning: ADA_PROJECT_PATH is not taken into account");
+ Write_Line (" when GPR_PROJECT_PATH is defined");
end if;
+
+ else
+ Prj_Path := Ada_Prj_Path;
end if;
-- The current directory is always first
diff --git a/gcc/ada/prj-makr.adb b/gcc/ada/prj-makr.adb
index aef8743..336c676 100644
--- a/gcc/ada/prj-makr.adb
+++ b/gcc/ada/prj-makr.adb
@@ -741,6 +741,7 @@ package body Prj.Makr is
Project_File_Name => Output_Name (1 .. Output_Name_Last),
Always_Errout_Finalize => False,
Store_Comments => True,
+ Current_Directory => Get_Current_Dir,
Packages_To_Check => Packages_To_Check_By_Gnatname);
-- Fail if parsing was not successful
diff --git a/gcc/ada/prj-nmsc.adb b/gcc/ada/prj-nmsc.adb
index 0574cb2..f6a37b6 100644
--- a/gcc/ada/prj-nmsc.adb
+++ b/gcc/ada/prj-nmsc.adb
@@ -97,6 +97,28 @@ package body Prj.Nmsc is
-- Source_Files or in a source list file, stored in hash table
-- Source_Names, used by procedure Get_Path_Names_And_Record_Sources.
+ -- More documentation needed on what unit exceptions are about ???
+
+ type Unit_Exception is record
+ Name : Name_Id;
+ Spec : File_Name_Type;
+ Impl : File_Name_Type;
+ end record;
+
+ No_Unit_Exception : constant Unit_Exception :=
+ (Name => No_Name,
+ Spec => No_File,
+ Impl => No_File);
+
+ package Unit_Exceptions is new GNAT.HTable.Simple_HTable
+ (Header_Num => Header_Num,
+ Element => Unit_Exception,
+ No_Element => No_Unit_Exception,
+ Key => Name_Id,
+ Hash => Hash,
+ Equal => "=");
+ -- Hash table to store the unit exceptions
+
package Recursive_Dirs is new GNAT.HTable.Simple_HTable
(Header_Num => Header_Num,
Element => Boolean,
@@ -137,6 +159,30 @@ package body Prj.Nmsc is
-- A hash table to store naming exceptions for Ada. For each file name
-- there is one or several unit in table Ada_Naming_Exception_Table.
+ type File_Found is record
+ File : File_Name_Type := No_File;
+ Found : Boolean := False;
+ Location : Source_Ptr := No_Location;
+ end record;
+ No_File_Found : constant File_Found := (No_File, False, No_Location);
+
+ package Excluded_Sources_Htable is new GNAT.HTable.Simple_HTable
+ (Header_Num => Header_Num,
+ Element => File_Found,
+ No_Element => No_File_Found,
+ Key => File_Name_Type,
+ Hash => Hash,
+ Equal => "=");
+ -- A hash table to store the excluded files, if any. This is filled by
+ -- Find_Excluded_Sources below
+
+ procedure Find_Excluded_Sources
+ (In_Tree : Project_Tree_Ref;
+ Data : Project_Data);
+ -- Find the list of files that should not be considered as source files
+ -- for this project.
+ -- Sets the list in the Excluded_Sources_Htable
+
function Hash (Unit : Unit_Info) return Header_Num;
type Name_And_Index is record
@@ -157,12 +203,30 @@ package body Prj.Nmsc is
-- a source with a file name following the naming convention.
procedure Add_Source
- (Id : Source_Id;
- Data : in out Project_Data;
- In_Tree : Project_Tree_Ref);
+ (Id : out Source_Id;
+ Data : in out Project_Data;
+ In_Tree : Project_Tree_Ref;
+ Project : Project_Id;
+ Lang : Name_Id;
+ Lang_Id : Language_Index;
+ Kind : Source_Kind;
+ File_Name : File_Name_Type;
+ Display_File : File_Name_Type;
+ Lang_Kind : Language_Kind;
+ Naming_Exception : Boolean := False;
+ Path : Path_Name_Type := No_Path;
+ Display_Path : Path_Name_Type := No_Path;
+ Alternate_Languages : Alternate_Language_Id := No_Alternate_Language;
+ Other_Part : Source_Id := No_Source;
+ Unit : Name_Id := No_Name;
+ Index : Int := 0;
+ Source_To_Replace : Source_Id := No_Source);
-- Add a new source to the different lists: list of all sources in the
-- project tree, list of source of a project and list of sources of a
-- language.
+ -- If Path is specified, the file is also added to Source_Paths_HT.
+ -- If Source_To_Replace is specified, it points to the source in the
+ -- extended project that the new file is overriding.
function ALI_File_Name (Source : String) return String;
-- Return the ALI file name corresponding to a source
@@ -212,9 +276,12 @@ package body Prj.Nmsc is
procedure Check_Library_Attributes
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
+ Current_Dir : String;
Data : in out Project_Data);
-- Check the library attributes of project Project in project tree In_Tree
-- and modify its data Data accordingly.
+ -- Current_Dir should represent the current directory, and is passed for
+ -- efficiency to avoid system calls to recompute it
procedure Check_Package_Naming
(Project : Project_Id;
@@ -240,12 +307,23 @@ package body Prj.Nmsc is
-- extended by Root_Project.
procedure Check_Stand_Alone_Library
- (Project : Project_Id;
- In_Tree : Project_Tree_Ref;
- Data : in out Project_Data;
- Extending : Boolean);
+ (Project : Project_Id;
+ In_Tree : Project_Tree_Ref;
+ Data : in out Project_Data;
+ Current_Dir : String;
+ Extending : Boolean);
-- Check if project Project in project tree In_Tree is a Stand-Alone
-- Library project, and modify its data Data accordingly if it is one.
+ -- Current_Dir should represent the current directory, and is passed for
+ -- efficiency to avoid system calls to recompute it
+
+ procedure Get_Path_Names_And_Record_Ada_Sources
+ (Project : Project_Id;
+ In_Tree : Project_Tree_Ref;
+ Data : in out Project_Data;
+ Current_Dir : String);
+ -- Find the path names of the source files in the Source_Names table
+ -- in the source directories and record those that are Ada sources.
function Compute_Directory_Last (Dir : String) return Natural;
-- Return the index of the last significant character in Dir. This is used
@@ -264,27 +342,89 @@ package body Prj.Nmsc is
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
Data : in out Project_Data;
- Follow_Links : Boolean := False);
+ Current_Dir : String);
-- Find all the Ada sources in all of the source directories of a project
+ -- Current_Dir should represent the current directory, and is passed for
+ -- efficiency to avoid system calls to recompute it
procedure Find_Sources
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
Data : in out Project_Data;
For_Language : Language_Index;
- Follow_Links : Boolean := False);
+ Current_Dir : String);
-- Find all the sources in all of the source directories of a project for
-- a specified language.
+ procedure Search_Directories
+ (Project : Project_Id;
+ In_Tree : Project_Tree_Ref;
+ Data : in out Project_Data;
+ For_All_Sources : Boolean);
+ -- Search the source directories to find the sources.
+ -- If For_All_Sources is True, check each regular file name against
+ -- the naming schemes of the different languages. Otherwise consider
+ -- only the file names in the hash table Source_Names.
+
+ procedure Check_File
+ (Project : Project_Id;
+ In_Tree : Project_Tree_Ref;
+ Data : in out Project_Data;
+ Name : String;
+ File_Name : File_Name_Type;
+ Display_File_Name : File_Name_Type;
+ Source_Directory : String;
+ For_All_Sources : Boolean);
+ -- Check if file File_Name is a valid source of the project. This is used
+ -- in multi-language mode only.
+ -- When the file matches one of the naming schemes, it is added to
+ -- various htables through Add_Source and to Source_Paths_Htable.
+ --
+ -- Name is the name of the candidate file. It hasn't been normalized yet
+ -- and is the direct result of readdir().
+ --
+ -- File_Name is the same as Name, but has been normalized.
+ -- Display_File_Name, however, has not been normalized.
+ --
+ -- Source_Directory is the directory in which the file
+ -- was found. It hasn't been normalized (nor has had links resolved).
+ -- It should not end with a directory separator, to avoid duplicates
+ -- later on.
+ --
+ -- If For_All_Sources is True, then all possible file names are analyzed
+ -- otherwise only those currently set in the Source_Names htable.
+
+ procedure Check_Naming_Schemes
+ (In_Tree : Project_Tree_Ref;
+ Data : in out Project_Data;
+ Filename : String;
+ File_Name : File_Name_Type;
+ Alternate_Languages : out Alternate_Language_Id;
+ Language : out Language_Index;
+ Language_Name : out Name_Id;
+ Display_Language_Name : out Name_Id;
+ Unit : out Name_Id;
+ Lang_Kind : out Language_Kind;
+ Kind : out Source_Kind);
+ -- Check if the file name File_Name conforms to one of the naming
+ -- schemes of the project.
+ -- If the file does not match one of the naming schemes, set Language
+ -- to No_Language_Index.
+ -- Filename is the name of the file being investigated. It has been
+ -- normalized (case-folded). File_Name is the same value.
+
procedure Free_Ada_Naming_Exceptions;
-- Free the internal hash tables used for checking naming exceptions
procedure Get_Directories
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
+ Current_Dir : String;
Data : in out Project_Data);
-- Get the object directory, the exec directory and the source directories
-- of a project.
+ -- Current_Dir should represent the current directory, and is passed for
+ -- efficiency to avoid system calls to recompute it
procedure Get_Mains
(Project : Project_Id;
@@ -301,6 +441,17 @@ package body Prj.Nmsc is
-- Get the list of sources from a text file and put them in hash table
-- Source_Names.
+ procedure Find_Explicit_Sources
+ (Lang : Language_Index;
+ Current_Dir : String;
+ Project : Project_Id;
+ In_Tree : Project_Tree_Ref;
+ Data : in out Project_Data);
+ -- Process the Source_Files and Source_List_File attributes, and store
+ -- the list of source files into the Source_Names htable.
+ -- Lang indicates which language is being processed when in Ada_Only
+ -- mode (all languages are processed anyway when in Multi_Language mode)
+
procedure Get_Unit
(In_Tree : Project_Tree_Ref;
Canonical_File_Name : File_Name_Type;
@@ -329,6 +480,7 @@ package body Prj.Nmsc is
Dir : out Path_Name_Type;
Display : out Path_Name_Type;
Create : String := "";
+ Current_Dir : String;
Location : Source_Ptr := No_Location);
-- Locate a directory. Name is the directory name. Parent is the root
-- directory, if Name a relative path name. Dir is set to the canonical
@@ -337,15 +489,18 @@ package body Prj.Nmsc is
-- is True and Create is a non null string, an attempt is made to create
-- the directory. If the directory does not exist and Project_Setup is
-- false, then Dir and Display are set to No_Name.
+ -- Current_Dir should represent the current directory, and is passed for
+ -- efficiency to avoid system calls to recompute it
procedure Look_For_Sources
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
Data : in out Project_Data;
- Follow_Links : Boolean);
+ Current_Dir : String);
-- Find all the sources of project Project in project tree In_Tree and
- -- update its Data accordingly. Resolve symbolic links in the path names
- -- if Follow_Links is True.
+ -- update its Data accordingly.
+ -- Current_Dir should represent the current directory, and is passed for
+ -- efficiency to avoid system calls to recompute it
function Path_Name_Of
(File_Name : File_Name_Type;
@@ -376,9 +531,11 @@ package body Prj.Nmsc is
Location : Source_Ptr;
Current_Source : in out String_List_Id;
Source_Recorded : in out Boolean;
- Follow_Links : Boolean);
+ Current_Dir : String);
-- Put a unit in the list of units of a project, if the file name
-- corresponds to a valid unit name.
+ -- Current_Dir should represent the current directory, and is passed for
+ -- efficiency to avoid system calls to recompute it
procedure Record_Other_Sources
(Project : Project_Id;
@@ -430,25 +587,78 @@ package body Prj.Nmsc is
----------------
procedure Add_Source
- (Id : Source_Id;
- Data : in out Project_Data;
- In_Tree : Project_Tree_Ref)
+ (Id : out Source_Id;
+ Data : in out Project_Data;
+ In_Tree : Project_Tree_Ref;
+ Project : Project_Id;
+ Lang : Name_Id;
+ Lang_Id : Language_Index;
+ Kind : Source_Kind;
+ File_Name : File_Name_Type;
+ Display_File : File_Name_Type;
+ Lang_Kind : Language_Kind;
+ Naming_Exception : Boolean := False;
+ Path : Path_Name_Type := No_Path;
+ Display_Path : Path_Name_Type := No_Path;
+ Alternate_Languages : Alternate_Language_Id := No_Alternate_Language;
+ Other_Part : Source_Id := No_Source;
+ Unit : Name_Id := No_Name;
+ Index : Int := 0;
+ Source_To_Replace : Source_Id := No_Source)
is
- Language : constant Language_Index :=
- In_Tree.Sources.Table (Id).Language;
-
- Source : Source_Id;
+ Source : constant Source_Id := Data.Last_Source;
+ Src_Data : Source_Data := No_Source_Data;
begin
+ -- This is a new source. Create an entry for it in the Sources table.
+
+ Source_Data_Table.Increment_Last (In_Tree.Sources);
+ Id := Source_Data_Table.Last (In_Tree.Sources);
+
+ if Current_Verbosity = High then
+ Write_Str ("Adding source #");
+ Write_Str (Id'Img);
+ Write_Str (", File : ");
+
+ if Lang_Kind = Unit_Based then
+ Write_Str (", Unit : ");
+ Write_Str (Get_Name_String (Unit));
+ end if;
+
+ Write_Line (Get_Name_String (File_Name));
+ end if;
+
+ Src_Data.Project := Project;
+ Src_Data.Language_Name := Lang;
+ Src_Data.Language := Lang_Id;
+ Src_Data.Lang_Kind := Lang_Kind;
+ Src_Data.Kind := Kind;
+ Src_Data.Alternate_Languages := Alternate_Languages;
+ Src_Data.Other_Part := Other_Part;
+ Src_Data.Unit := Unit;
+ Src_Data.Index := Index;
+ Src_Data.File := File_Name;
+ Src_Data.Object := Object_Name (File_Name);
+ Src_Data.Display_File := Display_File;
+ Src_Data.Dependency :=
+ In_Tree.Languages_Data.Table (Lang_Id).Config.Dependency_Kind;
+ Src_Data.Dep_Name := Dependency_Name (File_Name, Src_Data.Dependency);
+ Src_Data.Switches := Switches_Name (File_Name);
+ Src_Data.Naming_Exception := Naming_Exception;
+
+ if Path /= No_Path then
+ Src_Data.Path := Path;
+ Src_Data.Display_Path := Display_Path;
+ Source_Paths_Htable.Set (In_Tree.Source_Paths_HT, Path, Id);
+ end if;
+
-- Add the source to the global list
- In_Tree.Sources.Table (Id).Next_In_Sources := In_Tree.First_Source;
+ Src_Data.Next_In_Sources := In_Tree.First_Source;
In_Tree.First_Source := Id;
-- Add the source to the project list
- Source := Data.Last_Source;
-
if Source = No_Source then
Data.First_Source := Id;
else
@@ -459,9 +669,15 @@ package body Prj.Nmsc is
-- Add the source to the language list
- In_Tree.Sources.Table (Id).Next_In_Lang :=
- In_Tree.Languages_Data.Table (Language).First_Source;
- In_Tree.Languages_Data.Table (Language).First_Source := Id;
+ Src_Data.Next_In_Lang :=
+ In_Tree.Languages_Data.Table (Lang_Id).First_Source;
+ In_Tree.Languages_Data.Table (Lang_Id).First_Source := Id;
+
+ In_Tree.Sources.Table (Id) := Src_Data;
+
+ if Source_To_Replace /= No_Source then
+ Remove_Source (Source_To_Replace, Id, Project, Data, In_Tree);
+ end if;
end Add_Source;
-------------------
@@ -493,12 +709,11 @@ package body Prj.Nmsc is
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
Report_Error : Put_Line_Access;
- Follow_Links : Boolean;
- When_No_Sources : Error_Warning)
+ When_No_Sources : Error_Warning;
+ Current_Dir : String)
is
Data : Project_Data := In_Tree.Projects.Table (Project);
Extending : Boolean := False;
-
Lang_Proc_Pkg : Package_Id;
Linker_Name : Variable_Value;
@@ -512,7 +727,7 @@ package body Prj.Nmsc is
-- Object, exec and source directories
- Get_Directories (Project, In_Tree, Data);
+ Get_Directories (Project, In_Tree, Current_Dir, Data);
-- Get the programming languages
@@ -520,13 +735,13 @@ package body Prj.Nmsc is
-- Check configuration in multi language mode
- if Get_Mode = Multi_Language then
+ if Must_Check_Configuration then
Check_Configuration (Project, In_Tree, Data);
end if;
-- Library attributes
- Check_Library_Attributes (Project, In_Tree, Data);
+ Check_Library_Attributes (Project, In_Tree, Current_Dir, Data);
if Current_Verbosity = High then
Show_Source_Dirs (Data, In_Tree);
@@ -548,7 +763,7 @@ package body Prj.Nmsc is
-- Find the sources
if Data.Source_Dirs /= Nil_String then
- Look_For_Sources (Project, In_Tree, Data, Follow_Links);
+ Look_For_Sources (Project, In_Tree, Data, Current_Dir);
if Get_Mode = Ada_Only then
@@ -617,7 +832,8 @@ package body Prj.Nmsc is
-- If it is a library project file, check if it is a standalone library
if Data.Library then
- Check_Stand_Alone_Library (Project, In_Tree, Data, Extending);
+ Check_Stand_Alone_Library
+ (Project, In_Tree, Data, Current_Dir, Extending);
end if;
-- Put the list of Mains, if any, in the project data
@@ -670,11 +886,12 @@ package body Prj.Nmsc is
OK : Boolean := The_Name'Length > 0;
First : Positive;
- function Is_Reserved (S : String) return Boolean;
- -- Check that the given name is not an Ada 95 reserved word. The
- -- reason for the Ada 95 here is that we do not want to exclude the case
- -- of an Ada 95 unit called Interface (for example). In Ada 2005, such
- -- a unit name would be rejected anyway by the compiler, so there is no
+ function Is_Reserved (Name : Name_Id) return Boolean;
+ function Is_Reserved (S : String) return Boolean;
+ -- Check that the given name is not an Ada 95 reserved word. The reason
+ -- for the Ada 95 here is that we do not want to exclude the case of an
+ -- Ada 95 unit called Interface (for example). In Ada 2005, such a unit
+ -- name would be rejected anyway by the compiler. That means there is no
-- requirement that the project file parser reject this.
-----------------
@@ -682,13 +899,18 @@ package body Prj.Nmsc is
-----------------
function Is_Reserved (S : String) return Boolean is
- Name : Name_Id;
-
begin
Name_Len := 0;
Add_Str_To_Name_Buffer (S);
- Name := Name_Find;
+ return Is_Reserved (Name_Find);
+ end Is_Reserved;
+ -----------------
+ -- Is_Reserved --
+ -----------------
+
+ function Is_Reserved (Name : Name_Id) return Boolean is
+ begin
if Get_Name_Table_Byte (Name) /= 0
and then Name /= Name_Project
and then Name /= Name_Extends
@@ -735,7 +957,7 @@ package body Prj.Nmsc is
Real_Name := Name_Find;
- if Is_Reserved (Name_Buffer (1 .. Name_Len)) then
+ if Is_Reserved (Real_Name) then
return;
end if;
@@ -903,7 +1125,7 @@ package body Prj.Nmsc is
(Spec_Suffix, Dot_Replacement = ".")
then
Err_Vars.Error_Msg_File_1 :=
- Spec_Suffix_Id_Of (In_Tree, "ada", Naming);
+ Spec_Suffix_Id_Of (In_Tree, Name_Ada, Naming);
Error_Msg
(Project, In_Tree,
"{ is illegal for Spec_Suffix",
@@ -914,7 +1136,7 @@ package body Prj.Nmsc is
(Body_Suffix, Dot_Replacement = ".")
then
Err_Vars.Error_Msg_File_1 :=
- Body_Suffix_Id_Of (In_Tree, "ada", Naming);
+ Body_Suffix_Id_Of (In_Tree, Name_Ada, Naming);
Error_Msg
(Project, In_Tree,
"{ is illegal for Body_Suffix",
@@ -933,40 +1155,29 @@ package body Prj.Nmsc is
end if;
end if;
- -- Spec_Suffix cannot have the same termination as
- -- Body_Suffix or Separate_Suffix
+ -- Spec_Suffix cannot be equal to Body_Suffix Separate_Suffix,
+ -- since that would cause a clear ambiguity. Note that we do
+ -- allow a Spec_Suffix to have the same termination as one of
+ -- these, which causes a potential ambiguity, but we resolve
+ -- that my matching the longest possible suffix.
- if Spec_Suffix'Length <= Body_Suffix'Length
- and then
- Body_Suffix (Body_Suffix'Last -
- Spec_Suffix'Length + 1 ..
- Body_Suffix'Last) = Spec_Suffix
- then
+ if Spec_Suffix = Body_Suffix then
Error_Msg
(Project, In_Tree,
"Body_Suffix (""" &
Body_Suffix &
- """) cannot end with" &
- " Spec_Suffix (""" &
- Spec_Suffix & """).",
+ """) cannot be the same as Spec_Suffix.",
Naming.Ada_Body_Suffix_Loc);
end if;
if Body_Suffix /= Separate_Suffix
- and then Spec_Suffix'Length <= Separate_Suffix'Length
- and then
- Separate_Suffix
- (Separate_Suffix'Last - Spec_Suffix'Length + 1
- ..
- Separate_Suffix'Last) = Spec_Suffix
+ and then Spec_Suffix = Separate_Suffix
then
Error_Msg
(Project, In_Tree,
"Separate_Suffix (""" &
Separate_Suffix &
- """) cannot end with" &
- " Spec_Suffix (""" &
- Spec_Suffix & """).",
+ """) cannot be the same as Spec_Suffix.",
Naming.Sep_Suffix_Loc);
end if;
end;
@@ -989,6 +1200,9 @@ package body Prj.Nmsc is
Lang_Index : Language_Index := No_Language_Index;
-- The index of the language data being checked
+ Prev_Index : Language_Index := No_Language_Index;
+ -- The index of the previous language
+
Current_Language : Name_Id := No_Name;
-- The name of the language
@@ -1207,42 +1421,46 @@ package body Prj.Nmsc is
-- Attribute Dependency_Switches (<language>)
+ if In_Tree.Languages_Data.Table
+ (Lang_Index).Config.Dependency_Kind = None
+ then
+ In_Tree.Languages_Data.Table
+ (Lang_Index).Config.Dependency_Kind :=
+ Makefile;
+ end if;
+
List := Element.Value.Values;
- if List = Nil_String then
- Error_Msg
- (Project,
- In_Tree,
- "dependency option cannot be null",
- Element.Value.Location);
+ if List /= Nil_String then
+ Put (Into_List =>
+ In_Tree.Languages_Data.Table
+ (Lang_Index).Config.Dependency_Option,
+ From_List => List,
+ In_Tree => In_Tree);
end if;
- Put (Into_List =>
- In_Tree.Languages_Data.Table
- (Lang_Index).Config.Dependency_Option,
- From_List => List,
- In_Tree => In_Tree);
-
when Name_Dependency_Driver =>
-- Attribute Dependency_Driver (<language>)
+ if In_Tree.Languages_Data.Table
+ (Lang_Index).Config.Dependency_Kind = None
+ then
+ In_Tree.Languages_Data.Table
+ (Lang_Index).Config.Dependency_Kind :=
+ Makefile;
+ end if;
+
List := Element.Value.Values;
- if List = Nil_String then
- Error_Msg
- (Project,
- In_Tree,
- "compute dependency cannot be null",
- Element.Value.Location);
+ if List /= Nil_String then
+ Put (Into_List =>
+ In_Tree.Languages_Data.Table
+ (Lang_Index).Config.Compute_Dependency,
+ From_List => List,
+ In_Tree => In_Tree);
end if;
- Put (Into_List =>
- In_Tree.Languages_Data.Table
- (Lang_Index).Config.Compute_Dependency,
- From_List => List,
- In_Tree => In_Tree);
-
when Name_Include_Switches =>
-- Attribute Include_Switches (<language>)
@@ -2042,7 +2260,27 @@ package body Prj.Nmsc is
Current_Language := Lang_Data.Display_Name;
- if Lang_Data.Name = Name_Ada then
+ -- For all languages, Compiler_Driver needs to be specified
+
+ if Lang_Data.Config.Compiler_Driver = No_File then
+ Error_Msg_Name_1 := Current_Language;
+ Error_Msg
+ (Project,
+ In_Tree,
+ "?no compiler specified for language %%" &
+ ", ignoring all its sources",
+ No_Location);
+
+ if Lang_Index = Data.First_Language_Processing then
+ Data.First_Language_Processing :=
+ Lang_Data.Next;
+ else
+ In_Tree.Languages_Data.Table (Prev_Index).Next :=
+ Lang_Data.Next;
+ end if;
+
+ elsif Lang_Data.Name = Name_Ada then
+ Prev_Index := Lang_Index;
-- For unit based languages, Dot_Replacement, Spec_Suffix and
-- Body_Suffix need to be specified.
@@ -2072,32 +2310,23 @@ package body Prj.Nmsc is
end if;
else
+ Prev_Index := Lang_Index;
+
-- For file based languages, either Spec_Suffix or Body_Suffix
-- need to be specified.
if Lang_Data.Config.Naming_Data.Spec_Suffix = No_File and then
Lang_Data.Config.Naming_Data.Body_Suffix = No_File
then
+ Error_Msg_Name_1 := Current_Language;
Error_Msg
(Project,
In_Tree,
- "no suffixes specified for " &
- Get_Name_String (Current_Language),
+ "no suffixes specified for %%",
No_Location);
end if;
end if;
- -- For all languages, Compiler_Driver needs to be specified
-
- if Lang_Data.Config.Compiler_Driver = No_File then
- Error_Msg
- (Project,
- In_Tree,
- "no compiler specified for " &
- Get_Name_String (Current_Language),
- No_Location);
- end if;
-
Lang_Index := Lang_Data.Next;
end loop;
end Check_Configuration;
@@ -2137,9 +2366,6 @@ package body Prj.Nmsc is
end if;
declare
- Path : constant String := Get_Name_String (Path_Name);
- C_Path : String := Path;
-
Path_Id : Path_Name_Type;
C_Path_Id : Path_Name_Type;
-- The path name id (in canonical case)
@@ -2166,23 +2392,32 @@ package body Prj.Nmsc is
Source_Id : Other_Source_Id := Data.First_Other_Source;
begin
- Canonical_Case_File_Name (C_Path);
-
-- Get the file name id
- Name_Len := Name'Length;
- Name_Buffer (1 .. Name_Len) := Name;
- File_Id := Name_Find;
+ if Osint.File_Names_Case_Sensitive then
+ File_Id := File_Name;
+ else
+ Name_Len := Name'Length;
+ Name_Buffer (1 .. Name_Len) := Name;
+ File_Id := Name_Find;
+ end if;
-- Get the path name id
- Name_Len := Path'Length;
- Name_Buffer (1 .. Name_Len) := Path;
- Path_Id := Name_Find;
+ Path_Id := Path_Name;
- Name_Len := C_Path'Length;
- Name_Buffer (1 .. Name_Len) := C_Path;
- C_Path_Id := Name_Find;
+ if Osint.File_Names_Case_Sensitive then
+ C_Path_Id := Path_Name;
+ else
+ declare
+ C_Path : String := Get_Name_String (Path_Name);
+ begin
+ Canonical_Case_File_Name (C_Path);
+ Name_Len := C_Path'Length;
+ Name_Buffer (1 .. Name_Len) := C_Path;
+ C_Path_Id := Name_Find;
+ end;
+ end if;
-- Find the position of the last dot
@@ -2256,7 +2491,6 @@ package body Prj.Nmsc is
Source := In_Tree.Other_Sources.Table (Source_Id);
if Source.File_Name = File_Id then
-
-- Two sources of different languages cannot have the same
-- file name.
@@ -2418,9 +2652,9 @@ package body Prj.Nmsc is
end if;
end Check_If_Externally_Built;
- -----------------------------
+ --------------------------
-- Check_Naming_Schemes --
- -----------------------------
+ --------------------------
procedure Check_Naming_Schemes
(Data : in out Project_Data;
@@ -2456,9 +2690,11 @@ package body Prj.Nmsc is
-- Put file name in canonical case
- Get_Name_String (Element.Value.Value);
- Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
- Element.Value.Value := Name_Find;
+ if not Osint.File_Names_Case_Sensitive then
+ Get_Name_String (Element.Value.Value);
+ Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
+ Element.Value.Value := Name_Find;
+ end if;
-- Check that it contains a valid unit name
@@ -2499,6 +2735,7 @@ package body Prj.Nmsc is
File_Name : File_Name_Type;
Lang_Id : Language_Index;
Lang : Name_Id;
+ Lang_Kind : Language_Kind;
Source : Source_Id;
begin
@@ -2523,6 +2760,8 @@ package body Prj.Nmsc is
File_Based
then
Lang := In_Tree.Languages_Data.Table (Lang_Id).Name;
+ Lang_Kind :=
+ In_Tree.Languages_Data.Table (Lang_Id).Config.Kind;
Exception_List := Value_Of
(Index => Lang,
@@ -2531,14 +2770,16 @@ package body Prj.Nmsc is
if Exception_List /= Nil_Variable_Value then
Element_Id := Exception_List.Values;
-
while Element_Id /= Nil_String loop
- Element :=
- In_Tree.String_Elements.Table (Element_Id);
- Get_Name_String (Element.Value);
- Canonical_Case_File_Name
- (Name_Buffer (1 .. Name_Len));
- File_Name := Name_Find;
+ Element := In_Tree.String_Elements.Table (Element_Id);
+
+ if Osint.File_Names_Case_Sensitive then
+ File_Name := File_Name_Type (Element.Value);
+ else
+ Get_Name_String (Element.Value);
+ Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
+ File_Name := Name_Find;
+ end if;
Source := Data.First_Source;
while Source /= No_Source
@@ -2550,42 +2791,18 @@ package body Prj.Nmsc is
end loop;
if Source = No_Source then
-
- -- This is a new source. Create an entry for it
- -- in the Sources table.
-
- Source_Data_Table.Increment_Last (In_Tree.Sources);
- Source := Source_Data_Table.Last (In_Tree.Sources);
-
- if Current_Verbosity = High then
- Write_Str ("Adding source #");
- Write_Str (Source'Img);
- Write_Str (", File : ");
- Write_Line (Get_Name_String (File_Name));
- end if;
-
- declare
- Src_Data : Source_Data := No_Source_Data;
- begin
- Src_Data.Project := Project;
- Src_Data.Language_Name := Lang;
- Src_Data.Language := Lang_Id;
- Src_Data.Kind := Kind;
- Src_Data.File := File_Name;
- Src_Data.Display_File :=
- File_Name_Type (Element.Value);
- Src_Data.Object := Object_Name (File_Name);
- Src_Data.Dependency :=
- In_Tree.Languages_Data.Table
- (Lang_Id).Config.Dependency_Kind;
- Src_Data.Dep_Name :=
- Dependency_Name (File_Name, Src_Data.Dependency);
- Src_Data.Switches := Switches_Name (File_Name);
- Src_Data.Naming_Exception := True;
- In_Tree.Sources.Table (Source) := Src_Data;
- end;
-
- Add_Source (Source, Data, In_Tree);
+ Add_Source
+ (Id => Source,
+ Data => Data,
+ In_Tree => In_Tree,
+ Project => Project,
+ Lang => Lang,
+ Lang_Id => Lang_Id,
+ Kind => Kind,
+ File_Name => File_Name,
+ Display_File => File_Name_Type (Element.Value),
+ Naming_Exception => True,
+ Lang_Kind => Lang_Kind);
else
-- Check if the file name is already recorded for
@@ -2645,7 +2862,7 @@ package body Prj.Nmsc is
Source_To_Replace : Source_Id := No_Source;
Other_Project : Project_Id;
- Other_Part : Source_Id;
+ Other_Part : Source_Id := No_Source;
begin
if Lang_Id = No_Language_Index or else Lang = No_Name then
@@ -2685,9 +2902,13 @@ package body Prj.Nmsc is
while Exceptions /= No_Array_Element loop
Element := In_Tree.Array_Elements.Table (Exceptions);
- Get_Name_String (Element.Value.Value);
- Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
- File_Name := Name_Find;
+ if Osint.File_Names_Case_Sensitive then
+ File_Name := File_Name_Type (Element.Value.Value);
+ else
+ Get_Name_String (Element.Value.Value);
+ Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
+ File_Name := Name_Find;
+ end if;
Get_Name_String (Element.Index);
To_Lower (Name_Buffer (1 .. Name_Len));
@@ -2765,48 +2986,22 @@ package body Prj.Nmsc is
end if;
if Source = No_Source then
- Source_Data_Table.Increment_Last (In_Tree.Sources);
- Source := Source_Data_Table.Last (In_Tree.Sources);
-
- if Current_Verbosity = High then
- Write_Str ("Adding source #");
- Write_Str (Source'Img);
- Write_Str (", File : ");
- Write_Str (Get_Name_String (File_Name));
- Write_Str (", Unit : ");
- Write_Line (Get_Name_String (Unit));
- end if;
-
- declare
- Src_Data : Source_Data := No_Source_Data;
-
- begin
- Src_Data.Project := Project;
- Src_Data.Language_Name := Lang;
- Src_Data.Language := Lang_Id;
- Src_Data.Kind := Kind;
- Src_Data.Other_Part := Other_Part;
- Src_Data.Unit := Unit;
- Src_Data.Index := Index;
- Src_Data.File := File_Name;
- Src_Data.Object := Object_Name (File_Name);
- Src_Data.Display_File :=
- File_Name_Type (Element.Value.Value);
- Src_Data.Dependency := In_Tree.Languages_Data.Table
- (Lang_Id).Config.Dependency_Kind;
- Src_Data.Dep_Name :=
- Dependency_Name (File_Name, Src_Data.Dependency);
- Src_Data.Switches := Switches_Name (File_Name);
- Src_Data.Naming_Exception := True;
- In_Tree.Sources.Table (Source) := Src_Data;
- end;
-
- Add_Source (Source, Data, In_Tree);
-
- if Source_To_Replace /= No_Source then
- Remove_Source
- (Source_To_Replace, Source, Project, Data, In_Tree);
- end if;
+ Add_Source
+ (Id => Source,
+ Data => Data,
+ In_Tree => In_Tree,
+ Project => Project,
+ Lang => Lang,
+ Lang_Id => Lang_Id,
+ Kind => Kind,
+ File_Name => File_Name,
+ Display_File => File_Name_Type (Element.Value.Value),
+ Lang_Kind => Unit_Based,
+ Other_Part => Other_Part,
+ Unit => Unit,
+ Index => Index,
+ Naming_Exception => True,
+ Source_To_Replace => Source_To_Replace);
end if;
end if;
@@ -2903,8 +3098,13 @@ package body Prj.Nmsc is
Dot_Replacement.Location);
else
- Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
- Data.Naming.Dot_Replacement := Name_Find;
+ if Osint.File_Names_Case_Sensitive then
+ Data.Naming.Dot_Replacement :=
+ File_Name_Type (Dot_Replacement.Value);
+ else
+ Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
+ Data.Naming.Dot_Replacement := Name_Find;
+ end if;
Data.Naming.Dot_Repl_Loc := Dot_Replacement.Location;
end if;
end if;
@@ -3052,7 +3252,7 @@ package body Prj.Nmsc is
begin
if Ada_Sep_Suffix.Default then
Data.Naming.Separate_Suffix :=
- Body_Suffix_Id_Of (In_Tree, "ada", Data.Naming);
+ Body_Suffix_Id_Of (In_Tree, Name_Ada, Data.Naming);
else
Get_Name_String (Ada_Sep_Suffix.Value);
@@ -3207,8 +3407,7 @@ package body Prj.Nmsc is
if Current_Verbosity = High then
Write_Str (" Separate_Suffix = """);
- Write_Str
- (Get_Name_String (Data.Naming.Separate_Suffix));
+ Write_Str (Get_Name_String (Separate_Suffix));
Write_Char ('"');
Write_Eol;
end if;
@@ -3332,6 +3531,7 @@ package body Prj.Nmsc is
procedure Check_Library_Attributes
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
+ Current_Dir : String;
Data : in out Project_Data)
is
Attributes : constant Prj.Variable_Id := Data.Decl.Attributes;
@@ -3466,172 +3666,178 @@ package body Prj.Nmsc is
end;
end if;
- pragma Assert (Lib_Dir.Kind = Single);
+ pragma Assert (Lib_Name.Kind = Single);
- if Lib_Dir.Value = Empty_String then
- if Current_Verbosity = High then
- Write_Line ("No library directory");
+ if Lib_Name.Value = Empty_String then
+ if Current_Verbosity = High
+ and then Data.Library_Name = No_Name
+ then
+ Write_Line ("No library name");
end if;
else
- -- Find path name, check that it is a directory
+ -- There is no restriction on the syntax of library names
- Locate_Directory
- (Project,
- In_Tree,
- File_Name_Type (Lib_Dir.Value),
- Data.Display_Directory,
- Data.Library_Dir,
- Data.Display_Library_Dir,
- Create => "library",
- Location => Lib_Dir.Location);
+ Data.Library_Name := Lib_Name.Value;
+ end if;
- if Data.Library_Dir = No_Path then
+ if Data.Library_Name /= No_Name then
+ if Current_Verbosity = High then
+ Write_Str ("Library name = """);
+ Write_Str (Get_Name_String (Data.Library_Name));
+ Write_Line ("""");
+ end if;
- -- Get the absolute name of the library directory that
- -- does not exist, to report an error.
+ pragma Assert (Lib_Dir.Kind = Single);
- declare
- Dir_Name : constant String := Get_Name_String (Lib_Dir.Value);
+ if Lib_Dir.Value = Empty_String then
+ if Current_Verbosity = High then
+ Write_Line ("No library directory");
+ end if;
- begin
- if Is_Absolute_Path (Dir_Name) then
- Err_Vars.Error_Msg_File_1 := File_Name_Type (Lib_Dir.Value);
+ else
+ -- Find path name, check that it is a directory
- else
- Get_Name_String (Data.Display_Directory);
+ Locate_Directory
+ (Project,
+ In_Tree,
+ File_Name_Type (Lib_Dir.Value),
+ Data.Display_Directory,
+ Data.Library_Dir,
+ Data.Display_Library_Dir,
+ Create => "library",
+ Current_Dir => Current_Dir,
+ Location => Lib_Dir.Location);
- if Name_Buffer (Name_Len) /= Directory_Separator then
- Name_Len := Name_Len + 1;
- Name_Buffer (Name_Len) := Directory_Separator;
- end if;
+ if Data.Library_Dir = No_Path then
- Name_Buffer
- (Name_Len + 1 .. Name_Len + Dir_Name'Length) :=
- Dir_Name;
- Name_Len := Name_Len + Dir_Name'Length;
- Err_Vars.Error_Msg_File_1 := Name_Find;
- end if;
+ -- Get the absolute name of the library directory that
+ -- does not exist, to report an error.
- -- Report the error
+ declare
+ Dir_Name : constant String :=
+ Get_Name_String (Lib_Dir.Value);
- Error_Msg
- (Project, In_Tree,
- "library directory { does not exist",
- Lib_Dir.Location);
- end;
+ begin
+ if Is_Absolute_Path (Dir_Name) then
+ Err_Vars.Error_Msg_File_1 :=
+ File_Name_Type (Lib_Dir.Value);
- -- The library directory cannot be the same as the Object directory
+ else
+ Get_Name_String (Data.Display_Directory);
- elsif Data.Library_Dir = Data.Object_Directory then
- Error_Msg
- (Project, In_Tree,
- "library directory cannot be the same " &
- "as object directory",
- Lib_Dir.Location);
- Data.Library_Dir := No_Path;
- Data.Display_Library_Dir := No_Path;
+ if Name_Buffer (Name_Len) /= Directory_Separator then
+ Name_Len := Name_Len + 1;
+ Name_Buffer (Name_Len) := Directory_Separator;
+ end if;
- else
- declare
- OK : Boolean := True;
- Dirs_Id : String_List_Id;
- Dir_Elem : String_Element;
+ Name_Buffer
+ (Name_Len + 1 .. Name_Len + Dir_Name'Length) :=
+ Dir_Name;
+ Name_Len := Name_Len + Dir_Name'Length;
+ Err_Vars.Error_Msg_File_1 := Name_Find;
+ end if;
- begin
- -- The library directory cannot be the same as a source
- -- directory of the current project.
+ -- Report the error
- Dirs_Id := Data.Source_Dirs;
- while Dirs_Id /= Nil_String loop
- Dir_Elem := In_Tree.String_Elements.Table (Dirs_Id);
- Dirs_Id := Dir_Elem.Next;
+ Error_Msg
+ (Project, In_Tree,
+ "library directory { does not exist",
+ Lib_Dir.Location);
+ end;
- if Data.Library_Dir = Path_Name_Type (Dir_Elem.Value) then
- Err_Vars.Error_Msg_File_1 :=
- File_Name_Type (Dir_Elem.Value);
- Error_Msg
- (Project, In_Tree,
- "library directory cannot be the same " &
- "as source directory {",
- Lib_Dir.Location);
- OK := False;
- exit;
- end if;
- end loop;
+ -- The library directory cannot be the same as the Object
+ -- directory.
- if OK then
+ elsif Data.Library_Dir = Data.Object_Directory then
+ Error_Msg
+ (Project, In_Tree,
+ "library directory cannot be the same " &
+ "as object directory",
+ Lib_Dir.Location);
+ Data.Library_Dir := No_Path;
+ Data.Display_Library_Dir := No_Path;
+ else
+ declare
+ OK : Boolean := True;
+ Dirs_Id : String_List_Id;
+ Dir_Elem : String_Element;
+
+ begin
-- The library directory cannot be the same as a source
- -- directory of another project either.
+ -- directory of the current project.
- Project_Loop :
- for Pid in 1 .. Project_Table.Last (In_Tree.Projects) loop
- if Pid /= Project then
- Dirs_Id := In_Tree.Projects.Table (Pid).Source_Dirs;
+ Dirs_Id := Data.Source_Dirs;
+ while Dirs_Id /= Nil_String loop
+ Dir_Elem := In_Tree.String_Elements.Table (Dirs_Id);
+ Dirs_Id := Dir_Elem.Next;
- Dir_Loop : while Dirs_Id /= Nil_String loop
- Dir_Elem := In_Tree.String_Elements.Table (Dirs_Id);
- Dirs_Id := Dir_Elem.Next;
+ if Data.Library_Dir = Path_Name_Type (Dir_Elem.Value) then
+ Err_Vars.Error_Msg_File_1 :=
+ File_Name_Type (Dir_Elem.Value);
+ Error_Msg
+ (Project, In_Tree,
+ "library directory cannot be the same " &
+ "as source directory {",
+ Lib_Dir.Location);
+ OK := False;
+ exit;
+ end if;
+ end loop;
- if Data.Library_Dir =
- Path_Name_Type (Dir_Elem.Value)
- then
- Err_Vars.Error_Msg_File_1 :=
- File_Name_Type (Dir_Elem.Value);
- Err_Vars.Error_Msg_Name_1 :=
- In_Tree.Projects.Table (Pid).Name;
+ if OK then
- Error_Msg
- (Project, In_Tree,
- "library directory cannot be the same " &
- "as source directory { of project %%",
- Lib_Dir.Location);
- OK := False;
- exit Project_Loop;
- end if;
- end loop Dir_Loop;
- end if;
- end loop Project_Loop;
- end if;
+ -- The library directory cannot be the same as a source
+ -- directory of another project either.
- if not OK then
- Data.Library_Dir := No_Path;
- Data.Display_Library_Dir := No_Path;
+ Project_Loop :
+ for Pid in 1 .. Project_Table.Last (In_Tree.Projects) loop
+ if Pid /= Project then
+ Dirs_Id := In_Tree.Projects.Table (Pid).Source_Dirs;
- elsif Current_Verbosity = High then
+ Dir_Loop : while Dirs_Id /= Nil_String loop
+ Dir_Elem :=
+ In_Tree.String_Elements.Table (Dirs_Id);
+ Dirs_Id := Dir_Elem.Next;
- -- Display the Library directory in high verbosity
+ if Data.Library_Dir =
+ Path_Name_Type (Dir_Elem.Value)
+ then
+ Err_Vars.Error_Msg_File_1 :=
+ File_Name_Type (Dir_Elem.Value);
+ Err_Vars.Error_Msg_Name_1 :=
+ In_Tree.Projects.Table (Pid).Name;
- Write_Str ("Library directory =""");
- Write_Str (Get_Name_String (Data.Display_Library_Dir));
- Write_Line ("""");
- end if;
- end;
- end if;
- end if;
+ Error_Msg
+ (Project, In_Tree,
+ "library directory cannot be the same " &
+ "as source directory { of project %%",
+ Lib_Dir.Location);
+ OK := False;
+ exit Project_Loop;
+ end if;
+ end loop Dir_Loop;
+ end if;
+ end loop Project_Loop;
+ end if;
- pragma Assert (Lib_Name.Kind = Single);
+ if not OK then
+ Data.Library_Dir := No_Path;
+ Data.Display_Library_Dir := No_Path;
- if Lib_Name.Value = Empty_String then
- if Current_Verbosity = High
- and then Data.Library_Name = No_Name
- then
- Write_Line ("No library name");
- end if;
+ elsif Current_Verbosity = High then
- else
- -- There is no restriction on the syntax of library names
+ -- Display the Library directory in high verbosity
- Data.Library_Name := Lib_Name.Value;
- end if;
+ Write_Str ("Library directory =""");
+ Write_Str (Get_Name_String (Data.Display_Library_Dir));
+ Write_Line ("""");
+ end if;
+ end;
+ end if;
+ end if;
- if Data.Library_Name /= No_Name
- and then Current_Verbosity = High
- then
- Write_Str ("Library name = """);
- Write_Str (Get_Name_String (Data.Library_Name));
- Write_Line ("""");
end if;
Data.Library :=
@@ -3673,6 +3879,7 @@ package body Prj.Nmsc is
Data.Library_ALI_Dir,
Data.Display_Library_ALI_Dir,
Create => "library ALI",
+ Current_Dir => Current_Dir,
Location => Lib_ALI_Dir.Location);
if Data.Library_ALI_Dir = No_Path then
@@ -4166,48 +4373,62 @@ package body Prj.Nmsc is
Data.Other_Sources_Present := False;
- elsif Def_Lang.Default then
- Error_Msg
- (Project,
- In_Tree,
- "no languages defined for this project",
- Data.Location);
-
else
- Get_Name_String (Def_Lang.Value);
- To_Lower (Name_Buffer (1 .. Name_Len));
- Def_Lang_Id := Name_Find;
- In_Tree.Name_Lists.Table (Data.Languages) :=
- (Name => Def_Lang_Id, Next => No_Name_List);
- Language_Data_Table.Increment_Last (In_Tree.Languages_Data);
- Data.First_Language_Processing :=
- Language_Data_Table.Last (In_Tree.Languages_Data);
- In_Tree.Languages_Data.Table
- (Data.First_Language_Processing) := No_Language_Data;
- In_Tree.Languages_Data.Table
- (Data.First_Language_Processing).Name := Def_Lang_Id;
- Get_Name_String (Def_Lang_Id);
- Name_Buffer (1) := GNAT.Case_Util.To_Upper (Name_Buffer (1));
- In_Tree.Languages_Data.Table
- (Data.First_Language_Processing).Display_Name := Name_Find;
+ -- If the configuration file does not define a language either
+
+ if Def_Lang.Default then
+ if not Default_Language_Is_Ada then
+ Error_Msg
+ (Project,
+ In_Tree,
+ "no languages defined for this project",
+ Data.Location);
+ Def_Lang_Id := No_Name;
+ else
+ Def_Lang_Id := Name_Ada;
+ end if;
- if Def_Lang_Id = Name_Ada then
- In_Tree.Languages_Data.Table
- (Data.First_Language_Processing).Config.Kind := Unit_Based;
- In_Tree.Languages_Data.Table
- (Data.First_Language_Processing).Config.Dependency_Kind :=
- ALI_File;
- Data.Unit_Based_Language_Name := Name_Ada;
- Data.Unit_Based_Language_Index :=
- Data.First_Language_Processing;
else
+ -- ??? Are we supporting a single default language in the
+ -- configuration file ?
+ Get_Name_String (Def_Lang.Value);
+ To_Lower (Name_Buffer (1 .. Name_Len));
+ Def_Lang_Id := Name_Find;
+ end if;
+
+ if Def_Lang_Id /= No_Name then
+ In_Tree.Name_Lists.Table (Data.Languages) :=
+ (Name => Def_Lang_Id, Next => No_Name_List);
+
+ Language_Data_Table.Increment_Last (In_Tree.Languages_Data);
+
+ Data.First_Language_Processing :=
+ Language_Data_Table.Last (In_Tree.Languages_Data);
In_Tree.Languages_Data.Table
- (Data.First_Language_Processing).Config.Kind := File_Based;
+ (Data.First_Language_Processing) := No_Language_Data;
In_Tree.Languages_Data.Table
- (Data.First_Language_Processing).Config.Dependency_Kind :=
- Makefile;
+ (Data.First_Language_Processing).Name := Def_Lang_Id;
+ Get_Name_String (Def_Lang_Id);
+ Name_Buffer (1) := GNAT.Case_Util.To_Upper (Name_Buffer (1));
+ In_Tree.Languages_Data.Table
+ (Data.First_Language_Processing).Display_Name := Name_Find;
+
+ if Def_Lang_Id = Name_Ada then
+ In_Tree.Languages_Data.Table
+ (Data.First_Language_Processing).Config.Kind
+ := Unit_Based;
+ In_Tree.Languages_Data.Table
+ (Data.First_Language_Processing).Config.Dependency_Kind
+ := ALI_File;
+ Data.Unit_Based_Language_Name := Name_Ada;
+ Data.Unit_Based_Language_Index :=
+ Data.First_Language_Processing;
+ else
+ In_Tree.Languages_Data.Table
+ (Data.First_Language_Processing).Config.Kind
+ := File_Based;
+ end if;
end if;
-
end if;
else
@@ -4313,7 +4534,7 @@ package body Prj.Nmsc is
else
Lang_Data.Config.Kind := File_Based;
- Lang_Data.Config.Dependency_Kind := Makefile;
+ Lang_Data.Config.Dependency_Kind := None;
end if;
In_Tree.Languages_Data.Table (Index) := Lang_Data;
@@ -4366,10 +4587,11 @@ package body Prj.Nmsc is
-------------------------------
procedure Check_Stand_Alone_Library
- (Project : Project_Id;
- In_Tree : Project_Tree_Ref;
- Data : in out Project_Data;
- Extending : Boolean)
+ (Project : Project_Id;
+ In_Tree : Project_Tree_Ref;
+ Data : in out Project_Data;
+ Current_Dir : String;
+ Extending : Boolean)
is
Lib_Interfaces : constant Prj.Variable_Value :=
Prj.Util.Value_Of
@@ -4756,6 +4978,7 @@ package body Prj.Nmsc is
Data.Library_Src_Dir,
Data.Display_Library_Src_Dir,
Create => "library source copy",
+ Current_Dir => Current_Dir,
Location => Lib_Src_Dir.Location);
-- If directory does not exist, report an error
@@ -4794,6 +5017,7 @@ package body Prj.Nmsc is
-- Report the error
+ Error_Msg_File_1 := Dir_Id;
Error_Msg
(Project, In_Tree,
"Directory { does not exist",
@@ -4944,7 +5168,7 @@ package body Prj.Nmsc is
end if;
else
- -- Library_Symbol_File is defined.
+ -- Library_Symbol_File is defined
Data.Symbol_Data.Symbol_File :=
Path_Name_Type (Lib_Symbol_File.Value);
@@ -5063,11 +5287,17 @@ package body Prj.Nmsc is
(Get_Name_String
(Data.Object_Directory) &
Directory_Separator &
- Name_Buffer (1 .. Name_Len));
+ Name_Buffer (1 .. Name_Len),
+ Directory => Current_Dir,
+ Resolve_Links =>
+ Opt.Follow_Links_For_Files);
Ref_Path : constant String :=
Normalize_Pathname
(Get_Name_String
- (Data.Symbol_Data.Reference));
+ (Data.Symbol_Data.Reference),
+ Directory => Current_Dir,
+ Resolve_Links =>
+ Opt.Follow_Links_For_Files);
begin
if Symb_Path = Ref_Path then
Error_Msg
@@ -5263,7 +5493,7 @@ package body Prj.Nmsc is
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
Data : in out Project_Data;
- Follow_Links : Boolean := False)
+ Current_Dir : String)
is
Source_Dir : String_List_Id := Data.Source_Dirs;
Element : String_Element;
@@ -5299,8 +5529,8 @@ package body Prj.Nmsc is
-- We look at every entry in the source directory
- Open (Dir, Source_Directory
- (Source_Directory'First .. Dir_Last));
+ Open (Dir,
+ Source_Directory (Source_Directory'First .. Dir_Last));
loop
Read (Dir, Name_Buffer, Name_Len);
@@ -5314,13 +5544,25 @@ package body Prj.Nmsc is
declare
File_Name : constant File_Name_Type := Name_Find;
- Path : constant String :=
- Normalize_Pathname
- (Name => Name_Buffer (1 .. Name_Len),
- Directory => Source_Directory
- (Source_Directory'First .. Dir_Last),
- Resolve_Links => Follow_Links,
- Case_Sensitive => True);
+
+ -- ??? We could probably optimize the following call:
+ -- we need to resolve links only once for the
+ -- directory itself, and then do a single call to
+ -- readlink() for each file. Unfortunately that would
+ -- require a change in Normalize_Pathname so that it
+ -- has the option of not resolving links for its
+ -- Directory parameter, only for Name.
+
+ Path : constant String :=
+ Normalize_Pathname
+ (Name => Name_Buffer (1 .. Name_Len),
+ Directory =>
+ Source_Directory
+ (Source_Directory'First .. Dir_Last),
+ Resolve_Links =>
+ Opt.Follow_Links_For_Files,
+ Case_Sensitive => True);
+
Path_Name : Path_Name_Type;
begin
@@ -5329,9 +5571,9 @@ package body Prj.Nmsc is
Path_Name := Name_Find;
-- We attempt to register it as a source. However,
- -- there is no error if the file does not contain
- -- a valid source. But there is an error if we have
- -- a duplicate unit name.
+ -- there is no error if the file does not contain a
+ -- valid source. But there is an error if we have a
+ -- duplicate unit name.
Record_Ada_Source
(File_Name => File_Name,
@@ -5342,7 +5584,7 @@ package body Prj.Nmsc is
Location => No_Location,
Current_Source => Current_Source,
Source_Recorded => Source_Recorded,
- Follow_Links => Follow_Links);
+ Current_Dir => Current_Dir);
end;
end loop;
@@ -5367,15 +5609,6 @@ package body Prj.Nmsc is
Write_Line ("end Looking for sources.");
end if;
- -- If we have looked for sources and found none, then it is an error,
- -- except if it is an extending project. If a non extending project is
- -- not supposed to contain any source, then never call Find_Ada_Sources.
-
- if Current_Source = Nil_String and then
- Data.Extends = No_Project
- then
- Report_No_Sources (Project, "Ada", In_Tree, Data.Location);
- end if;
end Find_Ada_Sources;
------------------
@@ -5387,7 +5620,7 @@ package body Prj.Nmsc is
In_Tree : Project_Tree_Ref;
Data : in out Project_Data;
For_Language : Language_Index;
- Follow_Links : Boolean := False)
+ Current_Dir : String)
is
Source_Dir : String_List_Id;
Element : String_Element;
@@ -5447,7 +5680,7 @@ package body Prj.Nmsc is
(Name => Name_Buffer (1 .. Name_Len),
Directory => Source_Directory
(Source_Directory'First .. Dir_Last),
- Resolve_Links => Follow_Links,
+ Resolve_Links => Opt.Follow_Links_For_Files,
Case_Sensitive => True);
Path_Name : Path_Name_Type;
@@ -5472,7 +5705,7 @@ package body Prj.Nmsc is
Location => No_Location,
Current_Source => Current_Source,
Source_Recorded => Source_Recorded,
- Follow_Links => Follow_Links);
+ Current_Dir => Current_Dir);
else
Check_For_Source
@@ -5543,9 +5776,10 @@ package body Prj.Nmsc is
---------------------
procedure Get_Directories
- (Project : Project_Id;
- In_Tree : Project_Tree_Ref;
- Data : in out Project_Data)
+ (Project : Project_Id;
+ In_Tree : Project_Tree_Ref;
+ Current_Dir : String;
+ Data : in out Project_Data)
is
Object_Dir : constant Variable_Value :=
Util.Value_Of
@@ -5611,7 +5845,10 @@ package body Prj.Nmsc is
Canonical_Path : Name_Id := No_Name;
The_Path : constant String :=
- Normalize_Pathname (Get_Name_String (Path)) &
+ Normalize_Pathname
+ (Get_Name_String (Path),
+ Directory => Current_Dir,
+ Resolve_Links => Opt.Follow_Links_For_Dirs) &
Directory_Separator;
The_Path_Last : constant Natural :=
@@ -5622,9 +5859,14 @@ package body Prj.Nmsc is
Name_Buffer (1 .. Name_Len) :=
The_Path (The_Path'First .. The_Path_Last);
Non_Canonical_Path := Name_Find;
- Get_Name_String (Non_Canonical_Path);
- Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
- Canonical_Path := Name_Find;
+
+ if Osint.File_Names_Case_Sensitive then
+ Canonical_Path := Non_Canonical_Path;
+ else
+ Get_Name_String (Non_Canonical_Path);
+ Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
+ Canonical_Path := Name_Find;
+ end if;
-- To avoid processing the same directory several times, check
-- if the directory is already in Recursive_Dirs. If it is, then
@@ -5729,17 +5971,15 @@ package body Prj.Nmsc is
declare
Path_Name : constant String :=
- Normalize_Pathname
- (Name => Name (1 .. Last),
- Directory =>
- The_Path
- (The_Path'First .. The_Path_Last),
- Resolve_Links => False,
- Case_Sensitive => True);
+ Normalize_Pathname
+ (Name => Name (1 .. Last),
+ Directory =>
+ The_Path (The_Path'First .. The_Path_Last),
+ Resolve_Links => Opt.Follow_Links_For_Dirs,
+ Case_Sensitive => True);
begin
if Is_Directory (Path_Name) then
-
-- We have found a new subdirectory, call self
Name_Len := Path_Name'Length;
@@ -5854,12 +6094,13 @@ package body Prj.Nmsc is
begin
Locate_Directory
- (Project,
- In_Tree,
- From,
- Data.Display_Directory,
- Path_Name,
- Display_Path_Name);
+ (Project => Project,
+ In_Tree => In_Tree,
+ Name => From,
+ Parent => Data.Display_Directory,
+ Dir => Path_Name,
+ Display => Display_Path_Name,
+ Current_Dir => Current_Dir);
if Path_Name = No_Path then
Err_Vars.Error_Msg_File_1 := From;
@@ -6013,7 +6254,8 @@ package body Prj.Nmsc is
Data.Object_Directory,
Data.Display_Object_Dir,
Create => "object",
- Location => Object_Dir.Location);
+ Location => Object_Dir.Location,
+ Current_Dir => Current_Dir);
if Data.Object_Directory = No_Path then
@@ -6035,9 +6277,14 @@ package body Prj.Nmsc is
-- could create the non existent directory.
Data.Display_Object_Dir := Path_Name_Type (Object_Dir.Value);
- Get_Name_String (Object_Dir.Value);
- Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
- Data.Object_Directory := Name_Find;
+
+ if Osint.File_Names_Case_Sensitive then
+ Data.Object_Directory := Path_Name_Type (Object_Dir.Value);
+ else
+ Get_Name_String (Object_Dir.Value);
+ Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
+ Data.Object_Directory := Name_Find;
+ end if;
end if;
end if;
end if;
@@ -6082,7 +6329,8 @@ package body Prj.Nmsc is
Data.Exec_Directory,
Data.Display_Exec_Dir,
Create => "exec",
- Location => Exec_Dir.Location);
+ Location => Exec_Dir.Location,
+ Current_Dir => Current_Dir);
if Data.Exec_Directory = No_Path then
Err_Vars.Error_Msg_File_1 := File_Name_Type (Exec_Dir.Value);
@@ -6216,9 +6464,12 @@ package body Prj.Nmsc is
while Current /= Nil_String loop
Element := In_Tree.String_Elements.Table (Current);
if Element.Value /= No_Name then
- Get_Name_String (Element.Value);
- Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
- Element.Value := Name_Find;
+ if not Osint.File_Names_Case_Sensitive then
+ Get_Name_String (Element.Value);
+ Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
+ Element.Value := Name_Find;
+ end if;
+
In_Tree.String_Elements.Table (Current) := Element;
end if;
@@ -6306,12 +6557,25 @@ package body Prj.Nmsc is
if Last /= 0
and then (Last = 1 or else Line (1 .. 2) /= "--")
then
- -- ??? we should check that there is no directory information
-
Name_Len := Last;
Name_Buffer (1 .. Name_Len) := Line (1 .. Last);
Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
Source_Name := Name_Find;
+
+ -- Check that there is no directory information
+
+ for J in 1 .. Last loop
+ if Line (J) = '/' or else Line (J) = Directory_Separator then
+ Error_Msg_File_1 := Source_Name;
+ Error_Msg
+ (Project,
+ In_Tree,
+ "file name cannot include directory information ({)",
+ Location);
+ exit;
+ end if;
+ end loop;
+
Name_Loc := Source_Names.Get (Source_Name);
if Name_Loc = No_Name_Location then
@@ -6378,98 +6642,131 @@ package body Prj.Nmsc is
Get_Name_String (Canonical_File_Name);
+ -- How about some comments and a name for this declare block ???
+ -- In fact the whole code below needs more comments ???
+
declare
File : String := Name_Buffer (1 .. Name_Len);
First : constant Positive := File'First;
Last : Natural := File'Last;
Standard_GNAT : Boolean;
+ Spec : constant File_Name_Type :=
+ Spec_Suffix_Id_Of (In_Tree, Name_Ada, Naming);
+ Body_Suff : constant File_Name_Type :=
+ Body_Suffix_Id_Of (In_Tree, Name_Ada, Naming);
begin
- Standard_GNAT :=
- Spec_Suffix_Id_Of (In_Tree, "ada", Naming) = Default_Ada_Spec_Suffix
- and then
- Body_Suffix_Id_Of (In_Tree, "ada", Naming) = Default_Ada_Body_Suffix;
-
- -- Check if the end of the file name is Specification_Append
-
- Get_Name_String (Spec_Suffix_Id_Of (In_Tree, "ada", Naming));
+ Standard_GNAT := Spec = Default_Ada_Spec_Suffix
+ and then Body_Suff = Default_Ada_Body_Suffix;
- if File'Length > Name_Len
- and then File (Last - Name_Len + 1 .. Last) =
- Name_Buffer (1 .. Name_Len)
- then
- -- We have a spec
-
- Unit_Kind := Specification;
- Last := Last - Name_Len;
+ declare
+ Spec_Suffix : constant String := Get_Name_String (Spec);
+ Body_Suffix : constant String := Get_Name_String (Body_Suff);
+ Sep_Suffix : constant String :=
+ Get_Name_String (Naming.Separate_Suffix);
- if Current_Verbosity = High then
- Write_Str (" Specification: ");
- Write_Line (File (First .. Last));
- end if;
+ May_Be_Spec : Boolean;
+ May_Be_Body : Boolean;
+ May_Be_Sep : Boolean;
- else
- Get_Name_String (Body_Suffix_Id_Of (In_Tree, "ada", Naming));
+ begin
+ May_Be_Spec :=
+ File'Length > Spec_Suffix'Length
+ and then
+ File (Last - Spec_Suffix'Length + 1 .. Last) = Spec_Suffix;
- -- Check if the end of the file name is Body_Append
+ May_Be_Body :=
+ File'Length > Body_Suffix'Length
+ and then
+ File (Last - Body_Suffix'Length + 1 .. Last) = Body_Suffix;
- if File'Length > Name_Len
- and then File (Last - Name_Len + 1 .. Last) =
- Name_Buffer (1 .. Name_Len)
- then
- -- We have a body
+ May_Be_Sep :=
+ File'Length > Sep_Suffix'Length
+ and then
+ File (Last - Sep_Suffix'Length + 1 .. Last) = Sep_Suffix;
- Unit_Kind := Body_Part;
- Last := Last - Name_Len;
+ -- If two May_Be_ booleans are True, always choose the longer one
- if Current_Verbosity = High then
- Write_Str (" Body: ");
- Write_Line (File (First .. Last));
- end if;
+ if May_Be_Spec then
+ if May_Be_Body and then
+ Spec_Suffix'Length < Body_Suffix'Length
+ then
+ Unit_Kind := Body_Part;
- elsif Naming.Separate_Suffix /=
- Body_Suffix_Id_Of (In_Tree, "ada", Naming)
- then
- Get_Name_String (Naming.Separate_Suffix);
+ if May_Be_Sep and then
+ Body_Suffix'Length < Sep_Suffix'Length
+ then
+ Last := Last - Sep_Suffix'Length;
+ May_Be_Body := False;
- -- Check if the end of the file name is Separate_Append
+ else
+ Last := Last - Body_Suffix'Length;
+ May_Be_Sep := False;
+ end if;
- if File'Length > Name_Len
- and then File (Last - Name_Len + 1 .. Last) =
- Name_Buffer (1 .. Name_Len)
+ elsif May_Be_Sep and then
+ Spec_Suffix'Length < Sep_Suffix'Length
then
- -- We have a separate (a body)
-
Unit_Kind := Body_Part;
- Last := Last - Name_Len;
+ Last := Last - Sep_Suffix'Length;
- if Current_Verbosity = High then
- Write_Str (" Separate: ");
- Write_Line (File (First .. Last));
- end if;
+ else
+ Unit_Kind := Specification;
+ Last := Last - Spec_Suffix'Length;
+ end if;
+ elsif May_Be_Body then
+ Unit_Kind := Body_Part;
+
+ if May_Be_Sep and then
+ Body_Suffix'Length < Sep_Suffix'Length
+ then
+ Last := Last - Sep_Suffix'Length;
+ May_Be_Body := False;
else
- Last := 0;
+ Last := Last - Body_Suffix'Length;
+ May_Be_Sep := False;
end if;
+ elsif May_Be_Sep then
+ Unit_Kind := Body_Part;
+ Last := Last - Sep_Suffix'Length;
+
else
Last := 0;
end if;
- end if;
- if Last = 0 then
+ if Last = 0 then
- -- This is not a source file
+ -- This is not a source file
- Unit_Name := No_Name;
- Unit_Kind := Specification;
+ Unit_Name := No_Name;
+ Unit_Kind := Specification;
- if Current_Verbosity = High then
- Write_Line (" Not a valid file name.");
- end if;
+ if Current_Verbosity = High then
+ Write_Line (" Not a valid file name.");
+ end if;
- return;
- end if;
+ return;
+
+ elsif Current_Verbosity = High then
+ case Unit_Kind is
+ when Specification =>
+ Write_Str (" Specification: ");
+ Write_Line (File (First .. Last + Spec_Suffix'Length));
+
+ when Body_Part =>
+ if May_Be_Body then
+ Write_Str (" Body: ");
+ Write_Line (File (First .. Last + Body_Suffix'Length));
+
+ else
+ Write_Str (" Separate: ");
+ Write_Line (File (First .. Last + Sep_Suffix'Length));
+ end if;
+ end case;
+ end if;
+ end;
Get_Name_String (Naming.Dot_Replacement);
Standard_GNAT :=
@@ -6661,14 +6958,15 @@ package body Prj.Nmsc is
----------------------
procedure Locate_Directory
- (Project : Project_Id;
- In_Tree : Project_Tree_Ref;
- Name : File_Name_Type;
- Parent : Path_Name_Type;
- Dir : out Path_Name_Type;
- Display : out Path_Name_Type;
- Create : String := "";
- Location : Source_Ptr := No_Location)
+ (Project : Project_Id;
+ In_Tree : Project_Tree_Ref;
+ Name : File_Name_Type;
+ Parent : Path_Name_Type;
+ Dir : out Path_Name_Type;
+ Display : out Path_Name_Type;
+ Create : String := "";
+ Current_Dir : String;
+ Location : Source_Ptr := No_Location)
is
The_Name : String := Get_Name_String (Name);
@@ -6743,13 +7041,16 @@ package body Prj.Nmsc is
Normed : constant String :=
Normalize_Pathname
(Full_Path_Name,
+ Directory => Current_Dir,
Resolve_Links => False,
Case_Sensitive => True);
Canonical_Path : constant String :=
Normalize_Pathname
(Normed,
- Resolve_Links => True,
+ Directory => Current_Dir,
+ Resolve_Links =>
+ Opt.Follow_Links_For_Dirs,
Case_Sensitive => False);
begin
@@ -6765,1117 +7066,1256 @@ package body Prj.Nmsc is
end;
end Locate_Directory;
- ----------------------
- -- Look_For_Sources --
- ----------------------
+ ---------------------------
+ -- Find_Excluded_Sources --
+ ---------------------------
- procedure Look_For_Sources
- (Project : Project_Id;
- In_Tree : Project_Tree_Ref;
- Data : in out Project_Data;
- Follow_Links : Boolean)
+ procedure Find_Excluded_Sources
+ (In_Tree : Project_Tree_Ref;
+ Data : Project_Data)
is
- procedure Get_Path_Names_And_Record_Sources (Follow_Links : Boolean);
- -- Find the path names of the source files in the Source_Names table
- -- in the source directories and record those that are Ada sources.
-
- procedure Get_Sources_From_File
- (Path : String;
- Location : Source_Ptr);
- -- Get the sources of a project from a text file
-
- procedure Search_Directories (For_All_Sources : Boolean);
- -- Search the source directories to find the sources.
- -- If For_All_Sources is True, check each regular file name against
- -- the naming schemes of the different languages. Otherwise consider
- -- only the file names in the hash table Source_Names.
-
- ---------------------------------------
- -- Get_Path_Names_And_Record_Sources --
- ---------------------------------------
-
- procedure Get_Path_Names_And_Record_Sources (Follow_Links : Boolean) is
- Source_Dir : String_List_Id := Data.Source_Dirs;
- Element : String_Element;
- Path : Path_Name_Type;
-
- Dir : Dir_Type;
- Name : File_Name_Type;
- Canonical_Name : File_Name_Type;
- Name_Str : String (1 .. 1_024);
- Last : Natural := 0;
- NL : Name_Location;
- Current_Source : String_List_Id := Nil_String;
- First_Error : Boolean := True;
- Source_Recorded : Boolean := False;
+ Excluded_Sources : Variable_Value;
+ Current : String_List_Id;
+ Element : String_Element;
+ Location : Source_Ptr;
+ Name : File_Name_Type;
+ begin
+ -- If Excluded_Source_Files is not declared, check
+ -- Locally_Removed_Files.
- begin
- -- We look in all source directories for the file names in the
- -- hash table Source_Names
+ Excluded_Sources :=
+ Util.Value_Of
+ (Name_Excluded_Source_Files, Data.Decl.Attributes, In_Tree);
- while Source_Dir /= Nil_String loop
- Source_Recorded := False;
- Element := In_Tree.String_Elements.Table (Source_Dir);
+ if Excluded_Sources.Default then
+ Excluded_Sources :=
+ Util.Value_Of
+ (Name_Locally_Removed_Files, Data.Decl.Attributes, In_Tree);
+ end if;
- declare
- Dir_Path : constant String :=
- Get_Name_String (Element.Display_Value);
- begin
- if Current_Verbosity = High then
- Write_Str ("checking directory """);
- Write_Str (Dir_Path);
- Write_Line ("""");
- end if;
+ Excluded_Sources_Htable.Reset;
- Open (Dir, Dir_Path);
+ -- If there are excluded sources, put them in the table
- loop
- Read (Dir, Name_Str, Last);
- exit when Last = 0;
+ if not Excluded_Sources.Default then
+ Current := Excluded_Sources.Values;
+ while Current /= Nil_String loop
+ Element := In_Tree.String_Elements.Table (Current);
- Name_Len := Last;
- Name_Buffer (1 .. Name_Len) := Name_Str (1 .. Last);
- Name := Name_Find;
+ if Osint.File_Names_Case_Sensitive then
+ Name := File_Name_Type (Element.Value);
+ else
+ Get_Name_String (Element.Value);
+ Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
+ Name := Name_Find;
+ end if;
- Canonical_Case_File_Name (Name_Str (1 .. Last));
- Name_Buffer (1 .. Name_Len) := Name_Str (1 .. Last);
- Canonical_Name := Name_Find;
+ -- If the element has no location, then use the location
+ -- of Excluded_Sources to report possible errors.
- NL := Source_Names.Get (Canonical_Name);
+ if Element.Location = No_Location then
+ Location := Excluded_Sources.Location;
+ else
+ Location := Element.Location;
+ end if;
- if NL /= No_Name_Location and then not NL.Found then
- NL.Found := True;
- Source_Names.Set (Canonical_Name, NL);
- Name_Len := Dir_Path'Length;
- Name_Buffer (1 .. Name_Len) := Dir_Path;
+ Excluded_Sources_Htable.Set (Name, (Name, False, Location));
+ Current := Element.Next;
+ end loop;
+ end if;
+ end Find_Excluded_Sources;
- if Name_Buffer (Name_Len) /= Directory_Separator then
- Add_Char_To_Name_Buffer (Directory_Separator);
- end if;
+ ---------------------------
+ -- Find_Explicit_Sources --
+ ---------------------------
- Add_Str_To_Name_Buffer (Name_Str (1 .. Last));
- Path := Name_Find;
+ procedure Find_Explicit_Sources
+ (Lang : Language_Index;
+ Current_Dir : String;
+ Project : Project_Id;
+ In_Tree : Project_Tree_Ref;
+ Data : in out Project_Data)
+ is
+ Sources : constant Variable_Value :=
+ Util.Value_Of
+ (Name_Source_Files,
+ Data.Decl.Attributes,
+ In_Tree);
+ Source_List_File : constant Variable_Value :=
+ Util.Value_Of
+ (Name_Source_List_File,
+ Data.Decl.Attributes,
+ In_Tree);
+ Name_Loc : Name_Location;
- if Current_Verbosity = High then
- Write_Str (" found ");
- Write_Line (Get_Name_String (Name));
- end if;
+ begin
+ pragma Assert (Sources.Kind = List, "Source_Files is not a list");
+ pragma Assert
+ (Source_List_File.Kind = Single,
+ "Source_List_File is not a single string");
- -- Register the source if it is an Ada compilation unit
-
- Record_Ada_Source
- (File_Name => Name,
- Path_Name => Path,
- Project => Project,
- In_Tree => In_Tree,
- Data => Data,
- Location => NL.Location,
- Current_Source => Current_Source,
- Source_Recorded => Source_Recorded,
- Follow_Links => Follow_Links);
- end if;
- end loop;
+ -- If the user has specified a Sources attribute
- Close (Dir);
- end;
+ if not Sources.Default then
+ if not Source_List_File.Default then
+ Error_Msg
+ (Project, In_Tree,
+ "?both variables source_files and " &
+ "source_list_file are present",
+ Source_List_File.Location);
+ end if;
+
+ -- Sources is a list of file names
- if Source_Recorded then
- In_Tree.String_Elements.Table (Source_Dir).Flag :=
- True;
+ declare
+ Current : String_List_Id := Sources.Values;
+ Element : String_Element;
+ Location : Source_Ptr;
+ Name : File_Name_Type;
+
+ begin
+ if Get_Mode = Ada_Only then
+ Data.Ada_Sources_Present := Current /= Nil_String;
end if;
- Source_Dir := Element.Next;
- end loop;
+ -- If we are processing other languages in the case of gprmake,
+ -- we should not reset the list of sources, which was already
+ -- initialized for the Ada files.
- -- It is an error if a source file name in a source list or
- -- in a source list file is not found.
+ if Get_Mode /= Ada_Only or else Lang /= Ada_Language_Index then
+ if Current = Nil_String then
+ case Get_Mode is
+ when Ada_Only =>
+ Data.Source_Dirs := Nil_String;
+ when Multi_Language =>
+ Data.First_Language_Processing := No_Language_Index;
+ end case;
- NL := Source_Names.Get_First;
- while NL /= No_Name_Location loop
- if not NL.Found then
- Err_Vars.Error_Msg_File_1 := NL.Name;
+ -- This project contains no source. For projects that
+ -- don't extend other projects, this also means that
+ -- there is no need for an object directory, if not
+ -- specified.
- if First_Error then
- Error_Msg
- (Project, In_Tree,
- "source file { cannot be found",
- NL.Location);
- First_Error := False;
+ if Data.Extends = No_Project
+ and then Data.Object_Directory = Data.Directory
+ then
+ Data.Object_Directory := No_Path;
+ end if;
+ end if;
+ end if;
+ while Current /= Nil_String loop
+ Element := In_Tree.String_Elements.Table (Current);
+ Get_Name_String (Element.Value);
+
+ if Osint.File_Names_Case_Sensitive then
+ Name := File_Name_Type (Element.Value);
else
- Error_Msg
- (Project, In_Tree,
- "\source file { cannot be found",
- NL.Location);
+ Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
+ Name := Name_Find;
end if;
- end if;
- NL := Source_Names.Get_Next;
- end loop;
- end Get_Path_Names_And_Record_Sources;
+ -- If the element has no location, then use the
+ -- location of Sources to report possible errors.
- ---------------------------
- -- Get_Sources_From_File --
- ---------------------------
+ if Element.Location = No_Location then
+ Location := Sources.Location;
+ else
+ Location := Element.Location;
+ end if;
- procedure Get_Sources_From_File
- (Path : String;
- Location : Source_Ptr)
- is
- begin
- -- Get the list of sources from the file and put them in hash table
- -- Source_Names.
+ -- Check that there is no directory information
+
+ for J in 1 .. Name_Len loop
+ if Name_Buffer (J) = '/'
+ or else Name_Buffer (J) = Directory_Separator
+ then
+ Error_Msg_File_1 := Name;
+ Error_Msg
+ (Project,
+ In_Tree,
+ "file name cannot include directory " &
+ "information ({)",
+ Location);
+ exit;
+ end if;
+ end loop;
- Get_Sources_From_File (Path, Location, Project, In_Tree);
+ -- In Multi_Language mode, check whether the file is
+ -- already there (??? Is this really needed, and why ?)
- if Get_Mode = Ada_Only then
- -- Look in the source directories to find those sources
+ case Get_Mode is
+ when Ada_Only =>
+ Name_Loc := No_Name_Location;
+ when Multi_Language =>
+ Name_Loc := Source_Names.Get (Name);
+ end case;
- Get_Path_Names_And_Record_Sources (Follow_Links);
+ if Name_Loc = No_Name_Location then
+ Name_Loc :=
+ (Name => Name,
+ Location => Location,
+ Source => No_Source,
+ Except => False,
+ Found => False);
+ Source_Names.Set (Name, Name_Loc);
+ end if;
- -- We should have found at least one source.
- -- If not, report an error.
+ Current := Element.Next;
+ end loop;
- if Data.Ada_Sources = Nil_String then
- Report_No_Sources (Project, "Ada", In_Tree, Location);
+ if Get_Mode = Ada_Only then
+ if Lang = Ada_Language_Index then
+ Get_Path_Names_And_Record_Ada_Sources
+ (Project, In_Tree, Data, Current_Dir);
+ else
+ Record_Other_Sources
+ (Project => Project,
+ In_Tree => In_Tree,
+ Data => Data,
+ Language => Lang,
+ Naming_Exceptions => False);
+ end if;
end if;
+ end;
- else
- null;
- end if;
- end Get_Sources_From_File;
+ -- If we have no Source_Files attribute, check the Source_List_File
+ -- attribute
- ------------------------
- -- Search_Directories --
- ------------------------
+ elsif not Source_List_File.Default then
- procedure Search_Directories (For_All_Sources : Boolean) is
- Source_Dir : String_List_Id;
- Element : String_Element;
- Dir : Dir_Type;
- Name : String (1 .. 1_000);
- Last : Natural;
+ -- Source_List_File is the name of the file
+ -- that contains the source file names
- File_Name : File_Name_Type;
- Display_File_Name : File_Name_Type;
- Source : Source_Id;
- Source_To_Replace : Source_Id := No_Source;
- Src_Data : Source_Data;
- Add_Src : Boolean;
- Name_Loc : Name_Location;
- Check_Name : Boolean;
-
- Language : Language_Index;
- Language_Name : Name_Id;
- Display_Language_Name : Name_Id;
- Unit : Name_Id;
- Kind : Source_Kind := Spec;
- Alternate_Languages : Alternate_Language_Id :=
- No_Alternate_Language;
-
- OK : Boolean;
-
- procedure Check_Naming_Schemes;
- -- Check if the file name File_Name conforms to one of the naming
- -- schemes of the project. If it does, set the global variables
- -- Language, Language_Name, Display_Language_Name, Unit and Kind
- -- appropriately. If it does not, set Language to No_Language_Index.
-
- --------------------------
- -- Check_Naming_Schemes --
- --------------------------
-
- procedure Check_Naming_Schemes is
- Filename : constant String := Get_Name_String (File_Name);
- Last : Positive := Filename'Last;
- Config : Language_Config;
- Lang : Name_List_Index;
-
- Header_File : Boolean := False;
- First_Language : Language_Index;
+ declare
+ Source_File_Path_Name : constant String :=
+ Path_Name_Of
+ (File_Name_Type (Source_List_File.Value), Data.Directory);
begin
- Unit := No_Name;
+ if Source_File_Path_Name'Length = 0 then
+ Err_Vars.Error_Msg_File_1 :=
+ File_Name_Type (Source_List_File.Value);
+ Error_Msg
+ (Project, In_Tree,
+ "file with sources { does not exist",
+ Source_List_File.Location);
- Lang := Data.Languages;
- while Lang /= No_Name_List loop
- Language_Name := In_Tree.Name_Lists.Table (Lang).Name;
+ else
+ Get_Sources_From_File
+ (Source_File_Path_Name, Source_List_File.Location,
+ Project, In_Tree);
- Language := Data.First_Language_Processing;
- while Language /= No_Language_Index loop
- if In_Tree.Languages_Data.Table (Language).Name =
- Language_Name
- then
- Display_Language_Name :=
- In_Tree.Languages_Data.Table (Language).Display_Name;
- Config := In_Tree.Languages_Data.Table (Language).Config;
+ if Get_Mode = Ada_Only then
+ -- Look in the source directories to find those sources
- if Config.Kind = File_Based then
+ if Lang = Ada_Language_Index then
+ Get_Path_Names_And_Record_Ada_Sources
+ (Project, In_Tree, Data, Current_Dir);
- -- For file based languages, there is no Unit. Just
- -- check if the file name has the implementation or,
- -- if it is specified, the template suffix of the
- -- language.
+ else
+ Record_Other_Sources
+ (Project => Project,
+ In_Tree => In_Tree,
+ Data => Data,
+ Language => Lang,
+ Naming_Exceptions => False);
+ end if;
+ end if;
+ end if;
+ end;
- Unit := No_Name;
+ else
+ -- Neither Source_Files nor Source_List_File has been
+ -- specified. Find all the files that satisfy the naming
+ -- scheme in all the source directories.
+
+ case Get_Mode is
+ when Ada_Only =>
+ if Lang = Ada_Language_Index then
+ Find_Ada_Sources (Project, In_Tree, Data, Current_Dir);
+ else
+ -- Find all the files that satisfy the naming scheme in
+ -- all the source directories. All the naming exceptions
+ -- that effectively exist are also part of the source
+ -- of this language.
- if not Header_File and then
- Config.Naming_Data.Body_Suffix /= No_File
- then
- declare
- Impl_Suffix : constant String :=
- Get_Name_String
- (Config.Naming_Data.Body_Suffix);
+ Find_Sources (Project, In_Tree, Data, Lang, Current_Dir);
+ end if;
- begin
- if Filename'Length > Impl_Suffix'Length
- and then
- Filename
- (Last - Impl_Suffix'Length + 1 .. Last) =
- Impl_Suffix
- then
- Kind := Impl;
+ when Multi_Language =>
+ null;
+ end case;
+ end if;
- if Current_Verbosity = High then
- Write_Str (" source of language ");
- Write_Line
- (Get_Name_String
- (Display_Language_Name));
- end if;
+ if Get_Mode = Multi_Language then
+ Search_Directories
+ (Project, In_Tree, Data,
+ For_All_Sources =>
+ Sources.Default and then Source_List_File.Default);
+ end if;
- return;
- end if;
- end;
- end if;
+ if Get_Mode = Ada_Only
+ and then Lang = Ada_Language_Index
+ and then Data.Extends = No_Project
+ then
+ -- We should have found at least one source. If not, report an error.
- if Config.Naming_Data.Spec_Suffix /= No_File then
- declare
- Spec_Suffix : constant String :=
- Get_Name_String
- (Config.Naming_Data.Spec_Suffix);
+ if Data.Ada_Sources = Nil_String then
+ Report_No_Sources
+ (Project, "Ada", In_Tree, Source_List_File.Location);
+ end if;
+ end if;
- begin
- if Filename'Length > Spec_Suffix'Length
- and then
- Filename
- (Last - Spec_Suffix'Length + 1 .. Last) =
- Spec_Suffix
- then
- Kind := Spec;
+ end Find_Explicit_Sources;
- if Current_Verbosity = High then
- Write_Str
- (" header file of language ");
- Write_Line
- (Get_Name_String
- (Display_Language_Name));
- end if;
+ -------------------------------------------
+ -- Get_Path_Names_And_Record_Ada_Sources --
+ -------------------------------------------
- if Header_File then
- Alternate_Language_Table.Increment_Last
- (In_Tree.Alt_Langs);
- In_Tree.Alt_Langs.Table
- (Alternate_Language_Table.Last
- (In_Tree.Alt_Langs)) :=
- (Language => Language,
- Next => Alternate_Languages);
- Alternate_Languages :=
- Alternate_Language_Table.Last
- (In_Tree.Alt_Langs);
- else
- Header_File := True;
- First_Language := Language;
- end if;
- end if;
- end;
- end if;
+ procedure Get_Path_Names_And_Record_Ada_Sources
+ (Project : Project_Id;
+ In_Tree : Project_Tree_Ref;
+ Data : in out Project_Data;
+ Current_Dir : String)
+ is
+ Source_Dir : String_List_Id := Data.Source_Dirs;
+ Element : String_Element;
+ Path : Path_Name_Type;
+ Dir : Dir_Type;
+ Name : File_Name_Type;
+ Canonical_Name : File_Name_Type;
+ Name_Str : String (1 .. 1_024);
+ Last : Natural := 0;
+ NL : Name_Location;
+ Current_Source : String_List_Id := Nil_String;
+ First_Error : Boolean := True;
+ Source_Recorded : Boolean := False;
- elsif not Header_File then
+ begin
+ -- We look in all source directories for the file names in the
+ -- hash table Source_Names
- -- Unit based language
+ while Source_Dir /= Nil_String loop
+ Source_Recorded := False;
+ Element := In_Tree.String_Elements.Table (Source_Dir);
- OK := Config.Naming_Data.Dot_Replacement /= No_File;
+ declare
+ Dir_Path : constant String :=
+ Get_Name_String (Element.Display_Value);
+ begin
+ if Current_Verbosity = High then
+ Write_Str ("checking directory """);
+ Write_Str (Dir_Path);
+ Write_Line ("""");
+ end if;
- if OK then
+ Open (Dir, Dir_Path);
- -- Check casing
+ loop
+ Read (Dir, Name_Str, Last);
+ exit when Last = 0;
- case Config.Naming_Data.Casing is
- when All_Lower_Case =>
- for J in Filename'Range loop
- if Is_Letter (Filename (J)) then
- if not Is_Lower (Filename (J)) then
- OK := False;
- exit;
- end if;
- end if;
- end loop;
+ Name_Len := Last;
+ Name_Buffer (1 .. Name_Len) := Name_Str (1 .. Last);
+ Name := Name_Find;
- when All_Upper_Case =>
- for J in Filename'Range loop
- if Is_Letter (Filename (J)) then
- if not Is_Upper (Filename (J)) then
- OK := False;
- exit;
- end if;
- end if;
- end loop;
+ if Osint.File_Names_Case_Sensitive then
+ Canonical_Name := Name;
+ else
+ Canonical_Case_File_Name (Name_Str (1 .. Last));
+ Name_Buffer (1 .. Name_Len) := Name_Str (1 .. Last);
+ Canonical_Name := Name_Find;
+ end if;
- when others =>
- OK := False;
- end case;
- end if;
+ NL := Source_Names.Get (Canonical_Name);
- if OK then
- OK := False;
+ if NL /= No_Name_Location and then not NL.Found then
+ NL.Found := True;
+ Source_Names.Set (Canonical_Name, NL);
+ Name_Len := Dir_Path'Length;
+ Name_Buffer (1 .. Name_Len) := Dir_Path;
- if Config.Naming_Data.Separate_Suffix /= No_File
- and then
- Config.Naming_Data.Separate_Suffix /=
- Config.Naming_Data.Body_Suffix
- then
- declare
- Suffix : constant String :=
- Get_Name_String
- (Config.Naming_Data.Separate_Suffix);
- begin
- if Filename'Length > Suffix'Length
- and then
- Filename
- (Last - Suffix'Length + 1 .. Last) =
- Suffix
- then
- Kind := Sep;
- Last := Last - Suffix'Length;
- OK := True;
- end if;
- end;
- end if;
+ if Name_Buffer (Name_Len) /= Directory_Separator then
+ Add_Char_To_Name_Buffer (Directory_Separator);
+ end if;
- if not OK and then
- Config.Naming_Data.Body_Suffix /= No_File
- then
- declare
- Suffix : constant String :=
- Get_Name_String
- (Config.Naming_Data.Body_Suffix);
- begin
- if Filename'Length > Suffix'Length
- and then
- Filename
- (Last - Suffix'Length + 1 .. Last) =
- Suffix
- then
- Kind := Impl;
- Last := Last - Suffix'Length;
- OK := True;
- end if;
- end;
- end if;
+ Add_Str_To_Name_Buffer (Name_Str (1 .. Last));
+ Path := Name_Find;
- if not OK and then
- Config.Naming_Data.Spec_Suffix /= No_File
- then
- declare
- Suffix : constant String :=
- Get_Name_String
- (Config.Naming_Data.Spec_Suffix);
- begin
- if Filename'Length > Suffix'Length
- and then
- Filename
- (Last - Suffix'Length + 1 .. Last) =
- Suffix
- then
- Kind := Spec;
- Last := Last - Suffix'Length;
- OK := True;
- end if;
- end;
- end if;
- end if;
+ if Current_Verbosity = High then
+ Write_Str (" found ");
+ Write_Line (Get_Name_String (Name));
+ end if;
- if OK then
+ -- Register the source if it is an Ada compilation unit
+
+ Record_Ada_Source
+ (File_Name => Name,
+ Path_Name => Path,
+ Project => Project,
+ In_Tree => In_Tree,
+ Data => Data,
+ Location => NL.Location,
+ Current_Source => Current_Source,
+ Source_Recorded => Source_Recorded,
+ Current_Dir => Current_Dir);
+ end if;
+ end loop;
- -- Replace dot replacements with dots
+ Close (Dir);
+ end;
- Name_Len := 0;
+ if Source_Recorded then
+ In_Tree.String_Elements.Table (Source_Dir).Flag :=
+ True;
+ end if;
- declare
- J : Positive := Filename'First;
+ Source_Dir := Element.Next;
+ end loop;
- Dot_Replacement : constant String :=
- Get_Name_String
- (Config.Naming_Data.
- Dot_Replacement);
+ -- It is an error if a source file name in a source list or
+ -- in a source list file is not found.
- Max : constant Positive :=
- Last - Dot_Replacement'Length + 1;
+ NL := Source_Names.Get_First;
+ while NL /= No_Name_Location loop
+ if not NL.Found then
+ Err_Vars.Error_Msg_File_1 := NL.Name;
- begin
- loop
- Name_Len := Name_Len + 1;
+ if First_Error then
+ Error_Msg
+ (Project, In_Tree,
+ "source file { cannot be found",
+ NL.Location);
+ First_Error := False;
- if J <= Max and then
- Filename
- (J .. J + Dot_Replacement'Length - 1) =
- Dot_Replacement
- then
- Name_Buffer (Name_Len) := '.';
- J := J + Dot_Replacement'Length;
+ else
+ Error_Msg
+ (Project, In_Tree,
+ "\source file { cannot be found",
+ NL.Location);
+ end if;
+ end if;
- else
- if Filename (J) = '.' then
- OK := False;
- exit;
- end if;
+ NL := Source_Names.Get_Next;
+ end loop;
+ end Get_Path_Names_And_Record_Ada_Sources;
- Name_Buffer (Name_Len) :=
- GNAT.Case_Util.To_Lower (Filename (J));
- J := J + 1;
- end if;
+ --------------------------
+ -- Check_Naming_Schemes --
+ --------------------------
- exit when J > Last;
- end loop;
- end;
- end if;
+ procedure Check_Naming_Schemes
+ (In_Tree : Project_Tree_Ref;
+ Data : in out Project_Data;
+ Filename : String;
+ File_Name : File_Name_Type;
+ Alternate_Languages : out Alternate_Language_Id;
+ Language : out Language_Index;
+ Language_Name : out Name_Id;
+ Display_Language_Name : out Name_Id;
+ Unit : out Name_Id;
+ Lang_Kind : out Language_Kind;
+ Kind : out Source_Kind)
+ is
+ Last : Positive := Filename'Last;
+ Config : Language_Config;
+ Lang : Name_List_Index := Data.Languages;
+ Header_File : Boolean := False;
+ First_Language : Language_Index;
+ OK : Boolean;
- if OK then
+ begin
+ Unit := No_Name;
+ Alternate_Languages := No_Alternate_Language;
- -- The name buffer should contain the name of the
- -- the unit, if it is one.
+ while Lang /= No_Name_List loop
+ Language_Name := In_Tree.Name_Lists.Table (Lang).Name;
+ Language := Data.First_Language_Processing;
- -- Check that this is a valid unit name
+ if Current_Verbosity = High then
+ Write_Line
+ (" Testing language "
+ & Get_Name_String (Language_Name)
+ & " Header_File=" & Header_File'Img);
+ end if;
- Check_Ada_Name (Name_Buffer (1 .. Name_Len), Unit);
+ while Language /= No_Language_Index loop
+ if In_Tree.Languages_Data.Table (Language).Name =
+ Language_Name
+ then
+ Display_Language_Name :=
+ In_Tree.Languages_Data.Table (Language).Display_Name;
+ Config := In_Tree.Languages_Data.Table (Language).Config;
+ Lang_Kind := Config.Kind;
- if Unit /= No_Name then
+ if Config.Kind = File_Based then
- if Current_Verbosity = High then
- if Kind = Spec then
- Write_Str (" spec of ");
+ -- For file based languages, there is no Unit. Just
+ -- check if the file name has the implementation or,
+ -- if it is specified, the template suffix of the
+ -- language.
- else
- Write_Str (" body of ");
- end if;
+ Unit := No_Name;
- Write_Str (Get_Name_String (Unit));
- Write_Str (" (language ");
- Write_Str
- (Get_Name_String (Display_Language_Name));
- Write_Line (")");
- end if;
+ if not Header_File
+ and then Config.Naming_Data.Body_Suffix /= No_File
+ then
+ declare
+ Impl_Suffix : constant String :=
+ Get_Name_String (Config.Naming_Data.Body_Suffix);
+
+ begin
+ if Filename'Length > Impl_Suffix'Length
+ and then
+ Filename
+ (Last - Impl_Suffix'Length + 1 .. Last) =
+ Impl_Suffix
+ then
+ Kind := Impl;
- return;
+ if Current_Verbosity = High then
+ Write_Str (" source of language ");
+ Write_Line
+ (Get_Name_String (Display_Language_Name));
end if;
+
+ return;
end if;
- end if;
+ end;
end if;
- Language := In_Tree.Languages_Data.Table (Language).Next;
- end loop;
+ if Config.Naming_Data.Spec_Suffix /= No_File then
+ declare
+ Spec_Suffix : constant String :=
+ Get_Name_String
+ (Config.Naming_Data.Spec_Suffix);
- Lang := In_Tree.Name_Lists.Table (Lang).Next;
- end loop;
+ begin
+ if Filename'Length > Spec_Suffix'Length
+ and then
+ Filename
+ (Last - Spec_Suffix'Length + 1 .. Last) =
+ Spec_Suffix
+ then
+ Kind := Spec;
- if Header_File then
- Language := First_Language;
+ if Current_Verbosity = High then
+ Write_Str (" header file of language ");
+ Write_Line
+ (Get_Name_String (Display_Language_Name));
+ end if;
- else
- Language := No_Language_Index;
+ if Header_File then
+ Alternate_Language_Table.Increment_Last
+ (In_Tree.Alt_Langs);
+ In_Tree.Alt_Langs.Table
+ (Alternate_Language_Table.Last
+ (In_Tree.Alt_Langs)) :=
+ (Language => Language,
+ Next => Alternate_Languages);
+ Alternate_Languages :=
+ Alternate_Language_Table.Last
+ (In_Tree.Alt_Langs);
+ else
+ Header_File := True;
+ First_Language := Language;
+ end if;
+ end if;
+ end;
+ end if;
- if Current_Verbosity = High then
- Write_Line (" not a source of any language");
- end if;
- end if;
- end Check_Naming_Schemes;
+ elsif not Header_File then
+ -- Unit based language
- -- Start of processing for Search_Directories
+ OK := Config.Naming_Data.Dot_Replacement /= No_File;
- begin
- if Current_Verbosity = High then
- Write_Line ("Looking for sources:");
- end if;
+ if OK then
- -- Loop through subdirectories
+ -- Check casing
+ -- ??? Are we doing this once per file in the project ?
+ -- It should be done only once per project.
- Source_Dir := Data.Source_Dirs;
- while Source_Dir /= Nil_String loop
- begin
- Element := In_Tree.String_Elements.Table (Source_Dir);
- if Element.Value /= No_Name then
- Get_Name_String (Element.Display_Value);
+ case Config.Naming_Data.Casing is
+ when All_Lower_Case =>
+ for J in Filename'Range loop
+ if Is_Letter (Filename (J)) then
+ if not Is_Lower (Filename (J)) then
+ OK := False;
+ exit;
+ end if;
+ end if;
+ end loop;
- declare
- Source_Directory : constant String :=
- Name_Buffer (1 .. Name_Len) &
- Directory_Separator;
- Dir_Last : constant Natural :=
- Compute_Directory_Last
- (Source_Directory);
+ when All_Upper_Case =>
+ for J in Filename'Range loop
+ if Is_Letter (Filename (J)) then
+ if not Is_Upper (Filename (J)) then
+ OK := False;
+ exit;
+ end if;
+ end if;
+ end loop;
- begin
- if Current_Verbosity = High then
- Write_Str ("Source_Dir = ");
- Write_Line (Source_Directory);
+ when others =>
+ OK := False;
+ end case;
+ end if;
+
+ if OK then
+ OK := False;
+
+ if Config.Naming_Data.Separate_Suffix /= No_File
+ and then
+ Config.Naming_Data.Separate_Suffix /=
+ Config.Naming_Data.Body_Suffix
+ then
+ declare
+ Suffix : constant String :=
+ Get_Name_String
+ (Config.Naming_Data.Separate_Suffix);
+ begin
+ if Filename'Length > Suffix'Length
+ and then
+ Filename
+ (Last - Suffix'Length + 1 .. Last) =
+ Suffix
+ then
+ Kind := Sep;
+ Last := Last - Suffix'Length;
+ OK := True;
+ end if;
+ end;
+ end if;
+
+ if not OK
+ and then Config.Naming_Data.Body_Suffix /= No_File
+ then
+ declare
+ Suffix : constant String :=
+ Get_Name_String
+ (Config.Naming_Data.Body_Suffix);
+ begin
+ if Filename'Length > Suffix'Length
+ and then
+ Filename
+ (Last - Suffix'Length + 1 .. Last) =
+ Suffix
+ then
+ Kind := Impl;
+ Last := Last - Suffix'Length;
+ OK := True;
+ end if;
+ end;
+ end if;
+
+ if not OK
+ and then Config.Naming_Data.Spec_Suffix /= No_File
+ then
+ declare
+ Suffix : constant String :=
+ Get_Name_String
+ (Config.Naming_Data.Spec_Suffix);
+ begin
+ if Filename'Length > Suffix'Length
+ and then
+ Filename
+ (Last - Suffix'Length + 1 .. Last) =
+ Suffix
+ then
+ Kind := Spec;
+ Last := Last - Suffix'Length;
+ OK := True;
+ end if;
+ end;
end if;
+ end if;
- -- We look to every entry in the source directory
+ if OK then
- Open (Dir, Source_Directory
- (Source_Directory'First .. Dir_Last));
+ -- Replace dot replacements with dots
- loop
- Read (Dir, Name, Last);
+ Name_Len := 0;
- exit when Last = 0;
+ declare
+ J : Positive := Filename'First;
- if Is_Regular_File
- (Source_Directory & Name (1 .. Last))
- then
- if Current_Verbosity = High then
- Write_Str (" Checking ");
- Write_Line (Name (1 .. Last));
+ Dot_Replacement : constant String :=
+ Get_Name_String
+ (Config.Naming_Data.
+ Dot_Replacement);
+
+ Max : constant Positive :=
+ Last - Dot_Replacement'Length + 1;
+
+ begin
+ loop
+ Name_Len := Name_Len + 1;
+
+ if J <= Max and then
+ Filename
+ (J .. J + Dot_Replacement'Length - 1) =
+ Dot_Replacement
+ then
+ Name_Buffer (Name_Len) := '.';
+ J := J + Dot_Replacement'Length;
+
+ else
+ if Filename (J) = '.' then
+ OK := False;
+ exit;
+ end if;
+
+ Name_Buffer (Name_Len) :=
+ GNAT.Case_Util.To_Lower (Filename (J));
+ J := J + 1;
end if;
- Source_To_Replace := No_Source;
+ exit when J > Last;
+ end loop;
+ end;
+ end if;
- Name_Len := Last;
- Name_Buffer (1 .. Name_Len) := Name (1 .. Last);
- Display_File_Name := Name_Find;
- Canonical_Case_File_Name
- (Name_Buffer (1 .. Name_Len));
- File_Name := Name_Find;
+ if OK then
- declare
- Display_Path : constant String :=
- Normalize_Pathname
- (Name =>
- Name (1 .. Last),
- Directory =>
- Source_Directory
- (Source_Directory'First ..
- Dir_Last),
- Resolve_Links =>
- Follow_Links,
- Case_Sensitive => True);
- Path : String := Display_Path;
- Path_Id : Path_Name_Type;
- Display_Path_Id : Path_Name_Type;
+ -- The name buffer should contain the name of the
+ -- the unit, if it is one.
- begin
- Canonical_Case_File_Name (Path);
- Name_Len := Path'Length;
- Name_Buffer (1 .. Name_Len) := Path;
- Path_Id := Name_Find;
+ -- Check that this is a valid unit name
- Name_Len := Display_Path'Length;
- Name_Buffer (1 .. Name_Len) := Display_Path;
- Display_Path_Id := Name_Find;
+ Check_Ada_Name (Name_Buffer (1 .. Name_Len), Unit);
- Name_Loc := Source_Names.Get (File_Name);
- Check_Name := False;
+ if Unit /= No_Name then
- if Name_Loc = No_Name_Location then
- Check_Name := For_All_Sources;
+ if Current_Verbosity = High then
+ if Kind = Spec then
+ Write_Str (" spec of ");
+ else
+ Write_Str (" body of ");
+ end if;
- else
- if Name_Loc.Found then
+ Write_Str (Get_Name_String (Unit));
+ Write_Str (" (language ");
+ Write_Str
+ (Get_Name_String (Display_Language_Name));
+ Write_Line (")");
+ end if;
- -- Check if it is OK to have the same file
- -- name in several source directories.
+ -- Comments required, declare block should
+ -- be named ???
- if
- not Data.Known_Order_Of_Source_Dirs
- then
- Error_Msg_File_1 := File_Name;
- Error_Msg
- (Project, In_Tree,
- "{ is found in several " &
- "source directories",
- Name_Loc.Location);
- end if;
+ declare
+ Unit_Except : constant Unit_Exception :=
+ Unit_Exceptions.Get (Unit);
- else
- Name_Loc.Found := True;
-
- if Name_Loc.Source = No_Source then
- Check_Name := True;
-
- else
- In_Tree.Sources.Table
- (Name_Loc.Source).Path := Path_Id;
-
- Source_Paths_Htable.Set
- (In_Tree.Source_Paths_HT,
- Path_Id,
- Name_Loc.Source);
-
- In_Tree.Sources.Table
- (Name_Loc.Source).Display_Path :=
- Display_Path_Id;
-
- -- Check if this is a subunit
-
- if In_Tree.Sources.Table
- (Name_Loc.Source).Unit /= No_Name
- and then
- In_Tree.Sources.Table
- (Name_Loc.Source).Kind = Impl
- then
- declare
- Src_Ind : Source_File_Index;
-
- begin
- Src_Ind :=
- Sinput.P.Load_Project_File
- (Get_Name_String (Path_Id));
-
- if Sinput.P.Source_File_Is_Subunit
- (Src_Ind)
- then
- In_Tree.Sources.Table
- (Name_Loc.Source).Kind :=
- Sep;
- end if;
- end;
- end if;
- end if;
- end if;
- end if;
+ procedure Masked_Unit (Spec : Boolean);
+ -- Indicate that there is an exception for
+ -- the same unit, so the file is not a
+ -- source for the unit.
- if Check_Name then
- Alternate_Languages := No_Alternate_Language;
- Check_Naming_Schemes;
+ -----------------
+ -- Masked_Unit --
+ -----------------
- if Language = No_Language_Index then
- if Name_Loc.Found then
+ procedure Masked_Unit (Spec : Boolean) is
+ begin
+ if Current_Verbosity = High then
+ Write_Str (" """);
+ Write_Str (Filename);
+ Write_Str (""" contains the ");
- -- A file name in a list must be
- -- a source of a language.
+ if Spec then
+ Write_Str ("spec");
+ else
+ Write_Str ("body");
+ end if;
- Error_Msg_File_1 := File_Name;
- Error_Msg
- (Project, In_Tree,
- "language unknown for {",
- Name_Loc.Location);
- end if;
+ Write_Str
+ (" of a unit that is found in """);
+ if Spec then
+ Write_Str
+ (Get_Name_String
+ (Unit_Except.Spec));
else
- -- Check if the same file name or unit
- -- is used in the project tree.
-
- Source := In_Tree.First_Source;
- Add_Src := True;
-
- while Source /= No_Source loop
- Src_Data :=
- In_Tree.Sources.Table (Source);
-
- if (Unit /= No_Name and then
- Src_Data.Unit = Unit and then
- Src_Data.Kind = Kind)
- or else
- (Unit = No_Name and then
- Src_Data.File = File_Name)
- then
- -- Duplication of file/unit in the
- -- same project is only allowed if
- -- the order of source directories
- -- is known.
-
- if Project = Src_Data.Project then
- if
- Data.Known_Order_Of_Source_Dirs
- then
- Add_Src := False;
-
- elsif Unit /= No_Name then
- Error_Msg_Name_1 := Unit;
- Error_Msg
- (Project, In_Tree,
- "duplicate unit %%",
- No_Location);
- Add_Src := False;
-
- else
- Error_Msg_File_1 := File_Name;
- Error_Msg
- (Project, In_Tree,
- "duplicate source file " &
- "name {",
- No_Location);
- Add_Src := False;
- end if;
-
- -- Do not allow the same unit name
- -- in different projects, except if
- -- one is extending the other.
-
- -- For a file based language,
- -- the same file name replaces
- -- a file in a project being
- -- extended, but it is allowed
- -- to have the same file name in
- -- unrelated projects.
-
- elsif Is_Extending
- (Project,
- Src_Data.Project,
- In_Tree)
- then
- Source_To_Replace := Source;
-
- elsif Unit /= No_Name then
- Error_Msg_Name_1 := Unit;
- Error_Msg
- (Project, In_Tree,
- "unit %% cannot belong to " &
- "several projects",
- No_Location);
- Add_Src := False;
- end if;
- end if;
-
- Source := Src_Data.Next_In_Sources;
- end loop;
-
- if Add_Src then
- Source_Data_Table.Increment_Last
- (In_Tree.Sources);
- Source := Source_Data_Table.Last
- (In_Tree.Sources);
-
- declare
- Data : Source_Data;
- begin
- Data.Project := Project;
- Data.Language_Name := Language_Name;
- Data.Language := Language;
- Data.Alternate_Languages :=
- Alternate_Languages;
- Data.Kind := Kind;
- Data.Unit := Unit;
- Data.File := File_Name;
- Data.Object :=
- Object_Name (File_Name);
- Data.Dependency :=
- In_Tree.Languages_Data.Table
- (Language).Config.Dependency_Kind;
- Data.Dep_Name :=
- Dependency_Name
- (File_Name, Data.Dependency);
- Data.Switches :=
- Switches_Name (File_Name);
- Data.Display_File :=
- Display_File_Name;
- Data.Path := Path_Id;
- Data.Display_Path :=
- Display_Path_Id;
- In_Tree.Sources.Table (Source) :=
- Data;
- end;
-
- Add_Source (Source, Data, In_Tree);
-
- Source_Paths_Htable.Set
- (In_Tree.Source_Paths_HT,
- Path_Id,
- Source);
-
- if Source_To_Replace /= No_Source then
- Remove_Source
- (Source_To_Replace,
- Source,
- Project,
- Data,
- In_Tree);
- end if;
- end if;
+ Write_Str
+ (Get_Name_String
+ (Unit_Except.Impl));
end if;
+
+ Write_Line (""" (ignored)");
end if;
- end;
- end if;
- end loop;
- Close (Dir);
- end;
+ Language := No_Language_Index;
+ end Masked_Unit;
+
+ begin
+ if Kind = Spec then
+ if Unit_Except.Spec /= No_File
+ and then Unit_Except.Spec /= File_Name
+ then
+ Masked_Unit (Spec => True);
+ end if;
+
+ else
+ if Unit_Except.Impl /= No_File
+ and then Unit_Except.Impl /= File_Name
+ then
+ Masked_Unit (Spec => False);
+ end if;
+ end if;
+ end;
+
+ return;
+ end if;
+ end if;
end if;
+ end if;
- exception
- when Directory_Error =>
- null;
- end;
- Source_Dir := Element.Next;
+ Language := In_Tree.Languages_Data.Table (Language).Next;
end loop;
+ Lang := In_Tree.Name_Lists.Table (Lang).Next;
+ end loop;
+
+ -- Comment needed here ???
+
+ if Header_File then
+ Language := First_Language;
+
+ else
+ Language := No_Language_Index;
+
if Current_Verbosity = High then
- Write_Line ("end Looking for sources.");
+ Write_Line (" not a source of any language");
end if;
- end Search_Directories;
+ end if;
+ end Check_Naming_Schemes;
- Excluded_Sources : Variable_Value :=
- Util.Value_Of
- (Name_Excluded_Source_Files,
- Data.Decl.Attributes,
- In_Tree);
+ ----------------
+ -- Check_File --
+ ----------------
- -- Start of processing for Look_For_Sources
+ procedure Check_File
+ (Project : Project_Id;
+ In_Tree : Project_Tree_Ref;
+ Data : in out Project_Data;
+ Name : String;
+ File_Name : File_Name_Type;
+ Display_File_Name : File_Name_Type;
+ Source_Directory : String;
+ For_All_Sources : Boolean)
+ is
+ Display_Path : constant String :=
+ Normalize_Pathname
+ (Name => Name,
+ Directory => Source_Directory,
+ Resolve_Links => Opt.Follow_Links_For_Files,
+ Case_Sensitive => True);
+
+ Name_Loc : Name_Location := Source_Names.Get (File_Name);
+ Path_Id : Path_Name_Type;
+ Display_Path_Id : Path_Name_Type;
+ Check_Name : Boolean := False;
+ Alternate_Languages : Alternate_Language_Id := No_Alternate_Language;
+ Language : Language_Index;
+ Source : Source_Id;
+ Add_Src : Boolean;
+ Src_Ind : Source_File_Index;
+ Src_Data : Source_Data;
+ Unit : Name_Id;
+ Source_To_Replace : Source_Id := No_Source;
+ Language_Name : Name_Id;
+ Display_Language_Name : Name_Id;
+ Lang_Kind : Language_Kind;
+ Kind : Source_Kind := Spec;
begin
- -- If Excluded_Source_Files is not declared, check
- -- Locally_Removed_Files.
+ Name_Len := Display_Path'Length;
+ Name_Buffer (1 .. Name_Len) := Display_Path;
+ Display_Path_Id := Name_Find;
- if Excluded_Sources.Default then
- Excluded_Sources :=
- Util.Value_Of
- (Name_Locally_Removed_Files,
- Data.Decl.Attributes,
- In_Tree);
+ if Osint.File_Names_Case_Sensitive then
+ Path_Id := Display_Path_Id;
+ else
+ Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
+ Path_Id := Name_Find;
end if;
- if Get_Mode = Ada_Only and then
- Is_A_Language (In_Tree, Data, "ada")
- then
- declare
- Sources : constant Variable_Value :=
- Util.Value_Of
- (Name_Source_Files,
- Data.Decl.Attributes,
- In_Tree);
+ if Name_Loc = No_Name_Location then
+ Check_Name := For_All_Sources;
- Source_List_File : constant Variable_Value :=
- Util.Value_Of
- (Name_Source_List_File,
- Data.Decl.Attributes,
- In_Tree);
-
- begin
- pragma Assert
- (Sources.Kind = List,
- "Source_Files is not a list");
+ else
+ if Name_Loc.Found then
- pragma Assert
- (Source_List_File.Kind = Single,
- "Source_List_File is not a single string");
+ -- Check if it is OK to have the same file name in several
+ -- source directories.
- if not Sources.Default then
- if not Source_List_File.Default then
- Error_Msg
- (Project, In_Tree,
- "?both variables source_files and " &
- "source_list_file are present",
- Source_List_File.Location);
- end if;
-
- -- Sources is a list of file names
+ if not Data.Known_Order_Of_Source_Dirs then
+ Error_Msg_File_1 := File_Name;
+ Error_Msg
+ (Project, In_Tree,
+ "{ is found in several source directories",
+ Name_Loc.Location);
+ end if;
- declare
- Current : String_List_Id := Sources.Values;
- Element : String_Element;
- Location : Source_Ptr;
- Name : File_Name_Type;
+ else
+ Name_Loc.Found := True;
- begin
- Source_Names.Reset;
+ if Name_Loc.Source = No_Source then
+ Check_Name := True;
- Data.Ada_Sources_Present := Current /= Nil_String;
+ else
+ In_Tree.Sources.Table (Name_Loc.Source).Path := Path_Id;
+ In_Tree.Sources.Table
+ (Name_Loc.Source).Display_Path := Display_Path_Id;
- if Current = Nil_String then
- Data.Source_Dirs := Nil_String;
+ Source_Paths_Htable.Set
+ (In_Tree.Source_Paths_HT,
+ Path_Id,
+ Name_Loc.Source);
- -- This project contains no source. For projects that
- -- don't extend other projects, this also means that
- -- there is no need for an object directory, if not
- -- specified.
+ -- Check if this is a subunit
- if Data.Extends = No_Project
- and then Data.Object_Directory = Data.Directory
- then
- Data.Object_Directory := No_Path;
- end if;
+ if In_Tree.Sources.Table (Name_Loc.Source).Unit /= No_Name
+ and then
+ In_Tree.Sources.Table (Name_Loc.Source).Kind = Impl
+ then
+ Src_Ind := Sinput.P.Load_Project_File
+ (Get_Name_String (Path_Id));
- else
- while Current /= Nil_String loop
- Element :=
- In_Tree.String_Elements.Table (Current);
- Get_Name_String (Element.Value);
- Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
- Name := Name_Find;
+ if Sinput.P.Source_File_Is_Subunit (Src_Ind) then
+ In_Tree.Sources.Table (Name_Loc.Source).Kind := Sep;
+ end if;
+ end if;
+ end if;
+ end if;
+ end if;
- -- If the element has no location, then use the
- -- location of Sources to report possible errors.
+ if Check_Name then
+ Check_Naming_Schemes
+ (In_Tree => In_Tree,
+ Data => Data,
+ Filename => Get_Name_String (File_Name),
+ File_Name => File_Name,
+ Alternate_Languages => Alternate_Languages,
+ Language => Language,
+ Language_Name => Language_Name,
+ Display_Language_Name => Display_Language_Name,
+ Unit => Unit,
+ Lang_Kind => Lang_Kind,
+ Kind => Kind);
+
+ if Language = No_Language_Index then
+ if Name_Loc.Found then
+ -- A file name in a list must be a source of a language.
+ Error_Msg_File_1 := File_Name;
+ Error_Msg
+ (Project,
+ In_Tree,
+ "language unknown for {",
+ Name_Loc.Location);
+ end if;
- if Element.Location = No_Location then
- Location := Sources.Location;
- else
- Location := Element.Location;
- end if;
+ else
+ -- Check if the same file name or unit is used in the prj tree
- Source_Names.Set
- (K => Name,
- E =>
- (Name => Name,
- Location => Location,
- Source => No_Source,
- Except => False,
- Found => False));
+ Source := In_Tree.First_Source;
+ Add_Src := True;
+ while Source /= No_Source loop
+ Src_Data := In_Tree.Sources.Table (Source);
- Current := Element.Next;
- end loop;
+ if (Unit /= No_Name
+ and then Src_Data.Unit = Unit
+ and then Src_Data.Kind = Kind)
+ or else (Unit = No_Name
+ and then Src_Data.File = File_Name)
+ then
+ -- Duplication of file/unit in same project is only
+ -- allowed if order of source directories is known.
- Get_Path_Names_And_Record_Sources (Follow_Links);
- end if;
- end;
+ if Project = Src_Data.Project then
+ if Data.Known_Order_Of_Source_Dirs then
+ Add_Src := False;
- -- No source_files specified
+ elsif Unit /= No_Name then
+ Error_Msg_Name_1 := Unit;
+ Error_Msg
+ (Project, In_Tree,
+ "duplicate unit %%",
+ No_Location);
+ Add_Src := False;
- -- We check Source_List_File has been specified
+ else
+ Error_Msg_File_1 := File_Name;
+ Error_Msg
+ (Project, In_Tree,
+ "duplicate source file " &
+ "name {",
+ No_Location);
+ Add_Src := False;
+ end if;
- elsif not Source_List_File.Default then
+ -- Do not allow the same unit name in different
+ -- projects, except if one is extending the other.
- -- Source_List_File is the name of the file
- -- that contains the source file names
+ -- For a file based language, the same file name
+ -- replaces a file in a project being extended, but
+ -- it is allowed to have the same file name in
+ -- unrelated projects.
- declare
- Source_File_Path_Name : constant String :=
- Path_Name_Of
- (File_Name_Type
- (Source_List_File.Value),
- Data.Directory);
+ elsif Is_Extending
+ (Project, Src_Data.Project, In_Tree)
+ then
+ Source_To_Replace := Source;
- begin
- if Source_File_Path_Name'Length = 0 then
- Err_Vars.Error_Msg_File_1 :=
- File_Name_Type (Source_List_File.Value);
+ elsif Unit /= No_Name then
+ Error_Msg_Name_1 := Unit;
Error_Msg
(Project, In_Tree,
- "file with sources { does not exist",
- Source_List_File.Location);
-
- else
- Get_Sources_From_File
- (Source_File_Path_Name,
- Source_List_File.Location);
+ "unit %% cannot belong to " &
+ "several projects",
+ No_Location);
+ Add_Src := False;
end if;
- end;
+ end if;
- else
- -- Neither Source_Files nor Source_List_File has been
- -- specified. Find all the files that satisfy the naming
- -- scheme in all the source directories.
+ Source := Src_Data.Next_In_Sources;
+ end loop;
- Find_Ada_Sources
- (Project, In_Tree, Data, Follow_Links);
+ if Add_Src then
+ Add_Source
+ (Id => Source,
+ Data => Data,
+ In_Tree => In_Tree,
+ Project => Project,
+ Lang => Language_Name,
+ Lang_Id => Language,
+ Lang_Kind => Lang_Kind,
+ Kind => Kind,
+ Alternate_Languages => Alternate_Languages,
+ File_Name => File_Name,
+ Display_File => Display_File_Name,
+ Unit => Unit,
+ Path => Path_Id,
+ Display_Path => Display_Path_Id,
+ Source_To_Replace => Source_To_Replace);
end if;
+ end if;
+ end if;
+ end Check_File;
- -- If there are sources that are locally removed, mark them as
- -- such in the Units table.
+ ------------------------
+ -- Search_Directories --
+ ------------------------
- if not Excluded_Sources.Default then
+ procedure Search_Directories
+ (Project : Project_Id;
+ In_Tree : Project_Tree_Ref;
+ Data : in out Project_Data;
+ For_All_Sources : Boolean)
+ is
+ Source_Dir : String_List_Id;
+ Element : String_Element;
+ Dir : Dir_Type;
+ Name : String (1 .. 1_000);
+ Last : Natural;
+ File_Name : File_Name_Type;
+ Display_File_Name : File_Name_Type;
+
+ begin
+ if Current_Verbosity = High then
+ Write_Line ("Looking for sources:");
+ end if;
+
+ -- Loop through subdirectories
+
+ Source_Dir := Data.Source_Dirs;
+ while Source_Dir /= Nil_String loop
+ begin
+ Element := In_Tree.String_Elements.Table (Source_Dir);
+ if Element.Value /= No_Name then
+ Get_Name_String (Element.Display_Value);
declare
- Current : String_List_Id := Excluded_Sources.Values;
- Element : String_Element;
- Location : Source_Ptr;
- OK : Boolean;
- Unit : Unit_Data;
- Name : File_Name_Type;
- Extended : Project_Id;
+ Source_Directory : constant String :=
+ Name_Buffer (1 .. Name_Len) &
+ Directory_Separator;
+ Dir_Last : constant Natural :=
+ Compute_Directory_Last
+ (Source_Directory);
begin
- while Current /= Nil_String loop
- Element := In_Tree.String_Elements.Table (Current);
- Get_Name_String (Element.Value);
- Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
- Name := Name_Find;
+ if Current_Verbosity = High then
+ Write_Str ("Source_Dir = ");
+ Write_Line (Source_Directory);
+ end if;
+
+ -- We look to every entry in the source directory
- -- If the element has no location, then use the location
- -- of Excluded_Sources to report possible errors.
+ Open (Dir, Source_Directory);
- if Element.Location = No_Location then
- Location := Excluded_Sources.Location;
- else
- Location := Element.Location;
- end if;
+ loop
+ Read (Dir, Name, Last);
- OK := False;
+ exit when Last = 0;
- for Index in Unit_Table.First ..
- Unit_Table.Last (In_Tree.Units)
- loop
- Unit := In_Tree.Units.Table (Index);
+ -- ??? Duplicate system call here, we just did a
+ -- a similar one. Maybe Ada.Directories would be more
+ -- appropriate here
+ if Is_Regular_File
+ (Source_Directory & Name (1 .. Last))
+ then
+ if Current_Verbosity = High then
+ Write_Str (" Checking ");
+ Write_Line (Name (1 .. Last));
+ end if;
- if Unit.File_Names (Specification).Name = Name then
- OK := True;
+ Name_Len := Last;
+ Name_Buffer (1 .. Name_Len) := Name (1 .. Last);
+ Display_File_Name := Name_Find;
- -- Check that this is from the current project or
- -- that the current project extends.
+ if Osint.File_Names_Case_Sensitive then
+ File_Name := Display_File_Name;
+ else
+ Canonical_Case_File_Name
+ (Name_Buffer (1 .. Name_Len));
+ File_Name := Name_Find;
+ end if;
- Extended := Unit.File_Names
- (Specification).Project;
+ declare
+ FF : File_Found :=
+ Excluded_Sources_Htable.Get (File_Name);
- if Extended = Project or else
- Project_Extends (Project, Extended, In_Tree)
- then
- Unit.File_Names
- (Specification).Path := Slash;
- Unit.File_Names
- (Specification).Needs_Pragma := False;
- In_Tree.Units.Table (Index) := Unit;
- Add_Forbidden_File_Name
- (Unit.File_Names (Specification).Name);
- exit;
+ begin
+ if FF /= No_File_Found then
+ if not FF.Found then
+ FF.Found := True;
+ Excluded_Sources_Htable.Set
+ (File_Name, FF);
+
+ if Current_Verbosity = High then
+ Write_Str (" excluded source """);
+ Write_Str (Get_Name_String (File_Name));
+ Write_Line ("""");
+ end if;
+ end if;
else
- Error_Msg
- (Project, In_Tree,
- "cannot remove a source from " &
- "another project",
- Location);
+ Check_File
+ (Project => Project,
+ In_Tree => In_Tree,
+ Data => Data,
+ Name => Name (1 .. Last),
+ File_Name => File_Name,
+ Display_File_Name => Display_File_Name,
+ Source_Directory => Source_Directory
+ (Source_Directory'First .. Dir_Last),
+ For_All_Sources => For_All_Sources);
end if;
+ end;
+ end if;
+ end loop;
- elsif
- Unit.File_Names (Body_Part).Name = Name
- then
- OK := True;
+ Close (Dir);
+ end;
+ end if;
- -- Check that this is from the current project or
- -- that the current project extends.
+ exception
+ when Directory_Error =>
+ null;
+ end;
+ Source_Dir := Element.Next;
+ end loop;
- Extended := Unit.File_Names
- (Body_Part).Project;
+ if Current_Verbosity = High then
+ Write_Line ("end Looking for sources.");
+ end if;
+ end Search_Directories;
- if Extended = Project or else
- Project_Extends (Project, Extended, In_Tree)
- then
- Unit.File_Names (Body_Part).Path := Slash;
- Unit.File_Names (Body_Part).Needs_Pragma
- := False;
- In_Tree.Units.Table (Index) := Unit;
- Add_Forbidden_File_Name
- (Unit.File_Names (Body_Part).Name);
- exit;
- end if;
+ ----------------------
+ -- Look_For_Sources --
+ ----------------------
- end if;
- end loop;
+ procedure Look_For_Sources
+ (Project : Project_Id;
+ In_Tree : Project_Tree_Ref;
+ Data : in out Project_Data;
+ Current_Dir : String)
+ is
+ procedure Remove_Locally_Removed_Files_From_Units;
+ -- Mark all locally removed sources as such in the Units table
+
+ procedure Process_Other_Sources_In_Ada_Only_Mode;
+ -- Find sources for language other than Ada when in Ada_Only mode
- if not OK then
- Err_Vars.Error_Msg_File_1 := Name;
+ procedure Process_Sources_In_Multi_Language_Mode;
+ -- Find all source files when in multi language mode
+
+ ---------------------------------------------
+ -- Remove_Locally_Removed_Files_From_Units --
+ ---------------------------------------------
+
+ procedure Remove_Locally_Removed_Files_From_Units is
+ Excluded : File_Found := Excluded_Sources_Htable.Get_First;
+ OK : Boolean;
+ Unit : Unit_Data;
+ Extended : Project_Id;
+ begin
+ while Excluded /= No_File_Found loop
+ OK := False;
+
+ For_Each_Unit :
+ for Index in Unit_Table.First ..
+ Unit_Table.Last (In_Tree.Units)
+ loop
+ Unit := In_Tree.Units.Table (Index);
+
+ for Kind in Spec_Or_Body'Range loop
+ if Unit.File_Names (Kind).Name = Excluded.File then
+ OK := True;
+
+ -- Check that this is from the current project or
+ -- that the current project extends.
+
+ Extended := Unit.File_Names (Kind).Project;
+
+ if Extended = Project
+ or else Project_Extends (Project, Extended, In_Tree)
+ then
+ Unit.File_Names (Kind).Path := Slash;
+ Unit.File_Names (Kind).Needs_Pragma := False;
+ In_Tree.Units.Table (Index) := Unit;
+ Add_Forbidden_File_Name
+ (Unit.File_Names (Kind).Name);
+ else
Error_Msg
- (Project, In_Tree, "unknown file {", Location);
+ (Project, In_Tree,
+ "cannot remove a source from " &
+ "another project",
+ Excluded.Location);
end if;
+ exit For_Each_Unit;
+ end if;
+ end loop;
+ end loop For_Each_Unit;
- Current := Element.Next;
- end loop;
- end;
+ if not OK then
+ Err_Vars.Error_Msg_File_1 := Excluded.File;
+ Error_Msg
+ (Project, In_Tree, "unknown file {", Excluded.Location);
end if;
- end;
- end if;
- if Get_Mode = Ada_Only and then Data.Other_Sources_Present then
+ Excluded := Excluded_Sources_Htable.Get_Next;
+ end loop;
+ end Remove_Locally_Removed_Files_From_Units;
+ --------------------------------------------
+ -- Process_Other_Sources_In_Ada_Only_Mode --
+ --------------------------------------------
+
+ procedure Process_Other_Sources_In_Ada_Only_Mode is
+ begin
-- Set Source_Present to False. It will be set back to True
-- whenever a source is found.
@@ -7923,20 +8363,22 @@ package body Prj.Nmsc is
Element_Id := Naming_Exceptions.Values;
while Element_Id /= Nil_String loop
- Element := In_Tree.String_Elements.Table
- (Element_Id);
- Get_Name_String (Element.Value);
- Canonical_Case_File_Name
- (Name_Buffer (1 .. Name_Len));
- File_Id := Name_Find;
+ Element := In_Tree.String_Elements.Table (Element_Id);
+
+ if Osint.File_Names_Case_Sensitive then
+ File_Id := File_Name_Type (Element.Value);
+ else
+ Get_Name_String (Element.Value);
+ Canonical_Case_File_Name
+ (Name_Buffer (1 .. Name_Len));
+ File_Id := Name_Find;
+ end if;
-- Put each naming exception in the Source_Names
-- hash table, but if there are repetition, don't
-- bother after the first instance.
- if
- Source_Names.Get (File_Id) = No_Name_Location
- then
+ if Source_Names.Get (File_Id) = No_Name_Location then
Source_Found := True;
Source_Names.Set
(File_Id,
@@ -7971,375 +8413,147 @@ package body Prj.Nmsc is
-- we will consider only those naming exceptions that are
-- on the list.
- declare
- Sources : constant Variable_Value :=
- Util.Value_Of
- (Name_Source_Files,
- Data.Decl.Attributes,
- In_Tree);
-
- Source_List_File : constant Variable_Value :=
- Util.Value_Of
- (Name_Source_List_File,
- Data.Decl.Attributes,
- In_Tree);
-
- begin
- pragma Assert
- (Sources.Kind = List,
- "Source_Files is not a list");
-
- pragma Assert
- (Source_List_File.Kind = Single,
- "Source_List_File is not a single string");
-
- if not Sources.Default then
- if not Source_List_File.Default then
- Error_Msg
- (Project, In_Tree,
- "?both variables source_files and " &
- "source_list_file are present",
- Source_List_File.Location);
- end if;
-
- -- Sources is a list of file names
-
- declare
- Current : String_List_Id := Sources.Values;
- Element : String_Element;
- Location : Source_Ptr;
- Name : File_Name_Type;
-
- begin
- Source_Names.Reset;
-
- -- Put all the sources in the Source_Names hash table
-
- while Current /= Nil_String loop
- Element :=
- In_Tree.String_Elements.Table
- (Current);
- Get_Name_String (Element.Value);
- Canonical_Case_File_Name
- (Name_Buffer (1 .. Name_Len));
- Name := Name_Find;
-
- -- If the element has no location, then use the
- -- location of Sources to report possible errors.
-
- if Element.Location = No_Location then
- Location := Sources.Location;
- else
- Location := Element.Location;
- end if;
-
- Source_Names.Set
- (K => Name,
- E =>
- (Name => Name,
- Location => Location,
- Source => No_Source,
- Except => False,
- Found => False));
-
- Current := Element.Next;
- end loop;
-
- -- And look for their directories
-
- Record_Other_Sources
- (Project => Project,
- In_Tree => In_Tree,
- Data => Data,
- Language => Lang,
- Naming_Exceptions => False);
- end;
-
- -- No source_files specified
-
- -- We check if Source_List_File has been specified
-
- elsif not Source_List_File.Default then
-
- -- Source_List_File is the name of the file
- -- that contains the source file names
-
- declare
- Source_File_Path_Name : constant String :=
- Path_Name_Of
- (File_Name_Type (Source_List_File.Value),
- Data.Directory);
-
- begin
- if Source_File_Path_Name'Length = 0 then
- Err_Vars.Error_Msg_File_1 :=
- File_Name_Type (Source_List_File.Value);
-
- Error_Msg
- (Project, In_Tree,
- "file with sources { does not exist",
- Source_List_File.Location);
-
- else
- -- Read the file, putting each source in the
- -- Source_Names hash table.
-
- Get_Sources_From_File
- (Source_File_Path_Name,
- Source_List_File.Location,
- Project, In_Tree);
-
- -- And look for their directories
-
- Record_Other_Sources
- (Project => Project,
- In_Tree => In_Tree,
- Data => Data,
- Language => Lang,
- Naming_Exceptions => False);
- end if;
- end;
-
- -- Neither Source_Files nor Source_List_File was specified
-
- else
- -- Find all the files that satisfy the naming scheme in
- -- all the source directories. All the naming exceptions
- -- that effectively exist are also part of the source
- -- of this language.
-
- Find_Sources (Project, In_Tree, Data, Lang);
- end if;
- end;
+ Source_Names.Reset;
+ Find_Explicit_Sources
+ (Lang, Current_Dir, Project, In_Tree, Data);
end if;
end loop;
- end if;
+ end Process_Other_Sources_In_Ada_Only_Mode;
- if Get_Mode = Multi_Language and then
- Data.First_Language_Processing /= No_Language_Index
- then
+ --------------------------------------------
+ -- Process_Sources_In_Multi_Language_Mode --
+ --------------------------------------------
+
+ procedure Process_Sources_In_Multi_Language_Mode is
+ Source : Source_Id := Data.First_Source;
+ Src_Data : Source_Data;
+ Name_Loc : Name_Location;
+ OK : Boolean;
+ FF : File_Found;
+ begin
-- First, put all the naming exceptions, if any, in the Source_Names
-- table.
- Source_Names.Reset;
-
- declare
- Source : Source_Id;
- Src_Data : Source_Data;
- Name_Loc : Name_Location;
-
- begin
- Source := Data.First_Source;
-
- while Source /= No_Source loop
- Src_Data := In_Tree.Sources.Table (Source);
- Name_Loc := (Name => Src_Data.File,
- Location => No_Location,
- Source => Source,
- Except => Src_Data.Unit /= No_Name,
- Found => False);
-
- if Current_Verbosity = High then
- Write_Str ("Putting source #");
- Write_Str (Source'Img);
- Write_Str (", file ");
- Write_Str (Get_Name_String (Src_Data.File));
- Write_Line (" in Source_Names");
- end if;
-
- Source_Names.Set
- (K => Src_Data.File,
- E => Name_Loc);
-
- Source := Src_Data.Next_In_Project;
- end loop;
- end;
-
- -- Now check attributes Sources and Source_List_File
-
- declare
- Sources : constant Variable_Value :=
- Util.Value_Of
- (Name_Source_Files,
- Data.Decl.Attributes,
- In_Tree);
-
- Source_List_File : constant Variable_Value :=
- Util.Value_Of
- (Name_Source_List_File,
- Data.Decl.Attributes,
- In_Tree);
-
- Name_Loc : Name_Location;
-
- begin
- if not Sources.Default then
- if not Source_List_File.Default then
- Error_Msg
- (Project, In_Tree,
- "?both variables source_files and " &
- "source_list_file are present",
- Source_List_File.Location);
- end if;
-
- -- Sources is a list of file names
-
- declare
- Current : String_List_Id := Sources.Values;
- Element : String_Element;
- Location : Source_Ptr;
- Name : File_Name_Type;
-
- begin
- if Current = Nil_String then
- Data.First_Language_Processing := No_Language_Index;
-
- -- This project contains no source. For projects that
- -- don't extend other projects, this also means that
- -- there is no need for an object directory, if not
- -- specified.
-
- if Data.Extends = No_Project
- and then Data.Object_Directory = Data.Directory
- then
- Data.Object_Directory := No_Path;
- end if;
- end if;
-
- while Current /= Nil_String loop
- Element :=
- In_Tree.String_Elements.Table (Current);
- Get_Name_String (Element.Value);
- Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
- Name := Name_Find;
+ Unit_Exceptions.Reset;
- -- If the element has no location, then use the
- -- location of Sources to report possible errors.
+ while Source /= No_Source loop
+ Src_Data := In_Tree.Sources.Table (Source);
- if Element.Location = No_Location then
- Location := Sources.Location;
- else
- Location := Element.Location;
- end if;
+ -- A file that is excluded cannot also be an exception file name
- Name_Loc := Source_Names.Get (Name);
+ if Excluded_Sources_Htable.Get (Src_Data.File) /=
+ No_File_Found
+ then
+ Error_Msg_File_1 := Src_Data.File;
+ Error_Msg
+ (Project,
+ In_Tree,
+ "{ cannot be both excluded and an exception file name",
+ No_Location);
+ end if;
- if Name_Loc = No_Name_Location then
- Name_Loc :=
- (Name => Name,
- Location => Location,
- Source => No_Source,
- Except => False,
- Found => False);
- Source_Names.Set (Name, Name_Loc);
- end if;
+ Name_Loc := (Name => Src_Data.File,
+ Location => No_Location,
+ Source => Source,
+ Except => Src_Data.Unit /= No_Name,
+ Found => False);
- Current := Element.Next;
- end loop;
- end;
+ if Current_Verbosity = High then
+ Write_Str ("Putting source #");
+ Write_Str (Source'Img);
+ Write_Str (", file ");
+ Write_Str (Get_Name_String (Src_Data.File));
+ Write_Line (" in Source_Names");
+ end if;
- elsif not Source_List_File.Default then
+ Source_Names.Set (K => Src_Data.File, E => Name_Loc);
- -- Source_List_File is the name of the file
- -- that contains the source file names
+ -- If this is an Ada exception, record it in table Unit_Exceptions
+ if Src_Data.Unit /= No_Name then
declare
- Source_File_Path_Name : constant String :=
- Path_Name_Of
- (File_Name_Type
- (Source_List_File.Value),
- Data.Directory);
+ Unit_Except : Unit_Exception :=
+ Unit_Exceptions.Get (Src_Data.Unit);
begin
- if Source_File_Path_Name'Length = 0 then
- Err_Vars.Error_Msg_File_1 :=
- File_Name_Type (Source_List_File.Value);
- Error_Msg
- (Project, In_Tree,
- "file with sources { does not exist",
- Source_List_File.Location);
+ Unit_Except.Name := Src_Data.Unit;
+ if Src_Data.Kind = Spec then
+ Unit_Except.Spec := Src_Data.File;
else
- Get_Sources_From_File
- (Source_File_Path_Name,
- Source_List_File.Location);
+ Unit_Except.Impl := Src_Data.File;
end if;
+
+ Unit_Exceptions.Set (Src_Data.Unit, Unit_Except);
end;
end if;
- Search_Directories
- (For_All_Sources =>
- Sources.Default and then Source_List_File.Default);
+ Source := Src_Data.Next_In_Project;
+ end loop;
- -- If there are locally removed sources, mark them as such
+ Find_Explicit_Sources
+ (Ada_Language_Index, Current_Dir, Project, In_Tree, Data);
- if not Excluded_Sources.Default then
- declare
- Current : String_List_Id;
- Element : String_Element;
- Location : Source_Ptr;
- OK : Boolean;
- Name : File_Name_Type;
- Source : Source_Id;
- Src_Data : Source_Data;
+ FF := Excluded_Sources_Htable.Get_First;
- begin
- Current := Excluded_Sources.Values;
- while Current /= Nil_String loop
- Element :=
- In_Tree.String_Elements.Table (Current);
- Get_Name_String (Element.Value);
- Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
- Name := Name_Find;
+ while FF /= No_File_Found loop
+ OK := False;
+ Source := In_Tree.First_Source;
- -- If the element has no location, then use the location
- -- of Excluded_Sources to report possible errors.
+ while Source /= No_Source loop
+ Src_Data := In_Tree.Sources.Table (Source);
- if Element.Location = No_Location then
- Location := Excluded_Sources.Location;
- else
- Location := Element.Location;
- end if;
+ if Src_Data.File = FF.File then
- OK := False;
+ -- Check that this is from this project or a
+ -- project that the current project extends.
- Source := In_Tree.First_Source;
+ if Src_Data.Project = Project or else
+ Is_Extending (Project, Src_Data.Project, In_Tree)
+ then
+ Src_Data.Locally_Removed := True;
+ In_Tree.Sources.Table (Source) := Src_Data;
+ Add_Forbidden_File_Name (FF.File);
+ OK := True;
+ exit;
+ end if;
+ end if;
- while Source /= No_Source loop
- Src_Data := In_Tree.Sources.Table (Source);
+ Source := Src_Data.Next_In_Sources;
+ end loop;
- if Src_Data.File = Name then
+ if not FF.Found and not OK then
+ Err_Vars.Error_Msg_File_1 := FF.File;
+ Error_Msg (Project, In_Tree, "unknown file {", FF.Location);
+ end if;
- -- Check that this is from this project or a
- -- project that the current project extends.
+ FF := Excluded_Sources_Htable.Get_Next;
+ end loop;
+ end Process_Sources_In_Multi_Language_Mode;
- if Src_Data.Project = Project or else
- Is_Extending
- (Project, Src_Data.Project, In_Tree)
- then
- Src_Data.Locally_Removed := True;
- In_Tree.Sources.Table (Source) := Src_Data;
- Add_Forbidden_File_Name (Name);
- OK := True;
- exit;
- end if;
- end if;
+ -- Start of processing for Look_For_Sources
- Source := Src_Data.Next_In_Sources;
- end loop;
+ begin
+ Source_Names.Reset;
+ Find_Excluded_Sources (In_Tree, Data);
+
+ case Get_Mode is
+ when Ada_Only =>
+ if Is_A_Language (In_Tree, Data, Name_Ada) then
+ Find_Explicit_Sources
+ (Ada_Language_Index, Current_Dir, Project, In_Tree, Data);
+ Remove_Locally_Removed_Files_From_Units;
+ end if;
- if not OK then
- Err_Vars.Error_Msg_File_1 := Name;
- Error_Msg
- (Project, In_Tree, "unknown file {", Location);
- end if;
+ if Data.Other_Sources_Present then
+ Process_Other_Sources_In_Ada_Only_Mode;
+ end if;
- Current := Element.Next;
- end loop;
- end;
+ when Multi_Language =>
+ if Data.First_Language_Processing /= No_Language_Index then
+ Process_Sources_In_Multi_Language_Mode;
end if;
- end;
- end if;
+ end case;
end Look_For_Sources;
------------------
@@ -8445,7 +8659,7 @@ package body Prj.Nmsc is
Location : Source_Ptr;
Current_Source : in out String_List_Id;
Source_Recorded : in out Boolean;
- Follow_Links : Boolean)
+ Current_Dir : String)
is
Canonical_File_Name : File_Name_Type;
Canonical_Path_Name : Path_Name_Type;
@@ -8467,21 +8681,27 @@ package body Prj.Nmsc is
File_Name_Recorded : Boolean := False;
begin
- Get_Name_String (File_Name);
- Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
- Canonical_File_Name := Name_Find;
+ if Osint.File_Names_Case_Sensitive then
+ Canonical_File_Name := File_Name;
+ Canonical_Path_Name := Path_Name;
+ else
+ Get_Name_String (File_Name);
+ Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
+ Canonical_File_Name := Name_Find;
- declare
- Canonical_Path : constant String :=
- Normalize_Pathname
- (Get_Name_String (Path_Name),
- Resolve_Links => Follow_Links,
- Case_Sensitive => False);
- begin
- Name_Len := 0;
- Add_Str_To_Name_Buffer (Canonical_Path);
- Canonical_Path_Name := Name_Find;
- end;
+ declare
+ Canonical_Path : constant String :=
+ Normalize_Pathname
+ (Get_Name_String (Path_Name),
+ Directory => Current_Dir,
+ Resolve_Links => Opt.Follow_Links_For_Files,
+ Case_Sensitive => False);
+ begin
+ Name_Len := 0;
+ Add_Str_To_Name_Buffer (Canonical_Path);
+ Canonical_Path_Name := Name_Find;
+ end;
+ end if;
-- Find out the unit name, the unit kind and if it needs
-- a specific SFN pragma.
diff --git a/gcc/ada/prj-nmsc.ads b/gcc/ada/prj-nmsc.ads
index 448138e..4efdf26 100644
--- a/gcc/ada/prj-nmsc.ads
+++ b/gcc/ada/prj-nmsc.ads
@@ -35,8 +35,8 @@ private package Prj.Nmsc is
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
Report_Error : Put_Line_Access;
- Follow_Links : Boolean;
- When_No_Sources : Error_Warning);
+ When_No_Sources : Error_Warning;
+ Current_Dir : String);
-- Check the object directory and the source directories
--
-- Check the library attributes, including the library directory if any
@@ -53,10 +53,7 @@ private package Prj.Nmsc is
-- If Report_Error is null , use the standard error reporting mechanism
-- (Errout). Otherwise, report errors using Report_Error.
--
- -- If Follow_Links is False, it is assumed that the project doesn't contain
- -- any file duplicated through symbolic links (although the latter are
- -- still valid if they point to a file which is outside of the project),
- -- and that no directory has a name which is a valid source name.
+ -- Current_Dir is for optimization purposes only, avoiding system calls.
--
-- When_No_Sources indicates what should be done when no sources of a
-- language are found in a project where this language is declared.
diff --git a/gcc/ada/prj-pars.adb b/gcc/ada/prj-pars.adb
index 7a46de5..fb277b4 100644
--- a/gcc/ada/prj-pars.adb
+++ b/gcc/ada/prj-pars.adb
@@ -24,8 +24,8 @@
------------------------------------------------------------------------------
with Ada.Exceptions; use Ada.Exceptions;
+with GNAT.Directory_Operations; use GNAT.Directory_Operations;
-with Opt;
with Output; use Output;
with Prj.Err; use Prj.Err;
with Prj.Part;
@@ -52,6 +52,7 @@ package body Prj.Pars is
Project_Node : Project_Node_Id := Empty_Node;
The_Project : Project_Id := No_Project;
Success : Boolean := True;
+ Current_Dir : constant String := Get_Current_Dir;
begin
Prj.Tree.Initialize (Project_Node_Tree);
@@ -64,7 +65,8 @@ package body Prj.Pars is
Project => Project_Node,
Project_File_Name => Project_File_Name,
Always_Errout_Finalize => False,
- Packages_To_Check => Packages_To_Check);
+ Packages_To_Check => Packages_To_Check,
+ Current_Directory => Current_Dir);
-- If there were no error, process the tree
@@ -76,9 +78,9 @@ package body Prj.Pars is
From_Project_Node => Project_Node,
From_Project_Node_Tree => Project_Node_Tree,
Report_Error => null,
- Follow_Links => Opt.Follow_Links,
When_No_Sources => When_No_Sources,
- Reset_Tree => Reset_Tree);
+ Reset_Tree => Reset_Tree,
+ Current_Dir => Current_Dir);
Prj.Err.Finalize;
if not Success then
diff --git a/gcc/ada/prj-part.adb b/gcc/ada/prj-part.adb
index f576841..3c46138 100644
--- a/gcc/ada/prj-part.adb
+++ b/gcc/ada/prj-part.adb
@@ -39,8 +39,6 @@ with Table;
with Ada.Characters.Handling; use Ada.Characters.Handling;
with Ada.Exceptions; use Ada.Exceptions;
-with GNAT.Directory_Operations; use GNAT.Directory_Operations;
-
with System.HTable; use System.HTable;
package body Prj.Part is
@@ -48,7 +46,7 @@ package body Prj.Part is
Buffer : String_Access;
Buffer_Last : Natural := 0;
- Dir_Sep : Character renames GNAT.OS_Lib.Directory_Separator;
+ Dir_Sep : Character renames GNAT.OS_Lib.Directory_Separator;
------------------------------------
-- Local Packages and Subprograms --
@@ -116,6 +114,15 @@ package body Prj.Part is
-- need to have a virtual extending project, to avoid processing the same
-- project twice.
+ package Projects_Paths is new System.HTable.Simple_HTable
+ (Header_Num => Header_Num,
+ Element => Path_Name_Type,
+ No_Element => No_Path,
+ Key => Name_Id,
+ Hash => Hash,
+ Equal => "=");
+ -- Hash table to cache project path to avoid looking for them on the path
+
procedure Create_Virtual_Extending_Project
(For_Project : Project_Node_Id;
Main_Project : Project_Node_Id;
@@ -153,7 +160,8 @@ package body Prj.Part is
From_Extended : Extension_Origin;
In_Limited : Boolean;
Packages_To_Check : String_List_Access;
- Depth : Natural);
+ Depth : Natural;
+ Current_Dir : String);
-- Parse the imported projects that have been stored in table Withs,
-- if any. From_Extended is used for the call to Parse_Single_Project
-- below. When In_Limited is True, the importing path includes at least
@@ -327,8 +335,7 @@ package body Prj.Part is
----------------------------
function Immediate_Directory_Of
- (Path_Name : Path_Name_Type)
- return Path_Name_Type
+ (Path_Name : Path_Name_Type) return Path_Name_Type
is
begin
Get_Name_String (Path_Name);
@@ -366,7 +373,6 @@ package body Prj.Part is
(Proj : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref;
Potentially_Virtual : Boolean)
-
is
Declaration : Project_Node_Id := Empty_Node;
-- Node for the project declaration of Proj
@@ -436,10 +442,9 @@ package body Prj.Part is
Project_File_Name : String;
Always_Errout_Finalize : Boolean;
Packages_To_Check : String_List_Access := All_Packages;
- Store_Comments : Boolean := False)
+ Store_Comments : Boolean := False;
+ Current_Directory : String := "")
is
- Current_Directory : constant String := Get_Current_Dir;
-
Dummy : Boolean;
pragma Warnings (Off, Dummy);
@@ -454,6 +459,8 @@ package body Prj.Part is
Project := Empty_Node;
+ Projects_Paths.Reset;
+
if Current_Verbosity >= Medium then
Write_Str ("GPR_PROJECT_PATH=""");
Write_Str (Project_Path);
@@ -476,7 +483,9 @@ package body Prj.Part is
if Path_Name = "" then
Prj.Com.Fail
- ("project file """, Project_File_Name, """ not found");
+ ("project file """,
+ Project_File_Name,
+ """ not found in " & Project_Path);
Project := Empty_Node;
return;
end if;
@@ -490,7 +499,8 @@ package body Prj.Part is
From_Extended => None,
In_Limited => False,
Packages_To_Check => Packages_To_Check,
- Depth => 0);
+ Depth => 0,
+ Current_Dir => Current_Directory);
-- If Project is an extending-all project, create the eventual
-- virtual extending projects and check that there are no illegally
@@ -601,12 +611,10 @@ package body Prj.Part is
(In_Tree : Project_Node_Tree_Ref;
Context_Clause : out With_Id)
is
- Current_With_Clause : With_Id := No_With;
- Limited_With : Boolean := False;
-
- Current_With : With_Record;
-
- Current_With_Node : Project_Node_Id := Empty_Node;
+ Current_With_Clause : With_Id := No_With;
+ Limited_With : Boolean := False;
+ Current_With : With_Record;
+ Current_With_Node : Project_Node_Id := Empty_Node;
begin
-- Assume no context clause
@@ -704,7 +712,8 @@ package body Prj.Part is
From_Extended : Extension_Origin;
In_Limited : Boolean;
Packages_To_Check : String_List_Access;
- Depth : Natural)
+ Depth : Natural;
+ Current_Dir : String)
is
Current_With_Clause : With_Id := Context_Clause;
@@ -739,7 +748,8 @@ package body Prj.Part is
Resolved_Path : constant String :=
Normalize_Pathname
(Imported_Path_Name,
- Resolve_Links => True,
+ Directory => Current_Dir,
+ Resolve_Links => Opt.Follow_Links_For_Files,
Case_Sensitive => True);
Withed_Project : Project_Node_Id := Empty_Node;
@@ -828,7 +838,8 @@ package body Prj.Part is
From_Extended => From_Extended,
In_Limited => Limited_With,
Packages_To_Check => Packages_To_Check,
- Depth => Depth);
+ Depth => Depth,
+ Current_Dir => Current_Dir);
else
Extends_All := Is_Extending_All (Withed_Project, In_Tree);
@@ -887,7 +898,8 @@ package body Prj.Part is
From_Extended : Extension_Origin;
In_Limited : Boolean;
Packages_To_Check : String_List_Access;
- Depth : Natural)
+ Depth : Natural;
+ Current_Dir : String)
is
Normed_Path_Name : Path_Name_Type;
Canonical_Path_Name : Path_Name_Type;
@@ -918,11 +930,15 @@ package body Prj.Part is
declare
Normed_Path : constant String := Normalize_Pathname
- (Path_Name, Resolve_Links => False,
- Case_Sensitive => True);
+ (Path_Name,
+ Directory => Current_Dir,
+ Resolve_Links => False,
+ Case_Sensitive => True);
Canonical_Path : constant String := Normalize_Pathname
- (Normed_Path, Resolve_Links => True,
- Case_Sensitive => False);
+ (Normed_Path,
+ Directory => Current_Dir,
+ Resolve_Links => Opt.Follow_Links_For_Files,
+ Case_Sensitive => False);
begin
Name_Len := Normed_Path'Length;
@@ -1224,16 +1240,17 @@ package body Prj.Part is
From_Extended => From_Ext,
In_Limited => In_Limited,
Packages_To_Check => Packages_To_Check,
- Depth => Depth + 1);
+ Depth => Depth + 1,
+ Current_Dir => Current_Dir);
Set_First_With_Clause_Of (Project, In_Tree, Imported_Projects);
end;
if not In_Configuration then
declare
Name_And_Node : Tree_Private_Part.Project_Name_And_Node :=
- Tree_Private_Part.Projects_Htable.Get_First
- (In_Tree.Projects_HT);
- Project_Name : Name_Id := Name_And_Node.Name;
+ Tree_Private_Part.Projects_Htable.Get_First
+ (In_Tree.Projects_HT);
+ Project_Name : Name_Id := Name_And_Node.Name;
begin
-- Check if we already have a project with this name
@@ -1340,7 +1357,8 @@ package body Prj.Part is
From_Extended => From_Ext,
In_Limited => In_Limited,
Packages_To_Check => Packages_To_Check,
- Depth => Depth + 1);
+ Depth => Depth + 1,
+ Current_Dir => Current_Dir);
end;
-- A project that extends an extending-all project is also
@@ -1561,9 +1579,9 @@ package body Prj.Part is
function Project_Name_From (Path_Name : String) return Name_Id is
Canonical : String (1 .. Path_Name'Length) := Path_Name;
- First : Natural := Canonical'Last;
- Last : Natural := First;
- Index : Positive;
+ First : Natural := Canonical'Last;
+ Last : Natural := First;
+ Index : Positive;
begin
if Current_Verbosity = High then
@@ -1694,7 +1712,35 @@ package body Prj.Part is
(Project_File_Name : String;
Directory : String) return String
is
- Result : String_Access;
+
+ function Try_Path_Name (Path : String) return String_Access;
+ pragma Inline (Try_Path_Name);
+ -- Try the specified Path
+
+ -------------------
+ -- Try_Path_Name --
+ -------------------
+
+ function Try_Path_Name (Path : String) return String_Access is
+ begin
+ if Current_Verbosity = High then
+ Write_Str (" Trying ");
+ Write_Str (Path);
+ end if;
+
+ return Locate_Regular_File
+ (File_Name => Path,
+ Path => Project_Path);
+ end Try_Path_Name;
+
+ -- Local Declarations
+
+ Result : String_Access;
+ Result_Id : Path_Name_Type;
+ Has_Dot : Boolean := False;
+ Key : Name_Id;
+
+ -- Start of processing for Project_Path_Name_Of
begin
if Current_Verbosity = High then
@@ -1705,70 +1751,60 @@ package body Prj.Part is
Write_Line (""");");
end if;
- if not Is_Absolute_Path (Project_File_Name) then
- -- First we try <directory>/<file_name>.<extension>
+ -- Check the project cache
- if Current_Verbosity = High then
- Write_Str (" Trying ");
- Write_Str (Directory);
- Write_Char (Directory_Separator);
- Write_Str (Project_File_Name);
- Write_Line (Project_File_Extension);
- end if;
+ Name_Len := Project_File_Name'Length;
+ Name_Buffer (1 .. Name_Len) := Project_File_Name;
+ Key := Name_Find;
+ Result_Id := Projects_Paths.Get (Key);
- Result :=
- Locate_Regular_File
- (File_Name => Directory & Directory_Separator &
- Project_File_Name & Project_File_Extension,
- Path => Project_Path);
+ if Result_Id /= No_Path then
+ return Get_Name_String (Result_Id);
+ end if;
- -- Then we try <directory>/<file_name>
+ -- Check if Project_File_Name contains an extension (a dot before a
+ -- directory separator). If it is the case we do not try project file
+ -- with an added extension as it is not possible to have multiple dots
+ -- on a project file name.
- if Result = null then
- if Current_Verbosity = High then
- Write_Str (" Trying ");
- Write_Str (Directory);
- Write_Char (Directory_Separator);
- Write_Line (Project_File_Name);
- end if;
-
- Result :=
- Locate_Regular_File
- (File_Name => Directory & Directory_Separator &
- Project_File_Name,
- Path => Project_Path);
+ Check_Dot : for K in reverse Project_File_Name'Range loop
+ if Project_File_Name (K) = '.' then
+ Has_Dot := True;
+ exit Check_Dot;
end if;
- end if;
- if Result = null then
+ exit Check_Dot when Project_File_Name (K) = Directory_Separator
+ or else Project_File_Name (K) = '/';
+ end loop Check_Dot;
- -- Then we try <file_name>.<extension>
+ if not Is_Absolute_Path (Project_File_Name) then
- if Current_Verbosity = High then
- Write_Str (" Trying ");
- Write_Str (Project_File_Name);
- Write_Line (Project_File_Extension);
+ -- First we try <directory>/<file_name>.<extension>
+
+ if not Has_Dot then
+ Result := Try_Path_Name
+ (Directory & Directory_Separator &
+ Project_File_Name & Project_File_Extension);
end if;
- Result :=
- Locate_Regular_File
- (File_Name => Project_File_Name & Project_File_Extension,
- Path => Project_Path);
+ -- Then we try <directory>/<file_name>
+
+ if Result = null then
+ Result := Try_Path_Name
+ (Directory & Directory_Separator & Project_File_Name);
+ end if;
end if;
- if Result = null then
+ -- Then we try <file_name>.<extension>
- -- Then we try <file_name>
+ if Result = null and then not Has_Dot then
+ Result := Try_Path_Name (Project_File_Name & Project_File_Extension);
+ end if;
- if Current_Verbosity = High then
- Write_Str (" Trying ");
- Write_Line (Project_File_Name);
- end if;
+ -- Then we try <file_name>
- Result :=
- Locate_Regular_File
- (File_Name => Project_File_Name,
- Path => Project_Path);
+ if Result = null then
+ Result := Try_Path_Name (Project_File_Name);
end if;
-- If we cannot find the project file, we return an empty string
@@ -1781,10 +1817,16 @@ package body Prj.Part is
Final_Result : constant String :=
GNAT.OS_Lib.Normalize_Pathname
(Result.all,
+ Directory => Directory,
Resolve_Links => False,
Case_Sensitive => True);
begin
Free (Result);
+ Name_Len := Final_Result'Length;
+ Name_Buffer (1 .. Name_Len) := Final_Result;
+ Result_Id := Name_Find;
+
+ Projects_Paths.Set (Key, Result_Id);
return Final_Result;
end;
end if;
diff --git a/gcc/ada/prj-part.ads b/gcc/ada/prj-part.ads
index 91e57e0..8e366bc 100644
--- a/gcc/ada/prj-part.ads
+++ b/gcc/ada/prj-part.ads
@@ -35,7 +35,8 @@ package Prj.Part is
Project_File_Name : String;
Always_Errout_Finalize : Boolean;
Packages_To_Check : String_List_Access := All_Packages;
- Store_Comments : Boolean := False);
+ Store_Comments : Boolean := False;
+ Current_Directory : String := "");
-- Parse project file and all its imported project files and create a tree.
-- Return the node for the project (or Empty_Node if parsing failed). If
-- Always_Errout_Finalize is True, Errout.Finalize is called in all cases,
@@ -44,6 +45,9 @@ package Prj.Part is
-- where any unknown attribute produces an error. For other packages, an
-- unknown attribute produces a warning. When Store_Comments is True,
-- comments are stored in the parse tree.
+ --
+ -- Current_Directory is used for optimization purposes only, avoiding extra
+ -- system calls.
type Extension_Origin is (None, Extending_Simple, Extending_All);
-- Type of parameter From_Extended for procedures Parse_Single_Project and
@@ -59,7 +63,8 @@ package Prj.Part is
From_Extended : Extension_Origin;
In_Limited : Boolean;
Packages_To_Check : String_List_Access;
- Depth : Natural);
+ Depth : Natural;
+ Current_Dir : String);
-- Parse a project file.
-- Recursive procedure: it calls itself for imported and extended
-- projects. When From_Extended is not None, if the project has already
diff --git a/gcc/ada/prj-proc.adb b/gcc/ada/prj-proc.adb
index c3c321c..385e035 100644
--- a/gcc/ada/prj-proc.adb
+++ b/gcc/ada/prj-proc.adb
@@ -77,10 +77,11 @@ package body Prj.Proc is
procedure Check
(In_Tree : Project_Tree_Ref;
Project : Project_Id;
- Follow_Links : Boolean;
+ Current_Dir : String;
When_No_Sources : Error_Warning);
-- Set all projects to not checked, then call Recursive_Check for the
-- main project Project. Project is set to No_Project if errors occurred.
+ -- Current_Dir is for optimization purposes, avoiding extra system calls.
procedure Copy_Package_Declarations
(From : Declarations;
@@ -140,11 +141,12 @@ package body Prj.Proc is
procedure Recursive_Check
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
- Follow_Links : Boolean;
+ Current_Dir : String;
When_No_Sources : Error_Warning);
-- If Project is not marked as checked, mark it as checked, call
-- Check_Naming_Scheme for the project, then call itself for a
-- possible extended project and all the imported projects of Project.
+ -- Current_Dir is for optimization purposes, avoiding extra system calls.
---------
-- Add --
@@ -258,7 +260,7 @@ package body Prj.Proc is
procedure Check
(In_Tree : Project_Tree_Ref;
Project : Project_Id;
- Follow_Links : Boolean;
+ Current_Dir : String;
When_No_Sources : Error_Warning)
is
begin
@@ -270,8 +272,7 @@ package body Prj.Proc is
In_Tree.Projects.Table (Index).Checked := False;
end loop;
- Recursive_Check
- (Project, In_Tree, Follow_Links, When_No_Sources);
+ Recursive_Check (Project, In_Tree, Current_Dir, When_No_Sources);
-- Set the Other_Part field for the units
@@ -1209,9 +1210,9 @@ package body Prj.Proc is
From_Project_Node : Project_Node_Id;
From_Project_Node_Tree : Project_Node_Tree_Ref;
Report_Error : Put_Line_Access;
- Follow_Links : Boolean := True;
When_No_Sources : Error_Warning := Error;
- Reset_Tree : Boolean := True)
+ Reset_Tree : Boolean := True;
+ Current_Dir : String := "")
is
begin
Process_Project_Tree_Phase_1
@@ -1231,8 +1232,8 @@ package body Prj.Proc is
From_Project_Node => From_Project_Node,
From_Project_Node_Tree => From_Project_Node_Tree,
Report_Error => Report_Error,
- Follow_Links => Follow_Links,
- When_No_Sources => When_No_Sources);
+ When_No_Sources => When_No_Sources,
+ Current_Dir => Current_Dir);
end if;
end Process;
@@ -2292,8 +2293,8 @@ package body Prj.Proc is
From_Project_Node : Project_Node_Id;
From_Project_Node_Tree : Project_Node_Tree_Ref;
Report_Error : Put_Line_Access;
- Follow_Links : Boolean := True;
- When_No_Sources : Error_Warning := Error)
+ When_No_Sources : Error_Warning := Error;
+ Current_Dir : String)
is
Obj_Dir : Path_Name_Type;
Extending : Project_Id;
@@ -2306,8 +2307,7 @@ package body Prj.Proc is
Success := True;
if Project /= No_Project then
- Check
- (In_Tree, Project, Follow_Links, When_No_Sources);
+ Check (In_Tree, Project, Current_Dir, When_No_Sources);
end if;
-- If main project is an extending all project, set the object
@@ -2428,7 +2428,7 @@ package body Prj.Proc is
procedure Recursive_Check
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
- Follow_Links : Boolean;
+ Current_Dir : String;
When_No_Sources : Error_Warning)
is
Data : Project_Data;
@@ -2451,8 +2451,7 @@ package body Prj.Proc is
-- Call itself for a possible extended project.
-- (if there is no extended project, then nothing happens).
- Recursive_Check
- (Data.Extends, In_Tree, Follow_Links, When_No_Sources);
+ Recursive_Check (Data.Extends, In_Tree, Current_Dir, When_No_Sources);
-- Call itself for all imported projects
@@ -2461,7 +2460,7 @@ package body Prj.Proc is
Recursive_Check
(In_Tree.Project_Lists.Table
(Imported_Project_List).Project,
- In_Tree, Follow_Links, When_No_Sources);
+ In_Tree, Current_Dir, When_No_Sources);
Imported_Project_List :=
In_Tree.Project_Lists.Table
(Imported_Project_List).Next;
@@ -2474,7 +2473,8 @@ package body Prj.Proc is
end if;
Prj.Nmsc.Check
- (Project, In_Tree, Error_Report, Follow_Links, When_No_Sources);
+ (Project, In_Tree, Error_Report, When_No_Sources,
+ Current_Dir);
end if;
end Recursive_Check;
diff --git a/gcc/ada/prj-proc.ads b/gcc/ada/prj-proc.ads
index b9f8215..1074f3a 100644
--- a/gcc/ada/prj-proc.ads
+++ b/gcc/ada/prj-proc.ads
@@ -38,17 +38,14 @@ package Prj.Proc is
From_Project_Node : Project_Node_Id;
From_Project_Node_Tree : Project_Node_Tree_Ref;
Report_Error : Put_Line_Access;
- Follow_Links : Boolean := True;
When_No_Sources : Error_Warning := Error;
- Reset_Tree : Boolean := True);
+ Reset_Tree : Boolean := True;
+ Current_Dir : String := "");
-- Process a project file tree into project file data structures. If
-- Report_Error is null, use the error reporting mechanism. Otherwise,
-- report errors using Report_Error.
--
- -- If Follow_Links is False, it is assumed that the project doesn't contain
- -- any file duplicated through symbolic links (although the latter are
- -- still valid if they point to a file which is outside of the project),
- -- and that no directory has a name which is a valid source name.
+ -- Current_Dir is for optimization purposes, avoiding extra system calls.
--
-- When_No_Sources indicates what should be done when no sources are found
-- in a project for a specified or implied language.
@@ -79,8 +76,8 @@ package Prj.Proc is
From_Project_Node : Project_Node_Id;
From_Project_Node_Tree : Project_Node_Tree_Ref;
Report_Error : Put_Line_Access;
- Follow_Links : Boolean := True;
- When_No_Sources : Error_Warning := Error);
+ When_No_Sources : Error_Warning := Error;
+ Current_Dir : String);
-- See documentation of parameters in procedure Process above
end Prj.Proc;
diff --git a/gcc/ada/prj.adb b/gcc/ada/prj.adb
index 0bd6028..8f6e1a7 100644
--- a/gcc/ada/prj.adb
+++ b/gcc/ada/prj.adb
@@ -232,10 +232,6 @@ package body Prj is
Naming : Naming_Data) return File_Name_Type
is
Language_Id : Name_Id;
- Element_Id : Array_Element_Id;
- Element : Array_Element;
- Suffix : File_Name_Type := No_File;
- Lang : Language_Index;
begin
Name_Len := 0;
@@ -243,6 +239,29 @@ package body Prj is
To_Lower (Name_Buffer (1 .. Name_Len));
Language_Id := Name_Find;
+ return
+ Body_Suffix_Id_Of
+ (In_Tree => In_Tree,
+ Language_Id => Language_Id,
+ Naming => Naming);
+ end Body_Suffix_Id_Of;
+
+ -----------------------
+ -- Body_Suffix_Id_Of --
+ -----------------------
+
+ function Body_Suffix_Id_Of
+ (In_Tree : Project_Tree_Ref;
+ Language_Id : Name_Id;
+ Naming : Naming_Data) return File_Name_Type
+ is
+ Element_Id : Array_Element_Id;
+ Element : Array_Element;
+ Suffix : File_Name_Type := No_File;
+ Lang : Language_Index;
+
+ begin
+ -- ??? This seems to be only for Ada_Only mode...
Element_Id := Naming.Body_Suffix;
while Element_Id /= No_Array_Element loop
Element := In_Tree.Array_Elements.Table (Element_Id);
@@ -526,8 +545,7 @@ package body Prj is
In_Tree.Projects.Table (Project).Seen := True;
Action (Project, With_State);
- List :=
- In_Tree.Projects.Table (Project).Imported_Projects;
+ List := In_Tree.Projects.Table (Project).Imported_Projects;
while List /= Empty_Project_List loop
Recursive_Check (In_Tree.Project_Lists.Table (List).Project);
List := In_Tree.Project_Lists.Table (List).Next;
@@ -560,6 +578,9 @@ package body Prj is
-- Hash --
----------
+ function Hash is new System.HTable.Hash (Header_Num => Header_Num);
+ -- Used in implementation of other functions Hash below
+
function Hash (Name : File_Name_Type) return Header_Num is
begin
return Hash (Get_Name_String (Name));
@@ -644,25 +665,16 @@ package body Prj is
function Is_A_Language
(Tree : Project_Tree_Ref;
Data : Project_Data;
- Language_Name : String) return Boolean
+ Language_Name : Name_Id) return Boolean
is
- Lang_Id : Name_Id;
-
begin
- Name_Len := 0;
- Add_Str_To_Name_Buffer (Language_Name);
- To_Lower (Name_Buffer (1 .. Name_Len));
- Lang_Id := Name_Find;
-
if Get_Mode = Ada_Only then
declare
List : Name_List_Index := Data.Languages;
-
begin
while List /= No_Name_List loop
- if Tree.Name_Lists.Table (List).Name = Lang_Id then
+ if Tree.Name_Lists.Table (List).Name = Language_Name then
return True;
-
else
List := Tree.Name_Lists.Table (List).Next;
end if;
@@ -671,15 +683,14 @@ package body Prj is
else
declare
- Lang_Ind : Language_Index;
+ Lang_Ind : Language_Index := Data.First_Language_Processing;
Lang_Data : Language_Data;
begin
- Lang_Ind := Data.First_Language_Processing;
while Lang_Ind /= No_Language_Index loop
Lang_Data := Tree.Languages_Data.Table (Lang_Ind);
- if Lang_Data.Name = Lang_Id then
+ if Lang_Data.Name = Language_Name then
return True;
end if;
@@ -734,10 +745,11 @@ package body Prj is
when others =>
declare
- Supp : Supp_Language;
- Supp_Index : Supp_Language_Index := In_Project.Supp_Languages;
+ Supp : Supp_Language;
+ Supp_Index : Supp_Language_Index;
begin
+ Supp_Index := In_Project.Supp_Languages;
while Supp_Index /= No_Supp_Language_Index loop
Supp := In_Tree.Present_Languages.Table (Supp_Index);
@@ -772,11 +784,11 @@ package body Prj is
when others =>
declare
- Supp : Supp_Language_Data;
- Supp_Index : Supp_Language_Index :=
- In_Project.Supp_Language_Processing;
+ Supp : Supp_Language_Data;
+ Supp_Index : Supp_Language_Index;
begin
+ Supp_Index := In_Project.Supp_Language_Processing;
while Supp_Index /= No_Supp_Language_Index loop
Supp := In_Tree.Supp_Languages.Table (Supp_Index);
@@ -811,7 +823,6 @@ package body Prj is
Language_Id := Name_Find;
Lang := In_Tree.First_Language;
-
while Lang /= No_Language_Index loop
if In_Tree.Languages_Data.Table (Lang).Name = Language_Id then
return
@@ -870,12 +881,11 @@ package body Prj is
Name_Buffer (1 .. Name_Len) := To_Lower (Name_Buffer (1 .. Name_Len));
Lang := Name_Find;
- Suffix := In_Tree.Private_Part.Default_Naming.Spec_Suffix;
- Found := False;
-
-- Look for an element of the spec sufix array indexed by the language
-- name. If one is found, put the default value.
+ Suffix := In_Tree.Private_Part.Default_Naming.Spec_Suffix;
+ Found := False;
while Suffix /= No_Array_Element and then not Found loop
Element := In_Tree.Array_Elements.Table (Suffix);
@@ -911,12 +921,11 @@ package body Prj is
Array_Element_Table.Last (In_Tree.Array_Elements);
end if;
- Suffix := In_Tree.Private_Part.Default_Naming.Body_Suffix;
- Found := False;
-
-- Look for an element of the body sufix array indexed by the language
-- name. If one is found, put the default value.
+ Suffix := In_Tree.Private_Part.Default_Naming.Body_Suffix;
+ Found := False;
while Suffix /= No_Array_Element and then not Found loop
Element := In_Tree.Array_Elements.Table (Suffix);
@@ -1048,17 +1057,17 @@ package body Prj is
when others =>
declare
- Supp : Supp_Language;
- Supp_Index : Supp_Language_Index := In_Project.Supp_Languages;
+ Supp : Supp_Language;
+ Supp_Index : Supp_Language_Index;
begin
+ Supp_Index := In_Project.Supp_Languages;
while Supp_Index /= No_Supp_Language_Index loop
- Supp := In_Tree.Present_Languages.Table
- (Supp_Index);
+ Supp := In_Tree.Present_Languages.Table (Supp_Index);
if Supp.Index = Language then
- In_Tree.Present_Languages.Table
- (Supp_Index).Present := Present;
+ In_Tree.Present_Languages.Table (Supp_Index).Present :=
+ Present;
return;
end if;
@@ -1069,8 +1078,8 @@ package body Prj is
Next => In_Project.Supp_Languages);
Present_Language_Table.Increment_Last
(In_Tree.Present_Languages);
- Supp_Index := Present_Language_Table.Last
- (In_Tree.Present_Languages);
+ Supp_Index :=
+ Present_Language_Table.Last (In_Tree.Present_Languages);
In_Tree.Present_Languages.Table (Supp_Index) :=
Supp;
In_Project.Supp_Languages := Supp_Index;
@@ -1095,7 +1104,7 @@ package body Prj is
when others =>
declare
- Supp : Supp_Language_Data;
+ Supp : Supp_Language_Data;
Supp_Index : Supp_Language_Index;
begin
@@ -1140,18 +1149,16 @@ package body Prj is
when others =>
declare
- Supp : Supp_Suffix;
- Supp_Index : Supp_Language_Index :=
- In_Project.Naming.Supp_Suffixes;
+ Supp : Supp_Suffix;
+ Supp_Index : Supp_Language_Index;
begin
+ Supp_Index := In_Project.Naming.Supp_Suffixes;
while Supp_Index /= No_Supp_Language_Index loop
- Supp := In_Tree.Supp_Suffixes.Table
- (Supp_Index);
+ Supp := In_Tree.Supp_Suffixes.Table (Supp_Index);
if Supp.Index = For_Language then
- In_Tree.Supp_Suffixes.Table
- (Supp_Index).Suffix := Suffix;
+ In_Tree.Supp_Suffixes.Table (Supp_Index).Suffix := Suffix;
return;
end if;
@@ -1160,10 +1167,8 @@ package body Prj is
Supp := (Index => For_Language, Suffix => Suffix,
Next => In_Project.Naming.Supp_Suffixes);
- Supp_Suffix_Table.Increment_Last
- (In_Tree.Supp_Suffixes);
- Supp_Index := Supp_Suffix_Table.Last
- (In_Tree.Supp_Suffixes);
+ Supp_Suffix_Table.Increment_Last (In_Tree.Supp_Suffixes);
+ Supp_Index := Supp_Suffix_Table.Last (In_Tree.Supp_Suffixes);
In_Tree.Supp_Suffixes.Table (Supp_Index) := Supp;
In_Project.Naming.Supp_Suffixes := Supp_Index;
end;
@@ -1224,6 +1229,14 @@ package body Prj is
procedure Set_Mode (New_Mode : Mode) is
begin
Current_Mode := New_Mode;
+ case New_Mode is
+ when Ada_Only =>
+ Default_Language_Is_Ada := True;
+ Must_Check_Configuration := False;
+ when Multi_Language =>
+ Default_Language_Is_Ada := False;
+ Must_Check_Configuration := True;
+ end case;
end Set_Mode;
---------------------
@@ -1283,10 +1296,6 @@ package body Prj is
Naming : Naming_Data) return File_Name_Type
is
Language_Id : Name_Id;
- Element_Id : Array_Element_Id;
- Element : Array_Element;
- Suffix : File_Name_Type := No_File;
- Lang : Language_Index;
begin
Name_Len := 0;
@@ -1294,8 +1303,29 @@ package body Prj is
To_Lower (Name_Buffer (1 .. Name_Len));
Language_Id := Name_Find;
- Element_Id := Naming.Spec_Suffix;
+ return
+ Spec_Suffix_Id_Of
+ (In_Tree => In_Tree,
+ Language_Id => Language_Id,
+ Naming => Naming);
+ end Spec_Suffix_Id_Of;
+
+ -----------------------
+ -- Spec_Suffix_Id_Of --
+ -----------------------
+ function Spec_Suffix_Id_Of
+ (In_Tree : Project_Tree_Ref;
+ Language_Id : Name_Id;
+ Naming : Naming_Data) return File_Name_Type
+ is
+ Element_Id : Array_Element_Id;
+ Element : Array_Element;
+ Suffix : File_Name_Type := No_File;
+ Lang : Language_Index;
+
+ begin
+ Element_Id := Naming.Spec_Suffix;
while Element_Id /= No_Array_Element loop
Element := In_Tree.Array_Elements.Table (Element_Id);
@@ -1308,7 +1338,6 @@ package body Prj is
if Current_Mode = Multi_Language then
Lang := In_Tree.First_Language;
-
while Lang /= No_Language_Index loop
if In_Tree.Languages_Data.Table (Lang).Name = Language_Id then
Suffix :=
@@ -1346,7 +1375,6 @@ package body Prj is
Language_Id := Name_Find;
Element_Id := Naming.Spec_Suffix;
-
while Element_Id /= No_Array_Element loop
Element := In_Tree.Array_Elements.Table (Element_Id);
@@ -1359,7 +1387,6 @@ package body Prj is
if Current_Mode = Multi_Language then
Lang := In_Tree.First_Language;
-
while Lang /= No_Language_Index loop
if In_Tree.Languages_Data.Table (Lang).Name = Language_Id then
Suffix :=
@@ -1416,11 +1443,11 @@ package body Prj is
when others =>
declare
- Supp : Supp_Suffix;
- Supp_Index : Supp_Language_Index :=
- In_Project.Naming.Supp_Suffixes;
+ Supp : Supp_Suffix;
+ Supp_Index : Supp_Language_Index;
begin
+ Supp_Index := In_Project.Naming.Supp_Suffixes;
while Supp_Index /= No_Supp_Language_Index loop
Supp := In_Tree.Supp_Suffixes.Table (Supp_Index);
diff --git a/gcc/ada/prj.ads b/gcc/ada/prj.ads
index 938b3a0..b242c2c 100644
--- a/gcc/ada/prj.ads
+++ b/gcc/ada/prj.ads
@@ -62,6 +62,17 @@ package Prj is
procedure Set_Mode (New_Mode : Mode);
pragma Inline (Set_Mode);
+ Default_Language_Is_Ada : Boolean := True;
+ -- If no language was defined in the project or the configuration file, it
+ -- is an error, unless this variable is True, in which case it defaults to
+ -- Ada. Calling Set_Mode will reset this variable, default is for Ada_Only.
+
+ Must_Check_Configuration : Boolean := False;
+ -- Whether the contents of the configuration file must be checked. This is
+ -- in general only needed by gprbuild itself, since other applications can
+ -- ignore such errors when they don't need to build directly. Calling
+ -- Set_Mode will reset this variable, default is for Ada_Only.
+
function In_Configuration return Boolean;
pragma Inline (In_Configuration);
@@ -74,8 +85,8 @@ package Prj is
type Project_Tree_Data;
type Project_Tree_Ref is access all Project_Tree_Data;
- -- Reference to a project tree.
- -- Several project trees may exist in memory at the same time.
+ -- Reference to a project tree. Several project trees may exist in memory
+ -- at the same time.
No_Project_Tree : constant Project_Tree_Ref;
@@ -260,24 +271,33 @@ package Prj is
-- The table that contains all packages
type Language_Index is new Nat;
+ -- Index of language data
No_Language_Index : constant Language_Index := 0;
+ -- Constant indicating that there is no language data
procedure Display_Language_Name
(In_Tree : Project_Tree_Ref;
Language : Language_Index);
+ -- Output the name of a language
- type Header_Num is range 0 .. 2047;
-
- function Hash is new System.HTable.Hash (Header_Num => Header_Num);
+ type Header_Num is range 0 .. 6150;
+ -- Size for hash table below. The upper bound is an arbitrary value, the
+ -- value here was chosen after testing to determine a good compromise
+ -- between speed of access and memory usage.
function Hash (Name : Name_Id) return Header_Num;
function Hash (Name : File_Name_Type) return Header_Num;
function Hash (Name : Path_Name_Type) return Header_Num;
+ -- Used for computing hash values for names put into above hash table
type Language_Kind is (File_Based, Unit_Based);
+ -- Type for the kind of language. All languages are file based, except Ada
+ -- which is unit based.
type Dependency_File_Kind is (None, Makefile, ALI_File);
+ -- Type of dependency to be checked: no dependency file, Makefile fragment
+ -- or ALI file (for Ada).
Makefile_Dependency_Suffix : constant String := ".d";
ALI_Dependency_Suffix : constant String := ".ali";
@@ -345,8 +365,6 @@ package Prj is
No_Source : constant Source_Id := 0;
- -- All the fields in the below record should be commented ???
-
type Language_Config is record
Kind : Language_Kind := File_Based;
-- Kind of language. All languages are file based, except Ada which is
@@ -370,47 +388,104 @@ package Prj is
-- shared libraries. Specified in the configuration. When not specified,
-- there is no need for such switch.
- Runtime_Library_Dir : Name_Id := No_Name;
+ Runtime_Library_Dir : Name_Id := No_Name;
+ -- Path name of the runtime library directory, if any
Mapping_File_Switches : Name_List_Index := No_Name_List;
-- The option(s) to provide a mapping file to the compiler. Specified in
- -- the configuration. When not ???
+ -- the configuration. When value is No_Name_List, there is no mapping
+ -- file.
+
+ Mapping_Spec_Suffix : File_Name_Type := No_File;
+ -- Placeholder representing the spec suffix in a mapping file
+
+ Mapping_Body_Suffix : File_Name_Type := No_File;
+ -- Placeholder representing the body suffix in a mapping file
+
+ Config_File_Switches : Name_List_Index := No_Name_List;
+ -- The option(s) to provide a config file to the compiler. Specified in
+ -- the configuration. When value is No_Name_List, there is no config
+ -- file.
+
+ Dependency_Kind : Dependency_File_Kind := None;
+ -- The kind of dependency to be checked: none, Makefile fragment or
+ -- ALI file (for Ada).
+
+ Dependency_Option : Name_List_Index := No_Name_List;
+ -- The option(s) to be used to create the dependency file. When value is
+ -- No_Name_List, there is not such option(s).
+
+ Compute_Dependency : Name_List_Index := No_Name_List;
+ -- Hold the value of attribute Dependency_Driver, if declared for the
+ -- language.
- Mapping_Spec_Suffix : File_Name_Type := No_File;
- Mapping_Body_Suffix : File_Name_Type := No_File;
- Config_File_Switches : Name_List_Index := No_Name_List;
- Dependency_Kind : Dependency_File_Kind := None;
- Dependency_Option : Name_List_Index := No_Name_List;
- Compute_Dependency : Name_List_Index := No_Name_List;
- Include_Option : Name_List_Index := No_Name_List;
+ Include_Option : Name_List_Index := No_Name_List;
+ -- Hold the value of attribute Include_Switches, if declared for the
+ -- language.
Include_Path : Name_Id := No_Name;
- -- Name of an environment variable
+ -- Name of environment variable declared by attribute Include_Path for
+ -- the language.
Include_Path_File : Name_Id := No_Name;
- -- Name of an environment variable
+ -- Name of environment variable declared by attribute Include_Path_File
+ -- for the language.
Objects_Path : Name_Id := No_Name;
- -- Name of an environment variable
+ -- Name of environment variable declared by attribute Objects_Path for
+ -- the language.
Objects_Path_File : Name_Id := No_Name;
- -- Name of an environment variable
+ -- Name of environment variable declared by attribute Objects_Path_File
+ -- for the language.
+
+ Config_Body : Name_Id := No_Name;
+ -- The template for a pragma Source_File_Name(_Project) for a specific
+ -- file name of a body.
- Config_Body : Name_Id := No_Name;
Config_Spec : Name_Id := No_Name;
+ -- The template for a pragma Source_File_Name(_Project) for a specific
+ -- file name of a spec.
+
Config_Body_Pattern : Name_Id := No_Name;
+ -- The template for a pragma Source_File_Name(_Project) for a naming
+ -- body pattern.
+
Config_Spec_Pattern : Name_Id := No_Name;
- Config_File_Unique : Boolean := False;
- Runtime_Project : Path_Name_Type := No_Path;
- Binder_Driver : File_Name_Type := No_File;
- Binder_Driver_Path : Path_Name_Type := No_Path;
- Binder_Required_Switches : Name_List_Index := No_Name_List;
- Binder_Prefix : Name_Id := No_Name;
- Toolchain_Version : Name_Id := No_Name;
- Toolchain_Description : Name_Id := No_Name;
- PIC_Option : Name_Id := No_Name;
- Objects_Generated : Boolean := True;
+ -- The template for a pragma Source_File_Name(_Project) for a naming
+ -- spec pattern.
+
+ Config_File_Unique : Boolean := False;
+ -- Indicate if the config file specified to the compiler needs to be
+ -- unique. If it is unique, then all config files are concatenated into
+ -- a temp config file.
+
+ Binder_Driver : File_Name_Type := No_File;
+ -- The name of the binder driver for the language, if any
+
+ Binder_Driver_Path : Path_Name_Type := No_Path;
+ -- The path name of the binder driver
+
+ Binder_Required_Switches : Name_List_Index := No_Name_List;
+ -- Hold the value of attribute Binder'Required_Switches for the language
+
+ Binder_Prefix : Name_Id := No_Name;
+ -- Hold the value of attribute Binder'Prefixthe language
+
+ Toolchain_Version : Name_Id := No_Name;
+ -- Hold the value of attribute Toolchain_Version for the language
+
+ Toolchain_Description : Name_Id := No_Name;
+ -- Hold the value of attribute Toolchain_Description for the language
+
+ PIC_Option : Name_Id := No_Name;
+ -- Hold the value of attribute Compiler'PIC_Option for the language
+
+ Objects_Generated : Boolean := True;
+ -- Indicates if objects are generated for the language
+
end record;
+ -- Record describing the configuration of a language
No_Language_Config : constant Language_Config :=
(Kind => File_Based,
@@ -437,7 +512,6 @@ package Prj is
Config_Body_Pattern => No_Name,
Config_Spec_Pattern => No_Name,
Config_File_Unique => False,
- Runtime_Project => No_Path,
Binder_Driver => No_File,
Binder_Driver_Path => No_Path,
Binder_Required_Switches => No_Name_List,
@@ -493,30 +567,78 @@ package Prj is
type Source_Kind is (Spec, Impl, Sep);
- -- Following record needs full comments on every field ???
-
type Source_Data is record
Project : Project_Id := No_Project;
+ -- Project of the source
+
Language_Name : Name_Id := No_Name;
+ -- Name of the language of the source
+
Language : Language_Index := No_Language_Index;
+ -- Index of the language
+
+ Lang_Kind : Language_Kind := File_Based;
+ -- Kind of the language
+
Alternate_Languages : Alternate_Language_Id := No_Alternate_Language;
+ -- List of languages a header file may also be, in addition of
+ -- language Language_Name.
+
Kind : Source_Kind := Spec;
- Dependency : Dependency_File_Kind := Makefile;
+ -- Kind of the source: spec, body or subunit
+
+ Dependency : Dependency_File_Kind := None;
+ -- Kind of dependency: none, Makefile fragment or ALI file
+
Other_Part : Source_Id := No_Source;
+ -- Source ID for the other part, if any: for a spec, indicates its body;
+ -- for a body, indicates its spec.
+
Unit : Name_Id := No_Name;
+ -- Name of the unit, if language is unit based
+
Index : Int := 0;
+ -- Index of the source in a multi unit source file
+
Locally_Removed : Boolean := False;
+ -- True if the source has been "excluded"
+
+ Get_Object : Boolean := False;
+ -- Indicates that the object of the source should be put in the global
+ -- archive. This is for Ada, when only the closure of a main needs to
+ -- be compiled/recompiled.
+
Replaced_By : Source_Id := No_Source;
+
File : File_Name_Type := No_File;
+ -- Canonical file name of the source
+
Display_File : File_Name_Type := No_File;
+ -- File name of the source, for display purposes
+
Path : Path_Name_Type := No_Path;
+ -- Canonical path name of the source
+
Display_Path : Path_Name_Type := No_Path;
+ -- Path name of the source, for display purposes
+
Source_TS : Time_Stamp_Type := Empty_Time_Stamp;
+ -- Time stamp of the source file
+
Object_Project : Project_Id := No_Project;
+ -- Project where the object file is
+
Object_Exists : Boolean := True;
+ -- True if an object file exists
+
Object : File_Name_Type := No_File;
+ -- File name of the object file
+
Current_Object_Path : Path_Name_Type := No_Path;
+ -- Object path of an existing object file
+
Object_Path : Path_Name_Type := No_Path;
+ -- Object path of the real object file
Object_TS : Time_Stamp_Type := Empty_Time_Stamp;
-- Object file time stamp
@@ -525,33 +647,49 @@ package Prj is
-- Dependency file simple name
Current_Dep_Path : Path_Name_Type := No_Path;
+ -- Path name of an existing dependency file
Dep_Path : Path_Name_Type := No_Path;
- -- Dependency full path name
+ -- Path name of the real dependency file
Dep_TS : Time_Stamp_Type := Empty_Time_Stamp;
-- Dependency file time stamp
- Switches : File_Name_Type := No_File;
- Switches_Path : Path_Name_Type := No_Path;
- Switches_TS : Time_Stamp_Type := Empty_Time_Stamp;
- Naming_Exception : Boolean := False;
- Next_In_Sources : Source_Id := No_Source;
- Next_In_Project : Source_Id := No_Source;
- Next_In_Lang : Source_Id := No_Source;
+ Switches : File_Name_Type := No_File;
+ -- File name of the switches file
+
+ Switches_Path : Path_Name_Type := No_Path;
+ -- Path name of the switches file
+
+ Switches_TS : Time_Stamp_Type := Empty_Time_Stamp;
+ -- Switches file time stamp
+
+ Naming_Exception : Boolean := False;
+ -- True if the source has an exceptional name
+
+ Next_In_Sources : Source_Id := No_Source;
+ -- Link to another source in the project tree
+
+ Next_In_Project : Source_Id := No_Source;
+ -- Link to another source in the project
+
+ Next_In_Lang : Source_Id := No_Source;
+ -- Link to another source of the same language
end record;
No_Source_Data : constant Source_Data :=
(Project => No_Project,
Language_Name => No_Name,
Language => No_Language_Index,
+ Lang_Kind => File_Based,
Alternate_Languages => No_Alternate_Language,
Kind => Spec,
- Dependency => Makefile,
+ Dependency => None,
Other_Part => No_Source,
Unit => No_Name,
Index => 0,
Locally_Removed => False,
+ Get_Object => False,
Replaced_By => No_Source,
File => No_File,
Display_File => No_File,
@@ -855,6 +993,11 @@ package Prj is
Language : String;
Naming : Naming_Data) return File_Name_Type;
+ function Spec_Suffix_Id_Of
+ (In_Tree : Project_Tree_Ref;
+ Language_Id : Name_Id;
+ Naming : Naming_Data) return File_Name_Type;
+
procedure Set_Spec_Suffix
(In_Tree : Project_Tree_Ref;
Language : String;
@@ -866,6 +1009,11 @@ package Prj is
Language : String;
Naming : Naming_Data) return File_Name_Type;
+ function Body_Suffix_Id_Of
+ (In_Tree : Project_Tree_Ref;
+ Language_Id : Name_Id;
+ Naming : Naming_Data) return File_Name_Type;
+
function Body_Suffix_Of
(In_Tree : Project_Tree_Ref;
Language : String;
@@ -1034,10 +1182,10 @@ package Prj is
-- True if the project is externally built. In such case, the Project
-- Manager will not modify anything in this project.
- Languages : Name_List_Index := No_Name_List;
+ Languages : Name_List_Index := No_Name_List;
-- The list of languages of the sources of this project
- Config : Project_Configuration;
+ Config : Project_Configuration;
First_Referred_By : Project_Id := No_Project;
-- The project, if any, that was the first to be known as importing or
@@ -1141,7 +1289,7 @@ package Prj is
Ada_Sources : String_List_Id := Nil_String;
-- The list of all the Ada source file names (gnatmake only).
- Sources : String_List_Id := Nil_String;
+ Sources : String_List_Id := Nil_String;
-- Identical to Ada_Sources. For upward compatibility of GPS.
First_Source : Source_Id := No_Source;
@@ -1207,7 +1355,7 @@ package Prj is
-- The naming scheme of this project file
First_Language_Processing : Language_Index := No_Language_Index;
- -- Comment needed ???
+ -- First index of the language data in the project
Decl : Declarations := No_Declarations;
-- The declarations (variables, attributes and packages) of this project
@@ -1229,8 +1377,9 @@ package Prj is
-- use this field directly outside of the compiler, use
-- Prj.Env.Ada_Objects_Path instead.
- Objects_Path : String_Access := null;
- -- ???
+ Objects_Path : String_Access := null;
+ -- The cached value of the object dir path, used during the binding
+ -- phase of gprbuild.
Objects_Path_File_With_Libs : Path_Name_Type := No_Path;
-- The cached value of the object path temp file (including library
@@ -1247,13 +1396,13 @@ package Prj is
-- An indication that the configuration pragmas file is a temporary file
-- that must be deleted at the end.
- Linker_Name : File_Name_Type := No_File;
+ Linker_Name : File_Name_Type := No_File;
-- Value of attribute Language_Processing'Linker in the project file
- Linker_Path : Path_Name_Type := No_Path;
+ Linker_Path : Path_Name_Type := No_Path;
-- Path of linker when attribute Language_Processing'Linker is specified
- Minimum_Linker_Options : Name_List_Index := No_Name_List;
+ Minimum_Linker_Options : Name_List_Index := No_Name_List;
-- List of options specified in attribute
-- Language_Processing'Minimum_Linker_Options.
@@ -1280,19 +1429,32 @@ package Prj is
-- True if there are comments in the project sources that cannot be kept
-- in the project tree.
- -- For gprmake
+ ------------------
+ -- For gprmake --
+ ------------------
Langs : Languages_In_Project := No_Languages;
Supp_Languages : Supp_Language_Index := No_Supp_Language_Index;
-- Indicate the different languages of the source of this project
- Ada_Sources_Present : Boolean := True;
- Other_Sources_Present : Boolean := True;
- First_Other_Source : Other_Source_Id := No_Other_Source;
- Last_Other_Source : Other_Source_Id := No_Other_Source;
+ Ada_Sources_Present : Boolean := True;
+ -- True if there are Ada sources in the project
+
+ Other_Sources_Present : Boolean := True;
+ -- True if there are sources from languages other than Ada in the
+ -- project.
+
+ First_Other_Source : Other_Source_Id := No_Other_Source;
+ -- First source of a language other than Ada
+
+ Last_Other_Source : Other_Source_Id := No_Other_Source;
+ -- Last source of a language other than Ada
+
First_Lang_Processing : First_Language_Processing_Data :=
- Default_First_Language_Processing_Data;
- Supp_Language_Processing : Supp_Language_Index := No_Supp_Language_Index;
+ Default_First_Language_Processing_Data;
+ Supp_Language_Processing : Supp_Language_Index :=
+ No_Supp_Language_Index;
+ -- Language configurations
end record;
function Empty_Project (Tree : Project_Tree_Ref) return Project_Data;
@@ -1307,7 +1469,9 @@ package Prj is
function Is_A_Language
(Tree : Project_Tree_Ref;
Data : Project_Data;
- Language_Name : String) return Boolean;
+ Language_Name : Name_Id) return Boolean;
+ -- Whether Language_Name is one of the languages used for the project.
+ -- Language_Name must be lower cased.
function There_Are_Ada_Sources
(In_Tree : Project_Tree_Ref;
@@ -1329,12 +1493,12 @@ package Prj is
type File_Name_Data is record
Name : File_Name_Type := No_File;
- Index : Int := 0;
+ Index : Int := 0;
Display_Name : File_Name_Type := No_File;
Path : Path_Name_Type := No_Path;
Display_Path : Path_Name_Type := No_Path;
- Project : Project_Id := No_Project;
- Needs_Pragma : Boolean := False;
+ Project : Project_Id := No_Project;
+ Needs_Pragma : Boolean := False;
end record;
-- File and Path name of a spec or body
@@ -1389,29 +1553,29 @@ package Prj is
record
-- Languages and sources of the project
- First_Language : Language_Index := No_Language_Index;
+ First_Language : Language_Index := No_Language_Index;
--
- First_Source : Source_Id := No_Source;
+ First_Source : Source_Id := No_Source;
--
-- Tables
- Languages_Data : Language_Data_Table.Instance;
- Name_Lists : Name_List_Table.Instance;
- String_Elements : String_Element_Table.Instance;
- Variable_Elements : Variable_Element_Table.Instance;
- Array_Elements : Array_Element_Table.Instance;
- Arrays : Array_Table.Instance;
- Packages : Package_Table.Instance;
- Project_Lists : Project_List_Table.Instance;
- Projects : Project_Table.Instance;
- Sources : Source_Data_Table.Instance;
- Alt_Langs : Alternate_Language_Table.Instance;
- Units : Unit_Table.Instance;
- Units_HT : Units_Htable.Instance;
- Files_HT : Files_Htable.Instance;
- Source_Paths_HT : Source_Paths_Htable.Instance;
+ Languages_Data : Language_Data_Table.Instance;
+ Name_Lists : Name_List_Table.Instance;
+ String_Elements : String_Element_Table.Instance;
+ Variable_Elements : Variable_Element_Table.Instance;
+ Array_Elements : Array_Element_Table.Instance;
+ Arrays : Array_Table.Instance;
+ Packages : Package_Table.Instance;
+ Project_Lists : Project_List_Table.Instance;
+ Projects : Project_Table.Instance;
+ Sources : Source_Data_Table.Instance;
+ Alt_Langs : Alternate_Language_Table.Instance;
+ Units : Unit_Table.Instance;
+ Units_HT : Units_Htable.Instance;
+ Files_HT : Files_Htable.Instance;
+ Source_Paths_HT : Source_Paths_Htable.Instance;
-- For gprmake:
@@ -1422,7 +1586,7 @@ package Prj is
-- Private part
- Private_Part : Private_Project_Tree_Data;
+ Private_Part : Private_Project_Tree_Data;
end record;
-- Data for a project tree
@@ -1565,10 +1729,10 @@ private
Ignored : constant Variable_Kind := Single;
Nil_Variable_Value : constant Variable_Value :=
- (Project => No_Project,
- Kind => Undefined,
- Location => No_Location,
- Default => False);
+ (Project => No_Project,
+ Kind => Undefined,
+ Location => No_Location,
+ Default => False);
Virtual_Prefix : constant String := "v$";
-- The prefix for virtual extending projects. Because of the '$', which is
@@ -1592,7 +1756,7 @@ private
Table_Low_Bound => 1,
Table_Initial => 5,
Table_Increment => 100);
- -- Comment ???
+ -- Table storing the naming data for gnatmake/gprmake
package Path_File_Table is new GNAT.Dynamic_Tables
(Table_Component_Type => Path_Name_Type,
diff --git a/gcc/ada/switch-m.adb b/gcc/ada/switch-m.adb
index af66f6a..208bb38 100644
--- a/gcc/ada/switch-m.adb
+++ b/gcc/ada/switch-m.adb
@@ -584,7 +584,7 @@ package body Switch.M is
Bad_Switch (Switch_Chars);
else
- Follow_Links := True;
+ Follow_Links_For_Files := True;
end if;
-- Processing for eS switch
generated by cgit v1.1 at 2024-11-09 02:08:29 +0000