diff options
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/ada/ChangeLog | 15 | ||||
| -rw-r--r-- | gcc/ada/clean.adb | 1 | ||||
| -rw-r--r-- | gcc/ada/gnatcmd.adb | 1 | ||||
| -rw-r--r-- | gcc/ada/make.adb | 3 | ||||
| -rw-r--r-- | gcc/ada/prj-conf.adb | 42 | ||||
| -rw-r--r-- | gcc/ada/prj-conf.ads | 44 | ||||
| -rw-r--r-- | gcc/ada/prj-env.adb | 1 | ||||
| -rw-r--r-- | gcc/ada/prj-nmsc.adb | 746 | ||||
| -rw-r--r-- | gcc/ada/prj-nmsc.ads | 92 | ||||
| -rw-r--r-- | gcc/ada/prj-pars.adb | 11 | ||||
| -rw-r--r-- | gcc/ada/prj-pars.ads | 6 | ||||
| -rw-r--r-- | gcc/ada/prj-part.adb | 4 | ||||
| -rw-r--r-- | gcc/ada/prj-proc.adb | 119 | ||||
| -rw-r--r-- | gcc/ada/prj-proc.ads | 27 | ||||
| -rw-r--r-- | gcc/ada/prj-tree.adb | 43 | ||||
| -rw-r--r-- | gcc/ada/prj-tree.ads | 69 | ||||
| -rw-r--r-- | gcc/ada/prj.adb | 22 | ||||
| -rw-r--r-- | gcc/ada/prj.ads | 61 |
18 files changed, 644 insertions, 663 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index a7a3dbc..46f59b8 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,18 @@ +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. diff --git a/gcc/ada/clean.adb b/gcc/ada/clean.adb index 64f8045..79c0431 100644 --- a/gcc/ada/clean.adb +++ b/gcc/ada/clean.adb @@ -1391,6 +1391,7 @@ package body Clean is (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 diff --git a/gcc/ada/gnatcmd.adb b/gcc/ada/gnatcmd.adb index 8349d43..2aca64f 100644 --- a/gcc/ada/gnatcmd.adb +++ b/gcc/ada/gnatcmd.adb @@ -1777,6 +1777,7 @@ begin (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 diff --git a/gcc/ada/make.adb b/gcc/ada/make.adb index 877bff7..307d894 100644 --- a/gcc/ada/make.adb +++ b/gcc/ada/make.adb @@ -6865,7 +6865,8 @@ package body Make is (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 diff --git a/gcc/ada/prj-conf.adb b/gcc/ada/prj-conf.adb index e7e2972..7c4cad3 100644 --- a/gcc/ada/prj-conf.adb +++ b/gcc/ada/prj-conf.adb @@ -396,6 +396,7 @@ package body Prj.Conf is 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; @@ -862,7 +863,7 @@ package body Prj.Conf is 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; @@ -904,13 +905,9 @@ package body Prj.Conf is 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; @@ -925,7 +922,7 @@ package body Prj.Conf is 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 @@ -948,6 +945,7 @@ package body Prj.Conf is 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); @@ -960,12 +958,7 @@ package body Prj.Conf is 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; @@ -990,7 +983,7 @@ package body Prj.Conf is 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 @@ -1029,7 +1022,7 @@ package body Prj.Conf is 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; @@ -1131,19 +1124,22 @@ package body Prj.Conf is 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 @@ -1151,6 +1147,8 @@ package body Prj.Conf is -- 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, diff --git a/gcc/ada/prj-conf.ads b/gcc/ada/prj-conf.ads index f95adc1..89a3010 100644 --- a/gcc/ada/prj-conf.ads +++ b/gcc/ada/prj-conf.ads @@ -55,7 +55,7 @@ package Prj.Conf is 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. @@ -96,19 +96,17 @@ package Prj.Conf is 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 @@ -129,6 +127,7 @@ package Prj.Conf is 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 @@ -142,20 +141,19 @@ package Prj.Conf is -- -- 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 @@ -175,11 +173,11 @@ package Prj.Conf is 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 -- @@ -193,7 +191,7 @@ package Prj.Conf is -- --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; diff --git a/gcc/ada/prj-env.adb b/gcc/ada/prj-env.adb index 55f025d..93c51ab 100644 --- a/gcc/ada/prj-env.adb +++ b/gcc/ada/prj-env.adb @@ -646,7 +646,6 @@ package body Prj.Env is -- 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); diff --git a/gcc/ada/prj-nmsc.adb b/gcc/ada/prj-nmsc.adb index 6fd7b7e..2609dff 100644 --- a/gcc/ada/prj-nmsc.adb +++ b/gcc/ada/prj-nmsc.adb @@ -25,6 +25,7 @@ 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; @@ -80,7 +81,9 @@ package body Prj.Nmsc is 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, @@ -97,7 +100,9 @@ package body Prj.Nmsc is 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, @@ -122,7 +127,6 @@ package body Prj.Nmsc is 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 @@ -131,6 +135,41 @@ package body Prj.Nmsc is -- 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); @@ -138,8 +177,8 @@ package body Prj.Nmsc is -- 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. @@ -148,8 +187,8 @@ package body Prj.Nmsc is -- 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. @@ -231,8 +270,6 @@ package body Prj.Nmsc is 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; @@ -250,13 +287,10 @@ package body Prj.Nmsc is 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 @@ -327,11 +361,9 @@ package body Prj.Nmsc is 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; @@ -340,16 +372,16 @@ package body Prj.Nmsc is -- 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 @@ -398,8 +430,7 @@ package body Prj.Nmsc is -- 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; @@ -418,10 +449,10 @@ package body Prj.Nmsc is 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; @@ -561,6 +592,7 @@ package body Prj.Nmsc is 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); @@ -574,18 +606,20 @@ package body Prj.Nmsc is 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 @@ -599,7 +633,7 @@ package body Prj.Nmsc is 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; @@ -625,7 +659,7 @@ package body Prj.Nmsc is -- 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; @@ -655,7 +689,7 @@ package body Prj.Nmsc is 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; @@ -665,7 +699,8 @@ package body Prj.Nmsc is "{ 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; @@ -801,9 +836,8 @@ package body Prj.Nmsc is ----------- 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; @@ -817,7 +851,7 @@ package body Prj.Nmsc is -- Object, exec and source directories - Get_Directories (Project, Current_Dir, Data); + Get_Directories (Project, Data); -- Get the programming languages @@ -904,7 +938,7 @@ package body Prj.Nmsc is 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, @@ -941,18 +975,15 @@ package body Prj.Nmsc is 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 @@ -2341,7 +2372,7 @@ package body Prj.Nmsc 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). - 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; @@ -2579,13 +2610,14 @@ package body Prj.Nmsc is 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; @@ -2593,7 +2625,7 @@ package body Prj.Nmsc is 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; @@ -2601,8 +2633,7 @@ package body Prj.Nmsc is 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 @@ -2846,21 +2877,22 @@ package body Prj.Nmsc is (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 := @@ -2878,10 +2910,11 @@ package body Prj.Nmsc is 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; @@ -2928,13 +2961,14 @@ package body Prj.Nmsc is 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; @@ -3016,18 +3050,20 @@ package body Prj.Nmsc is -- 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 @@ -3071,7 +3107,7 @@ package body Prj.Nmsc is 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, @@ -3082,9 +3118,9 @@ package body Prj.Nmsc is 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, @@ -3104,17 +3140,17 @@ package body Prj.Nmsc is 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 -- @@ -3145,15 +3181,15 @@ package body Prj.Nmsc is 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)); @@ -3179,6 +3215,7 @@ package body Prj.Nmsc is & Get_Name_String (Lang_Name) & " since language is not defined for this project"); end if; + else Value := Data.Tree.Array_Elements.Table (Specs).Value; @@ -3193,8 +3230,9 @@ package body Prj.Nmsc is 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 @@ -3239,7 +3277,7 @@ package body Prj.Nmsc is end if; Initialize_Naming_Data; - Check_Naming_Multi_Lang; + Check_Naming; end if; end Check_Package_Naming; @@ -3293,8 +3331,8 @@ package body Prj.Nmsc is ------------------- 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 @@ -3873,17 +3911,15 @@ package body Prj.Nmsc is 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; @@ -3972,7 +4008,7 @@ package body Prj.Nmsc is 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 @@ -3987,8 +4023,9 @@ package body Prj.Nmsc is -- ??? 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, @@ -4128,7 +4165,6 @@ package body Prj.Nmsc is procedure Check_Stand_Alone_Library (Project : Project_Id; - Current_Dir : String; Extending : Boolean; Data : in out Tree_Processing_Data) is @@ -4217,19 +4253,22 @@ package body Prj.Nmsc 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; @@ -4269,79 +4308,50 @@ package body Prj.Nmsc is 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 @@ -4350,11 +4360,31 @@ package body Prj.Nmsc is 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 @@ -4413,14 +4443,14 @@ package body Prj.Nmsc is 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 @@ -4498,7 +4528,7 @@ package body Prj.Nmsc is 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, @@ -4622,8 +4652,8 @@ package body Prj.Nmsc is 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 @@ -4741,7 +4771,7 @@ package body Prj.Nmsc is 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); @@ -4779,19 +4809,23 @@ package body Prj.Nmsc is 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 @@ -4944,7 +4978,7 @@ package body Prj.Nmsc is 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; @@ -4981,14 +5015,16 @@ package body Prj.Nmsc is 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; @@ -4998,7 +5034,6 @@ package body Prj.Nmsc is 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 @@ -5085,7 +5120,8 @@ package body Prj.Nmsc is 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; @@ -5209,6 +5245,7 @@ package body Prj.Nmsc is begin if Is_Directory (Path_Name) then + -- We have found a new subdirectory, call self Name_Len := Path_Name'Length; @@ -5459,7 +5496,7 @@ package body Prj.Nmsc is -- 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 @@ -5621,6 +5658,7 @@ package body Prj.Nmsc is Flag => False, Next => Nil_String, Index => 0)); + Project.Source_Dirs := String_Element_Table.Last (Data.Tree.String_Elements); @@ -6083,7 +6121,9 @@ package body Prj.Nmsc is begin if Suffix_Str'Length = 0 then + -- Always valid + return; elsif Index (Suffix_Str, ".") = 0 then @@ -6298,15 +6338,14 @@ package body Prj.Nmsc is --------------------------- 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, @@ -6705,21 +6744,13 @@ package body Prj.Nmsc is ---------------- 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; ---------- @@ -6751,7 +6782,6 @@ package body Prj.Nmsc is 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; ------------------------------- @@ -6934,7 +6964,8 @@ package body Prj.Nmsc is (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; @@ -6951,6 +6982,7 @@ package body Prj.Nmsc is else if Name_Loc.Found then + -- Check if it is OK to have the same file name in several -- source directories. @@ -7014,14 +7046,14 @@ package body Prj.Nmsc is -- 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 @@ -7201,8 +7233,8 @@ package body Prj.Nmsc is ---------------------------- 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; @@ -7216,7 +7248,7 @@ package body Prj.Nmsc is -- 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 @@ -7235,10 +7267,10 @@ package body Prj.Nmsc is (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 @@ -7274,15 +7306,49 @@ package body Prj.Nmsc is (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 -- --------------------------- @@ -7291,6 +7357,7 @@ package body Prj.Nmsc is 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 @@ -7299,7 +7366,7 @@ package body Prj.Nmsc is -- 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 @@ -7335,7 +7402,6 @@ package body Prj.Nmsc is -- the source file Excluded := Excluded_Sources_Htable.Get_First (Project.Excluded); - while Excluded /= No_File_Found loop if not Excluded.Found then @@ -7366,129 +7432,77 @@ package body Prj.Nmsc is 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; ------------------ @@ -7579,7 +7593,7 @@ package body Prj.Nmsc is Continuation : Boolean := False) is begin - case Data.When_No_Sources is + case Data.Flags.When_No_Sources is when Silent => null; @@ -7591,7 +7605,7 @@ package body Prj.Nmsc is " 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); @@ -7626,4 +7640,46 @@ package body Prj.Nmsc is 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; diff --git a/gcc/ada/prj-nmsc.ads b/gcc/ada/prj-nmsc.ads index c706636..eec6289 100644 --- a/gcc/ada/prj-nmsc.ads +++ b/gcc/ada/prj-nmsc.ads @@ -23,87 +23,21 @@ -- -- ------------------------------------------------------------------------------ --- 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; diff --git a/gcc/ada/prj-pars.adb b/gcc/ada/prj-pars.adb index 239c3ea..83b0549 100644 --- a/gcc/ada/prj-pars.adb +++ b/gcc/ada/prj-pars.adb @@ -44,8 +44,7 @@ package body Prj.Pars is 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; @@ -90,15 +89,11 @@ package body Prj.Pars is 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; diff --git a/gcc/ada/prj-pars.ads b/gcc/ada/prj-pars.ads index 2494dcb..01caff9 100644 --- a/gcc/ada/prj-pars.ads +++ b/gcc/ada/prj-pars.ads @@ -35,8 +35,7 @@ package Prj.Pars is 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. @@ -56,9 +55,6 @@ package Prj.Pars is -- 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. diff --git a/gcc/ada/prj-part.adb b/gcc/ada/prj-part.adb index c411f2f..9115952 100644 --- a/gcc/ada/prj-part.adb +++ b/gcc/ada/prj-part.adb @@ -1110,8 +1110,8 @@ package body Prj.Part is 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? diff --git a/gcc/ada/prj-proc.adb b/gcc/ada/prj-proc.adb index 6f9897f..dbf6441 100644 --- a/gcc/ada/prj-proc.adb +++ b/gcc/ada/prj-proc.adb @@ -79,12 +79,7 @@ package body Prj.Proc is 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. @@ -141,7 +136,7 @@ package body Prj.Proc is 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); @@ -152,18 +147,6 @@ package body Prj.Proc is -- 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 -- --------- @@ -283,33 +266,10 @@ package body Prj.Proc is 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 @@ -342,8 +302,6 @@ package body Prj.Proc is Next (Iter); end loop; end; - - Free (Data.Proc_Data); end Check; ------------------------------- @@ -1244,10 +1202,8 @@ package body Prj.Proc is 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 @@ -1256,7 +1212,7 @@ package body Prj.Proc is 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) /= @@ -1268,12 +1224,7 @@ package body Prj.Proc is 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; @@ -2287,7 +2238,7 @@ package body Prj.Proc is 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 @@ -2306,7 +2257,7 @@ package body Prj.Proc is 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); @@ -2327,12 +2278,7 @@ package body Prj.Proc is 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; @@ -2345,12 +2291,7 @@ package body Prj.Proc is 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 @@ -2400,13 +2341,13 @@ package body Prj.Proc is 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 " & @@ -2418,7 +2359,7 @@ package body Prj.Proc is 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); @@ -2427,13 +2368,13 @@ package body Prj.Proc is 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; @@ -2456,24 +2397,6 @@ package body Prj.Proc is (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 -- ----------------------- @@ -2481,7 +2404,7 @@ package body Prj.Proc is 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) @@ -2522,7 +2445,7 @@ package body Prj.Proc is 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), @@ -2664,7 +2587,7 @@ package body Prj.Proc is 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), @@ -2674,7 +2597,7 @@ package body Prj.Proc is 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, diff --git a/gcc/ada/prj-proc.ads b/gcc/ada/prj-proc.ads index 7be4382..4231b4e 100644 --- a/gcc/ada/prj-proc.ads +++ b/gcc/ada/prj-proc.ads @@ -37,7 +37,7 @@ package Prj.Proc is 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. @@ -48,12 +48,6 @@ package Prj.Proc is -- 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. @@ -63,24 +57,13 @@ package Prj.Proc is 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; @@ -88,10 +71,8 @@ package Prj.Proc is 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; diff --git a/gcc/ada/prj-tree.adb b/gcc/ada/prj-tree.adb index ff53472..e85078b 100644 --- a/gcc/ada/prj-tree.adb +++ b/gcc/ada/prj-tree.adb @@ -24,7 +24,7 @@ ------------------------------------------------------------------------------ with Ada.Unchecked_Deallocation; -with Osint; use Osint; +with Osint; use Osint; with Prj.Err; package body Prj.Tree is @@ -97,8 +97,7 @@ 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; @@ -109,25 +108,25 @@ package body Prj.Tree is 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; diff --git a/gcc/ada/prj-tree.ads b/gcc/ada/prj-tree.ads index 3f62d79..591c3db 100644 --- a/gcc/ada/prj-tree.ads +++ b/gcc/ada/prj-tree.ads @@ -294,9 +294,8 @@ package Prj.Tree is (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; @@ -441,8 +440,7 @@ package Prj.Tree is (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; @@ -601,8 +599,8 @@ package Prj.Tree is -- 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. @@ -971,6 +969,7 @@ package Prj.Tree is 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. @@ -1006,38 +1005,45 @@ package Prj.Tree is 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; @@ -1256,15 +1262,14 @@ package Prj.Tree is -- -- 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; @@ -1320,13 +1325,9 @@ private 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; diff --git a/gcc/ada/prj.adb b/gcc/ada/prj.adb index f9aca92..3f5feed 100644 --- a/gcc/ada/prj.adb +++ b/gcc/ada/prj.adb @@ -1219,6 +1219,28 @@ package body Prj is 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. diff --git a/gcc/ada/prj.ads b/gcc/ada/prj.ads index bf6b03b..72193ca 100644 --- a/gcc/ada/prj.ads +++ b/gcc/ada/prj.ads @@ -1342,6 +1342,42 @@ package Prj is -- 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, @@ -1517,4 +1553,29 @@ private -- 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; |