+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>
* lib.adb, make.adb, mlib.adb, exp_dist.adb: Update comments.
(Project => Main_Project,
In_Tree => Project_Tree,
Project_File_Name => Project_File_Name.all,
+ Flags => Gnatmake_Flags,
Packages_To_Check => Packages_To_Check_By_Gnatmake);
if Main_Project = No_Project then
(Project => Project,
In_Tree => Project_Tree,
Project_File_Name => Project_File.all,
+ Flags => Gnatmake_Flags,
Packages_To_Check => Packages_To_Check);
if Project = Prj.No_Project then
(Project => Main_Project,
In_Tree => Project_Tree,
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
Config : out Prj.Project_Id;
Config_File_Path : out String_Access;
Automatically_Generated : out Boolean;
+ Flags : Processing_Flags;
On_Load_Config : Config_File_Hook := null)
is
function Default_File_Name return String;
Success => Success,
From_Project_Node => Config_Project_Node,
From_Project_Node_Tree => Project_Node_Tree,
- Report_Error => null,
+ Flags => Flags,
Reset_Tree => False);
end if;
Config_File_Path : out String_Access;
Target_Name : String := "";
Normalized_Hostname : String;
- Report_Error : Put_Line_Access := null;
+ Flags : Processing_Flags;
On_Load_Config : Config_File_Hook := null;
- Compiler_Driver_Mandatory : Boolean := True;
- Allow_Duplicate_Basenames : Boolean := False;
- Reset_Tree : Boolean := True;
- Require_Sources_Other_Lang : Boolean := True;
- When_No_Sources : Error_Warning := Warning)
+ Reset_Tree : Boolean := True)
is
Main_Config_Project : Project_Id;
Success : Boolean;
Success => Success,
From_Project_Node => User_Project_Node,
From_Project_Node_Tree => Project_Node_Tree,
- Report_Error => Report_Error,
+ Flags => Flags,
Reset_Tree => Reset_Tree);
if not Success then
Packages_To_Check => Packages_To_Check,
Config_File_Path => Config_File_Path,
Automatically_Generated => Automatically_Generated,
+ Flags => Flags,
On_Load_Config => On_Load_Config);
Apply_Config_File (Main_Config_Project, Project_Tree);
Success => Success,
From_Project_Node => User_Project_Node,
From_Project_Node_Tree => Project_Node_Tree,
- Report_Error => Report_Error,
- 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);
+ Flags => Flags);
if not Success then
Main_Project := No_Project;
Config_File_Path : out String_Access;
Target_Name : String := "";
Normalized_Hostname : String;
- Report_Error : Put_Line_Access := null;
+ Flags : Processing_Flags;
On_Load_Config : Config_File_Hook := null)
is
begin
Config_File_Path => Config_File_Path,
Target_Name => Target_Name,
Normalized_Hostname => Normalized_Hostname,
- Report_Error => Report_Error,
+ Flags => Flags,
On_Load_Config => On_Load_Config);
end Parse_Project_And_Apply_Config;
Project_Tree : Project_Node_Tree_Ref)
is
Name : Name_Id;
+
begin
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_Buffer (1 .. Name_Len) := Auto_Cgpr;
Name := Name_Find;
- Config_File := Create_Project
- (In_Tree => Project_Tree,
- Name => Name,
- Full_Path => Path_Name_Type (Name),
- Is_Config_File => True);
+ Config_File :=
+ Create_Project
+ (In_Tree => Project_Tree,
+ Name => Name,
+ Full_Path => Path_Name_Type (Name),
+ Is_Config_File => True);
-- ??? This isn't strictly required, since Prj.Nmsc.Add_Language
-- already has a workaround in the Ada_Only case. But it would be
-- Likewise for the default language, hard-coded in
-- Pjr.Nmsc.Check_Programming_Languages
+ -- Why is all the following code commented out???
+
-- Update_Attribute_Value_In_Scenario
-- (Tree => Project_Tree,
-- Project => Config_File,
Config_File_Path : out String_Access;
Target_Name : String := "";
Normalized_Hostname : String;
- Report_Error : Put_Line_Access := null;
+ Flags : Processing_Flags;
On_Load_Config : Config_File_Hook := null);
-- Find the main configuration project and parse the project tree rooted at
-- this configuration project.
Config_File_Path : out String_Access;
Target_Name : String := "";
Normalized_Hostname : String;
- Report_Error : Put_Line_Access := null;
+ Flags : Processing_Flags;
On_Load_Config : Config_File_Hook := null;
- Compiler_Driver_Mandatory : Boolean := True;
- Allow_Duplicate_Basenames : Boolean := False;
- Reset_Tree : Boolean := True;
- Require_Sources_Other_Lang : Boolean := True;
- When_No_Sources : Error_Warning := Warning);
+ Reset_Tree : Boolean := True);
-- Same as above, except the project must already have been parsed through
-- Prj.Part.Parse, and only the processing of the project and the
-- configuration is done at this level.
+ --
-- 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
-- for one of the languages of the project.
+ --
-- 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
Config : out Prj.Project_Id;
Config_File_Path : out String_Access;
Automatically_Generated : out Boolean;
+ Flags : Processing_Flags;
On_Load_Config : Config_File_Hook := null);
-- Compute the name of the configuration file that should be used. If no
-- default configuration file is found, a new one will be automatically
--
-- The choice and generation of a configuration file depends on several
-- attributes of the user's project file (given by the Project argument),
- -- like the list of languages that must be supported. Project must
- -- therefore have been partially processed (phase one of the processing
- -- only).
+ -- e.g. list of languages that must be supported. Project must therefore
+ -- have been partially processed (phase one of the processing only).
--
-- 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).
- -- In the latter case, Autoconf_Specified should be set to true, to
- -- indicate that the configuration file can be regenerated to match target
- -- and languages. This name can either be an absolute path, or the a base
- -- name that will be searched in the default config file directories (which
+ -- In the latter case, Autoconf_Specified should be set to true to indicate
+ -- that the configuration file can be regenerated to match target and
+ -- languages. This name can either be an absolute path, or the a base name
+ -- that will be searched in the default config file directories (which
-- depends on the installation path for the tools).
--
- -- Target_Name is used to chose among several possibilities
- -- the configuration file that will be used.
+ -- Target_Name is used to chose the configuration file that will be used
+ -- from among several possibilities.
--
-- If a project file could be found, it is automatically parsed and
-- processed (and Packages_To_Check is used to indicate which packages
procedure Add_Default_GNAT_Naming_Scheme
(Config_File : in out Prj.Tree.Project_Node_Id;
Project_Tree : Prj.Tree.Project_Node_Tree_Ref);
- -- A hook for Get_Or_Create_Configuration_File and
- -- Process_Project_And_Apply_Config that will create a new config file (in
- -- memory) and add the default GNAT naming scheme to it. Nothing is done
- -- if the config_file already exists, to avoid overriding what the user
- -- might have put in there.
+ -- A hook that will create a new config file (in memory), used for
+ -- Get_Or_Create_Configuration_File and Process_Project_And_Apply_Config
+ -- and add the default GNAT naming scheme to it. Nothing is done if the
+ -- config_file already exists, to avoid overriding what the user might
+ -- have put in there.
--------------
-- Runtimes --
-- --config switch then automatically generating a configuration file.
function Runtime_Name_For (Language : Name_Id) return String;
- -- Returns the runtime name for a language. Returns an empty string if
- -- no runtime was specified for the language using option --RTS.
+ -- Returns the runtime name for a language. Returns an empty string if no
+ -- runtime was specified for the language using option --RTS.
end Prj.Conf;
-- Visit all the files and process those that need an SFN pragma
Iter := For_Each_Source (In_Tree, For_Project);
-
while Element (Iter) /= No_Source loop
Source := Element (Iter);
with GNAT.Case_Util; use GNAT.Case_Util;
with GNAT.Directory_Operations; use GNAT.Directory_Operations;
+with GNAT.Dynamic_HTables;
with Err_Vars; use Err_Vars;
with MLib.Tgt;
Spec : File_Name_Type;
Impl : File_Name_Type;
end record;
+
No_Unit_Exception : constant Unit_Exception := (No_Name, No_File, No_File);
+
package Unit_Exceptions_Htable is new GNAT.Dynamic_HTables.Simple_HTable
(Header_Num => Header_Num,
Element => Unit_Exception,
Found : Boolean := False;
Location : Source_Ptr := No_Location;
end record;
+
No_File_Found : constant File_Found := (No_File, False, No_Location);
+
package Excluded_Sources_Htable is new GNAT.Dynamic_HTables.Simple_HTable
(Header_Num => Header_Num,
Element => File_Found,
Source_Names : Source_Names_Htable.Instance;
Unit_Exceptions : Unit_Exceptions_Htable.Instance;
Excluded : Excluded_Sources_Htable.Instance;
- Object_Files : Object_File_Names_Htable.Instance;
Source_List_File_Location : Source_Ptr;
-- Location of the Source_List_File attribute, for error messages
-- information which is only useful while processing the project, and can
-- 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
(Data : in out Project_Processing_Data;
Project : Project_Id);
-- Initialize or free memory for a project-specific data
procedure Find_Excluded_Sources
- (Project : in out Project_Processing_Data;
- Data : in out Tree_Processing_Data);
+ (Project : in out Project_Processing_Data;
+ Data : in out Tree_Processing_Data);
-- 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.
-- the unit data if necessary.
procedure Load_Naming_Exceptions
- (Project : in out Project_Processing_Data;
- Data : in out Tree_Processing_Data);
+ (Project : in out Project_Processing_Data;
+ Data : in out Tree_Processing_Data);
-- All source files in Data.First_Source are considered as naming
-- exceptions, and copied into the Source_Names and Unit_Exceptions tables
-- as appropriate.
Data : in out Tree_Processing_Data);
-- Check the library attributes of project Project in project tree
-- and modify its data Data accordingly.
- -- Current_Dir should represent the current directory, and is passed for
- -- efficiency to avoid system calls to recompute it.
procedure Check_Programming_Languages
(Project : Project_Id;
procedure Check_Stand_Alone_Library
(Project : Project_Id;
- Current_Dir : String;
Extending : Boolean;
Data : in out Tree_Processing_Data);
-- 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.
- -- 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;
-- Return the index of the last significant character in Dir. This is used
procedure Get_Directories
(Project : Project_Id;
- Current_Dir : String;
Data : in out Tree_Processing_Data);
-- Get the object directory, the exec directory and the source directories
- -- of a project. Current_Dir should represent the current directory, and is
- -- passed for efficiency to avoid system calls to recompute it.
+ -- of a project.
procedure Get_Mains
(Project : Project_Id;
-- them in the project data.
procedure Get_Sources_From_File
- (Path : String;
- Location : Source_Ptr;
- Project : in out Project_Processing_Data;
- Data : in out Tree_Processing_Data);
+ (Path : String;
+ Location : Source_Ptr;
+ Project : in out Project_Processing_Data;
+ Data : in out Tree_Processing_Data);
-- Get the list of sources from a text file and put them in hash table
-- Source_Names.
procedure Find_Sources
- (Project : in out Project_Processing_Data;
- Data : in out Tree_Processing_Data);
+ (Project : in out Project_Processing_Data;
+ Data : in out Tree_Processing_Data);
-- Process the Source_Files and Source_List_File attributes, and store the
-- list of source files into the Source_Names htable. When these attributes
-- are not defined, find all files matching the naming schemes in the
-- returned), or simply returned without checking for its existence (if
-- Must_Exist is False) or No_Path_Information is returned. In all cases,
-- Dir_Exists indicates whether the directory now exists. Create is also
- -- used for debugging traces to show which path we are
- -- computing
+ -- used for debugging traces to show which path we are computing.
procedure Look_For_Sources
(Project : in out Project_Processing_Data;
procedure Remove_Source
(Id : Source_Id;
Replaced_By : Source_Id);
- -- Remove a file from the list of sources of a project.
- -- This might be because the file is replaced by another one in an
- -- extending project, or because a file was added as a naming exception
- -- but was not found in the end.
+ -- Remove a file from the list of sources of a project. This might be
+ -- because the file is replaced by another one in an extending project,
+ -- or because a file was added as a naming exception but was not found
+ -- in the end.
procedure Report_No_Sources
(Project : Project_Id;
and then Prev_Unit.File_Names (Kind) /= null
then
-- Suspicious, we need to check later whether this is authorized
+
Add_Src := False;
Source := Prev_Unit.File_Names (Kind);
end if;
end if;
- -- Duplication of file/unit in same project is allowed
- -- if order of source directories is known.
+ -- Duplication of file/unit in same project is allowed if order of
+ -- source directories is known.
if Add_Src = False then
Add_Src := True;
if Project = Source.Project then
if Prev_Unit = No_Unit_Index then
- if Data.Allow_Duplicate_Basenames then
+ if Data.Flags.Allow_Duplicate_Basenames then
Add_Src := True;
+
elsif Project.Known_Order_Of_Source_Dirs then
Add_Src := False;
+
else
Error_Msg_File_1 := File_Name;
Error_Msg
Add_Src := False;
-- 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
Error_Msg_Name_1 := Unit;
-- 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
-- when the source is added from one of the naming exceptions in
- -- the project
+ -- the project.
if Path /= No_Path_Information then
Error_Msg_Name_1 := Unit;
Add_Src := False;
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
then
Error_Msg_File_1 := File_Name;
"{ is already a source of project {", Location, Data);
-- Add the file anyway, to avoid further warnings like "language
- -- unknown"
+ -- unknown".
+
Add_Src := True;
end if;
end if;
-----------
procedure Check
- (Project : Project_Id;
- Current_Dir : String;
- Data : in out Tree_Processing_Data)
+ (Project : Project_Id;
+ Data : in out Tree_Processing_Data)
is
Specs : Array_Element_Id;
Bodies : Array_Element_Id;
-- Object, exec and source directories
- Get_Directories (Project, Current_Dir, Data);
+ Get_Directories (Project, Data);
-- Get the programming languages
if Language.First_Source = No_Source
and then
- (Data.Require_Sources_Other_Lang
+ (Data.Flags.Require_Sources_Other_Lang
or else Language.Name = Name_Ada)
then
Iter := For_Each_Source (In_Tree => Data.Tree,
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
- -- In_Interfaces only for the sources specified in the list.
-
- Check_Interfaces (Project, Data);
- end if;
+ Check_Interfaces (Project, Data);
-- If it is a library project file, check if it is a standalone library
if Project.Library then
- Check_Stand_Alone_Library (Project, Current_Dir, Extending, Data);
+ Check_Stand_Alone_Library (Project, Extending, Data);
end if;
-- Put the list of Mains, if any, in the project data
-- For all languages, Compiler_Driver needs to be specified. This is
-- 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
then
Error_Msg_Name_1 := Lang_Index.Display_Name;
Specs : out Array_Element_Id)
is
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;
Ada_Body_Suffix_Loc : Source_Ptr := No_Location;
- procedure Check_Naming_Multi_Lang;
- -- Does Check_Naming_Schemes processing for Multi_Language mode
+ procedure Check_Naming;
+ -- Check the validity of the Naming package (suffixes valid, ...)
procedure Check_Common
(Dot_Replacement : in out File_Name_Type;
Casing_Defined : out Boolean;
Separate_Suffix : in out File_Name_Type;
Sep_Suffix_Loc : out Source_Ptr);
- -- Check attributes common to Ada_Only and Multi_Lang modes
+ -- Check attributes common
procedure Process_Exceptions_File_Based
(Lang_Id : Language_Ptr;
procedure Process_Exceptions_Unit_Based
(Lang_Id : Language_Ptr;
Kind : Source_Kind);
- -- In Multi_Lang mode, process the naming exceptions for the two types
- -- of languages we can have.
+ -- Process the naming exceptions for the two types of languages
procedure Initialize_Naming_Data;
-- Initialize internal naming data for the various languages
(Lang_Id : Language_Ptr;
Kind : Source_Kind)
is
- Lang : constant Name_Id := Lang_Id.Name;
- Exceptions : Array_Element_Id;
- Element : Array_Element;
- Unit : Name_Id;
- Index : Int;
- File_Name : File_Name_Type;
- Source : Source_Id;
+ Lang : constant Name_Id := Lang_Id.Name;
+ Exceptions : Array_Element_Id;
+ Element : Array_Element;
+ Unit : Name_Id;
+ Index : Int;
+ File_Name : File_Name_Type;
+ Source : Source_Id;
begin
case Kind is
when Impl | Sep =>
- Exceptions := Value_Of
- (Name_Body,
- In_Arrays => Naming.Decl.Arrays,
- In_Tree => Data.Tree);
+ Exceptions :=
+ Value_Of
+ (Name_Body,
+ In_Arrays => Naming.Decl.Arrays,
+ In_Tree => Data.Tree);
if Exceptions = No_Array_Element then
Exceptions :=
In_Tree => Data.Tree);
if Exceptions = No_Array_Element then
- Exceptions := Value_Of
- (Name_Spec,
- In_Arrays => Naming.Decl.Arrays,
- In_Tree => Data.Tree);
+ Exceptions :=
+ Value_Of
+ (Name_Spec,
+ In_Arrays => Naming.Decl.Arrays,
+ In_Tree => Data.Tree);
end if;
end case;
end loop;
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 :=
- File_Name_Type (First_Name_Id + Character'Pos ('-'));
+ File_Name_Type
+ (First_Name_Id + Character'Pos ('-'));
Separate_Suffix : File_Name_Type := No_File;
Casing : Casing_Type := All_Lower_Case;
Casing_Defined : Boolean;
-- Body_Suffix
- Suffix := Value_Of
- (Name => Lang,
- Attribute_Or_Array_Name => Name_Body_Suffix,
- In_Package => Naming_Id,
- In_Tree => Data.Tree);
+ Suffix :=
+ Value_Of
+ (Name => Lang,
+ Attribute_Or_Array_Name => Name_Body_Suffix,
+ In_Package => Naming_Id,
+ In_Tree => Data.Tree);
if Suffix = Nil_Variable_Value then
- Suffix := Value_Of
- (Name => Lang,
- Attribute_Or_Array_Name => Name_Implementation_Suffix,
- In_Package => Naming_Id,
- In_Tree => Data.Tree);
+ Suffix :=
+ Value_Of
+ (Name => Lang,
+ Attribute_Or_Array_Name => Name_Implementation_Suffix,
+ In_Package => Naming_Id,
+ In_Tree => Data.Tree);
end if;
if Suffix /= Nil_Variable_Value then
if Lang_Id.Config.Naming_Data.Spec_Suffix /= No_File
and then Lang_Id.Config.Naming_Data.Spec_Suffix =
- Lang_Id.Config.Naming_Data.Body_Suffix
+ Lang_Id.Config.Naming_Data.Body_Suffix
then
Error_Msg
(Project,
end if;
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 =
- Lang_Id.Config.Naming_Data.Separate_Suffix
+ Lang_Id.Config.Naming_Data.Separate_Suffix
then
Error_Msg
(Project,
Lang_Id := Project.Languages;
while Lang_Id /= No_Language_Index loop
case Lang_Id.Config.Kind is
- when File_Based =>
- Process_Exceptions_File_Based (Lang_Id, Kind);
+ when File_Based =>
+ Process_Exceptions_File_Based (Lang_Id, Kind);
- when Unit_Based =>
- Process_Exceptions_Unit_Based (Lang_Id, Kind);
+ when Unit_Based =>
+ Process_Exceptions_Unit_Based (Lang_Id, Kind);
end case;
Lang_Id := Lang_Id.Next;
end loop;
end loop;
- end Check_Naming_Multi_Lang;
+ end Check_Naming;
----------------------------
-- Initialize_Naming_Data --
while Specs /= No_Array_Element loop
Lang_Name := Data.Tree.Array_Elements.Table (Specs).Index;
- Lang := Get_Language_From_Name
- (Project, Name => Get_Name_String (Lang_Name));
+ Lang :=
+ Get_Language_From_Name
+ (Project, Name => Get_Name_String (Lang_Name));
-- An extending project inherits its parent projects' languages
-- so if needed we should create entries for those languages
if Lang = null then
Extended := Project.Extends;
-
while Extended /= null loop
Lang := Get_Language_From_Name
(Extended, Name => Get_Name_String (Lang_Name));
& Get_Name_String (Lang_Name)
& " since language is not defined for this project");
end if;
+
else
Value := Data.Tree.Array_Elements.Table (Specs).Value;
while Impls /= No_Array_Element loop
Lang_Name := Data.Tree.Array_Elements.Table (Impls).Index;
- Lang := Get_Language_From_Name
- (Project, Name => Get_Name_String (Lang_Name));
+ Lang :=
+ Get_Language_From_Name
+ (Project, Name => Get_Name_String (Lang_Name));
if Lang = null then
if Current_Verbosity = High then
end if;
Initialize_Naming_Data;
- Check_Naming_Multi_Lang;
+ Check_Naming;
end if;
end Check_Package_Naming;
-------------------
procedure Check_Library (Proj : Project_Id; Extends : Boolean) is
- Src_Id : Source_Id;
- Iter : Source_Iterator;
+ Src_Id : Source_Id;
+ Iter : Source_Iterator;
begin
if Proj /= No_Project then
Write_Line ("This is a library project file");
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;
- while Imported_Project_List /= null loop
- Check_Library
- (Imported_Project_List.Project,
- Extends => False);
- Imported_Project_List := Imported_Project_List.Next;
- end loop;
- end if;
+ Imported_Project_List := Project.Imported_Projects;
+ while Imported_Project_List /= null loop
+ Check_Library
+ (Imported_Project_List.Project,
+ Extends => False);
+ Imported_Project_List := Imported_Project_List.Next;
+ end loop;
end if;
end if;
Lang := new Language_Data'(No_Language_Data);
Lang.Next := Project.Languages;
Project.Languages := Lang;
- Lang.Name := Name;
+ Lang.Name := Name;
Lang.Display_Name := Display_Name;
if Name = Name_Ada then
-- ??? We should do as GPS does and create a dummy config file
Lang.Config.Naming_Data :=
- (Dot_Replacement => File_Name_Type
- (First_Name_Id + Character'Pos ('-')),
+ (Dot_Replacement =>
+ File_Name_Type
+ (First_Name_Id + Character'Pos ('-')),
Casing => All_Lower_Case,
Separate_Suffix => Default_Ada_Body_Suffix,
Spec_Suffix => Default_Ada_Spec_Suffix,
procedure Check_Stand_Alone_Library
(Project : Project_Id;
- Current_Dir : String;
Extending : Boolean;
Data : in out Tree_Processing_Data)
is
String_Element_Table.Increment_Last
(Data.Tree.String_Elements);
+
Data.Tree.String_Elements.Table
(String_Element_Table.Last
(Data.Tree.String_Elements)) :=
- (Value => ALI_Name_Id,
- Index => 0,
- Display_Value => ALI_Name_Id,
- Location =>
- Data.Tree.String_Elements.Table
- (Interfaces).Location,
- Flag => False,
- Next => Interface_ALIs);
- Interface_ALIs := String_Element_Table.Last
- (Data.Tree.String_Elements);
+ (Value => ALI_Name_Id,
+ Index => 0,
+ Display_Value => ALI_Name_Id,
+ Location =>
+ Data.Tree.String_Elements.Table
+ (Interfaces).Location,
+ Flag => False,
+ Next => Interface_ALIs);
+
+ Interface_ALIs :=
+ String_Element_Table.Last
+ (Data.Tree.String_Elements);
end;
end Add_ALI_For;
if Get_Mode = Ada_Only then
UData := Units_Htable.Get (Data.Tree.Units_HT, Unit);
- if UData = No_Unit_Index then
- Error_Msg
- (Project,
- "unknown unit %%",
- Data.Tree.String_Elements.Table
- (Interfaces).Location, Data);
+ -- Check that the unit is part of the project
- else
- -- Check that the unit is part of the project
-
- if UData.File_Names (Impl) /= null
- and then not UData.File_Names (Impl).Locally_Removed
+ if UData /= null
+ and then UData.File_Names (Impl) /= null
+ and then not UData.File_Names (Impl).Locally_Removed
+ then
+ if Check_Project
+ (UData.File_Names (Impl).Project,
+ Project, Extending)
then
- if Check_Project
- (UData.File_Names (Impl).Project,
- Project, Extending)
- 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;
+ -- There is a body for this unit. If there is
+ -- no spec, we need to check that it is not a
+ -- subunit.
- -- The unit is not a subunit, so we add the
- -- ALI file for its body to the Interface ALIs.
+ if UData.File_Names (Spec) = null then
+ declare
+ Src_Ind : Source_File_Index;
- Add_ALI_For
- (UData.File_Names (Impl).File);
+ begin
+ Src_Ind :=
+ Sinput.P.Load_Project_File
+ (Get_Name_String (UData.File_Names
+ (Impl).Path.Name));
- else
- Error_Msg
- (Project,
- "%% is not an unit of this project",
- Data.Tree.String_Elements.Table
- (Interfaces).Location, Data);
+ 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;
- elsif 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.
+ -- The unit is not a subunit, so we add the
+ -- ALI file for its body to the Interface ALIs.
Add_ALI_For
- (UData.File_Names (Spec).File);
+ (UData.File_Names (Impl).File);
else
Error_Msg
Data.Tree.String_Elements.Table
(Interfaces).Location, Data);
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;
else
- -- Multi_Language mode
-
Next_Proj := Project.Extends;
Iter := For_Each_Source (Data.Tree, Project);
loop
Data.Tree.String_Elements.Table
(String_Element_Table.Last
(Data.Tree.String_Elements)) :=
- (Value => Name_Id (Source.Dep_Name),
- Index => 0,
- Display_Value => Name_Id (Source.Dep_Name),
- Location =>
- Data.Tree.String_Elements.Table
- (Interfaces).Location,
- Flag => False,
- Next => Interface_ALIs);
+ (Value => Name_Id (Source.Dep_Name),
+ Index => 0,
+ Display_Value => Name_Id (Source.Dep_Name),
+ Location =>
+ Data.Tree.String_Elements.Table
+ (Interfaces).Location,
+ Flag => False,
+ Next => Interface_ALIs);
Interface_ALIs :=
String_Element_Table.Last
Dir_Id,
Path => Project.Library_Src_Dir,
Dir_Exists => Dir_Exists,
- Data => Data,
+ Data => Data,
Must_Exist => False,
Create => "library source copy",
Location => Lib_Src_Dir.Location,
if not Lib_Symbol_Policy.Default then
declare
Value : constant String :=
- To_Lower
- (Get_Name_String (Lib_Symbol_Policy.Value));
+ To_Lower
+ (Get_Name_String (Lib_Symbol_Policy.Value));
begin
-- Symbol policy must hove one of a limited number of values
end if;
if not Is_Regular_File
- (Get_Name_String (Project.Symbol_Data.Reference))
+ (Get_Name_String (Project.Symbol_Data.Reference))
then
Error_Msg_File_1 :=
File_Name_Type (Lib_Ref_Symbol_File.Value);
if Name_Len > 0 then
declare
+ -- We do not need to pass a Directory to
+ -- Normalize_Pathname, since the path_information
+ -- already contains absolute information.
+
Symb_Path : constant String :=
Normalize_Pathname
(Get_Name_String
(Project.Object_Directory.Name) &
Name_Buffer (1 .. Name_Len),
- Directory => Current_Dir,
+ Directory => "/",
Resolve_Links =>
Opt.Follow_Links_For_Files);
Ref_Path : constant String :=
Normalize_Pathname
(Get_Name_String
(Project.Symbol_Data.Reference),
- Directory => Current_Dir,
+ Directory => "/",
Resolve_Links =>
Opt.Follow_Links_For_Files);
begin
Real_Location := Project.Location;
end if;
- if Data.Report_Error = null then
+ if Data.Flags.Report_Error = null then
Prj.Err.Error_Msg (Msg, Real_Location);
return;
end if;
end if;
Add_Name;
+
else
Add (Msg (Index));
end if;
+
Index := Index + 1;
end loop;
- Data.Report_Error
+ Data.Flags.Report_Error
(Error_Buffer (1 .. Error_Last), Project, Data.Tree);
end Error_Msg;
procedure Get_Directories
(Project : Project_Id;
- Current_Dir : String;
Data : in out Tree_Processing_Data)
is
package Recursive_Dirs is new GNAT.Dynamic_HTables.Simple_HTable
The_Path : constant String :=
Normalize_Pathname
(Get_Name_String (Path),
- Directory => Current_Dir,
+ Directory => Get_Name_String
+ (Project.Directory.Display_Name),
Resolve_Links => Opt.Follow_Links_For_Dirs) &
Directory_Separator;
begin
if Is_Directory (Path_Name) then
+
-- We have found a new subdirectory, call self
Name_Len := Path_Name'Length;
-- is no sources in the project.
if (((not Source_Files.Default)
- and then Source_Files.Values = Nil_String)
+ and then Source_Files.Values = Nil_String)
or else
((not Source_Dirs.Default) and then Source_Dirs.Values = Nil_String)
or else
Flag => False,
Next => Nil_String,
Index => 0));
+
Project.Source_Dirs :=
String_Element_Table.Last (Data.Tree.String_Elements);
begin
if Suffix_Str'Length = 0 then
+
-- Always valid
+
return;
elsif Index (Suffix_Str, ".") = 0 then
---------------------------
procedure Find_Excluded_Sources
- (Project : in out Project_Processing_Data;
- Data : in out Tree_Processing_Data)
+ (Project : in out Project_Processing_Data;
+ Data : in out Tree_Processing_Data)
is
Excluded_Source_List_File : constant Variable_Value :=
Util.Value_Of
(Name_Excluded_Source_List_File,
Project.Project.Decl.Attributes,
Data.Tree);
-
Excluded_Sources : Variable_Value := Util.Value_Of
(Name_Excluded_Source_Files,
Project.Project.Decl.Attributes,
----------------
procedure Initialize
- (Data : out Tree_Processing_Data;
- Tree : Project_Tree_Ref;
- 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) is
+ (Data : out Tree_Processing_Data;
+ Tree : Project_Tree_Ref;
+ Flags : Prj.Processing_Flags) is
begin
Files_Htable.Reset (Data.File_To_Source);
- Data.Tree := Tree;
- Data.Require_Sources_Other_Lang := Require_Sources_Other_Lang;
- 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;
+ Data.Tree := Tree;
+ Data.Flags := Flags;
end Initialize;
----------
Source_Names_Htable.Reset (Data.Source_Names);
Unit_Exceptions_Htable.Reset (Data.Unit_Exceptions);
Excluded_Sources_Htable.Reset (Data.Excluded);
- Object_File_Names_Htable.Reset (Data.Object_Files);
end Free;
-------------------------------
(Canonical_Case_File_Name (Name_Id (Path)));
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;
Alternate_Languages : Language_List;
Language : Language_Ptr;
else
if Name_Loc.Found then
+
-- Check if it is OK to have the same file name in several
-- source directories.
-- A file name in a list must be a source of a language
- if Get_Mode = Multi_Language then
- if Name_Loc.Found then
- Error_Msg_File_1 := File_Name;
- Error_Msg
- (Project.Project,
- "language unknown for {",
- Name_Loc.Location, Data);
- end if;
+ if Data.Flags.Error_On_Unknown_Language
+ and then Name_Loc.Found
+ then
+ Error_Msg_File_1 := File_Name;
+ Error_Msg
+ (Project.Project,
+ "language unknown for {",
+ Name_Loc.Location, Data);
end if;
else
----------------------------
procedure Load_Naming_Exceptions
- (Project : in out Project_Processing_Data;
- Data : in out Tree_Processing_Data)
+ (Project : in out Project_Processing_Data;
+ Data : in out Tree_Processing_Data)
is
Source : Source_Id;
Iter : Source_Iterator;
-- An excluded file cannot also be an exception file name
if Excluded_Sources_Htable.Get (Project.Excluded, Source.File) /=
- No_File_Found
+ No_File_Found
then
Error_Msg_File_1 := Source.File;
Error_Msg
(Project.Source_Names,
K => Source.File,
E => Name_Location'
- (Name => Source.File,
- Location => No_Location,
- Source => Source,
- Found => False));
+ (Name => Source.File,
+ Location => No_Location,
+ Source => Source,
+ Found => False));
-- If this is an Ada exception, record in table Unit_Exceptions
(Project : in out Project_Processing_Data;
Data : in out Tree_Processing_Data)
is
- Iter : Source_Iterator;
- Src : Source_Id;
+ Object_Files : Object_File_Names_Htable.Instance;
+ Iter : Source_Iterator;
+ Src : Source_Id;
- procedure Process_Sources_In_Multi_Language_Mode;
- -- Find all source files when in multi language mode
+ procedure Check_Object (Src : Source_Id);
+ -- 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;
-- 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 --
---------------------------
Source : Source_Id := No_Source;
Excluded : File_Found;
Proj : Project_Id;
+
begin
-- Minor optimization: if there are no excluded files, no need to
-- traverse the list of sources. We cannot however also check whether
-- them in any case.
if Excluded_Sources_Htable.Get_First (Project.Excluded) /=
- No_File_Found
+ No_File_Found
then
Proj := Project.Project;
while Proj /= No_Project loop
-- the source file
Excluded := Excluded_Sources_Htable.Get_First (Project.Excluded);
-
while Excluded /= No_File_Found loop
if not Excluded.Found then
end loop;
end Mark_Excluded_Sources;
- --------------------------------------------
- -- Process_Sources_In_Multi_Language_Mode --
- --------------------------------------------
+ ------------------------
+ -- Check_Object_Files --
+ ------------------------
- procedure Process_Sources_In_Multi_Language_Mode is
- Iter : Source_Iterator;
+ procedure Check_Object_Files is
+ Iter : Source_Iterator;
+ Src_Id : Source_Id;
+ Src_Ind : Source_File_Index;
begin
- -- Check that two sources of this project do not have the same object
- -- file name.
-
- Check_Object_File_Names : declare
- 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)
+ Iter := For_Each_Source (Data.Tree);
+ loop
+ Src_Id := Prj.Element (Iter);
+ exit when Src_Id = No_Source;
- 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);
+ if Is_Compilable (Src_Id)
+ and then Src_Id.Language.Config.Object_Generated
+ and then Is_Extending (Project.Project, Src_Id.Project)
+ then
+ if Src_Id.Unit = No_Unit_Index then
+ if Src_Id.Kind = Impl then
+ Check_Object (Src_Id);
+ end if;
else
- Object_File_Names_Htable.Set
- (Project.Object_Files, Src.Object, Src);
- end if;
- end Check_Object;
-
- -- Start of processing for Check_Object_File_Names
+ case Src_Id.Kind is
+ when Spec =>
+ if Other_Part (Src_Id) = No_Source then
+ Check_Object (Src_Id);
+ end if;
- begin
- Iter := For_Each_Source (Data.Tree);
- loop
- Src_Id := Prj.Element (Iter);
- exit when Src_Id = No_Source;
+ when Sep =>
+ null;
- if Is_Compilable (Src_Id)
- and then Src_Id.Language.Config.Object_Generated
- and then Is_Extending (Project.Project, Src_Id.Project)
- then
- if Src_Id.Unit = No_Unit_Index then
- if Src_Id.Kind = Impl then
- Check_Object (Src_Id);
- end if;
+ when Impl =>
+ if Other_Part (Src_Id) /= No_Source then
+ Check_Object (Src_Id);
- else
- case Src_Id.Kind is
- when Spec =>
- if Other_Part (Src_Id) = No_Source then
- Check_Object (Src_Id);
- end if;
-
- when Sep =>
- null;
+ else
+ -- Check if it is a subunit
- when Impl =>
- if Other_Part (Src_Id) /= No_Source then
- Check_Object (Src_Id);
+ Src_Ind := Sinput.P.Load_Project_File
+ (Get_Name_String (Src_Id.Path.Name));
+ if Sinput.P.Source_File_Is_Subunit (Src_Ind) then
+ Override_Kind (Src_Id, Sep);
else
- -- Check if it is a subunit
-
- 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;
+ Check_Object (Src_Id);
end if;
- end case;
- end if;
+ end if;
+ end case;
end if;
+ end if;
- Next (Iter);
- end loop;
- end Check_Object_File_Names;
- end Process_Sources_In_Multi_Language_Mode;
+ Next (Iter);
+ end loop;
+ end Check_Object_Files;
-- Start of processing for Look_For_Sources
begin
Find_Excluded_Sources (Project, Data);
- if (Get_Mode = Ada_Only
- and then Is_A_Language (Project.Project, Name_Ada))
- or else (Get_Mode = Multi_Language
- and then Project.Project.Languages /= No_Language_Index)
- then
+ if Project.Project.Languages /= No_Language_Index then
Load_Naming_Exceptions (Project, Data);
Find_Sources (Project, Data);
Mark_Excluded_Sources;
-
- Process_Sources_In_Multi_Language_Mode;
+ Check_Object_Files;
end if;
+
+ Object_File_Names_Htable.Reset (Object_Files);
end Look_For_Sources;
------------------
Continuation : Boolean := False)
is
begin
- case Data.When_No_Sources is
+ case Data.Flags.When_No_Sources is
when Silent =>
null;
" sources in this project";
begin
- Error_Msg_Warn := Data.When_No_Sources = Warning;
+ Error_Msg_Warn := Data.Flags.When_No_Sources = Warning;
if Continuation then
Error_Msg (Project, "\" & Msg, Location, Data);
Write_Line ("end 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;
-- --
------------------------------------------------------------------------------
--- Perform various checks on a project and find all its source files
-
-with GNAT.Dynamic_HTables;
+-- Find source dirs and source files for a project
private package Prj.Nmsc is
- type Tree_Processing_Data is private;
- -- 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;
- 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);
- -- 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;
+ procedure Process_Naming_Scheme
+ (Tree : Project_Tree_Ref;
+ Root_Project : Project_Id;
+ Flags : Processing_Flags);
+ -- Perform consistency and semantic checks on all the projects in the tree.
+ -- 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.
- 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;
Project : out Project_Id;
Project_File_Name : String;
Packages_To_Check : String_List_Access := All_Packages;
- When_No_Sources : Error_Warning := Error;
- Report_Error : Put_Line_Access := null;
+ Flags : Processing_Flags;
Reset_Tree : Boolean := True)
is
Project_Node : Project_Node_Id := Empty_Node;
Allow_Automatic_Generation => False,
Automatically_Generated => Automatically_Generated,
Config_File_Path => Config_File_Path,
- Report_Error => Report_Error,
+ Flags => Flags,
Normalized_Hostname => "",
- Compiler_Driver_Mandatory => False,
- Allow_Duplicate_Basenames => False,
- Require_Sources_Other_Lang => False,
On_Load_Config =>
Add_Default_GNAT_Naming_Scheme'Access,
- Reset_Tree => Reset_Tree,
- When_No_Sources => When_No_Sources);
+ Reset_Tree => Reset_Tree);
Success := The_Project /= No_Project;
Project : out Project_Id;
Project_File_Name : String;
Packages_To_Check : String_List_Access := All_Packages;
- When_No_Sources : Error_Warning := Error;
- Report_Error : Prj.Put_Line_Access := null;
+ Flags : Processing_Flags;
Reset_Tree : Boolean := True);
-- Parse and process a project files and all its imported project files, in
-- the project tree In_Tree.
-- produces an error. For other packages, an unknown attribute produces a
-- 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
-- project table before processing.
Write_Eol;
end if;
- Project_Directory := Path_Name_Type
- (Get_Directory (File_Name_Type (Normed_Path_Name)));
+ Project_Directory :=
+ Path_Name_Type (Get_Directory (File_Name_Type (Normed_Path_Name)));
-- Is there any imported project?
procedure Check
(In_Tree : Project_Tree_Ref;
Project : Project_Id;
- Current_Dir : String;
- Report_Error : Put_Line_Access;
- When_No_Sources : Error_Warning;
- Require_Sources_Other_Lang : Boolean;
- Compiler_Driver_Mandatory : Boolean;
- Allow_Duplicate_Basenames : Boolean);
+ Flags : Processing_Flags);
-- Set all projects to not checked, then call Recursive_Check for the
-- main project Project. Project is set to No_Project if errors occurred.
-- Current_Dir is for optimization purposes, avoiding extra system calls.
procedure Recursive_Process
(In_Tree : Project_Tree_Ref;
Project : out Project_Id;
- Report_Error : Put_Line_Access;
+ Flags : Processing_Flags;
From_Project_Node : Project_Node_Id;
From_Project_Node_Tree : Project_Node_Tree_Ref;
Extended_By : Project_Id);
-- extended project, if any. Then process the declarative items of the
-- 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 --
---------
procedure Check
(In_Tree : Project_Tree_Ref;
Project : Project_Id;
- Current_Dir : String;
- Report_Error : Put_Line_Access;
- When_No_Sources : Error_Warning;
- Require_Sources_Other_Lang : Boolean;
- Compiler_Driver_Mandatory : Boolean;
- Allow_Duplicate_Basenames : Boolean)
+ Flags : Processing_Flags)
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
- Data.Current_Dir := Dir'Unchecked_Access;
-
- 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);
+ Process_Naming_Scheme (In_Tree, Project, Flags);
-- Set the Other_Part field for the units
Next (Iter);
end loop;
end;
-
- Free (Data.Proc_Data);
end Check;
-------------------------------
Success : out Boolean;
From_Project_Node : Project_Node_Id;
From_Project_Node_Tree : Project_Node_Tree_Ref;
- Report_Error : Put_Line_Access;
- When_No_Sources : Error_Warning := Error;
- Reset_Tree : Boolean := True;
- Current_Dir : String := "")
+ Flags : Processing_Flags;
+ Reset_Tree : Boolean := True)
is
begin
Process_Project_Tree_Phase_1
Success => Success,
From_Project_Node => From_Project_Node,
From_Project_Node_Tree => From_Project_Node_Tree,
- Report_Error => Report_Error,
+ Flags => Flags,
Reset_Tree => Reset_Tree);
if Project_Qualifier_Of (From_Project_Node, From_Project_Node_Tree) /=
Success => Success,
From_Project_Node => From_Project_Node,
From_Project_Node_Tree => From_Project_Node_Tree,
- Report_Error => Report_Error,
- When_No_Sources => When_No_Sources,
- Current_Dir => Current_Dir,
- Require_Sources_Other_Lang => False,
- Compiler_Driver_Mandatory => True,
- Allow_Duplicate_Basenames => False);
+ Flags => Flags);
end if;
end Process;
Success : out Boolean;
From_Project_Node : Project_Node_Id;
From_Project_Node_Tree : Project_Node_Tree_Ref;
- Report_Error : Put_Line_Access;
+ Flags : Processing_Flags;
Reset_Tree : Boolean := True)
is
begin
Recursive_Process
(Project => Project,
In_Tree => In_Tree,
- Report_Error => Report_Error,
+ Flags => Flags,
From_Project_Node => From_Project_Node,
From_Project_Node_Tree => From_Project_Node_Tree,
Extended_By => No_Project);
Success : out Boolean;
From_Project_Node : Project_Node_Id;
From_Project_Node_Tree : Project_Node_Tree_Ref;
- Report_Error : Put_Line_Access;
- When_No_Sources : Error_Warning := Error;
- Current_Dir : String;
- Require_Sources_Other_Lang : Boolean;
- Compiler_Driver_Mandatory : Boolean;
- Allow_Duplicate_Basenames : Boolean)
+ Flags : Processing_Flags)
is
Obj_Dir : Path_Name_Type;
Extending : Project_Id;
Success := True;
if Project /= No_Project then
- Check (In_Tree, Project, Current_Dir,
- 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);
+ Check (In_Tree, Project, Flags);
end if;
-- If main project is an extending all project, set the object
if Extending2.Virtual then
Error_Msg_Name_1 := Prj.Project.Display_Name;
- if Report_Error = null then
+ if Flags.Report_Error = null then
Error_Msg
("project %% cannot be extended by a virtual" &
" project with the same object directory",
Prj.Project.Location);
else
- Report_Error
+ Flags.Report_Error
("project """ &
Get_Name_String (Error_Msg_Name_1) &
""" cannot be extended by a virtual " &
Error_Msg_Name_1 := Extending2.Display_Name;
Error_Msg_Name_2 := Prj.Project.Display_Name;
- if Report_Error = null then
+ if Flags.Report_Error = null then
Error_Msg
("project %% cannot extend project %%",
Extending2.Location);
Extending2.Location);
else
- Report_Error
+ Flags.Report_Error
("project """ &
Get_Name_String (Error_Msg_Name_1) &
""" cannot extend project """ &
Get_Name_String (Error_Msg_Name_2) & """",
Project, In_Tree);
- Report_Error
+ Flags.Report_Error
("they share the same object directory",
Project, In_Tree);
end if;
(Warning_Mode /= Treat_As_Error or else Warnings_Detected = 0);
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 --
-----------------------
procedure Recursive_Process
(In_Tree : Project_Tree_Ref;
Project : out Project_Id;
- Report_Error : Put_Line_Access;
+ Flags : Processing_Flags;
From_Project_Node : Project_Node_Id;
From_Project_Node_Tree : Project_Node_Tree_Ref;
Extended_By : Project_Id)
Recursive_Process
(In_Tree => In_Tree,
Project => New_Project,
- Report_Error => Report_Error,
+ Flags => Flags,
From_Project_Node =>
Project_Node_Of
(With_Clause, From_Project_Node_Tree),
Recursive_Process
(In_Tree => In_Tree,
Project => Project.Extends,
- Report_Error => Report_Error,
+ Flags => Flags,
From_Project_Node => Extended_Project_Of
(Declaration_Node,
From_Project_Node_Tree),
Process_Declarative_Items
(Project => Project,
In_Tree => In_Tree,
- Report_Error => Report_Error,
+ Report_Error => Flags.Report_Error,
From_Project_Node => From_Project_Node,
From_Project_Node_Tree => From_Project_Node_Tree,
Pkg => No_Package,
Success : out Boolean;
From_Project_Node : Project_Node_Id;
From_Project_Node_Tree : Project_Node_Tree_Ref;
- Report_Error : Put_Line_Access;
+ Flags : Prj.Processing_Flags;
Reset_Tree : Boolean := True);
-- Process a project tree (ie the direct resulting of parsing a .gpr file)
-- based on the current scenario variables.
-- needed to automatically generate a configuration file. This first phase
-- 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
-- project table before processing.
Success : out Boolean;
From_Project_Node : Project_Node_Id;
From_Project_Node_Tree : Project_Node_Tree_Ref;
- Report_Error : Put_Line_Access;
- When_No_Sources : Error_Warning := Error;
- Current_Dir : String;
- Require_Sources_Other_Lang : Boolean;
- Compiler_Driver_Mandatory : Boolean;
- Allow_Duplicate_Basenames : Boolean);
+ Flags : Processing_Flags);
-- Perform the second phase of the processing, filling the rest of the
-- project with the information extracted from the project tree. This phase
-- requires that the configuration file has already been parsed (in fact
-- we currently assume that the contents of the configuration file has
-- been included in Project through Confgpr.Apply_Config_File). The
-- 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
(In_Tree : Project_Tree_Ref;
Success : out Boolean;
From_Project_Node : Project_Node_Id;
From_Project_Node_Tree : Project_Node_Tree_Ref;
- Report_Error : Put_Line_Access;
- When_No_Sources : Error_Warning := Error;
- Reset_Tree : Boolean := True;
- Current_Dir : String := "");
+ Flags : Processing_Flags;
+ Reset_Tree : Boolean := True);
-- Performs the two phases of the processing
end Prj.Proc;
------------------------------------------------------------------------------
with Ada.Unchecked_Deallocation;
-with Osint; use Osint;
+with Osint; use Osint;
with Prj.Err;
package body Prj.Tree is
begin
pragma Assert
(Present (To)
- and then
- In_Tree.Project_Nodes.Table (To).Kind /= N_Comment);
+ and then In_Tree.Project_Nodes.Table (To).Kind /= N_Comment);
Zone := In_Tree.Project_Nodes.Table (To).Comments;
Project_Node_Table.Increment_Last (In_Tree.Project_Nodes);
In_Tree.Project_Nodes.Table
(Project_Node_Table.Last (In_Tree.Project_Nodes)) :=
- (Kind => N_Comment_Zones,
- Qualifier => Unspecified,
- Expr_Kind => Undefined,
- Location => No_Location,
- Directory => No_Path,
- Variables => Empty_Node,
- Packages => Empty_Node,
- Pkg_Id => Empty_Package,
- Name => No_Name,
- Src_Index => 0,
- Path_Name => No_Path,
- Value => No_Name,
- Field1 => Empty_Node,
- Field2 => Empty_Node,
- Field3 => Empty_Node,
- Field4 => Empty_Node,
- Flag1 => False,
- Flag2 => False,
- Comments => Empty_Node);
+ (Kind => N_Comment_Zones,
+ Qualifier => Unspecified,
+ Expr_Kind => Undefined,
+ Location => No_Location,
+ Directory => No_Path,
+ Variables => Empty_Node,
+ Packages => Empty_Node,
+ Pkg_Id => Empty_Package,
+ Name => No_Name,
+ Src_Index => 0,
+ Path_Name => No_Path,
+ Value => No_Name,
+ Field1 => Empty_Node,
+ Field2 => Empty_Node,
+ Field3 => Empty_Node,
+ Field4 => Empty_Node,
+ Flag1 => False,
+ Flag2 => False,
+ Comments => Empty_Node);
Zone := Project_Node_Table.Last (In_Tree.Project_Nodes);
In_Tree.Project_Nodes.Table (To).Comments := Zone;
(Node : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref) return Path_Name_Type;
pragma Inline (Directory_Of);
- -- Only valid for N_Project nodes.
- -- Returns the directory that contains the project file. This always
- -- ends with a directory separator
+ -- Returns the directory that contains the project file. This always ends
+ -- with a directory separator. Only valid for N_Project nodes.
function Expression_Kind_Of
(Node : Project_Node_Id;
(Node : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref) return Project_Node_Id;
pragma Inline (Project_Of_Renamed_Package_Of);
- -- Only valid for N_Package_Declaration nodes.
- -- May return Empty_Node.
+ -- Only valid for N_Package_Declaration nodes. May return Empty_Node.
function Next_Package_In_Project
(Node : Project_Node_Id;
-- Set Procedures --
--------------------
- -- The following procedures are part of the abstract interface of
- -- the Project File tree.
+ -- The following procedures are part of the abstract interface of the
+ -- Project File tree.
-- Each Set_* procedure is valid only for the same Project_Node_Kind
-- nodes as the corresponding query function above.
Pkg_Id : Package_Node_Id := Empty_Package;
-- Only used for N_Package_Declaration
+ --
-- 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
-- package with their characteristics.
Flag1 : Boolean := False;
-- This flag is significant only for:
+ --
-- 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.
- -- N_Comment - it indicates that the comment is preceded by an
- -- empty line.
- -- N_Project - it indicates that there are comments in the project
- -- source that cannot be kept in the tree.
+ --
+ -- N_Comment
+ -- Indicates that the comment is preceded by an empty line.
+ --
+ -- N_Project
+ -- Indicates that there are comments in the project source that
+ -- cannot be kept in the tree.
+ --
-- N_Project_Declaration
- -- - it indicates that there are unkept comments in the
- -- project.
+ -- Indicates that there are unkept comments in the project.
+ --
-- N_With_Clause
- -- - it indicates that this is not the last with in a
- -- with clause. It is set for "A", but not for "B" in
- -- with "B";
- -- and
- -- with "A", "B";
+ -- Indicates that this is not the last with in a with clause.
+ -- Set for "A", but not for "B" in with "B"; and with "A", "B";
Flag2 : Boolean := False;
-- This flag is significant only for:
- -- N_Project - it indicates that the project "extends all" another
- -- project.
- -- N_Comment - it indicates that the comment is followed by an
- -- empty line.
+ --
+ -- N_Project
+ -- Indicates that the project "extends all" another project.
+ --
+ -- N_Comment
+ -- Indicates that the comment is followed by an empty line.
+ --
-- N_With_Clause
- -- - it indicates that the originally imported project
- -- is an extending all project.
+ -- Indicates that the originally imported project is an extending
+ -- all project.
Comments : Project_Node_Id := Empty_Node;
-- For nodes other that N_Comment_Zones or N_Comment, designates the
-- 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.
+ --
-- For N_Comment, designates the next comment, if any.
end record;
-- -- Flag2: comment is followed by an empty line
-- -- Comments: next comment
- package Project_Node_Table is
- new GNAT.Dynamic_Tables
+ package Project_Node_Table is new
+ GNAT.Dynamic_Tables
(Table_Component_Type => Project_Node_Record,
Table_Index_Type => Project_Node_Id,
Table_Low_Bound => First_Node_Id,
Table_Initial => Project_Nodes_Initial,
Table_Increment => Project_Nodes_Increment);
- -- This table contains the syntactic tree of project data
- -- from project files.
+ -- Table contains the syntactic tree of project data from project files
type Project_Name_And_Node is record
Name : Name_Id;
type Comment_State is record
End_Of_Line_Node : Project_Node_Id := Empty_Node;
-
Previous_Line_Node : Project_Node_Id := Empty_Node;
-
Previous_End_Node : Project_Node_Id := Empty_Node;
-
Unkept_Comments : Boolean := False;
-
Comments : Comments_Ptr := null;
end record;
end if;
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
-- Make sure that the standard config and user project file extensions are
-- compatible with canonical case file naming.
-- This procedure resets all the tables that are used when processing a
-- 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
(Header_Num => Header_Num,
Element => Boolean,
-- Type to represent the part of a project tree which is private to the
-- 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;
OSDN Git Service
