Skip to content

R
riscv-gcc-1
Commit 32404665 by Emmanuel Briot Committed by Arnaud Charlet
Options

gnatcmd.adb, [...]: Minor reformatting. 

2009-07-13  Emmanuel Briot  <briot@adacore.com>

	* gnatcmd.adb, prj-proc.adb, prj-proc.ads, make.adb, prj-part.adb,
	prj.adb, prj.ads, clean.adb, prj-nmsc.adb, prj-nmsc.ads, prj-pars.adb,
	prj-pars.ads, prj-conf.adb, prj-conf.ads, prj-env.adb, prj-tree.adb,
	prj-tree.ads: Minor reformatting.
	(Processing_Flags): new record to encapsulate the set of common
	parameters to several subprograms in the project manager.
	(Prj.Nmsc.Process_Naming_Scheme): renames Check, and moved to body
	Remove the need for the Current_Dir parameter in subprograms.
	(Look_For_Sources): minor refactoring, now that we no longer need to
	share subprograms between the two Ada_Only and Multi_Language modes
	(Processing_Flags): New field Error_On_Unknown_Language.
	Merge tests for library project between gnatmake and gprbuild.

From-SVN: r149563
parent 959dd7d8
Showing with 644 additions and 663 deletions
gcc/ada/ChangeLog
2009-07-13 Emmanuel Briot <briot@adacore.com>
* gnatcmd.adb, prj-proc.adb, prj-proc.ads, make.adb, prj-part.adb,
prj.adb, prj.ads, clean.adb, prj-nmsc.adb, prj-nmsc.ads, prj-pars.adb,
prj-pars.ads, prj-conf.adb, prj-conf.ads, prj-env.adb, prj-tree.adb,
prj-tree.ads: Minor reformatting.
(Processing_Flags): new record to encapsulate the set of common
parameters to several subprograms in the project manager.
(Prj.Nmsc.Process_Naming_Scheme): renames Check, and moved to body
Remove the need for the Current_Dir parameter in subprograms.
(Look_For_Sources): minor refactoring, now that we no longer need to
share subprograms between the two Ada_Only and Multi_Language modes
(Processing_Flags): New field Error_On_Unknown_Language.
Merge tests for library project between gnatmake and gprbuild.
2009-07-13 Arnaud Charlet <charlet@adacore.com> 2009-07-13 Arnaud Charlet <charlet@adacore.com>
* lib.adb, make.adb, mlib.adb, exp_dist.adb: Update comments. * lib.adb, make.adb, mlib.adb, exp_dist.adb: Update comments.
......
gcc/ada/clean.adb
...@@ -1391,6 +1391,7 @@ package body Clean is ...@@ -1391,6 +1391,7 @@ package body Clean is
(Project => Main_Project, (Project => Main_Project,
In_Tree => Project_Tree, In_Tree => Project_Tree,
Project_File_Name => Project_File_Name.all, Project_File_Name => Project_File_Name.all,
Flags => Gnatmake_Flags,
Packages_To_Check => Packages_To_Check_By_Gnatmake); Packages_To_Check => Packages_To_Check_By_Gnatmake);
if Main_Project = No_Project then if Main_Project = No_Project then
......
gcc/ada/gnatcmd.adb
...@@ -1777,6 +1777,7 @@ begin ...@@ -1777,6 +1777,7 @@ begin
(Project => Project, (Project => Project,
In_Tree => Project_Tree, In_Tree => Project_Tree,
Project_File_Name => Project_File.all, Project_File_Name => Project_File.all,
Flags => Gnatmake_Flags,
Packages_To_Check => Packages_To_Check); Packages_To_Check => Packages_To_Check);
if Project = Prj.No_Project then if Project = Prj.No_Project then
......
gcc/ada/make.adb
...@@ -6865,7 +6865,8 @@ package body Make is ...@@ -6865,7 +6865,8 @@ package body Make is
(Project => Main_Project, (Project => Main_Project,
In_Tree => Project_Tree, In_Tree => Project_Tree,
Project_File_Name => Project_File_Name.all, Project_File_Name => Project_File_Name.all,
Packages_To_Check => Packages_To_Check_By_Gnatmake); Packages_To_Check => Packages_To_Check_By_Gnatmake,
Flags => Gnatmake_Flags);
-- The parsing of project files may have changed the current output -- The parsing of project files may have changed the current output
......
gcc/ada/prj-conf.adb
...@@ -396,6 +396,7 @@ package body Prj.Conf is ...@@ -396,6 +396,7 @@ package body Prj.Conf is
Config : out Prj.Project_Id; Config : out Prj.Project_Id;
Config_File_Path : out String_Access; Config_File_Path : out String_Access;
Automatically_Generated : out Boolean; Automatically_Generated : out Boolean;
Flags : Processing_Flags;
On_Load_Config : Config_File_Hook := null) On_Load_Config : Config_File_Hook := null)
is is
function Default_File_Name return String; function Default_File_Name return String;
...@@ -862,7 +863,7 @@ package body Prj.Conf is ...@@ -862,7 +863,7 @@ package body Prj.Conf is
Success => Success, Success => Success,
From_Project_Node => Config_Project_Node, From_Project_Node => Config_Project_Node,
From_Project_Node_Tree => Project_Node_Tree, From_Project_Node_Tree => Project_Node_Tree,
Report_Error => null, Flags => Flags,
Reset_Tree => False); Reset_Tree => False);
end if; end if;
...@@ -904,13 +905,9 @@ package body Prj.Conf is ...@@ -904,13 +905,9 @@ package body Prj.Conf is
Config_File_Path : out String_Access; Config_File_Path : out String_Access;
Target_Name : String := ""; Target_Name : String := "";
Normalized_Hostname : String; Normalized_Hostname : String;
Report_Error : Put_Line_Access := null; Flags : Processing_Flags;
On_Load_Config : Config_File_Hook := null; On_Load_Config : Config_File_Hook := null;
Compiler_Driver_Mandatory : Boolean := True; Reset_Tree : Boolean := True)
Allow_Duplicate_Basenames : Boolean := False;
Reset_Tree : Boolean := True;
Require_Sources_Other_Lang : Boolean := True;
When_No_Sources : Error_Warning := Warning)
is is
Main_Config_Project : Project_Id; Main_Config_Project : Project_Id;
Success : Boolean; Success : Boolean;
...@@ -925,7 +922,7 @@ package body Prj.Conf is ...@@ -925,7 +922,7 @@ package body Prj.Conf is
Success => Success, Success => Success,
From_Project_Node => User_Project_Node, From_Project_Node => User_Project_Node,
From_Project_Node_Tree => Project_Node_Tree, From_Project_Node_Tree => Project_Node_Tree,
Report_Error => Report_Error, Flags => Flags,
Reset_Tree => Reset_Tree); Reset_Tree => Reset_Tree);
if not Success then if not Success then
...@@ -948,6 +945,7 @@ package body Prj.Conf is ...@@ -948,6 +945,7 @@ package body Prj.Conf is
Packages_To_Check => Packages_To_Check, Packages_To_Check => Packages_To_Check,
Config_File_Path => Config_File_Path, Config_File_Path => Config_File_Path,
Automatically_Generated => Automatically_Generated, Automatically_Generated => Automatically_Generated,
Flags => Flags,
On_Load_Config => On_Load_Config); On_Load_Config => On_Load_Config);
Apply_Config_File (Main_Config_Project, Project_Tree); Apply_Config_File (Main_Config_Project, Project_Tree);
...@@ -960,12 +958,7 @@ package body Prj.Conf is ...@@ -960,12 +958,7 @@ package body Prj.Conf is
Success => Success, Success => Success,
From_Project_Node => User_Project_Node, From_Project_Node => User_Project_Node,
From_Project_Node_Tree => Project_Node_Tree, From_Project_Node_Tree => Project_Node_Tree,
Report_Error => Report_Error, Flags => Flags);
Current_Dir => Current_Directory,
When_No_Sources => When_No_Sources,
Require_Sources_Other_Lang => Require_Sources_Other_Lang,
Compiler_Driver_Mandatory => Compiler_Driver_Mandatory,
Allow_Duplicate_Basenames => Allow_Duplicate_Basenames);
if not Success then if not Success then
Main_Project := No_Project; Main_Project := No_Project;
...@@ -990,7 +983,7 @@ package body Prj.Conf is ...@@ -990,7 +983,7 @@ package body Prj.Conf is
Config_File_Path : out String_Access; Config_File_Path : out String_Access;
Target_Name : String := ""; Target_Name : String := "";
Normalized_Hostname : String; Normalized_Hostname : String;
Report_Error : Put_Line_Access := null; Flags : Processing_Flags;
On_Load_Config : Config_File_Hook := null) On_Load_Config : Config_File_Hook := null)
is is
begin begin
...@@ -1029,7 +1022,7 @@ package body Prj.Conf is ...@@ -1029,7 +1022,7 @@ package body Prj.Conf is
Config_File_Path => Config_File_Path, Config_File_Path => Config_File_Path,
Target_Name => Target_Name, Target_Name => Target_Name,
Normalized_Hostname => Normalized_Hostname, Normalized_Hostname => Normalized_Hostname,
Report_Error => Report_Error, Flags => Flags,
On_Load_Config => On_Load_Config); On_Load_Config => On_Load_Config);
end Parse_Project_And_Apply_Config; end Parse_Project_And_Apply_Config;
...@@ -1131,19 +1124,22 @@ package body Prj.Conf is ...@@ -1131,19 +1124,22 @@ package body Prj.Conf is
Project_Tree : Project_Node_Tree_Ref) Project_Tree : Project_Node_Tree_Ref)
is is
Name : Name_Id; Name : Name_Id;
begin begin
if Config_File = Empty_Node then if Config_File = Empty_Node then
-- Create a dummy config file is none was found.
-- Create a dummy config file is none was found
Name_Len := Auto_Cgpr'Length; Name_Len := Auto_Cgpr'Length;
Name_Buffer (1 .. Name_Len) := Auto_Cgpr; Name_Buffer (1 .. Name_Len) := Auto_Cgpr;
Name := Name_Find; Name := Name_Find;
Config_File := Create_Project Config_File :=
(In_Tree => Project_Tree, Create_Project
Name => Name, (In_Tree => Project_Tree,
Full_Path => Path_Name_Type (Name), Name => Name,
Is_Config_File => True); Full_Path => Path_Name_Type (Name),
Is_Config_File => True);
-- ??? This isn't strictly required, since Prj.Nmsc.Add_Language -- ??? This isn't strictly required, since Prj.Nmsc.Add_Language
-- already has a workaround in the Ada_Only case. But it would be -- already has a workaround in the Ada_Only case. But it would be
...@@ -1151,6 +1147,8 @@ package body Prj.Conf is ...@@ -1151,6 +1147,8 @@ package body Prj.Conf is
-- Likewise for the default language, hard-coded in -- Likewise for the default language, hard-coded in
-- Pjr.Nmsc.Check_Programming_Languages -- Pjr.Nmsc.Check_Programming_Languages
-- Why is all the following code commented out???
-- Update_Attribute_Value_In_Scenario -- Update_Attribute_Value_In_Scenario
-- (Tree => Project_Tree, -- (Tree => Project_Tree,
-- Project => Config_File, -- Project => Config_File,
......
gcc/ada/prj-conf.ads
...@@ -55,7 +55,7 @@ package Prj.Conf is ...@@ -55,7 +55,7 @@ package Prj.Conf is
Config_File_Path : out String_Access; Config_File_Path : out String_Access;
Target_Name : String := ""; Target_Name : String := "";
Normalized_Hostname : String; Normalized_Hostname : String;
Report_Error : Put_Line_Access := null; Flags : Processing_Flags;
On_Load_Config : Config_File_Hook := null); On_Load_Config : Config_File_Hook := null);
-- Find the main configuration project and parse the project tree rooted at -- Find the main configuration project and parse the project tree rooted at
-- this configuration project. -- this configuration project.
...@@ -96,19 +96,17 @@ package Prj.Conf is ...@@ -96,19 +96,17 @@ package Prj.Conf is
Config_File_Path : out String_Access; Config_File_Path : out String_Access;
Target_Name : String := ""; Target_Name : String := "";
Normalized_Hostname : String; Normalized_Hostname : String;
Report_Error : Put_Line_Access := null; Flags : Processing_Flags;
On_Load_Config : Config_File_Hook := null; On_Load_Config : Config_File_Hook := null;
Compiler_Driver_Mandatory : Boolean := True; Reset_Tree : Boolean := True);
Allow_Duplicate_Basenames : Boolean := False;
Reset_Tree : Boolean := True;
Require_Sources_Other_Lang : Boolean := True;
When_No_Sources : Error_Warning := Warning);
-- Same as above, except the project must already have been parsed through -- Same as above, except the project must already have been parsed through
-- Prj.Part.Parse, and only the processing of the project and the -- Prj.Part.Parse, and only the processing of the project and the
-- configuration is done at this level. -- configuration is done at this level.
--
-- If Reset_Tree is true, all projects are first removed from the tree. -- If Reset_Tree is true, all projects are first removed from the tree.
-- When_No_Sources indicates what should be done when no sources are found -- When_No_Sources indicates what should be done when no sources are found
-- for one of the languages of the project. -- for one of the languages of the project.
--
-- If Require_Sources_Other_Lang is true, then all languages must have at -- If Require_Sources_Other_Lang is true, then all languages must have at
-- least one source file, or an error is reported via When_No_Sources. If -- least one source file, or an error is reported via When_No_Sources. If
-- it is false, this is only required for Ada (and only if it is a language -- it is false, this is only required for Ada (and only if it is a language
...@@ -129,6 +127,7 @@ package Prj.Conf is ...@@ -129,6 +127,7 @@ package Prj.Conf is
Config : out Prj.Project_Id; Config : out Prj.Project_Id;
Config_File_Path : out String_Access; Config_File_Path : out String_Access;
Automatically_Generated : out Boolean; Automatically_Generated : out Boolean;
Flags : Processing_Flags;
On_Load_Config : Config_File_Hook := null); On_Load_Config : Config_File_Hook := null);
-- Compute the name of the configuration file that should be used. If no -- Compute the name of the configuration file that should be used. If no
-- default configuration file is found, a new one will be automatically -- default configuration file is found, a new one will be automatically
...@@ -142,20 +141,19 @@ package Prj.Conf is ...@@ -142,20 +141,19 @@ package Prj.Conf is
-- --
-- The choice and generation of a configuration file depends on several -- The choice and generation of a configuration file depends on several
-- attributes of the user's project file (given by the Project argument), -- attributes of the user's project file (given by the Project argument),
-- like the list of languages that must be supported. Project must -- e.g. list of languages that must be supported. Project must therefore
-- therefore have been partially processed (phase one of the processing -- have been partially processed (phase one of the processing only).
-- only).
-- --
-- Config_File_Name should be set to the name of the config file specified -- Config_File_Name should be set to the name of the config file specified
-- by the user (either through gprbuild's --config or --autoconf switches). -- by the user (either through gprbuild's --config or --autoconf switches).
-- In the latter case, Autoconf_Specified should be set to true, to -- In the latter case, Autoconf_Specified should be set to true to indicate
-- indicate that the configuration file can be regenerated to match target -- that the configuration file can be regenerated to match target and
-- and languages. This name can either be an absolute path, or the a base -- languages. This name can either be an absolute path, or the a base name
-- name that will be searched in the default config file directories (which -- that will be searched in the default config file directories (which
-- depends on the installation path for the tools). -- depends on the installation path for the tools).
-- --
-- Target_Name is used to chose among several possibilities -- Target_Name is used to chose the configuration file that will be used
-- the configuration file that will be used. -- from among several possibilities.
-- --
-- If a project file could be found, it is automatically parsed and -- If a project file could be found, it is automatically parsed and
-- processed (and Packages_To_Check is used to indicate which packages -- processed (and Packages_To_Check is used to indicate which packages
...@@ -175,11 +173,11 @@ package Prj.Conf is ...@@ -175,11 +173,11 @@ package Prj.Conf is
procedure Add_Default_GNAT_Naming_Scheme procedure Add_Default_GNAT_Naming_Scheme
(Config_File : in out Prj.Tree.Project_Node_Id; (Config_File : in out Prj.Tree.Project_Node_Id;
Project_Tree : Prj.Tree.Project_Node_Tree_Ref); Project_Tree : Prj.Tree.Project_Node_Tree_Ref);
-- A hook for Get_Or_Create_Configuration_File and -- A hook that will create a new config file (in memory), used for
-- Process_Project_And_Apply_Config that will create a new config file (in -- Get_Or_Create_Configuration_File and Process_Project_And_Apply_Config
-- memory) and add the default GNAT naming scheme to it. Nothing is done -- and add the default GNAT naming scheme to it. Nothing is done if the
-- if the config_file already exists, to avoid overriding what the user -- config_file already exists, to avoid overriding what the user might
-- might have put in there. -- have put in there.
-------------- --------------
-- Runtimes -- -- Runtimes --
...@@ -193,7 +191,7 @@ package Prj.Conf is ...@@ -193,7 +191,7 @@ package Prj.Conf is
-- --config switch then automatically generating a configuration file. -- --config switch then automatically generating a configuration file.
function Runtime_Name_For (Language : Name_Id) return String; function Runtime_Name_For (Language : Name_Id) return String;
-- Returns the runtime name for a language. Returns an empty string if -- Returns the runtime name for a language. Returns an empty string if no
-- no runtime was specified for the language using option --RTS. -- runtime was specified for the language using option --RTS.
end Prj.Conf; end Prj.Conf;
gcc/ada/prj-env.adb
...@@ -646,7 +646,6 @@ package body Prj.Env is ...@@ -646,7 +646,6 @@ package body Prj.Env is
-- Visit all the files and process those that need an SFN pragma -- Visit all the files and process those that need an SFN pragma
Iter := For_Each_Source (In_Tree, For_Project); Iter := For_Each_Source (In_Tree, For_Project);
while Element (Iter) /= No_Source loop while Element (Iter) /= No_Source loop
Source := Element (Iter); Source := Element (Iter);
......
gcc/ada/prj-nmsc.adb
...@@ -25,6 +25,7 @@ ...@@ -25,6 +25,7 @@
with GNAT.Case_Util; use GNAT.Case_Util; with GNAT.Case_Util; use GNAT.Case_Util;
with GNAT.Directory_Operations; use GNAT.Directory_Operations; with GNAT.Directory_Operations; use GNAT.Directory_Operations;
with GNAT.Dynamic_HTables;
with Err_Vars; use Err_Vars; with Err_Vars; use Err_Vars;
with MLib.Tgt; with MLib.Tgt;
...@@ -80,7 +81,9 @@ package body Prj.Nmsc is ...@@ -80,7 +81,9 @@ package body Prj.Nmsc is
Spec : File_Name_Type; Spec : File_Name_Type;
Impl : File_Name_Type; Impl : File_Name_Type;
end record; end record;
No_Unit_Exception : constant Unit_Exception := (No_Name, No_File, No_File); No_Unit_Exception : constant Unit_Exception := (No_Name, No_File, No_File);
package Unit_Exceptions_Htable is new GNAT.Dynamic_HTables.Simple_HTable package Unit_Exceptions_Htable is new GNAT.Dynamic_HTables.Simple_HTable
(Header_Num => Header_Num, (Header_Num => Header_Num,
Element => Unit_Exception, Element => Unit_Exception,
...@@ -97,7 +100,9 @@ package body Prj.Nmsc is ...@@ -97,7 +100,9 @@ package body Prj.Nmsc is
Found : Boolean := False; Found : Boolean := False;
Location : Source_Ptr := No_Location; Location : Source_Ptr := No_Location;
end record; end record;
No_File_Found : constant File_Found := (No_File, False, No_Location); No_File_Found : constant File_Found := (No_File, False, No_Location);
package Excluded_Sources_Htable is new GNAT.Dynamic_HTables.Simple_HTable package Excluded_Sources_Htable is new GNAT.Dynamic_HTables.Simple_HTable
(Header_Num => Header_Num, (Header_Num => Header_Num,
Element => File_Found, Element => File_Found,
...@@ -122,7 +127,6 @@ package body Prj.Nmsc is ...@@ -122,7 +127,6 @@ package body Prj.Nmsc is
Source_Names : Source_Names_Htable.Instance; Source_Names : Source_Names_Htable.Instance;
Unit_Exceptions : Unit_Exceptions_Htable.Instance; Unit_Exceptions : Unit_Exceptions_Htable.Instance;
Excluded : Excluded_Sources_Htable.Instance; Excluded : Excluded_Sources_Htable.Instance;
Object_Files : Object_File_Names_Htable.Instance;
Source_List_File_Location : Source_Ptr; Source_List_File_Location : Source_Ptr;
-- Location of the Source_List_File attribute, for error messages -- Location of the Source_List_File attribute, for error messages
...@@ -131,6 +135,41 @@ package body Prj.Nmsc is ...@@ -131,6 +135,41 @@ package body Prj.Nmsc is
-- information which is only useful while processing the project, and can -- information which is only useful while processing the project, and can
-- be discarded as soon as we have finished processing the project -- be discarded as soon as we have finished processing the project
package Files_Htable is new GNAT.Dynamic_HTables.Simple_HTable
(Header_Num => Header_Num,
Element => Source_Id,
No_Element => No_Source,
Key => File_Name_Type,
Hash => Hash,
Equal => "=");
-- Mapping from base file names to Source_Id (containing full info about
-- the source)
type Tree_Processing_Data is record
Tree : Project_Tree_Ref;
File_To_Source : Files_Htable.Instance;
Flags : Prj.Processing_Flags;
end record;
-- Temporary data which is needed while parsing a project. It does not need
-- to be kept in memory once a project has been fully loaded, but is
-- necessary while performing consistency checks (duplicate sources,...)
-- This data must be initialized before processing any project, and the
-- same data is used for processing all projects in the tree.
procedure Initialize
(Data : out Tree_Processing_Data;
Tree : Project_Tree_Ref;
Flags : Prj.Processing_Flags);
-- Initialize Data
procedure Free (Data : in out Tree_Processing_Data);
-- Free the memory occupied by Data
procedure Check
(Project : Project_Id;
Data : in out Tree_Processing_Data);
-- Process the naming scheme for a single project.
procedure Initialize procedure Initialize
(Data : in out Project_Processing_Data; (Data : in out Project_Processing_Data;
Project : Project_Id); Project : Project_Id);
...@@ -138,8 +177,8 @@ package body Prj.Nmsc is ...@@ -138,8 +177,8 @@ package body Prj.Nmsc is
-- Initialize or free memory for a project-specific data -- Initialize or free memory for a project-specific data
procedure Find_Excluded_Sources procedure Find_Excluded_Sources
(Project : in out Project_Processing_Data; (Project : in out Project_Processing_Data;
Data : in out Tree_Processing_Data); Data : in out Tree_Processing_Data);
-- Find the list of files that should not be considered as source files -- Find the list of files that should not be considered as source files
-- for this project. Sets the list in the Project.Excluded_Sources_Htable. -- for this project. Sets the list in the Project.Excluded_Sources_Htable.
...@@ -148,8 +187,8 @@ package body Prj.Nmsc is ...@@ -148,8 +187,8 @@ package body Prj.Nmsc is
-- the unit data if necessary. -- the unit data if necessary.
procedure Load_Naming_Exceptions procedure Load_Naming_Exceptions
(Project : in out Project_Processing_Data; (Project : in out Project_Processing_Data;
Data : in out Tree_Processing_Data); Data : in out Tree_Processing_Data);
-- All source files in Data.First_Source are considered as naming -- All source files in Data.First_Source are considered as naming
-- exceptions, and copied into the Source_Names and Unit_Exceptions tables -- exceptions, and copied into the Source_Names and Unit_Exceptions tables
-- as appropriate. -- as appropriate.
...@@ -231,8 +270,6 @@ package body Prj.Nmsc is ...@@ -231,8 +270,6 @@ package body Prj.Nmsc is
Data : in out Tree_Processing_Data); Data : in out Tree_Processing_Data);
-- Check the library attributes of project Project in project tree -- Check the library attributes of project Project in project tree
-- and modify its data Data accordingly. -- 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_Programming_Languages procedure Check_Programming_Languages
(Project : Project_Id; (Project : Project_Id;
...@@ -250,13 +287,10 @@ package body Prj.Nmsc is ...@@ -250,13 +287,10 @@ package body Prj.Nmsc is
procedure Check_Stand_Alone_Library procedure Check_Stand_Alone_Library
(Project : Project_Id; (Project : Project_Id;
Current_Dir : String;
Extending : Boolean; Extending : Boolean;
Data : in out Tree_Processing_Data); Data : in out Tree_Processing_Data);
-- Check if project Project in project tree Data.Tree is a Stand-Alone -- Check if project Project in project tree Data.Tree is a Stand-Alone
-- Library project, and modify its data Data accordingly if it is one. -- 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.
function Compute_Directory_Last (Dir : String) return Natural; function Compute_Directory_Last (Dir : String) return Natural;
-- Return the index of the last significant character in Dir. This is used -- Return the index of the last significant character in Dir. This is used
...@@ -327,11 +361,9 @@ package body Prj.Nmsc is ...@@ -327,11 +361,9 @@ package body Prj.Nmsc is
procedure Get_Directories procedure Get_Directories
(Project : Project_Id; (Project : Project_Id;
Current_Dir : String;
Data : in out Tree_Processing_Data); Data : in out Tree_Processing_Data);
-- Get the object directory, the exec directory and the source directories -- Get the object directory, the exec directory and the source directories
-- of a project. Current_Dir should represent the current directory, and is -- of a project.
-- passed for efficiency to avoid system calls to recompute it.
procedure Get_Mains procedure Get_Mains
(Project : Project_Id; (Project : Project_Id;
...@@ -340,16 +372,16 @@ package body Prj.Nmsc is ...@@ -340,16 +372,16 @@ package body Prj.Nmsc is
-- them in the project data. -- them in the project data.
procedure Get_Sources_From_File procedure Get_Sources_From_File
(Path : String; (Path : String;
Location : Source_Ptr; Location : Source_Ptr;
Project : in out Project_Processing_Data; Project : in out Project_Processing_Data;
Data : in out Tree_Processing_Data); Data : in out Tree_Processing_Data);
-- Get the list of sources from a text file and put them in hash table -- Get the list of sources from a text file and put them in hash table
-- Source_Names. -- Source_Names.
procedure Find_Sources procedure Find_Sources
(Project : in out Project_Processing_Data; (Project : in out Project_Processing_Data;
Data : in out Tree_Processing_Data); Data : in out Tree_Processing_Data);
-- Process the Source_Files and Source_List_File attributes, and store the -- Process the Source_Files and Source_List_File attributes, and store the
-- list of source files into the Source_Names htable. When these attributes -- list of source files into the Source_Names htable. When these attributes
-- are not defined, find all files matching the naming schemes in the -- are not defined, find all files matching the naming schemes in the
...@@ -398,8 +430,7 @@ package body Prj.Nmsc is ...@@ -398,8 +430,7 @@ package body Prj.Nmsc is
-- returned), or simply returned without checking for its existence (if -- returned), or simply returned without checking for its existence (if
-- Must_Exist is False) or No_Path_Information is returned. In all cases, -- Must_Exist is False) or No_Path_Information is returned. In all cases,
-- Dir_Exists indicates whether the directory now exists. Create is also -- Dir_Exists indicates whether the directory now exists. Create is also
-- used for debugging traces to show which path we are -- used for debugging traces to show which path we are computing.
-- computing
procedure Look_For_Sources procedure Look_For_Sources
(Project : in out Project_Processing_Data; (Project : in out Project_Processing_Data;
...@@ -418,10 +449,10 @@ package body Prj.Nmsc is ...@@ -418,10 +449,10 @@ package body Prj.Nmsc is
procedure Remove_Source procedure Remove_Source
(Id : Source_Id; (Id : Source_Id;
Replaced_By : Source_Id); Replaced_By : Source_Id);
-- Remove a file from the list of sources of a project. -- Remove a file from the list of sources of a project. This might be
-- This might be because the file is replaced by another one in an -- because the file is replaced by another one in an extending project,
-- extending project, or because a file was added as a naming exception -- or because a file was added as a naming exception but was not found
-- but was not found in the end. -- in the end.
procedure Report_No_Sources procedure Report_No_Sources
(Project : Project_Id; (Project : Project_Id;
...@@ -561,6 +592,7 @@ package body Prj.Nmsc is ...@@ -561,6 +592,7 @@ package body Prj.Nmsc is
and then Prev_Unit.File_Names (Kind) /= null and then Prev_Unit.File_Names (Kind) /= null
then then
-- Suspicious, we need to check later whether this is authorized -- Suspicious, we need to check later whether this is authorized
Add_Src := False; Add_Src := False;
Source := Prev_Unit.File_Names (Kind); Source := Prev_Unit.File_Names (Kind);
...@@ -574,18 +606,20 @@ package body Prj.Nmsc is ...@@ -574,18 +606,20 @@ package body Prj.Nmsc is
end if; end if;
end if; end if;
-- Duplication of file/unit in same project is allowed -- Duplication of file/unit in same project is allowed if order of
-- if order of source directories is known. -- source directories is known.
if Add_Src = False then if Add_Src = False then
Add_Src := True; Add_Src := True;
if Project = Source.Project then if Project = Source.Project then
if Prev_Unit = No_Unit_Index then if Prev_Unit = No_Unit_Index then
if Data.Allow_Duplicate_Basenames then if Data.Flags.Allow_Duplicate_Basenames then
Add_Src := True; Add_Src := True;
elsif Project.Known_Order_Of_Source_Dirs then elsif Project.Known_Order_Of_Source_Dirs then
Add_Src := False; Add_Src := False;
else else
Error_Msg_File_1 := File_Name; Error_Msg_File_1 := File_Name;
Error_Msg Error_Msg
...@@ -599,7 +633,7 @@ package body Prj.Nmsc is ...@@ -599,7 +633,7 @@ package body Prj.Nmsc is
Add_Src := False; Add_Src := False;
-- We might be seeing the same file through a different path -- We might be seeing the same file through a different path
-- (for instance because of symbolic links) -- (for instance because of symbolic links).
elsif Source.Path.Name /= Path.Name then elsif Source.Path.Name /= Path.Name then
Error_Msg_Name_1 := Unit; Error_Msg_Name_1 := Unit;
...@@ -625,7 +659,7 @@ package body Prj.Nmsc is ...@@ -625,7 +659,7 @@ package body Prj.Nmsc is
-- Path is set if this is a source we found on the disk, in which -- Path is set if this is a source we found on the disk, in which
-- case we can provide more explicit error message. Path is unset -- case we can provide more explicit error message. Path is unset
-- when the source is added from one of the naming exceptions in -- when the source is added from one of the naming exceptions in
-- the project -- the project.
if Path /= No_Path_Information then if Path /= No_Path_Information then
Error_Msg_Name_1 := Unit; Error_Msg_Name_1 := Unit;
...@@ -655,7 +689,7 @@ package body Prj.Nmsc is ...@@ -655,7 +689,7 @@ package body Prj.Nmsc is
Add_Src := False; Add_Src := False;
elsif not Source.Locally_Removed elsif not Source.Locally_Removed
and then not Data.Allow_Duplicate_Basenames and then not Data.Flags.Allow_Duplicate_Basenames
and then Lang_Id.Config.Kind = Unit_Based and then Lang_Id.Config.Kind = Unit_Based
then then
Error_Msg_File_1 := File_Name; Error_Msg_File_1 := File_Name;
...@@ -665,7 +699,8 @@ package body Prj.Nmsc is ...@@ -665,7 +699,8 @@ package body Prj.Nmsc is
"{ is already a source of project {", Location, Data); "{ is already a source of project {", Location, Data);
-- Add the file anyway, to avoid further warnings like "language -- Add the file anyway, to avoid further warnings like "language
-- unknown" -- unknown".
Add_Src := True; Add_Src := True;
end if; end if;
end if; end if;
...@@ -801,9 +836,8 @@ package body Prj.Nmsc is ...@@ -801,9 +836,8 @@ package body Prj.Nmsc is
----------- -----------
procedure Check procedure Check
(Project : Project_Id; (Project : Project_Id;
Current_Dir : String; Data : in out Tree_Processing_Data)
Data : in out Tree_Processing_Data)
is is
Specs : Array_Element_Id; Specs : Array_Element_Id;
Bodies : Array_Element_Id; Bodies : Array_Element_Id;
...@@ -817,7 +851,7 @@ package body Prj.Nmsc is ...@@ -817,7 +851,7 @@ package body Prj.Nmsc is
-- Object, exec and source directories -- Object, exec and source directories
Get_Directories (Project, Current_Dir, Data); Get_Directories (Project, Data);
-- Get the programming languages -- Get the programming languages
...@@ -904,7 +938,7 @@ package body Prj.Nmsc is ...@@ -904,7 +938,7 @@ package body Prj.Nmsc is
if Language.First_Source = No_Source if Language.First_Source = No_Source
and then and then
(Data.Require_Sources_Other_Lang (Data.Flags.Require_Sources_Other_Lang
or else Language.Name = Name_Ada) or else Language.Name = Name_Ada)
then then
Iter := For_Each_Source (In_Tree => Data.Tree, Iter := For_Each_Source (In_Tree => Data.Tree,
...@@ -941,18 +975,15 @@ package body Prj.Nmsc is ...@@ -941,18 +975,15 @@ package body Prj.Nmsc is
end if; end if;
end if; end if;
if Get_Mode = Multi_Language then -- If a list of sources is specified in attribute Interfaces, set
-- In_Interfaces only for the sources specified in the list.
-- If a list of sources is specified in attribute Interfaces, set Check_Interfaces (Project, Data);
-- In_Interfaces only for the sources specified in the list.
Check_Interfaces (Project, Data);
end if;
-- If it is a library project file, check if it is a standalone library -- If it is a library project file, check if it is a standalone library
if Project.Library then if Project.Library then
Check_Stand_Alone_Library (Project, Current_Dir, Extending, Data); Check_Stand_Alone_Library (Project, Extending, Data);
end if; end if;
-- Put the list of Mains, if any, in the project data -- Put the list of Mains, if any, in the project data
...@@ -2341,7 +2372,7 @@ package body Prj.Nmsc is ...@@ -2341,7 +2372,7 @@ package body Prj.Nmsc is
-- For all languages, Compiler_Driver needs to be specified. This is -- For all languages, Compiler_Driver needs to be specified. This is
-- only needed if we do intend to compile (not in GPS for instance). -- only needed if we do intend to compile (not in GPS for instance).
if Data.Compiler_Driver_Mandatory if Data.Flags.Compiler_Driver_Mandatory
and then Lang_Index.Config.Compiler_Driver = No_File and then Lang_Index.Config.Compiler_Driver = No_File
then then
Error_Msg_Name_1 := Lang_Index.Display_Name; Error_Msg_Name_1 := Lang_Index.Display_Name;
...@@ -2579,13 +2610,14 @@ package body Prj.Nmsc is ...@@ -2579,13 +2610,14 @@ package body Prj.Nmsc is
Specs : out Array_Element_Id) Specs : out Array_Element_Id)
is is
Naming_Id : constant Package_Id := Naming_Id : constant Package_Id :=
Util.Value_Of (Name_Naming, Project.Decl.Packages, Data.Tree); Util.Value_Of
(Name_Naming, Project.Decl.Packages, Data.Tree);
Naming : Package_Element; Naming : Package_Element;
Ada_Body_Suffix_Loc : Source_Ptr := No_Location; Ada_Body_Suffix_Loc : Source_Ptr := No_Location;
procedure Check_Naming_Multi_Lang; procedure Check_Naming;
-- Does Check_Naming_Schemes processing for Multi_Language mode -- Check the validity of the Naming package (suffixes valid, ...)
procedure Check_Common procedure Check_Common
(Dot_Replacement : in out File_Name_Type; (Dot_Replacement : in out File_Name_Type;
...@@ -2593,7 +2625,7 @@ package body Prj.Nmsc is ...@@ -2593,7 +2625,7 @@ package body Prj.Nmsc is
Casing_Defined : out Boolean; Casing_Defined : out Boolean;
Separate_Suffix : in out File_Name_Type; Separate_Suffix : in out File_Name_Type;
Sep_Suffix_Loc : out Source_Ptr); Sep_Suffix_Loc : out Source_Ptr);
-- Check attributes common to Ada_Only and Multi_Lang modes -- Check attributes common
procedure Process_Exceptions_File_Based procedure Process_Exceptions_File_Based
(Lang_Id : Language_Ptr; (Lang_Id : Language_Ptr;
...@@ -2601,8 +2633,7 @@ package body Prj.Nmsc is ...@@ -2601,8 +2633,7 @@ package body Prj.Nmsc is
procedure Process_Exceptions_Unit_Based procedure Process_Exceptions_Unit_Based
(Lang_Id : Language_Ptr; (Lang_Id : Language_Ptr;
Kind : Source_Kind); Kind : Source_Kind);
-- In Multi_Lang mode, process the naming exceptions for the two types -- Process the naming exceptions for the two types of languages
-- of languages we can have.
procedure Initialize_Naming_Data; procedure Initialize_Naming_Data;
-- Initialize internal naming data for the various languages -- Initialize internal naming data for the various languages
...@@ -2846,21 +2877,22 @@ package body Prj.Nmsc is ...@@ -2846,21 +2877,22 @@ package body Prj.Nmsc is
(Lang_Id : Language_Ptr; (Lang_Id : Language_Ptr;
Kind : Source_Kind) Kind : Source_Kind)
is is
Lang : constant Name_Id := Lang_Id.Name; Lang : constant Name_Id := Lang_Id.Name;
Exceptions : Array_Element_Id; Exceptions : Array_Element_Id;
Element : Array_Element; Element : Array_Element;
Unit : Name_Id; Unit : Name_Id;
Index : Int; Index : Int;
File_Name : File_Name_Type; File_Name : File_Name_Type;
Source : Source_Id; Source : Source_Id;
begin begin
case Kind is case Kind is
when Impl | Sep => when Impl | Sep =>
Exceptions := Value_Of Exceptions :=
(Name_Body, Value_Of
In_Arrays => Naming.Decl.Arrays, (Name_Body,
In_Tree => Data.Tree); In_Arrays => Naming.Decl.Arrays,
In_Tree => Data.Tree);
if Exceptions = No_Array_Element then if Exceptions = No_Array_Element then
Exceptions := Exceptions :=
...@@ -2878,10 +2910,11 @@ package body Prj.Nmsc is ...@@ -2878,10 +2910,11 @@ package body Prj.Nmsc is
In_Tree => Data.Tree); In_Tree => Data.Tree);
if Exceptions = No_Array_Element then if Exceptions = No_Array_Element then
Exceptions := Value_Of Exceptions :=
(Name_Spec, Value_Of
In_Arrays => Naming.Decl.Arrays, (Name_Spec,
In_Tree => Data.Tree); In_Arrays => Naming.Decl.Arrays,
In_Tree => Data.Tree);
end if; end if;
end case; end case;
...@@ -2928,13 +2961,14 @@ package body Prj.Nmsc is ...@@ -2928,13 +2961,14 @@ package body Prj.Nmsc is
end loop; end loop;
end Process_Exceptions_Unit_Based; end Process_Exceptions_Unit_Based;
----------------------------- ------------------
-- Check_Naming_Multi_Lang -- -- Check_Naming --
----------------------------- ------------------
procedure Check_Naming_Multi_Lang is procedure Check_Naming is
Dot_Replacement : File_Name_Type := Dot_Replacement : File_Name_Type :=
File_Name_Type (First_Name_Id + Character'Pos ('-')); File_Name_Type
(First_Name_Id + Character'Pos ('-'));
Separate_Suffix : File_Name_Type := No_File; Separate_Suffix : File_Name_Type := No_File;
Casing : Casing_Type := All_Lower_Case; Casing : Casing_Type := All_Lower_Case;
Casing_Defined : Boolean; Casing_Defined : Boolean;
...@@ -3016,18 +3050,20 @@ package body Prj.Nmsc is ...@@ -3016,18 +3050,20 @@ package body Prj.Nmsc is
-- Body_Suffix -- Body_Suffix
Suffix := Value_Of Suffix :=
(Name => Lang, Value_Of
Attribute_Or_Array_Name => Name_Body_Suffix, (Name => Lang,
In_Package => Naming_Id, Attribute_Or_Array_Name => Name_Body_Suffix,
In_Tree => Data.Tree); In_Package => Naming_Id,
In_Tree => Data.Tree);
if Suffix = Nil_Variable_Value then if Suffix = Nil_Variable_Value then
Suffix := Value_Of Suffix :=
(Name => Lang, Value_Of
Attribute_Or_Array_Name => Name_Implementation_Suffix, (Name => Lang,
In_Package => Naming_Id, Attribute_Or_Array_Name => Name_Implementation_Suffix,
In_Tree => Data.Tree); In_Package => Naming_Id,
In_Tree => Data.Tree);
end if; end if;
if Suffix /= Nil_Variable_Value then if Suffix /= Nil_Variable_Value then
...@@ -3071,7 +3107,7 @@ package body Prj.Nmsc is ...@@ -3071,7 +3107,7 @@ package body Prj.Nmsc is
if Lang_Id.Config.Naming_Data.Spec_Suffix /= No_File if Lang_Id.Config.Naming_Data.Spec_Suffix /= No_File
and then Lang_Id.Config.Naming_Data.Spec_Suffix = and then Lang_Id.Config.Naming_Data.Spec_Suffix =
Lang_Id.Config.Naming_Data.Body_Suffix Lang_Id.Config.Naming_Data.Body_Suffix
then then
Error_Msg Error_Msg
(Project, (Project,
...@@ -3082,9 +3118,9 @@ package body Prj.Nmsc is ...@@ -3082,9 +3118,9 @@ package body Prj.Nmsc is
end if; end if;
if Lang_Id.Config.Naming_Data.Body_Suffix /= if Lang_Id.Config.Naming_Data.Body_Suffix /=
Lang_Id.Config.Naming_Data.Separate_Suffix Lang_Id.Config.Naming_Data.Separate_Suffix
and then Lang_Id.Config.Naming_Data.Spec_Suffix = and then Lang_Id.Config.Naming_Data.Spec_Suffix =
Lang_Id.Config.Naming_Data.Separate_Suffix Lang_Id.Config.Naming_Data.Separate_Suffix
then then
Error_Msg Error_Msg
(Project, (Project,
...@@ -3104,17 +3140,17 @@ package body Prj.Nmsc is ...@@ -3104,17 +3140,17 @@ package body Prj.Nmsc is
Lang_Id := Project.Languages; Lang_Id := Project.Languages;
while Lang_Id /= No_Language_Index loop while Lang_Id /= No_Language_Index loop
case Lang_Id.Config.Kind is case Lang_Id.Config.Kind is
when File_Based => when File_Based =>
Process_Exceptions_File_Based (Lang_Id, Kind); Process_Exceptions_File_Based (Lang_Id, Kind);
when Unit_Based => when Unit_Based =>
Process_Exceptions_Unit_Based (Lang_Id, Kind); Process_Exceptions_Unit_Based (Lang_Id, Kind);
end case; end case;
Lang_Id := Lang_Id.Next; Lang_Id := Lang_Id.Next;
end loop; end loop;
end loop; end loop;
end Check_Naming_Multi_Lang; end Check_Naming;
---------------------------- ----------------------------
-- Initialize_Naming_Data -- -- Initialize_Naming_Data --
...@@ -3145,15 +3181,15 @@ package body Prj.Nmsc is ...@@ -3145,15 +3181,15 @@ package body Prj.Nmsc is
while Specs /= No_Array_Element loop while Specs /= No_Array_Element loop
Lang_Name := Data.Tree.Array_Elements.Table (Specs).Index; Lang_Name := Data.Tree.Array_Elements.Table (Specs).Index;
Lang := Get_Language_From_Name Lang :=
(Project, Name => Get_Name_String (Lang_Name)); Get_Language_From_Name
(Project, Name => Get_Name_String (Lang_Name));
-- An extending project inherits its parent projects' languages -- An extending project inherits its parent projects' languages
-- so if needed we should create entries for those languages -- so if needed we should create entries for those languages
if Lang = null then if Lang = null then
Extended := Project.Extends; Extended := Project.Extends;
while Extended /= null loop while Extended /= null loop
Lang := Get_Language_From_Name Lang := Get_Language_From_Name
(Extended, Name => Get_Name_String (Lang_Name)); (Extended, Name => Get_Name_String (Lang_Name));
...@@ -3179,6 +3215,7 @@ package body Prj.Nmsc is ...@@ -3179,6 +3215,7 @@ package body Prj.Nmsc is
& Get_Name_String (Lang_Name) & Get_Name_String (Lang_Name)
& " since language is not defined for this project"); & " since language is not defined for this project");
end if; end if;
else else
Value := Data.Tree.Array_Elements.Table (Specs).Value; Value := Data.Tree.Array_Elements.Table (Specs).Value;
...@@ -3193,8 +3230,9 @@ package body Prj.Nmsc is ...@@ -3193,8 +3230,9 @@ package body Prj.Nmsc is
while Impls /= No_Array_Element loop while Impls /= No_Array_Element loop
Lang_Name := Data.Tree.Array_Elements.Table (Impls).Index; Lang_Name := Data.Tree.Array_Elements.Table (Impls).Index;
Lang := Get_Language_From_Name Lang :=
(Project, Name => Get_Name_String (Lang_Name)); Get_Language_From_Name
(Project, Name => Get_Name_String (Lang_Name));
if Lang = null then if Lang = null then
if Current_Verbosity = High then if Current_Verbosity = High then
...@@ -3239,7 +3277,7 @@ package body Prj.Nmsc is ...@@ -3239,7 +3277,7 @@ package body Prj.Nmsc is
end if; end if;
Initialize_Naming_Data; Initialize_Naming_Data;
Check_Naming_Multi_Lang; Check_Naming;
end if; end if;
end Check_Package_Naming; end Check_Package_Naming;
...@@ -3293,8 +3331,8 @@ package body Prj.Nmsc is ...@@ -3293,8 +3331,8 @@ package body Prj.Nmsc is
------------------- -------------------
procedure Check_Library (Proj : Project_Id; Extends : Boolean) is procedure Check_Library (Proj : Project_Id; Extends : Boolean) is
Src_Id : Source_Id; Src_Id : Source_Id;
Iter : Source_Iterator; Iter : Source_Iterator;
begin begin
if Proj /= No_Project then if Proj /= No_Project then
...@@ -3873,17 +3911,15 @@ package body Prj.Nmsc is ...@@ -3873,17 +3911,15 @@ package body Prj.Nmsc is
Write_Line ("This is a library project file"); Write_Line ("This is a library project file");
end if; end if;
if Get_Mode = Multi_Language then Check_Library (Project.Extends, Extends => True);
Check_Library (Project.Extends, Extends => True);
Imported_Project_List := Project.Imported_Projects; Imported_Project_List := Project.Imported_Projects;
while Imported_Project_List /= null loop while Imported_Project_List /= null loop
Check_Library Check_Library
(Imported_Project_List.Project, (Imported_Project_List.Project,
Extends => False); Extends => False);
Imported_Project_List := Imported_Project_List.Next; Imported_Project_List := Imported_Project_List.Next;
end loop; end loop;
end if;
end if; end if;
end if; end if;
...@@ -3972,7 +4008,7 @@ package body Prj.Nmsc is ...@@ -3972,7 +4008,7 @@ package body Prj.Nmsc is
Lang := new Language_Data'(No_Language_Data); Lang := new Language_Data'(No_Language_Data);
Lang.Next := Project.Languages; Lang.Next := Project.Languages;
Project.Languages := Lang; Project.Languages := Lang;
Lang.Name := Name; Lang.Name := Name;
Lang.Display_Name := Display_Name; Lang.Display_Name := Display_Name;
if Name = Name_Ada then if Name = Name_Ada then
...@@ -3987,8 +4023,9 @@ package body Prj.Nmsc is ...@@ -3987,8 +4023,9 @@ package body Prj.Nmsc is
-- ??? We should do as GPS does and create a dummy config file -- ??? We should do as GPS does and create a dummy config file
Lang.Config.Naming_Data := Lang.Config.Naming_Data :=
(Dot_Replacement => File_Name_Type (Dot_Replacement =>
(First_Name_Id + Character'Pos ('-')), File_Name_Type
(First_Name_Id + Character'Pos ('-')),
Casing => All_Lower_Case, Casing => All_Lower_Case,
Separate_Suffix => Default_Ada_Body_Suffix, Separate_Suffix => Default_Ada_Body_Suffix,
Spec_Suffix => Default_Ada_Spec_Suffix, Spec_Suffix => Default_Ada_Spec_Suffix,
...@@ -4128,7 +4165,6 @@ package body Prj.Nmsc is ...@@ -4128,7 +4165,6 @@ package body Prj.Nmsc is
procedure Check_Stand_Alone_Library procedure Check_Stand_Alone_Library
(Project : Project_Id; (Project : Project_Id;
Current_Dir : String;
Extending : Boolean; Extending : Boolean;
Data : in out Tree_Processing_Data) Data : in out Tree_Processing_Data)
is is
...@@ -4217,19 +4253,22 @@ package body Prj.Nmsc is ...@@ -4217,19 +4253,22 @@ package body Prj.Nmsc is
String_Element_Table.Increment_Last String_Element_Table.Increment_Last
(Data.Tree.String_Elements); (Data.Tree.String_Elements);
Data.Tree.String_Elements.Table Data.Tree.String_Elements.Table
(String_Element_Table.Last (String_Element_Table.Last
(Data.Tree.String_Elements)) := (Data.Tree.String_Elements)) :=
(Value => ALI_Name_Id, (Value => ALI_Name_Id,
Index => 0, Index => 0,
Display_Value => ALI_Name_Id, Display_Value => ALI_Name_Id,
Location => Location =>
Data.Tree.String_Elements.Table Data.Tree.String_Elements.Table
(Interfaces).Location, (Interfaces).Location,
Flag => False, Flag => False,
Next => Interface_ALIs); Next => Interface_ALIs);
Interface_ALIs := String_Element_Table.Last
(Data.Tree.String_Elements); Interface_ALIs :=
String_Element_Table.Last
(Data.Tree.String_Elements);
end; end;
end Add_ALI_For; end Add_ALI_For;
...@@ -4269,79 +4308,50 @@ package body Prj.Nmsc is ...@@ -4269,79 +4308,50 @@ package body Prj.Nmsc is
if Get_Mode = Ada_Only then if Get_Mode = Ada_Only then
UData := Units_Htable.Get (Data.Tree.Units_HT, Unit); UData := Units_Htable.Get (Data.Tree.Units_HT, Unit);
if UData = No_Unit_Index then -- Check that the unit is part of the project
Error_Msg
(Project,
"unknown unit %%",
Data.Tree.String_Elements.Table
(Interfaces).Location, Data);
else if UData /= null
-- Check that the unit is part of the project and then UData.File_Names (Impl) /= null
and then not UData.File_Names (Impl).Locally_Removed
if UData.File_Names (Impl) /= null then
and then not UData.File_Names (Impl).Locally_Removed if Check_Project
(UData.File_Names (Impl).Project,
Project, Extending)
then then
if Check_Project -- There is a body for this unit. If there is
(UData.File_Names (Impl).Project, -- no spec, we need to check that it is not a
Project, Extending) -- subunit.
then
-- There is a body for this unit. If there is
-- no spec, we need to check that it is not a
-- subunit.
if UData.File_Names (Spec) = null then
declare
Src_Ind : Source_File_Index;
begin
Src_Ind :=
Sinput.P.Load_Project_File
(Get_Name_String (UData.File_Names
(Impl).Path.Name));
if Sinput.P.Source_File_Is_Subunit
(Src_Ind)
then
Error_Msg
(Project,
"%% is a subunit; " &
"it cannot be an interface",
Data.Tree.
String_Elements.Table
(Interfaces).Location,
Data);
end if;
end;
end if;
-- The unit is not a subunit, so we add the if UData.File_Names (Spec) = null then
-- ALI file for its body to the Interface ALIs. declare
Src_Ind : Source_File_Index;
Add_ALI_For begin
(UData.File_Names (Impl).File); Src_Ind :=
Sinput.P.Load_Project_File
(Get_Name_String (UData.File_Names
(Impl).Path.Name));
else if Sinput.P.Source_File_Is_Subunit
Error_Msg (Src_Ind)
(Project, then
"%% is not an unit of this project", Error_Msg
Data.Tree.String_Elements.Table (Project,
(Interfaces).Location, Data); "%% is a subunit; " &
"it cannot be an interface",
Data.Tree.
String_Elements.Table
(Interfaces).Location,
Data);
end if;
end;
end if; end if;
elsif UData.File_Names (Spec) /= null -- The unit is not a subunit, so we add the
and then not UData.File_Names (Spec).Locally_Removed -- ALI file for its body to the Interface ALIs.
and then Check_Project
(UData.File_Names (Spec).Project,
Project, Extending)
then
-- The unit is part of the project, it has a spec,
-- but no body. We add the ALI for its spec to the
-- Interface ALIs.
Add_ALI_For Add_ALI_For
(UData.File_Names (Spec).File); (UData.File_Names (Impl).File);
else else
Error_Msg Error_Msg
...@@ -4350,11 +4360,31 @@ package body Prj.Nmsc is ...@@ -4350,11 +4360,31 @@ package body Prj.Nmsc is
Data.Tree.String_Elements.Table Data.Tree.String_Elements.Table
(Interfaces).Location, Data); (Interfaces).Location, Data);
end if; end if;
elsif UData /= null
and then UData.File_Names (Spec) /= null
and then not UData.File_Names (Spec).Locally_Removed
and then Check_Project
(UData.File_Names (Spec).Project,
Project, Extending)
then
-- The unit is part of the project, it has a spec,
-- but no body. We add the ALI for its spec to the
-- Interface ALIs.
Add_ALI_For
(UData.File_Names (Spec).File);
else
Error_Msg
(Project,
"%% is not an unit of this project",
Data.Tree.String_Elements.Table
(Interfaces).Location, Data);
end if; end if;
else else
-- Multi_Language mode
Next_Proj := Project.Extends; Next_Proj := Project.Extends;
Iter := For_Each_Source (Data.Tree, Project); Iter := For_Each_Source (Data.Tree, Project);
loop loop
...@@ -4413,14 +4443,14 @@ package body Prj.Nmsc is ...@@ -4413,14 +4443,14 @@ package body Prj.Nmsc is
Data.Tree.String_Elements.Table Data.Tree.String_Elements.Table
(String_Element_Table.Last (String_Element_Table.Last
(Data.Tree.String_Elements)) := (Data.Tree.String_Elements)) :=
(Value => Name_Id (Source.Dep_Name), (Value => Name_Id (Source.Dep_Name),
Index => 0, Index => 0,
Display_Value => Name_Id (Source.Dep_Name), Display_Value => Name_Id (Source.Dep_Name),
Location => Location =>
Data.Tree.String_Elements.Table Data.Tree.String_Elements.Table
(Interfaces).Location, (Interfaces).Location,
Flag => False, Flag => False,
Next => Interface_ALIs); Next => Interface_ALIs);
Interface_ALIs := Interface_ALIs :=
String_Element_Table.Last String_Element_Table.Last
...@@ -4498,7 +4528,7 @@ package body Prj.Nmsc is ...@@ -4498,7 +4528,7 @@ package body Prj.Nmsc is
Dir_Id, Dir_Id,
Path => Project.Library_Src_Dir, Path => Project.Library_Src_Dir,
Dir_Exists => Dir_Exists, Dir_Exists => Dir_Exists,
Data => Data, Data => Data,
Must_Exist => False, Must_Exist => False,
Create => "library source copy", Create => "library source copy",
Location => Lib_Src_Dir.Location, Location => Lib_Src_Dir.Location,
...@@ -4622,8 +4652,8 @@ package body Prj.Nmsc is ...@@ -4622,8 +4652,8 @@ package body Prj.Nmsc is
if not Lib_Symbol_Policy.Default then if not Lib_Symbol_Policy.Default then
declare declare
Value : constant String := Value : constant String :=
To_Lower To_Lower
(Get_Name_String (Lib_Symbol_Policy.Value)); (Get_Name_String (Lib_Symbol_Policy.Value));
begin begin
-- Symbol policy must hove one of a limited number of values -- Symbol policy must hove one of a limited number of values
...@@ -4741,7 +4771,7 @@ package body Prj.Nmsc is ...@@ -4741,7 +4771,7 @@ package body Prj.Nmsc is
end if; end if;
if not Is_Regular_File if not Is_Regular_File
(Get_Name_String (Project.Symbol_Data.Reference)) (Get_Name_String (Project.Symbol_Data.Reference))
then then
Error_Msg_File_1 := Error_Msg_File_1 :=
File_Name_Type (Lib_Ref_Symbol_File.Value); File_Name_Type (Lib_Ref_Symbol_File.Value);
...@@ -4779,19 +4809,23 @@ package body Prj.Nmsc is ...@@ -4779,19 +4809,23 @@ package body Prj.Nmsc is
if Name_Len > 0 then if Name_Len > 0 then
declare declare
-- We do not need to pass a Directory to
-- Normalize_Pathname, since the path_information
-- already contains absolute information.
Symb_Path : constant String := Symb_Path : constant String :=
Normalize_Pathname Normalize_Pathname
(Get_Name_String (Get_Name_String
(Project.Object_Directory.Name) & (Project.Object_Directory.Name) &
Name_Buffer (1 .. Name_Len), Name_Buffer (1 .. Name_Len),
Directory => Current_Dir, Directory => "/",
Resolve_Links => Resolve_Links =>
Opt.Follow_Links_For_Files); Opt.Follow_Links_For_Files);
Ref_Path : constant String := Ref_Path : constant String :=
Normalize_Pathname Normalize_Pathname
(Get_Name_String (Get_Name_String
(Project.Symbol_Data.Reference), (Project.Symbol_Data.Reference),
Directory => Current_Dir, Directory => "/",
Resolve_Links => Resolve_Links =>
Opt.Follow_Links_For_Files); Opt.Follow_Links_For_Files);
begin begin
...@@ -4944,7 +4978,7 @@ package body Prj.Nmsc is ...@@ -4944,7 +4978,7 @@ package body Prj.Nmsc is
Real_Location := Project.Location; Real_Location := Project.Location;
end if; end if;
if Data.Report_Error = null then if Data.Flags.Report_Error = null then
Prj.Err.Error_Msg (Msg, Real_Location); Prj.Err.Error_Msg (Msg, Real_Location);
return; return;
end if; end if;
...@@ -4981,14 +5015,16 @@ package body Prj.Nmsc is ...@@ -4981,14 +5015,16 @@ package body Prj.Nmsc is
end if; end if;
Add_Name; Add_Name;
else else
Add (Msg (Index)); Add (Msg (Index));
end if; end if;
Index := Index + 1; Index := Index + 1;
end loop; end loop;
Data.Report_Error Data.Flags.Report_Error
(Error_Buffer (1 .. Error_Last), Project, Data.Tree); (Error_Buffer (1 .. Error_Last), Project, Data.Tree);
end Error_Msg; end Error_Msg;
...@@ -4998,7 +5034,6 @@ package body Prj.Nmsc is ...@@ -4998,7 +5034,6 @@ package body Prj.Nmsc is
procedure Get_Directories procedure Get_Directories
(Project : Project_Id; (Project : Project_Id;
Current_Dir : String;
Data : in out Tree_Processing_Data) Data : in out Tree_Processing_Data)
is is
package Recursive_Dirs is new GNAT.Dynamic_HTables.Simple_HTable package Recursive_Dirs is new GNAT.Dynamic_HTables.Simple_HTable
...@@ -5085,7 +5120,8 @@ package body Prj.Nmsc is ...@@ -5085,7 +5120,8 @@ package body Prj.Nmsc is
The_Path : constant String := The_Path : constant String :=
Normalize_Pathname Normalize_Pathname
(Get_Name_String (Path), (Get_Name_String (Path),
Directory => Current_Dir, Directory => Get_Name_String
(Project.Directory.Display_Name),
Resolve_Links => Opt.Follow_Links_For_Dirs) & Resolve_Links => Opt.Follow_Links_For_Dirs) &
Directory_Separator; Directory_Separator;
...@@ -5209,6 +5245,7 @@ package body Prj.Nmsc is ...@@ -5209,6 +5245,7 @@ package body Prj.Nmsc is
begin begin
if Is_Directory (Path_Name) then if Is_Directory (Path_Name) then
-- We have found a new subdirectory, call self -- We have found a new subdirectory, call self
Name_Len := Path_Name'Length; Name_Len := Path_Name'Length;
...@@ -5459,7 +5496,7 @@ package body Prj.Nmsc is ...@@ -5459,7 +5496,7 @@ package body Prj.Nmsc is
-- is no sources in the project. -- is no sources in the project.
if (((not Source_Files.Default) if (((not Source_Files.Default)
and then Source_Files.Values = Nil_String) and then Source_Files.Values = Nil_String)
or else or else
((not Source_Dirs.Default) and then Source_Dirs.Values = Nil_String) ((not Source_Dirs.Default) and then Source_Dirs.Values = Nil_String)
or else or else
...@@ -5621,6 +5658,7 @@ package body Prj.Nmsc is ...@@ -5621,6 +5658,7 @@ package body Prj.Nmsc is
Flag => False, Flag => False,
Next => Nil_String, Next => Nil_String,
Index => 0)); Index => 0));
Project.Source_Dirs := Project.Source_Dirs :=
String_Element_Table.Last (Data.Tree.String_Elements); String_Element_Table.Last (Data.Tree.String_Elements);
...@@ -6083,7 +6121,9 @@ package body Prj.Nmsc is ...@@ -6083,7 +6121,9 @@ package body Prj.Nmsc is
begin begin
if Suffix_Str'Length = 0 then if Suffix_Str'Length = 0 then
-- Always valid -- Always valid
return; return;
elsif Index (Suffix_Str, ".") = 0 then elsif Index (Suffix_Str, ".") = 0 then
...@@ -6298,15 +6338,14 @@ package body Prj.Nmsc is ...@@ -6298,15 +6338,14 @@ package body Prj.Nmsc is
--------------------------- ---------------------------
procedure Find_Excluded_Sources procedure Find_Excluded_Sources
(Project : in out Project_Processing_Data; (Project : in out Project_Processing_Data;
Data : in out Tree_Processing_Data) Data : in out Tree_Processing_Data)
is is
Excluded_Source_List_File : constant Variable_Value := Excluded_Source_List_File : constant Variable_Value :=
Util.Value_Of Util.Value_Of
(Name_Excluded_Source_List_File, (Name_Excluded_Source_List_File,
Project.Project.Decl.Attributes, Project.Project.Decl.Attributes,
Data.Tree); Data.Tree);
Excluded_Sources : Variable_Value := Util.Value_Of Excluded_Sources : Variable_Value := Util.Value_Of
(Name_Excluded_Source_Files, (Name_Excluded_Source_Files,
Project.Project.Decl.Attributes, Project.Project.Decl.Attributes,
...@@ -6705,21 +6744,13 @@ package body Prj.Nmsc is ...@@ -6705,21 +6744,13 @@ package body Prj.Nmsc is
---------------- ----------------
procedure Initialize procedure Initialize
(Data : out Tree_Processing_Data; (Data : out Tree_Processing_Data;
Tree : Project_Tree_Ref; Tree : Project_Tree_Ref;
Report_Error : Put_Line_Access; Flags : Prj.Processing_Flags) is
When_No_Sources : Error_Warning;
Require_Sources_Other_Lang : Boolean := True;
Allow_Duplicate_Basenames : Boolean := True;
Compiler_Driver_Mandatory : Boolean := False) is
begin begin
Files_Htable.Reset (Data.File_To_Source); Files_Htable.Reset (Data.File_To_Source);
Data.Tree := Tree; Data.Tree := Tree;
Data.Require_Sources_Other_Lang := Require_Sources_Other_Lang; Data.Flags := Flags;
Data.Report_Error := Report_Error;
Data.When_No_Sources := When_No_Sources;
Data.Allow_Duplicate_Basenames := Allow_Duplicate_Basenames;
Data.Compiler_Driver_Mandatory := Compiler_Driver_Mandatory;
end Initialize; end Initialize;
---------- ----------
...@@ -6751,7 +6782,6 @@ package body Prj.Nmsc is ...@@ -6751,7 +6782,6 @@ package body Prj.Nmsc is
Source_Names_Htable.Reset (Data.Source_Names); Source_Names_Htable.Reset (Data.Source_Names);
Unit_Exceptions_Htable.Reset (Data.Unit_Exceptions); Unit_Exceptions_Htable.Reset (Data.Unit_Exceptions);
Excluded_Sources_Htable.Reset (Data.Excluded); Excluded_Sources_Htable.Reset (Data.Excluded);
Object_File_Names_Htable.Reset (Data.Object_Files);
end Free; end Free;
------------------------------- -------------------------------
...@@ -6934,7 +6964,8 @@ package body Prj.Nmsc is ...@@ -6934,7 +6964,8 @@ package body Prj.Nmsc is
(Canonical_Case_File_Name (Name_Id (Path))); (Canonical_Case_File_Name (Name_Id (Path)));
Name_Loc : Name_Location := Name_Loc : Name_Location :=
Source_Names_Htable.Get (Project.Source_Names, File_Name); Source_Names_Htable.Get
(Project.Source_Names, File_Name);
Check_Name : Boolean := False; Check_Name : Boolean := False;
Alternate_Languages : Language_List; Alternate_Languages : Language_List;
Language : Language_Ptr; Language : Language_Ptr;
...@@ -6951,6 +6982,7 @@ package body Prj.Nmsc is ...@@ -6951,6 +6982,7 @@ package body Prj.Nmsc is
else else
if Name_Loc.Found then if Name_Loc.Found then
-- Check if it is OK to have the same file name in several -- Check if it is OK to have the same file name in several
-- source directories. -- source directories.
...@@ -7014,14 +7046,14 @@ package body Prj.Nmsc is ...@@ -7014,14 +7046,14 @@ package body Prj.Nmsc is
-- A file name in a list must be a source of a language -- A file name in a list must be a source of a language
if Get_Mode = Multi_Language then if Data.Flags.Error_On_Unknown_Language
if Name_Loc.Found then and then Name_Loc.Found
Error_Msg_File_1 := File_Name; then
Error_Msg Error_Msg_File_1 := File_Name;
(Project.Project, Error_Msg
"language unknown for {", (Project.Project,
Name_Loc.Location, Data); "language unknown for {",
end if; Name_Loc.Location, Data);
end if; end if;
else else
...@@ -7201,8 +7233,8 @@ package body Prj.Nmsc is ...@@ -7201,8 +7233,8 @@ package body Prj.Nmsc is
---------------------------- ----------------------------
procedure Load_Naming_Exceptions procedure Load_Naming_Exceptions
(Project : in out Project_Processing_Data; (Project : in out Project_Processing_Data;
Data : in out Tree_Processing_Data) Data : in out Tree_Processing_Data)
is is
Source : Source_Id; Source : Source_Id;
Iter : Source_Iterator; Iter : Source_Iterator;
...@@ -7216,7 +7248,7 @@ package body Prj.Nmsc is ...@@ -7216,7 +7248,7 @@ package body Prj.Nmsc is
-- An excluded file cannot also be an exception file name -- An excluded file cannot also be an exception file name
if Excluded_Sources_Htable.Get (Project.Excluded, Source.File) /= if Excluded_Sources_Htable.Get (Project.Excluded, Source.File) /=
No_File_Found No_File_Found
then then
Error_Msg_File_1 := Source.File; Error_Msg_File_1 := Source.File;
Error_Msg Error_Msg
...@@ -7235,10 +7267,10 @@ package body Prj.Nmsc is ...@@ -7235,10 +7267,10 @@ package body Prj.Nmsc is
(Project.Source_Names, (Project.Source_Names,
K => Source.File, K => Source.File,
E => Name_Location' E => Name_Location'
(Name => Source.File, (Name => Source.File,
Location => No_Location, Location => No_Location,
Source => Source, Source => Source,
Found => False)); Found => False));
-- If this is an Ada exception, record in table Unit_Exceptions -- If this is an Ada exception, record in table Unit_Exceptions
...@@ -7274,15 +7306,49 @@ package body Prj.Nmsc is ...@@ -7274,15 +7306,49 @@ package body Prj.Nmsc is
(Project : in out Project_Processing_Data; (Project : in out Project_Processing_Data;
Data : in out Tree_Processing_Data) Data : in out Tree_Processing_Data)
is is
Iter : Source_Iterator; Object_Files : Object_File_Names_Htable.Instance;
Src : Source_Id; Iter : Source_Iterator;
Src : Source_Id;
procedure Process_Sources_In_Multi_Language_Mode; procedure Check_Object (Src : Source_Id);
-- Find all source files when in multi language mode -- Check if object file name of Src is already used in the project tree,
-- and report an error if so.
procedure Check_Object_Files;
-- Check that no two sources of this project have the same object file
procedure Mark_Excluded_Sources; procedure Mark_Excluded_Sources;
-- Mark as such the sources that are declared as excluded -- Mark as such the sources that are declared as excluded
------------------
-- Check_Object --
------------------
procedure Check_Object (Src : Source_Id) is
Source : Source_Id;
begin
Source := Object_File_Names_Htable.Get (Object_Files, Src.Object);
-- We cannot just check on "Source /= Src", since we might have
-- two different entries for the same file (and since that's
-- the same file it is expected that it has the same object)
if Source /= No_Source
and then Source.Path /= Src.Path
then
Error_Msg_File_1 := Src.File;
Error_Msg_File_2 := Source.File;
Error_Msg
(Project.Project,
"{ and { have the same object file name",
No_Location, Data);
else
Object_File_Names_Htable.Set (Object_Files, Src.Object, Src);
end if;
end Check_Object;
--------------------------- ---------------------------
-- Mark_Excluded_Sources -- -- Mark_Excluded_Sources --
--------------------------- ---------------------------
...@@ -7291,6 +7357,7 @@ package body Prj.Nmsc is ...@@ -7291,6 +7357,7 @@ package body Prj.Nmsc is
Source : Source_Id := No_Source; Source : Source_Id := No_Source;
Excluded : File_Found; Excluded : File_Found;
Proj : Project_Id; Proj : Project_Id;
begin begin
-- Minor optimization: if there are no excluded files, no need to -- Minor optimization: if there are no excluded files, no need to
-- traverse the list of sources. We cannot however also check whether -- traverse the list of sources. We cannot however also check whether
...@@ -7299,7 +7366,7 @@ package body Prj.Nmsc is ...@@ -7299,7 +7366,7 @@ package body Prj.Nmsc is
-- them in any case. -- them in any case.
if Excluded_Sources_Htable.Get_First (Project.Excluded) /= if Excluded_Sources_Htable.Get_First (Project.Excluded) /=
No_File_Found No_File_Found
then then
Proj := Project.Project; Proj := Project.Project;
while Proj /= No_Project loop while Proj /= No_Project loop
...@@ -7335,7 +7402,6 @@ package body Prj.Nmsc is ...@@ -7335,7 +7402,6 @@ package body Prj.Nmsc is
-- the source file -- the source file
Excluded := Excluded_Sources_Htable.Get_First (Project.Excluded); Excluded := Excluded_Sources_Htable.Get_First (Project.Excluded);
while Excluded /= No_File_Found loop while Excluded /= No_File_Found loop
if not Excluded.Found then if not Excluded.Found then
...@@ -7366,129 +7432,77 @@ package body Prj.Nmsc is ...@@ -7366,129 +7432,77 @@ package body Prj.Nmsc is
end loop; end loop;
end Mark_Excluded_Sources; end Mark_Excluded_Sources;
-------------------------------------------- ------------------------
-- Process_Sources_In_Multi_Language_Mode -- -- Check_Object_Files --
-------------------------------------------- ------------------------
procedure Process_Sources_In_Multi_Language_Mode is procedure Check_Object_Files is
Iter : Source_Iterator; Iter : Source_Iterator;
Src_Id : Source_Id;
Src_Ind : Source_File_Index;
begin begin
-- Check that two sources of this project do not have the same object Iter := For_Each_Source (Data.Tree);
-- file name. loop
Src_Id := Prj.Element (Iter);
Check_Object_File_Names : declare exit when Src_Id = No_Source;
Src_Id : Source_Id;
procedure Check_Object (Src : Source_Id);
-- Check if object file name of the current source is already in
-- hash table Object_File_Names. If it is, report an error. If it
-- is not, put it there with the file name of the current source.
------------------
-- Check_Object --
------------------
procedure Check_Object (Src : Source_Id) is
Source : Source_Id;
begin
Source := Object_File_Names_Htable.Get
(Project.Object_Files, Src.Object);
-- We cannot just check on "Source /= Src", since we might have
-- two different entries for the same file (and since that's
-- the same file it is expected that it has the same object)
if Source /= No_Source if Is_Compilable (Src_Id)
and then Source.Path /= Src.Path and then Src_Id.Language.Config.Object_Generated
then and then Is_Extending (Project.Project, Src_Id.Project)
Error_Msg_File_1 := Src.File; then
Error_Msg_File_2 := Source.File; if Src_Id.Unit = No_Unit_Index then
Error_Msg if Src_Id.Kind = Impl then
(Project.Project, Check_Object (Src_Id);
"{ and { have the same object file name", end if;
No_Location, Data);
else else
Object_File_Names_Htable.Set case Src_Id.Kind is
(Project.Object_Files, Src.Object, Src); when Spec =>
end if; if Other_Part (Src_Id) = No_Source then
end Check_Object; Check_Object (Src_Id);
end if;
-- Start of processing for Check_Object_File_Names
begin when Sep =>
Iter := For_Each_Source (Data.Tree); null;
loop
Src_Id := Prj.Element (Iter);
exit when Src_Id = No_Source;
if Is_Compilable (Src_Id) when Impl =>
and then Src_Id.Language.Config.Object_Generated if Other_Part (Src_Id) /= No_Source then
and then Is_Extending (Project.Project, Src_Id.Project) Check_Object (Src_Id);
then
if Src_Id.Unit = No_Unit_Index then
if Src_Id.Kind = Impl then
Check_Object (Src_Id);
end if;
else else
case Src_Id.Kind is -- Check if it is a subunit
when Spec =>
if Other_Part (Src_Id) = No_Source then
Check_Object (Src_Id);
end if;
when Sep =>
null;
when Impl => Src_Ind := Sinput.P.Load_Project_File
if Other_Part (Src_Id) /= No_Source then (Get_Name_String (Src_Id.Path.Name));
Check_Object (Src_Id);
if Sinput.P.Source_File_Is_Subunit (Src_Ind) then
Override_Kind (Src_Id, Sep);
else else
-- Check if it is a subunit Check_Object (Src_Id);
declare
Src_Ind : constant Source_File_Index :=
Sinput.P.Load_Project_File
(Get_Name_String
(Src_Id.Path.Name));
begin
if Sinput.P.Source_File_Is_Subunit
(Src_Ind)
then
Override_Kind (Src_Id, Sep);
else
Check_Object (Src_Id);
end if;
end;
end if; end if;
end case; end if;
end if; end case;
end if; end if;
end if;
Next (Iter); Next (Iter);
end loop; end loop;
end Check_Object_File_Names; end Check_Object_Files;
end Process_Sources_In_Multi_Language_Mode;
-- Start of processing for Look_For_Sources -- Start of processing for Look_For_Sources
begin begin
Find_Excluded_Sources (Project, Data); Find_Excluded_Sources (Project, Data);
if (Get_Mode = Ada_Only if Project.Project.Languages /= No_Language_Index then
and then Is_A_Language (Project.Project, Name_Ada))
or else (Get_Mode = Multi_Language
and then Project.Project.Languages /= No_Language_Index)
then
Load_Naming_Exceptions (Project, Data); Load_Naming_Exceptions (Project, Data);
Find_Sources (Project, Data); Find_Sources (Project, Data);
Mark_Excluded_Sources; Mark_Excluded_Sources;
Check_Object_Files;
Process_Sources_In_Multi_Language_Mode;
end if; end if;
Object_File_Names_Htable.Reset (Object_Files);
end Look_For_Sources; end Look_For_Sources;
------------------ ------------------
...@@ -7579,7 +7593,7 @@ package body Prj.Nmsc is ...@@ -7579,7 +7593,7 @@ package body Prj.Nmsc is
Continuation : Boolean := False) Continuation : Boolean := False)
is is
begin begin
case Data.When_No_Sources is case Data.Flags.When_No_Sources is
when Silent => when Silent =>
null; null;
...@@ -7591,7 +7605,7 @@ package body Prj.Nmsc is ...@@ -7591,7 +7605,7 @@ package body Prj.Nmsc is
" sources in this project"; " sources in this project";
begin begin
Error_Msg_Warn := Data.When_No_Sources = Warning; Error_Msg_Warn := Data.Flags.When_No_Sources = Warning;
if Continuation then if Continuation then
Error_Msg (Project, "\" & Msg, Location, Data); Error_Msg (Project, "\" & Msg, Location, Data);
...@@ -7626,4 +7640,46 @@ package body Prj.Nmsc is ...@@ -7626,4 +7640,46 @@ package body Prj.Nmsc is
Write_Line ("end Source_Dirs."); Write_Line ("end Source_Dirs.");
end Show_Source_Dirs; end Show_Source_Dirs;
---------------------------
-- Process_Naming_Scheme --
---------------------------
procedure Process_Naming_Scheme
(Tree : Project_Tree_Ref;
Root_Project : Project_Id;
Flags : Processing_Flags)
is
procedure Recursive_Check
(Project : Project_Id;
Data : in out Tree_Processing_Data);
-- Check_Naming_Scheme for the project
---------------------
-- Recursive_Check --
---------------------
procedure Recursive_Check
(Project : Project_Id;
Data : in out Tree_Processing_Data) is
begin
if Verbose_Mode then
Write_Str ("Processing_Naming_Scheme for project """);
Write_Str (Get_Name_String (Project.Name));
Write_Line ("""");
end if;
Prj.Nmsc.Check (Project, Data);
end Recursive_Check;
procedure Check_All_Projects is new
For_Every_Project_Imported (Tree_Processing_Data, Recursive_Check);
Data : Tree_Processing_Data;
begin
Initialize (Data, Tree => Tree, Flags => Flags);
Check_All_Projects (Root_Project, Data, Imported_First => True);
Free (Data);
end Process_Naming_Scheme;
end Prj.Nmsc; end Prj.Nmsc;
gcc/ada/prj-nmsc.ads
...@@ -23,87 +23,21 @@ ...@@ -23,87 +23,21 @@
-- -- -- --
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
-- Perform various checks on a project and find all its source files -- Find source dirs and source files for a project
with GNAT.Dynamic_HTables;
private package Prj.Nmsc is private package Prj.Nmsc is
type Tree_Processing_Data is private; procedure Process_Naming_Scheme
-- Temporary data which is needed while parsing a project. It does not need (Tree : Project_Tree_Ref;
-- to be kept in memory once a project has been fully loaded, but is Root_Project : Project_Id;
-- necessary while performing consistency checks (duplicate sources,...) Flags : Processing_Flags);
-- This data must be initialized before processing any project, and the -- Perform consistency and semantic checks on all the projects in the tree.
-- same data is used for processing all projects in the tree. -- This procedure interprets the various case statements in the project
-- based on the current environment variables (the "scenario"). After
procedure Initialize -- checking the validity of the naming scheme, it searches for all the
(Data : out Tree_Processing_Data; -- source files of the project. The result of this procedure is a filled-in
Tree : Project_Tree_Ref; -- data structure for Project_Id which contains all the information about
Report_Error : Put_Line_Access; -- the project. This information is only valid while the scenario variables
When_No_Sources : Error_Warning; -- are preserved.
Require_Sources_Other_Lang : Boolean := True;
Allow_Duplicate_Basenames : Boolean := True;
Compiler_Driver_Mandatory : Boolean := False);
-- Initialize Data
-- If Allow_Duplicate_Basenames, then files with the same base names are
-- authorized within a project for source-based languages (never for unit
-- based languages)
-- If Compiler_Driver_Mandatory is true, then a Compiler.Driver attribute
-- for each language must be defined, or we will not look for its source
-- files.
-- When_No_Sources indicates what should be done when no sources of a
-- language are found in a project where this language is declared.
-- If Require_Sources_Other_Lang is true, then all languages must have at
-- least one source file, or an error is reported via When_No_Sources. If
-- it is false, this is only required for Ada (and only if it is a language
-- of the project).
-- If Report_Error is null, use the standard error reporting mechanism
-- (Errout). Otherwise, report errors using Report_Error.
procedure Free (Data : in out Tree_Processing_Data);
-- Free the memory occupied by Data
procedure Check
(Project : Project_Id;
Current_Dir : String;
Data : in out Tree_Processing_Data);
-- Perform consistency and semantic checks on a project, starting from the
-- project tree parsed from the .gpr file. This procedure interprets the
-- various case statements in the project based on the current environment
-- variables (the "scenario"). After checking the validity of the naming
-- scheme, it searches for all the source files of the project. The result
-- of this procedure is a filled-in data structure for Project_Id which
-- contains all the information about the project. This information is only
-- valid while the scenario variables are preserved. If the current mode
-- is Ada_Only, this procedure will only search Ada sources, but in multi-
-- language mode it will look for sources for all supported languages.
--
-- Current_Dir is for optimization purposes only, avoiding system calls to
-- query it.
private
package Files_Htable is new GNAT.Dynamic_HTables.Simple_HTable
(Header_Num => Header_Num,
Element => Source_Id,
No_Element => No_Source,
Key => File_Name_Type,
Hash => Hash,
Equal => "=");
-- Mapping from base file names to Source_Id (containing full info about
-- the source)
type Tree_Processing_Data is record
Tree : Project_Tree_Ref;
-- The data applies when parsing this tree
File_To_Source : Files_Htable.Instance;
Require_Sources_Other_Lang : Boolean;
Report_Error : Put_Line_Access;
When_No_Sources : Error_Warning;
Allow_Duplicate_Basenames : Boolean := True;
Compiler_Driver_Mandatory : Boolean := False;
-- See comments for Initialize
end record;
end Prj.Nmsc; end Prj.Nmsc;
gcc/ada/prj-pars.adb
...@@ -44,8 +44,7 @@ package body Prj.Pars is ...@@ -44,8 +44,7 @@ package body Prj.Pars is
Project : out Project_Id; Project : out Project_Id;
Project_File_Name : String; Project_File_Name : String;
Packages_To_Check : String_List_Access := All_Packages; Packages_To_Check : String_List_Access := All_Packages;
When_No_Sources : Error_Warning := Error; Flags : Processing_Flags;
Report_Error : Put_Line_Access := null;
Reset_Tree : Boolean := True) Reset_Tree : Boolean := True)
is is
Project_Node : Project_Node_Id := Empty_Node; Project_Node : Project_Node_Id := Empty_Node;
...@@ -90,15 +89,11 @@ package body Prj.Pars is ...@@ -90,15 +89,11 @@ package body Prj.Pars is
Allow_Automatic_Generation => False, Allow_Automatic_Generation => False,
Automatically_Generated => Automatically_Generated, Automatically_Generated => Automatically_Generated,
Config_File_Path => Config_File_Path, Config_File_Path => Config_File_Path,
Report_Error => Report_Error, Flags => Flags,
Normalized_Hostname => "", Normalized_Hostname => "",
Compiler_Driver_Mandatory => False,
Allow_Duplicate_Basenames => False,
Require_Sources_Other_Lang => False,
On_Load_Config => On_Load_Config =>
Add_Default_GNAT_Naming_Scheme'Access, Add_Default_GNAT_Naming_Scheme'Access,
Reset_Tree => Reset_Tree, Reset_Tree => Reset_Tree);
When_No_Sources => When_No_Sources);
Success := The_Project /= No_Project; Success := The_Project /= No_Project;
......
gcc/ada/prj-pars.ads
...@@ -35,8 +35,7 @@ package Prj.Pars is ...@@ -35,8 +35,7 @@ package Prj.Pars is
Project : out Project_Id; Project : out Project_Id;
Project_File_Name : String; Project_File_Name : String;
Packages_To_Check : String_List_Access := All_Packages; Packages_To_Check : String_List_Access := All_Packages;
When_No_Sources : Error_Warning := Error; Flags : Processing_Flags;
Report_Error : Prj.Put_Line_Access := null;
Reset_Tree : Boolean := True); Reset_Tree : Boolean := True);
-- Parse and process a project files and all its imported project files, in -- Parse and process a project files and all its imported project files, in
-- the project tree In_Tree. -- the project tree In_Tree.
...@@ -56,9 +55,6 @@ package Prj.Pars is ...@@ -56,9 +55,6 @@ package Prj.Pars is
-- produces an error. For other packages, an unknown attribute produces a -- produces an error. For other packages, an unknown attribute produces a
-- warning. -- warning.
-- --
-- When_No_Sources indicates what should be done when no sources are found
-- in a project for a specified or implied language.
--
-- When Reset_Tree is True, all the project data are removed from the -- When Reset_Tree is True, all the project data are removed from the
-- project table before processing. -- project table before processing.
......
gcc/ada/prj-part.adb
...@@ -1110,8 +1110,8 @@ package body Prj.Part is ...@@ -1110,8 +1110,8 @@ package body Prj.Part is
Write_Eol; Write_Eol;
end if; end if;
Project_Directory := Path_Name_Type Project_Directory :=
(Get_Directory (File_Name_Type (Normed_Path_Name))); Path_Name_Type (Get_Directory (File_Name_Type (Normed_Path_Name)));
-- Is there any imported project? -- Is there any imported project?
......
gcc/ada/prj-proc.adb
...@@ -79,12 +79,7 @@ package body Prj.Proc is ...@@ -79,12 +79,7 @@ package body Prj.Proc is
procedure Check procedure Check
(In_Tree : Project_Tree_Ref; (In_Tree : Project_Tree_Ref;
Project : Project_Id; Project : Project_Id;
Current_Dir : String; Flags : Processing_Flags);
Report_Error : Put_Line_Access;
When_No_Sources : Error_Warning;
Require_Sources_Other_Lang : Boolean;
Compiler_Driver_Mandatory : Boolean;
Allow_Duplicate_Basenames : Boolean);
-- Set all projects to not checked, then call Recursive_Check for the -- Set all projects to not checked, then call Recursive_Check for the
-- main project Project. Project is set to No_Project if errors occurred. -- main project Project. Project is set to No_Project if errors occurred.
-- Current_Dir is for optimization purposes, avoiding extra system calls. -- Current_Dir is for optimization purposes, avoiding extra system calls.
...@@ -141,7 +136,7 @@ package body Prj.Proc is ...@@ -141,7 +136,7 @@ package body Prj.Proc is
procedure Recursive_Process procedure Recursive_Process
(In_Tree : Project_Tree_Ref; (In_Tree : Project_Tree_Ref;
Project : out Project_Id; Project : out Project_Id;
Report_Error : Put_Line_Access; Flags : Processing_Flags;
From_Project_Node : Project_Node_Id; From_Project_Node : Project_Node_Id;
From_Project_Node_Tree : Project_Node_Tree_Ref; From_Project_Node_Tree : Project_Node_Tree_Ref;
Extended_By : Project_Id); Extended_By : Project_Id);
...@@ -152,18 +147,6 @@ package body Prj.Proc is ...@@ -152,18 +147,6 @@ package body Prj.Proc is
-- extended project, if any. Then process the declarative items of the -- extended project, if any. Then process the declarative items of the
-- project. -- project.
type Recursive_Check_Data is record
Current_Dir : String_Access;
Proc_Data : Tree_Processing_Data;
end record;
-- Data passed to Recursive_Check
-- Current_Dir is for optimization purposes, avoiding extra system calls.
procedure Recursive_Check
(Project : Project_Id;
Data : in out Recursive_Check_Data);
-- Check_Naming_Scheme for the project
--------- ---------
-- Add -- -- Add --
--------- ---------
...@@ -283,33 +266,10 @@ package body Prj.Proc is ...@@ -283,33 +266,10 @@ package body Prj.Proc is
procedure Check procedure Check
(In_Tree : Project_Tree_Ref; (In_Tree : Project_Tree_Ref;
Project : Project_Id; Project : Project_Id;
Current_Dir : String; Flags : Processing_Flags)
Report_Error : Put_Line_Access;
When_No_Sources : Error_Warning;
Require_Sources_Other_Lang : Boolean;
Compiler_Driver_Mandatory : Boolean;
Allow_Duplicate_Basenames : Boolean)
is is
Dir : aliased String := Current_Dir;
procedure Check_All_Projects is new
For_Every_Project_Imported (Recursive_Check_Data, Recursive_Check);
Data : Recursive_Check_Data;
begin begin
Data.Current_Dir := Dir'Unchecked_Access; Process_Naming_Scheme (In_Tree, Project, Flags);
Initialize
(Data.Proc_Data,
Tree => In_Tree,
Allow_Duplicate_Basenames => Allow_Duplicate_Basenames,
Require_Sources_Other_Lang => Require_Sources_Other_Lang,
Compiler_Driver_Mandatory => Compiler_Driver_Mandatory,
When_No_Sources => When_No_Sources,
Report_Error => Report_Error);
Check_All_Projects (Project, Data, Imported_First => True);
-- Set the Other_Part field for the units -- Set the Other_Part field for the units
...@@ -342,8 +302,6 @@ package body Prj.Proc is ...@@ -342,8 +302,6 @@ package body Prj.Proc is
Next (Iter); Next (Iter);
end loop; end loop;
end; end;
Free (Data.Proc_Data);
end Check; end Check;
------------------------------- -------------------------------
...@@ -1244,10 +1202,8 @@ package body Prj.Proc is ...@@ -1244,10 +1202,8 @@ package body Prj.Proc is
Success : out Boolean; Success : out Boolean;
From_Project_Node : Project_Node_Id; From_Project_Node : Project_Node_Id;
From_Project_Node_Tree : Project_Node_Tree_Ref; From_Project_Node_Tree : Project_Node_Tree_Ref;
Report_Error : Put_Line_Access; Flags : Processing_Flags;
When_No_Sources : Error_Warning := Error; Reset_Tree : Boolean := True)
Reset_Tree : Boolean := True;
Current_Dir : String := "")
is is
begin begin
Process_Project_Tree_Phase_1 Process_Project_Tree_Phase_1
...@@ -1256,7 +1212,7 @@ package body Prj.Proc is ...@@ -1256,7 +1212,7 @@ package body Prj.Proc is
Success => Success, Success => Success,
From_Project_Node => From_Project_Node, From_Project_Node => From_Project_Node,
From_Project_Node_Tree => From_Project_Node_Tree, From_Project_Node_Tree => From_Project_Node_Tree,
Report_Error => Report_Error, Flags => Flags,
Reset_Tree => Reset_Tree); Reset_Tree => Reset_Tree);
if Project_Qualifier_Of (From_Project_Node, From_Project_Node_Tree) /= if Project_Qualifier_Of (From_Project_Node, From_Project_Node_Tree) /=
...@@ -1268,12 +1224,7 @@ package body Prj.Proc is ...@@ -1268,12 +1224,7 @@ package body Prj.Proc is
Success => Success, Success => Success,
From_Project_Node => From_Project_Node, From_Project_Node => From_Project_Node,
From_Project_Node_Tree => From_Project_Node_Tree, From_Project_Node_Tree => From_Project_Node_Tree,
Report_Error => Report_Error, Flags => Flags);
When_No_Sources => When_No_Sources,
Current_Dir => Current_Dir,
Require_Sources_Other_Lang => False,
Compiler_Driver_Mandatory => True,
Allow_Duplicate_Basenames => False);
end if; end if;
end Process; end Process;
...@@ -2287,7 +2238,7 @@ package body Prj.Proc is ...@@ -2287,7 +2238,7 @@ package body Prj.Proc is
Success : out Boolean; Success : out Boolean;
From_Project_Node : Project_Node_Id; From_Project_Node : Project_Node_Id;
From_Project_Node_Tree : Project_Node_Tree_Ref; From_Project_Node_Tree : Project_Node_Tree_Ref;
Report_Error : Put_Line_Access; Flags : Processing_Flags;
Reset_Tree : Boolean := True) Reset_Tree : Boolean := True)
is is
begin begin
...@@ -2306,7 +2257,7 @@ package body Prj.Proc is ...@@ -2306,7 +2257,7 @@ package body Prj.Proc is
Recursive_Process Recursive_Process
(Project => Project, (Project => Project,
In_Tree => In_Tree, In_Tree => In_Tree,
Report_Error => Report_Error, Flags => Flags,
From_Project_Node => From_Project_Node, From_Project_Node => From_Project_Node,
From_Project_Node_Tree => From_Project_Node_Tree, From_Project_Node_Tree => From_Project_Node_Tree,
Extended_By => No_Project); Extended_By => No_Project);
...@@ -2327,12 +2278,7 @@ package body Prj.Proc is ...@@ -2327,12 +2278,7 @@ package body Prj.Proc is
Success : out Boolean; Success : out Boolean;
From_Project_Node : Project_Node_Id; From_Project_Node : Project_Node_Id;
From_Project_Node_Tree : Project_Node_Tree_Ref; From_Project_Node_Tree : Project_Node_Tree_Ref;
Report_Error : Put_Line_Access; Flags : Processing_Flags)
When_No_Sources : Error_Warning := Error;
Current_Dir : String;
Require_Sources_Other_Lang : Boolean;
Compiler_Driver_Mandatory : Boolean;
Allow_Duplicate_Basenames : Boolean)
is is
Obj_Dir : Path_Name_Type; Obj_Dir : Path_Name_Type;
Extending : Project_Id; Extending : Project_Id;
...@@ -2345,12 +2291,7 @@ package body Prj.Proc is ...@@ -2345,12 +2291,7 @@ package body Prj.Proc is
Success := True; Success := True;
if Project /= No_Project then if Project /= No_Project then
Check (In_Tree, Project, Current_Dir, Check (In_Tree, Project, Flags);
When_No_Sources => When_No_Sources,
Report_Error => Report_Error,
Require_Sources_Other_Lang => Require_Sources_Other_Lang,
Compiler_Driver_Mandatory => Compiler_Driver_Mandatory,
Allow_Duplicate_Basenames => Allow_Duplicate_Basenames);
end if; end if;
-- If main project is an extending all project, set the object -- If main project is an extending all project, set the object
...@@ -2400,13 +2341,13 @@ package body Prj.Proc is ...@@ -2400,13 +2341,13 @@ package body Prj.Proc is
if Extending2.Virtual then if Extending2.Virtual then
Error_Msg_Name_1 := Prj.Project.Display_Name; Error_Msg_Name_1 := Prj.Project.Display_Name;
if Report_Error = null then if Flags.Report_Error = null then
Error_Msg Error_Msg
("project %% cannot be extended by a virtual" & ("project %% cannot be extended by a virtual" &
" project with the same object directory", " project with the same object directory",
Prj.Project.Location); Prj.Project.Location);
else else
Report_Error Flags.Report_Error
("project """ & ("project """ &
Get_Name_String (Error_Msg_Name_1) & Get_Name_String (Error_Msg_Name_1) &
""" cannot be extended by a virtual " & """ cannot be extended by a virtual " &
...@@ -2418,7 +2359,7 @@ package body Prj.Proc is ...@@ -2418,7 +2359,7 @@ package body Prj.Proc is
Error_Msg_Name_1 := Extending2.Display_Name; Error_Msg_Name_1 := Extending2.Display_Name;
Error_Msg_Name_2 := Prj.Project.Display_Name; Error_Msg_Name_2 := Prj.Project.Display_Name;
if Report_Error = null then if Flags.Report_Error = null then
Error_Msg Error_Msg
("project %% cannot extend project %%", ("project %% cannot extend project %%",
Extending2.Location); Extending2.Location);
...@@ -2427,13 +2368,13 @@ package body Prj.Proc is ...@@ -2427,13 +2368,13 @@ package body Prj.Proc is
Extending2.Location); Extending2.Location);
else else
Report_Error Flags.Report_Error
("project """ & ("project """ &
Get_Name_String (Error_Msg_Name_1) & Get_Name_String (Error_Msg_Name_1) &
""" cannot extend project """ & """ cannot extend project """ &
Get_Name_String (Error_Msg_Name_2) & """", Get_Name_String (Error_Msg_Name_2) & """",
Project, In_Tree); Project, In_Tree);
Report_Error Flags.Report_Error
("they share the same object directory", ("they share the same object directory",
Project, In_Tree); Project, In_Tree);
end if; end if;
...@@ -2456,24 +2397,6 @@ package body Prj.Proc is ...@@ -2456,24 +2397,6 @@ package body Prj.Proc is
(Warning_Mode /= Treat_As_Error or else Warnings_Detected = 0); (Warning_Mode /= Treat_As_Error or else Warnings_Detected = 0);
end Process_Project_Tree_Phase_2; end Process_Project_Tree_Phase_2;
---------------------
-- Recursive_Check --
---------------------
procedure Recursive_Check
(Project : Project_Id;
Data : in out Recursive_Check_Data)
is
begin
if Verbose_Mode then
Write_Str ("Checking project file """);
Write_Str (Get_Name_String (Project.Name));
Write_Line ("""");
end if;
Prj.Nmsc.Check (Project, Data.Current_Dir.all, Data.Proc_Data);
end Recursive_Check;
----------------------- -----------------------
-- Recursive_Process -- -- Recursive_Process --
----------------------- -----------------------
...@@ -2481,7 +2404,7 @@ package body Prj.Proc is ...@@ -2481,7 +2404,7 @@ package body Prj.Proc is
procedure Recursive_Process procedure Recursive_Process
(In_Tree : Project_Tree_Ref; (In_Tree : Project_Tree_Ref;
Project : out Project_Id; Project : out Project_Id;
Report_Error : Put_Line_Access; Flags : Processing_Flags;
From_Project_Node : Project_Node_Id; From_Project_Node : Project_Node_Id;
From_Project_Node_Tree : Project_Node_Tree_Ref; From_Project_Node_Tree : Project_Node_Tree_Ref;
Extended_By : Project_Id) Extended_By : Project_Id)
...@@ -2522,7 +2445,7 @@ package body Prj.Proc is ...@@ -2522,7 +2445,7 @@ package body Prj.Proc is
Recursive_Process Recursive_Process
(In_Tree => In_Tree, (In_Tree => In_Tree,
Project => New_Project, Project => New_Project,
Report_Error => Report_Error, Flags => Flags,
From_Project_Node => From_Project_Node =>
Project_Node_Of Project_Node_Of
(With_Clause, From_Project_Node_Tree), (With_Clause, From_Project_Node_Tree),
...@@ -2664,7 +2587,7 @@ package body Prj.Proc is ...@@ -2664,7 +2587,7 @@ package body Prj.Proc is
Recursive_Process Recursive_Process
(In_Tree => In_Tree, (In_Tree => In_Tree,
Project => Project.Extends, Project => Project.Extends,
Report_Error => Report_Error, Flags => Flags,
From_Project_Node => Extended_Project_Of From_Project_Node => Extended_Project_Of
(Declaration_Node, (Declaration_Node,
From_Project_Node_Tree), From_Project_Node_Tree),
...@@ -2674,7 +2597,7 @@ package body Prj.Proc is ...@@ -2674,7 +2597,7 @@ package body Prj.Proc is
Process_Declarative_Items Process_Declarative_Items
(Project => Project, (Project => Project,
In_Tree => In_Tree, In_Tree => In_Tree,
Report_Error => Report_Error, Report_Error => Flags.Report_Error,
From_Project_Node => From_Project_Node, From_Project_Node => From_Project_Node,
From_Project_Node_Tree => From_Project_Node_Tree, From_Project_Node_Tree => From_Project_Node_Tree,
Pkg => No_Package, Pkg => No_Package,
......
gcc/ada/prj-proc.ads
...@@ -37,7 +37,7 @@ package Prj.Proc is ...@@ -37,7 +37,7 @@ package Prj.Proc is
Success : out Boolean; Success : out Boolean;
From_Project_Node : Project_Node_Id; From_Project_Node : Project_Node_Id;
From_Project_Node_Tree : Project_Node_Tree_Ref; From_Project_Node_Tree : Project_Node_Tree_Ref;
Report_Error : Put_Line_Access; Flags : Prj.Processing_Flags;
Reset_Tree : Boolean := True); Reset_Tree : Boolean := True);
-- Process a project tree (ie the direct resulting of parsing a .gpr file) -- Process a project tree (ie the direct resulting of parsing a .gpr file)
-- based on the current scenario variables. -- based on the current scenario variables.
...@@ -48,12 +48,6 @@ package Prj.Proc is ...@@ -48,12 +48,6 @@ package Prj.Proc is
-- needed to automatically generate a configuration file. This first phase -- needed to automatically generate a configuration file. This first phase
-- of the processing does not require a configuration file. -- of the processing does not require a configuration file.
-- --
-- If Report_Error is null, use the error reporting mechanism. Otherwise,
-- report errors using Report_Error.
--
-- When_No_Sources indicates what should be done when no sources are found
-- in a project for a specified or implied language.
--
-- When Reset_Tree is True, all the project data are removed from the -- When Reset_Tree is True, all the project data are removed from the
-- project table before processing. -- project table before processing.
...@@ -63,24 +57,13 @@ package Prj.Proc is ...@@ -63,24 +57,13 @@ package Prj.Proc is
Success : out Boolean; Success : out Boolean;
From_Project_Node : Project_Node_Id; From_Project_Node : Project_Node_Id;
From_Project_Node_Tree : Project_Node_Tree_Ref; From_Project_Node_Tree : Project_Node_Tree_Ref;
Report_Error : Put_Line_Access; Flags : Processing_Flags);
When_No_Sources : Error_Warning := Error;
Current_Dir : String;
Require_Sources_Other_Lang : Boolean;
Compiler_Driver_Mandatory : Boolean;
Allow_Duplicate_Basenames : Boolean);
-- Perform the second phase of the processing, filling the rest of the -- Perform the second phase of the processing, filling the rest of the
-- project with the information extracted from the project tree. This phase -- project with the information extracted from the project tree. This phase
-- requires that the configuration file has already been parsed (in fact -- requires that the configuration file has already been parsed (in fact
-- we currently assume that the contents of the configuration file has -- we currently assume that the contents of the configuration file has
-- been included in Project through Confgpr.Apply_Config_File). The -- been included in Project through Confgpr.Apply_Config_File). The
-- parameters are the same as for phase_1, with the addition of: -- parameters are the same as for phase_1, with the addition of:
--
-- Current_Dir is for optimization purposes, avoiding extra system calls.
--
-- If Allow_Duplicate_Basenames, then files with the same base names are
-- authorized within a project for source-based languages (never for unit
-- based languages)
procedure Process procedure Process
(In_Tree : Project_Tree_Ref; (In_Tree : Project_Tree_Ref;
...@@ -88,10 +71,8 @@ package Prj.Proc is ...@@ -88,10 +71,8 @@ package Prj.Proc is
Success : out Boolean; Success : out Boolean;
From_Project_Node : Project_Node_Id; From_Project_Node : Project_Node_Id;
From_Project_Node_Tree : Project_Node_Tree_Ref; From_Project_Node_Tree : Project_Node_Tree_Ref;
Report_Error : Put_Line_Access; Flags : Processing_Flags;
When_No_Sources : Error_Warning := Error; Reset_Tree : Boolean := True);
Reset_Tree : Boolean := True;
Current_Dir : String := "");
-- Performs the two phases of the processing -- Performs the two phases of the processing
end Prj.Proc; end Prj.Proc;
gcc/ada/prj-tree.adb
...@@ -24,7 +24,7 @@ ...@@ -24,7 +24,7 @@
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
with Ada.Unchecked_Deallocation; with Ada.Unchecked_Deallocation;
with Osint; use Osint; with Osint; use Osint;
with Prj.Err; with Prj.Err;
package body Prj.Tree is package body Prj.Tree is
...@@ -97,8 +97,7 @@ package body Prj.Tree is ...@@ -97,8 +97,7 @@ package body Prj.Tree is
begin begin
pragma Assert pragma Assert
(Present (To) (Present (To)
and then and then In_Tree.Project_Nodes.Table (To).Kind /= N_Comment);
In_Tree.Project_Nodes.Table (To).Kind /= N_Comment);
Zone := In_Tree.Project_Nodes.Table (To).Comments; Zone := In_Tree.Project_Nodes.Table (To).Comments;
...@@ -109,25 +108,25 @@ package body Prj.Tree is ...@@ -109,25 +108,25 @@ package body Prj.Tree is
Project_Node_Table.Increment_Last (In_Tree.Project_Nodes); Project_Node_Table.Increment_Last (In_Tree.Project_Nodes);
In_Tree.Project_Nodes.Table In_Tree.Project_Nodes.Table
(Project_Node_Table.Last (In_Tree.Project_Nodes)) := (Project_Node_Table.Last (In_Tree.Project_Nodes)) :=
(Kind => N_Comment_Zones, (Kind => N_Comment_Zones,
Qualifier => Unspecified, Qualifier => Unspecified,
Expr_Kind => Undefined, Expr_Kind => Undefined,
Location => No_Location, Location => No_Location,
Directory => No_Path, Directory => No_Path,
Variables => Empty_Node, Variables => Empty_Node,
Packages => Empty_Node, Packages => Empty_Node,
Pkg_Id => Empty_Package, Pkg_Id => Empty_Package,
Name => No_Name, Name => No_Name,
Src_Index => 0, Src_Index => 0,
Path_Name => No_Path, Path_Name => No_Path,
Value => No_Name, Value => No_Name,
Field1 => Empty_Node, Field1 => Empty_Node,
Field2 => Empty_Node, Field2 => Empty_Node,
Field3 => Empty_Node, Field3 => Empty_Node,
Field4 => Empty_Node, Field4 => Empty_Node,
Flag1 => False, Flag1 => False,
Flag2 => False, Flag2 => False,
Comments => Empty_Node); Comments => Empty_Node);
Zone := Project_Node_Table.Last (In_Tree.Project_Nodes); Zone := Project_Node_Table.Last (In_Tree.Project_Nodes);
In_Tree.Project_Nodes.Table (To).Comments := Zone; In_Tree.Project_Nodes.Table (To).Comments := Zone;
......
gcc/ada/prj-tree.ads
...@@ -294,9 +294,8 @@ package Prj.Tree is ...@@ -294,9 +294,8 @@ package Prj.Tree is
(Node : Project_Node_Id; (Node : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref) return Path_Name_Type; In_Tree : Project_Node_Tree_Ref) return Path_Name_Type;
pragma Inline (Directory_Of); pragma Inline (Directory_Of);
-- Only valid for N_Project nodes. -- Returns the directory that contains the project file. This always ends
-- Returns the directory that contains the project file. This always -- with a directory separator. Only valid for N_Project nodes.
-- ends with a directory separator
function Expression_Kind_Of function Expression_Kind_Of
(Node : Project_Node_Id; (Node : Project_Node_Id;
...@@ -441,8 +440,7 @@ package Prj.Tree is ...@@ -441,8 +440,7 @@ package Prj.Tree is
(Node : Project_Node_Id; (Node : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref) return Project_Node_Id; In_Tree : Project_Node_Tree_Ref) return Project_Node_Id;
pragma Inline (Project_Of_Renamed_Package_Of); pragma Inline (Project_Of_Renamed_Package_Of);
-- Only valid for N_Package_Declaration nodes. -- Only valid for N_Package_Declaration nodes. May return Empty_Node.
-- May return Empty_Node.
function Next_Package_In_Project function Next_Package_In_Project
(Node : Project_Node_Id; (Node : Project_Node_Id;
...@@ -601,8 +599,8 @@ package Prj.Tree is ...@@ -601,8 +599,8 @@ package Prj.Tree is
-- Set Procedures -- -- Set Procedures --
-------------------- --------------------
-- The following procedures are part of the abstract interface of -- The following procedures are part of the abstract interface of the
-- the Project File tree. -- Project File tree.
-- Each Set_* procedure is valid only for the same Project_Node_Kind -- Each Set_* procedure is valid only for the same Project_Node_Kind
-- nodes as the corresponding query function above. -- nodes as the corresponding query function above.
...@@ -971,6 +969,7 @@ package Prj.Tree is ...@@ -971,6 +969,7 @@ package Prj.Tree is
Pkg_Id : Package_Node_Id := Empty_Package; Pkg_Id : Package_Node_Id := Empty_Package;
-- Only used for N_Package_Declaration -- Only used for N_Package_Declaration
--
-- The component Pkg_Id is an entry into the table Package_Attributes -- The component Pkg_Id is an entry into the table Package_Attributes
-- (in Prj.Attr). It is used to indicate all the attributes of the -- (in Prj.Attr). It is used to indicate all the attributes of the
-- package with their characteristics. -- package with their characteristics.
...@@ -1006,38 +1005,45 @@ package Prj.Tree is ...@@ -1006,38 +1005,45 @@ package Prj.Tree is
Flag1 : Boolean := False; Flag1 : Boolean := False;
-- This flag is significant only for: -- This flag is significant only for:
--
-- N_Attribute_Declaration and N_Attribute_Reference -- N_Attribute_Declaration and N_Attribute_Reference
-- It indicates for an associative array attribute, that the -- Indicates for an associative array attribute, that the
-- index is case insensitive. -- index is case insensitive.
-- N_Comment - it indicates that the comment is preceded by an --
-- empty line. -- N_Comment
-- N_Project - it indicates that there are comments in the project -- Indicates that the comment is preceded by an empty line.
-- source that cannot be kept in the tree. --
-- N_Project
-- Indicates that there are comments in the project source that
-- cannot be kept in the tree.
--
-- N_Project_Declaration -- N_Project_Declaration
-- - it indicates that there are unkept comments in the -- Indicates that there are unkept comments in the project.
-- project. --
-- N_With_Clause -- N_With_Clause
-- - it indicates that this is not the last with in a -- Indicates that this is not the last with in a with clause.
-- with clause. It is set for "A", but not for "B" in -- Set for "A", but not for "B" in with "B"; and with "A", "B";
-- with "B";
-- and
-- with "A", "B";
Flag2 : Boolean := False; Flag2 : Boolean := False;
-- This flag is significant only for: -- This flag is significant only for:
-- N_Project - it indicates that the project "extends all" another --
-- project. -- N_Project
-- N_Comment - it indicates that the comment is followed by an -- Indicates that the project "extends all" another project.
-- empty line. --
-- N_Comment
-- Indicates that the comment is followed by an empty line.
--
-- N_With_Clause -- N_With_Clause
-- - it indicates that the originally imported project -- Indicates that the originally imported project is an extending
-- is an extending all project. -- all project.
Comments : Project_Node_Id := Empty_Node; Comments : Project_Node_Id := Empty_Node;
-- For nodes other that N_Comment_Zones or N_Comment, designates the -- For nodes other that N_Comment_Zones or N_Comment, designates the
-- comment zones associated with the node. -- comment zones associated with the node.
-- for N_Comment_Zones, designates the comment after the "end" of --
-- For N_Comment_Zones, designates the comment after the "end" of
-- the construct. -- the construct.
--
-- For N_Comment, designates the next comment, if any. -- For N_Comment, designates the next comment, if any.
end record; end record;
...@@ -1256,15 +1262,14 @@ package Prj.Tree is ...@@ -1256,15 +1262,14 @@ package Prj.Tree is
-- -- Flag2: comment is followed by an empty line -- -- Flag2: comment is followed by an empty line
-- -- Comments: next comment -- -- Comments: next comment
package Project_Node_Table is package Project_Node_Table is new
new GNAT.Dynamic_Tables GNAT.Dynamic_Tables
(Table_Component_Type => Project_Node_Record, (Table_Component_Type => Project_Node_Record,
Table_Index_Type => Project_Node_Id, Table_Index_Type => Project_Node_Id,
Table_Low_Bound => First_Node_Id, Table_Low_Bound => First_Node_Id,
Table_Initial => Project_Nodes_Initial, Table_Initial => Project_Nodes_Initial,
Table_Increment => Project_Nodes_Increment); Table_Increment => Project_Nodes_Increment);
-- This table contains the syntactic tree of project data -- Table contains the syntactic tree of project data from project files
-- from project files.
type Project_Name_And_Node is record type Project_Name_And_Node is record
Name : Name_Id; Name : Name_Id;
...@@ -1320,13 +1325,9 @@ private ...@@ -1320,13 +1325,9 @@ private
type Comment_State is record type Comment_State is record
End_Of_Line_Node : Project_Node_Id := Empty_Node; End_Of_Line_Node : Project_Node_Id := Empty_Node;
Previous_Line_Node : Project_Node_Id := Empty_Node; Previous_Line_Node : Project_Node_Id := Empty_Node;
Previous_End_Node : Project_Node_Id := Empty_Node; Previous_End_Node : Project_Node_Id := Empty_Node;
Unkept_Comments : Boolean := False; Unkept_Comments : Boolean := False;
Comments : Comments_Ptr := null; Comments : Comments_Ptr := null;
end record; end record;
......
gcc/ada/prj.adb
...@@ -1219,6 +1219,28 @@ package body Prj is ...@@ -1219,6 +1219,28 @@ package body Prj is
end if; end if;
end Other_Part; end Other_Part;
------------------
-- Create_Flags --
------------------
function Create_Flags
(Report_Error : Put_Line_Access;
When_No_Sources : Error_Warning;
Require_Sources_Other_Lang : Boolean := True;
Allow_Duplicate_Basenames : Boolean := True;
Compiler_Driver_Mandatory : Boolean := False;
Error_On_Unknown_Language : Boolean := True)
return Processing_Flags is
begin
return Processing_Flags'
(Report_Error => Report_Error,
When_No_Sources => When_No_Sources,
Require_Sources_Other_Lang => Require_Sources_Other_Lang,
Allow_Duplicate_Basenames => Allow_Duplicate_Basenames,
Error_On_Unknown_Language => Error_On_Unknown_Language,
Compiler_Driver_Mandatory => Compiler_Driver_Mandatory);
end Create_Flags;
begin begin
-- Make sure that the standard config and user project file extensions are -- Make sure that the standard config and user project file extensions are
-- compatible with canonical case file naming. -- compatible with canonical case file naming.
......
gcc/ada/prj.ads
...@@ -1342,6 +1342,42 @@ package Prj is ...@@ -1342,6 +1342,42 @@ package Prj is
-- This procedure resets all the tables that are used when processing a -- This procedure resets all the tables that are used when processing a
-- project file tree. Initialize must be called before the call to Reset. -- project file tree. Initialize must be called before the call to Reset.
type Processing_Flags is private;
-- Flags used while parsing and processing a project tree.
-- These configure various behavior in the parser, as well as indicate how
-- to report error messages.
-- This structure does not allocate memory and never needs to be freed
function Create_Flags
(Report_Error : Put_Line_Access;
When_No_Sources : Error_Warning;
Require_Sources_Other_Lang : Boolean := True;
Allow_Duplicate_Basenames : Boolean := True;
Compiler_Driver_Mandatory : Boolean := False;
Error_On_Unknown_Language : Boolean := True)
return Processing_Flags;
-- If Allow_Duplicate_Basenames, then files with the same base names are
-- authorized within a project for source-based languages (never for unit
-- based languages)
-- If Compiler_Driver_Mandatory is true, then a Compiler.Driver attribute
-- for each language must be defined, or we will not look for its source
-- files.
-- When_No_Sources indicates what should be done when no sources of a
-- language are found in a project where this language is declared.
-- If Require_Sources_Other_Lang is true, then all languages must have at
-- least one source file, or an error is reported via When_No_Sources. If
-- it is false, this is only required for Ada (and only if it is a language
-- of the project).
-- If Report_Error is null, use the standard error reporting mechanism
-- (Errout). Otherwise, report errors using Report_Error.
-- If Error_On_Unknown_Language is true, an error is displayed if some of
-- the source files listed in the project do not match any naming scheme
Gprbuild_Flags : constant Processing_Flags;
Gnatmake_Flags : constant Processing_Flags;
-- Flags used by the various tools. They all display the error messages
-- through Prj.Err
package Project_Boolean_Htable is new Simple_HTable package Project_Boolean_Htable is new Simple_HTable
(Header_Num => Header_Num, (Header_Num => Header_Num,
Element => Boolean, Element => Boolean,
...@@ -1517,4 +1553,29 @@ private ...@@ -1517,4 +1553,29 @@ private
-- Type to represent the part of a project tree which is private to the -- Type to represent the part of a project tree which is private to the
-- Project Manager. -- Project Manager.
type Processing_Flags is record
Require_Sources_Other_Lang : Boolean;
Report_Error : Put_Line_Access;
When_No_Sources : Error_Warning;
Allow_Duplicate_Basenames : Boolean;
Compiler_Driver_Mandatory : Boolean;
Error_On_Unknown_Language : Boolean;
end record;
Gprbuild_Flags : constant Processing_Flags :=
(Report_Error => null,
When_No_Sources => Warning,
Require_Sources_Other_Lang => True,
Allow_Duplicate_Basenames => False,
Compiler_Driver_Mandatory => True,
Error_On_Unknown_Language => True);
Gnatmake_Flags : constant Processing_Flags :=
(Report_Error => null,
When_No_Sources => Error,
Require_Sources_Other_Lang => False,
Allow_Duplicate_Basenames => False,
Compiler_Driver_Mandatory => False,
Error_On_Unknown_Language => False);
end Prj; end Prj;
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment