X-Git-Url: http://git.sourceforge.jp/view?a=blobdiff_plain;f=gcc%2Fada%2Fprj-nmsc.adb;h=2a1d90b7e357863cdee3a0705730c79e97a94893;hb=a02740bf3317a567a563ee9dde43500466a07ea3;hp=8ba798140db7dab108e3f95b01876bce975740df;hpb=d3931fdc9c478060e2557375de89797dee3416e7;p=pf3gnuchains%2Fgcc-fork.git diff --git a/gcc/ada/prj-nmsc.adb b/gcc/ada/prj-nmsc.adb index 8ba798140db..2a1d90b7e35 100644 --- a/gcc/ada/prj-nmsc.adb +++ b/gcc/ada/prj-nmsc.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2000-2009, Free Software Foundation, Inc. -- +-- Copyright (C) 2000-2010, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -25,20 +25,18 @@ with GNAT.Case_Util; use GNAT.Case_Util; with GNAT.Directory_Operations; use GNAT.Directory_Operations; -with GNAT.HTable; +with GNAT.Dynamic_HTables; +with GNAT.Table; with Err_Vars; use Err_Vars; -with Hostparm; -with MLib.Tgt; with Opt; use Opt; with Osint; use Osint; with Output; use Output; -with Prj.Env; use Prj.Env; -with Prj.Err; +with Prj.Com; +with Prj.Err; use Prj.Err; with Prj.Util; use Prj.Util; with Sinput.P; with Snames; use Snames; -with Table; use Table; with Targparm; use Targparm; with Ada.Characters.Handling; use Ada.Characters.Handling; @@ -54,205 +52,216 @@ package body Prj.Nmsc is -- Used in Check_Library for continuation error messages at the same -- location. - Error_Report : Put_Line_Access := null; - -- Set to point to error reporting procedure - - When_No_Sources : Error_Warning := Error; - -- Indicates what should be done when there is no Ada sources in a non - -- extending Ada project. - - ALI_Suffix : constant String := ".ali"; - -- File suffix for ali files - type Name_Location is record - Name : File_Name_Type; + Name : File_Name_Type; -- ??? duplicates the key Location : Source_Ptr; Source : Source_Id := No_Source; - Except : Boolean := False; + Listed : Boolean := False; Found : Boolean := False; end record; - -- Information about file names found in string list attribute: - -- Source_Files or in a source list file, stored in hash table. - -- Source_Names, used by procedure Get_Path_Names_And_Record_Sources. - -- Except is set to True if source is a naming exception in the project. No_Name_Location : constant Name_Location := (Name => No_File, Location => No_Location, Source => No_Source, - Except => False, + Listed => False, Found => False); - package Source_Names is new GNAT.HTable.Simple_HTable + package Source_Names_Htable is new GNAT.Dynamic_HTables.Simple_HTable (Header_Num => Header_Num, Element => Name_Location, No_Element => No_Name_Location, Key => File_Name_Type, Hash => Hash, Equal => "="); - -- Hash table to store file names found in string list attribute - -- Source_Files or in a source list file, stored in hash table - -- Source_Names, used by procedure Get_Path_Names_And_Record_Sources. - -- - -- ??? Should not be a global table, as it is needed only when processing - -- a project - - -- More documentation needed on what unit exceptions are about ??? + -- File name information found in string list attribute (Source_Files or + -- Source_List_File). Except is set to True if source is a naming exception + -- in the project. Used to check that all referenced files were indeed + -- found on the disk. type Unit_Exception is record - Name : Name_Id; + Name : Name_Id; -- ??? duplicates the key Spec : File_Name_Type; Impl : File_Name_Type; end record; - -- Record special naming schemes for Ada units (name of spec file and name - -- of implementation file). - No_Unit_Exception : constant Unit_Exception := - (Name => No_Name, - Spec => No_File, - Impl => No_File); + No_Unit_Exception : constant Unit_Exception := (No_Name, No_File, No_File); - package Unit_Exceptions is new GNAT.HTable.Simple_HTable + package Unit_Exceptions_Htable is new GNAT.Dynamic_HTables.Simple_HTable (Header_Num => Header_Num, Element => Unit_Exception, No_Element => No_Unit_Exception, Key => Name_Id, Hash => Hash, Equal => "="); - -- Hash table to store the unit exceptions. - -- ??? Seems to be used only by the multi_lang mode - -- ??? Should not be a global array, but stored in the project_data - - package Recursive_Dirs is new GNAT.HTable.Simple_HTable - (Header_Num => Header_Num, - Element => Boolean, - No_Element => False, - Key => Name_Id, - Hash => Hash, - Equal => "="); - -- Hash table stores recursive source directories, to avoid looking several - -- times, and to avoid cycles that may be introduced by symbolic links. - - type Ada_Naming_Exception_Id is new Nat; - No_Ada_Naming_Exception : constant Ada_Naming_Exception_Id := 0; + -- Record special naming schemes for Ada units (name of spec file and name + -- of implementation file). The elements in this list come from the naming + -- exceptions specified in the project files. - type Unit_Info is record - Kind : Spec_Or_Body; - Unit : Name_Id; - Next : Ada_Naming_Exception_Id := No_Ada_Naming_Exception; + type File_Found is record + File : File_Name_Type := No_File; + Found : Boolean := False; + Location : Source_Ptr := No_Location; end record; - -- Comment needed??? - package Ada_Naming_Exception_Table is new Table.Table - (Table_Component_Type => Unit_Info, - Table_Index_Type => Ada_Naming_Exception_Id, - Table_Low_Bound => 1, - Table_Initial => 20, - Table_Increment => 100, - Table_Name => "Prj.Nmsc.Ada_Naming_Exception_Table"); + No_File_Found : constant File_Found := (No_File, False, No_Location); - package Ada_Naming_Exceptions is new GNAT.HTable.Simple_HTable + package Excluded_Sources_Htable is new GNAT.Dynamic_HTables.Simple_HTable (Header_Num => Header_Num, - Element => Ada_Naming_Exception_Id, - No_Element => No_Ada_Naming_Exception, + Element => File_Found, + No_Element => No_File_Found, Key => File_Name_Type, Hash => Hash, Equal => "="); - -- A hash table to store naming exceptions for Ada. For each file name - -- there is one or several unit in table Ada_Naming_Exception_Table. - -- ??? This is for ada_only mode, we should be able to merge with - -- Unit_Exceptions table, used by multi_lang mode. + -- A hash table to store the base names of excluded files, if any - package Object_File_Names is new GNAT.HTable.Simple_HTable + package Object_File_Names_Htable is new GNAT.Dynamic_HTables.Simple_HTable (Header_Num => Header_Num, - Element => File_Name_Type, - No_Element => No_File, + Element => Source_Id, + No_Element => No_Source, Key => File_Name_Type, Hash => Hash, Equal => "="); -- A hash table to store the object file names for a project, to check that -- two different sources have different object file names. - type File_Found is record - File : File_Name_Type := No_File; - Found : Boolean := False; - Location : Source_Ptr := No_Location; + type Project_Processing_Data is record + Project : Project_Id; + Source_Names : Source_Names_Htable.Instance; + Unit_Exceptions : Unit_Exceptions_Htable.Instance; + Excluded : Excluded_Sources_Htable.Instance; + + Source_List_File_Location : Source_Ptr; + -- Location of the Source_List_File attribute, for error messages end record; - No_File_Found : constant File_Found := (No_File, False, No_Location); - -- Comments needed ??? + -- This is similar to Tree_Processing_Data, but contains project-specific + -- information which is only useful while processing the project, and can + -- be discarded as soon as we have finished processing the project - package Excluded_Sources_Htable is new GNAT.Dynamic_HTables.Simple_HTable + package Files_Htable is new GNAT.Dynamic_HTables.Simple_HTable (Header_Num => Header_Num, - Element => File_Found, - No_Element => No_File_Found, + Element => Source_Id, + No_Element => No_Source, Key => File_Name_Type, Hash => Hash, Equal => "="); - -- A hash table to store the excluded files, if any. This is filled by - -- Find_Excluded_Sources below. + -- Mapping from base file names to Source_Id (containing full info about + -- the source). + + type Tree_Processing_Data is record + Tree : Project_Tree_Ref; + Node_Tree : Prj.Tree.Project_Node_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. + + type Lib_Data is record + Name : Name_Id; + Proj : Project_Id; + end record; + + package Lib_Data_Table is new GNAT.Table + (Table_Component_Type => Lib_Data, + Table_Index_Type => Natural, + Table_Low_Bound => 1, + Table_Initial => 10, + Table_Increment => 100); + -- A table to record library names in order to check that two library + -- projects do not have the same library names. + + procedure Initialize + (Data : out Tree_Processing_Data; + Tree : Project_Tree_Ref; + Node_Tree : Prj.Tree.Project_Node_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); + procedure Free (Data : in out Project_Processing_Data); + -- Initialize or free memory for a project-specific data procedure Find_Excluded_Sources - (Project : Project_Id; - In_Tree : Project_Tree_Ref; - Excluded : in out Excluded_Sources_Htable.Instance); + (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 Excluded_Sources_Htable. + -- for this project. Sets the list in the Project.Excluded_Sources_Htable. procedure Override_Kind (Source : Source_Id; Kind : Source_Kind); -- Override the reference kind for a source file. This properly updates -- the unit data if necessary. - function Hash (Unit : Unit_Info) return Header_Num; - - type Name_And_Index is record - Name : Name_Id := No_Name; - Index : Int := 0; - end record; - No_Name_And_Index : constant Name_And_Index := - (Name => No_Name, Index => 0); - -- Name of a unit, and its index inside the source file. The first unit has - -- index 1 (see doc for pragma Source_File_Name), but the index might be - -- set to 0 when the source file contains a single unit. - - package Reverse_Ada_Naming_Exceptions is new GNAT.HTable.Simple_HTable - (Header_Num => Header_Num, - Element => Name_And_Index, - No_Element => No_Name_And_Index, - Key => Unit_Info, - Hash => Hash, - Equal => "="); - -- A table to check if a unit with an exceptional name will hide a source - -- with a file name following the naming convention. - procedure Load_Naming_Exceptions - (Project : Project_Id; - In_Tree : Project_Tree_Ref; - Excluded : in out Excluded_Sources_Htable.Instance); + (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. + type Search_Type is (Search_Files, Search_Directories); + pragma Unreferenced (Search_Files); + + generic + with procedure Callback + (Path_Id : Path_Name_Type; + Display_Path_Id : Path_Name_Type; + Pattern_Index : Natural); + procedure Expand_Subdirectory_Pattern + (Project : Project_Id; + Data : in out Tree_Processing_Data; + Patterns : String_List_Id; + Search_For : Search_Type; + Resolve_Links : Boolean); + -- Search the subdirectories of Project's directory for files or + -- directories that match the globbing patterns found in Patterns (for + -- instance "**/*.adb"). Typically, Patterns will be the value of the + -- Source_Dirs or Excluded_Source_Dirs attributes. + -- Every time such a file or directory is found, the callback is called. + -- Resolve_Links indicates whether we should resolve links while + -- normalizing names. + -- In the callback, Pattern_Index is the index within Patterns where the + -- expanded pattern was found (1 for the first element of Patterns and + -- all its matching directories, then 2,...). + -- We use a generic and not an access-to-subprogram because in some cases + -- this code is compiled with the restriction No_Implicit_Dynamic_Code + procedure Add_Source (Id : out Source_Id; - In_Tree : Project_Tree_Ref; + Data : in out Tree_Processing_Data; Project : Project_Id; + Source_Dir_Rank : Natural; Lang_Id : Language_Ptr; Kind : Source_Kind; File_Name : File_Name_Type; Display_File : File_Name_Type; - Naming_Exception : Boolean := False; + Naming_Exception : Boolean := False; Path : Path_Information := No_Path_Information; - Alternate_Languages : Language_List := null; - Unit : Name_Id := No_Name; - Index : Int := 0; - Source_To_Replace : Source_Id := No_Source); + Alternate_Languages : Language_List := null; + Unit : Name_Id := No_Name; + Index : Int := 0; + Locally_Removed : Boolean := False; + Location : Source_Ptr := No_Location); -- Add a new source to the different lists: list of all sources in the -- project tree, list of source of a project and list of sources of a -- language. -- -- If Path is specified, the file is also added to Source_Paths_HT. - -- If Source_To_Replace is specified, it points to the source in the - -- extended project that the new file is overriding. + -- + -- Location is used for error messages function Canonical_Case_File_Name (Name : Name_Id) return File_Name_Type; -- Same as Osint.Canonical_Case_File_Name but applies to Name_Id. @@ -271,158 +280,108 @@ package body Prj.Nmsc is -- Copy Str into Name_Buffer, replacing Pattern with Replacement. Str is -- converted to lower-case at the same time. - function ALI_File_Name (Source : String) return String; - -- Return the ALI file name corresponding to a source - procedure Check_Ada_Name (Name : String; Unit : out Name_Id); -- Check that a name is a valid Ada unit name procedure Check_Package_Naming - (Project : Project_Id; - In_Tree : Project_Tree_Ref; - Is_Config_File : Boolean; - Bodies : out Array_Element_Id; - Specs : out Array_Element_Id); + (Project : Project_Id; + Data : in out Tree_Processing_Data); -- Check the naming scheme part of Data, and initialize the naming scheme - -- data in the config of the various languages. Is_Config_File should be - -- True if Project is a config file (.cgpr) This also returns the naming - -- scheme exceptions for unit-based languages (Bodies and Specs are - -- associative arrays mapping individual unit names to source file names). + -- data in the config of the various languages. procedure Check_Configuration - (Project : Project_Id; - In_Tree : Project_Tree_Ref; - Compiler_Driver_Mandatory : Boolean); + (Project : Project_Id; + Data : in out Tree_Processing_Data); -- Check the configuration attributes for the project - -- 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. procedure Check_If_Externally_Built (Project : Project_Id; - In_Tree : Project_Tree_Ref); + Data : in out Tree_Processing_Data); -- Check attribute Externally_Built of project Project in project tree - -- In_Tree and modify its data Data if it has the value "true". + -- Data.Tree and modify its data Data if it has the value "true". procedure Check_Interfaces (Project : Project_Id; - In_Tree : Project_Tree_Ref); + Data : in out Tree_Processing_Data); -- If a list of sources is specified in attribute Interfaces, set -- In_Interfaces only for the sources specified in the list. procedure Check_Library_Attributes - (Project : Project_Id; - In_Tree : Project_Tree_Ref); - -- Check the library attributes of project Project in project tree In_Tree + (Project : Project_Id; + 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_Aggregate_Project + (Project : Project_Id; + Data : in out Tree_Processing_Data); + -- Check aggregate projects attributes + + procedure Check_Abstract_Project + (Project : Project_Id; + Data : in out Tree_Processing_Data); + -- Check abstract projects attributes procedure Check_Programming_Languages - (In_Tree : Project_Tree_Ref; - Project : Project_Id); + (Project : Project_Id; + Data : in out Tree_Processing_Data); -- Check attribute Languages for the project with data Data in project - -- tree In_Tree and set the components of Data for all the programming + -- tree Data.Tree and set the components of Data for all the programming -- languages indicated in attribute Languages, if any. - function Check_Project - (P : Project_Id; - Root_Project : Project_Id; - Extending : Boolean) return Boolean; - -- Returns True if P is Root_Project or, if Extending is True, a project - -- extended by Root_Project. - procedure Check_Stand_Alone_Library - (Project : Project_Id; - In_Tree : Project_Tree_Ref; - Current_Dir : String; - Extending : Boolean); - -- Check if project Project in project tree In_Tree is a Stand-Alone + (Project : Project_Id; + 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. - - procedure Check_And_Normalize_Unit_Names - (Project : Project_Id; - In_Tree : Project_Tree_Ref; - List : Array_Element_Id; - Debug_Name : String); - -- Check that a list of unit names contains only valid names. Casing - -- is normalized where appropriate. - -- Debug_Name is the name representing the list, and is used for debug - -- output only. - - procedure Find_Ada_Sources - (Project : Project_Id; - In_Tree : Project_Tree_Ref; - Explicit_Sources_Only : Boolean; - Proc_Data : in out Processing_Data); - -- Find all Ada sources by traversing all source directories. If - -- Explicit_Sources_Only is True, then the sources found must belong to - -- the list of sources specified explicitly in the project file. If - -- Explicit_Sources_Only is False, then all sources matching the naming - -- scheme are recorded. function Compute_Directory_Last (Dir : String) return Natural; -- Return the index of the last significant character in Dir. This is used -- to avoid duplicate '/' (slash) characters at the end of directory names. - procedure Error_Msg - (Project : Project_Id; - In_Tree : Project_Tree_Ref; - Msg : String; - Flag_Location : Source_Ptr); - -- Output an error message. If Error_Report is null, simply call - -- Prj.Err.Error_Msg. Otherwise, disregard Flag_Location and use - -- Error_Report. - procedure Search_Directories - (Project : Project_Id; - In_Tree : Project_Tree_Ref; - For_All_Sources : Boolean; - Allow_Duplicate_Basenames : Boolean; - Excluded : in out Excluded_Sources_Htable.Instance); + (Project : in out Project_Processing_Data; + Data : in out Tree_Processing_Data; + For_All_Sources : Boolean); -- Search the source directories to find the sources. If For_All_Sources is -- True, check each regular file name against the naming schemes of the - -- different languages. Otherwise consider only the file names in the hash - -- table Source_Names. 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) + -- various languages. Otherwise consider only the file names in hash table + -- Source_Names. If Allow_Duplicate_Basenames then files with identical + -- base names are permitted within a project for source-based languages + -- (never for unit based languages). procedure Check_File - (Project : Project_Id; - In_Tree : Project_Tree_Ref; - Path : Path_Name_Type; - File_Name : File_Name_Type; - Display_File_Name : File_Name_Type; - For_All_Sources : Boolean; - Allow_Duplicate_Basenames : Boolean); + (Project : in out Project_Processing_Data; + Data : in out Tree_Processing_Data; + Source_Dir_Rank : Natural; + Path : Path_Name_Type; + Display_Path : Path_Name_Type; + File_Name : File_Name_Type; + Display_File_Name : File_Name_Type; + Locally_Removed : Boolean; + For_All_Sources : Boolean); -- Check if file File_Name is a valid source of the project. This is used -- in multi-language mode only. When the file matches one of the naming -- schemes, it is added to various htables through Add_Source and to -- Source_Paths_Htable. -- - -- Name is the name of the candidate file. It hasn't been normalized yet - -- and is the direct result of readdir(). + -- File_Name is the same as Display_File_Name, but has been normalized. + -- They do not include the directory information. -- - -- File_Name is the same as Name, but has been normalized. - -- Display_File_Name, however, has not been normalized. + -- Path and Display_Path on the other hand are the full path to the file. + -- Path must have been normalized (canonical casing and possibly links + -- resolved). -- - -- Source_Directory is the directory in which the file - -- was found. It hasn't been normalized (nor has had links resolved). - -- It should not end with a directory separator, to avoid duplicates - -- later on. + -- Source_Directory is the directory in which the file was found. It is + -- neither normalized nor has had links resolved, and must not end with a + -- a directory separator, to avoid duplicates later on. -- -- If For_All_Sources is True, then all possible file names are analyzed - -- otherwise only those currently set in the Source_Names htable. - -- - -- 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) + -- otherwise only those currently set in the Source_Names hash table. procedure Check_File_Naming_Schemes (In_Tree : Project_Tree_Ref; - Project : Project_Id; + Project : Project_Processing_Data; File_Name : File_Name_Type; Alternate_Languages : out Language_List; Language : out Language_Ptr; @@ -436,37 +395,29 @@ package body Prj.Nmsc is -- being investigated. It has been normalized (case-folded). File_Name is -- the same value. - procedure Free_Ada_Naming_Exceptions; - -- Free the internal hash tables used for checking naming exceptions - procedure Get_Directories (Project : Project_Id; - In_Tree : Project_Tree_Ref; - Current_Dir : String); + Data : in out 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; - In_Tree : Project_Tree_Ref); + Data : in out Tree_Processing_Data); -- Get the mains of a project from attribute Main, if it exists, and put -- them in the project data. procedure Get_Sources_From_File (Path : String; Location : Source_Ptr; - Project : Project_Id; - In_Tree : Project_Tree_Ref); + 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 : Project_Id; - In_Tree : Project_Tree_Ref; - Proc_Data : in out Processing_Data; - Allow_Duplicate_Basenames : Boolean; - Excluded : in out Excluded_Sources_Htable.Instance); + (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 @@ -479,36 +430,30 @@ package body Prj.Nmsc is Naming : Lang_Naming_Data; Kind : out Source_Kind; Unit : out Name_Id; + Project : Project_Processing_Data; In_Tree : Project_Tree_Ref); -- Check whether the file matches the naming scheme. If it does, -- compute its unit name. If Unit is set to No_Name on exit, none of the -- other out parameters are relevant. - procedure Get_Unit - (In_Tree : Project_Tree_Ref; - Canonical_File_Name : File_Name_Type; - Project : Project_Id; - Exception_Id : out Ada_Naming_Exception_Id; - Unit_Name : out Name_Id; - Unit_Kind : out Spec_Or_Body); - -- Find out, from a file name, the unit name, the unit kind and if a - -- specific SFN pragma is needed. If the file name corresponds to no unit, - -- then Unit_Name will be No_Name. If the file is a multi-unit source or an - -- exception to the naming scheme, then Exception_Id is set to the unit or - -- units that the source contains, and the other information are not set. - - function Is_Illegal_Suffix - (Suffix : File_Name_Type; - Dot_Replacement : File_Name_Type) return Boolean; - -- Returns True if the string Suffix cannot be used as a spec suffix, a - -- body suffix or a separate suffix. + procedure Check_Illegal_Suffix + (Project : Project_Id; + Suffix : File_Name_Type; + Dot_Replacement : File_Name_Type; + Attribute_Name : String; + Location : Source_Ptr; + Data : in out Tree_Processing_Data); + -- Display an error message if the given suffix is illegal for some reason. + -- The name of the attribute we are testing is specified in Attribute_Name, + -- which is used in the error message. Location is the location where the + -- suffix is defined. procedure Locate_Directory (Project : Project_Id; - In_Tree : Project_Tree_Ref; Name : File_Name_Type; Path : out Path_Information; Dir_Exists : out Boolean; + Data : in out Tree_Processing_Data; Create : String := ""; Location : Source_Ptr := No_Location; Must_Exist : Boolean := True; @@ -521,20 +466,14 @@ 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 : Project_Id; - In_Tree : Project_Tree_Ref; - Proc_Data : in out Processing_Data; - Allow_Duplicate_Basenames : Boolean); - -- Find all the sources of project Project in project tree In_Tree and - -- update its Data accordingly. This assumes that Data.First_Source has - -- been initialized with the list of excluded sources and special naming - -- exceptions. 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) + (Project : in out Project_Processing_Data; + Data : in out Tree_Processing_Data); + -- Find all the sources of project Project in project tree Data.Tree and + -- update its Data accordingly. This assumes that the special naming + -- exceptions have already been processed. function Path_Name_Of (File_Name : File_Name_Type; @@ -542,38 +481,18 @@ package body Prj.Nmsc is -- Returns the path name of a (non project) file. Returns an empty string -- if file cannot be found. - procedure Prepare_Ada_Naming_Exceptions - (List : Array_Element_Id; - In_Tree : Project_Tree_Ref; - Kind : Spec_Or_Body); - -- Prepare the internal hash tables used for checking naming exceptions - -- for Ada. Insert all elements of List in the tables. - - procedure Record_Ada_Source - (File_Name : File_Name_Type; - Path_Name : Path_Name_Type; - Project : Project_Id; - In_Tree : Project_Tree_Ref; - Proc_Data : in out Processing_Data; - Ada_Language : Language_Ptr; - Location : Source_Ptr; - Source_Recorded : in out Boolean); - -- Put a unit in the list of units of a project, if the file name - -- corresponds to a valid unit name. Ada_Language is a pointer to the - -- Language_Data for "Ada" in Project. - 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; Lang_Name : String; - In_Tree : Project_Tree_Ref; + Data : Tree_Processing_Data; Location : Source_Ptr; Continuation : Boolean := False); -- Report an error or a warning depending on the value of When_No_Sources @@ -583,19 +502,36 @@ package body Prj.Nmsc is (Project : Project_Id; In_Tree : Project_Tree_Ref); -- List all the source directories of a project - procedure Warn_If_Not_Sources - (Project : Project_Id; - In_Tree : Project_Tree_Ref; - Conventions : Array_Element_Id; - Specs : Boolean; - Extending : Boolean); - -- Check that individual naming conventions apply to immediate sources of - -- the project. If not, issue a warning. - procedure Write_Attr (Name, Value : String); -- Debug print a value for a specific property. Does nothing when not in -- debug mode + procedure Error_Or_Warning + (Flags : Processing_Flags; + Kind : Error_Warning; + Msg : String; + Location : Source_Ptr; + Project : Project_Id); + -- Emits either an error or warning message (or nothing), depending on Kind + + ---------------------- + -- Error_Or_Warning -- + ---------------------- + + procedure Error_Or_Warning + (Flags : Processing_Flags; + Kind : Error_Warning; + Msg : String; + Location : Source_Ptr; + Project : Project_Id) is + begin + case Kind is + when Error => Error_Msg (Flags, Msg, Location, Project); + when Warning => Error_Msg (Flags, "?" & Msg, Location, Project); + when Silent => null; + end case; + end Error_Or_Warning; + ------------------------------ -- Replace_Into_Name_Buffer -- ------------------------------ @@ -644,9 +580,13 @@ package body Prj.Nmsc is end if; declare - Suf : constant String := Get_Name_String (Suffix); + Suf : String := Get_Name_String (Suffix); begin + -- On non case-sensitive systems, use proper suffix casing + + Canonical_Case_File_Name (Suf); + -- The file name must end with the suffix (which is not an extension) -- For instance a suffix "configure.in" must match a file with the -- same name. To avoid dummy cases, though, a suffix starting with @@ -683,28 +623,175 @@ package body Prj.Nmsc is procedure Add_Source (Id : out Source_Id; - In_Tree : Project_Tree_Ref; + Data : in out Tree_Processing_Data; Project : Project_Id; + Source_Dir_Rank : Natural; Lang_Id : Language_Ptr; Kind : Source_Kind; File_Name : File_Name_Type; Display_File : File_Name_Type; - Naming_Exception : Boolean := False; + Naming_Exception : Boolean := False; Path : Path_Information := No_Path_Information; - Alternate_Languages : Language_List := null; - Unit : Name_Id := No_Name; - Index : Int := 0; - Source_To_Replace : Source_Id := No_Source) + Alternate_Languages : Language_List := null; + Unit : Name_Id := No_Name; + Index : Int := 0; + Locally_Removed : Boolean := False; + Location : Source_Ptr := No_Location) is - Config : constant Language_Config := Lang_Id.Config; - UData : Unit_Index; + Config : constant Language_Config := Lang_Id.Config; + UData : Unit_Index; + Add_Src : Boolean; + Source : Source_Id; + Prev_Unit : Unit_Index := No_Unit_Index; + + Source_To_Replace : Source_Id := No_Source; begin + -- Check if the same file name or unit is used in the prj tree + + Add_Src := True; + + if Unit /= No_Name then + Prev_Unit := Units_Htable.Get (Data.Tree.Units_HT, Unit); + end if; + + if Prev_Unit /= No_Unit_Index + and then (Kind = Impl or else Kind = Spec) + 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); + + else + Source := Files_Htable.Get (Data.File_To_Source, File_Name); + + if Source /= No_Source + and then Source.Index = Index + then + Add_Src := False; + end if; + end if; + + -- 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.Flags.Allow_Duplicate_Basenames then + Add_Src := True; + + elsif Source_Dir_Rank /= Source.Source_Dir_Rank then + Add_Src := False; + + else + Error_Msg_File_1 := File_Name; + Error_Msg + (Data.Flags, "duplicate source file name {", + Location, Project); + Add_Src := False; + end if; + + else + if Source_Dir_Rank /= Source.Source_Dir_Rank then + Add_Src := False; + + -- We might be seeing the same file through a different path + -- (for instance because of symbolic links). + + elsif Source.Path.Name /= Path.Name then + Error_Msg_Name_1 := Unit; + Error_Msg + (Data.Flags, "duplicate unit %%", Location, Project); + Add_Src := False; + end if; + end if; + + -- Do not allow the same unit name in different projects, except + -- if one is extending the other. + + -- For a file based language, the same file name replaces a file + -- in a project being extended, but it is allowed to have the same + -- file name in unrelated projects. + + elsif Is_Extending (Project, Source.Project) then + if not Locally_Removed then + Source_To_Replace := Source; + end if; + + elsif Prev_Unit /= No_Unit_Index + and then Prev_Unit.File_Names (Kind) /= null + and then not Source.Locally_Removed + then + -- 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. + + if Path /= No_Path_Information then + Error_Msg_Name_1 := Unit; + Error_Msg + (Data.Flags, + "unit %% cannot belong to several projects", + Location, Project); + + Error_Msg_Name_1 := Project.Name; + Error_Msg_Name_2 := Name_Id (Path.Display_Name); + Error_Msg + (Data.Flags, "\ project %%, %%", Location, Project); + + Error_Msg_Name_1 := Source.Project.Name; + Error_Msg_Name_2 := Name_Id (Source.Path.Display_Name); + Error_Msg + (Data.Flags, "\ project %%, %%", Location, Project); + + else + Error_Msg_Name_1 := Unit; + Error_Msg_Name_2 := Source.Project.Name; + Error_Msg + (Data.Flags, "unit %% already belongs to project %%", + Location, Project); + end if; + + Add_Src := False; + + elsif not Source.Locally_Removed + and then not Data.Flags.Allow_Duplicate_Basenames + and then Lang_Id.Config.Kind = Unit_Based + and then Source.Language.Config.Kind = Unit_Based + then + Error_Msg_File_1 := File_Name; + Error_Msg_File_2 := File_Name_Type (Source.Project.Name); + Error_Msg + (Data.Flags, + "{ is already a source of project {", Location, Project); + + -- Add the file anyway, to avoid further warnings like "language + -- unknown". + + Add_Src := True; + end if; + end if; + + if not Add_Src then + return; + end if; + + -- Add the new file + Id := new Source_Data; if Current_Verbosity = High then Write_Str ("Adding source File: "); - Write_Str (Get_Name_String (File_Name)); + Write_Str (Get_Name_String (Display_File)); + + if Index /= 0 then + Write_Str (" at" & Index'Img); + end if; if Lang_Id.Config.Kind = Unit_Based then Write_Str (" Unit: "); @@ -724,26 +811,43 @@ package body Prj.Nmsc is end if; Id.Project := Project; + Id.Location := Location; + Id.Source_Dir_Rank := Source_Dir_Rank; Id.Language := Lang_Id; Id.Kind := Kind; Id.Alternate_Languages := Alternate_Languages; + Id.Locally_Removed := Locally_Removed; + Id.Index := Index; + Id.File := File_Name; + Id.Display_File := Display_File; + Id.Dep_Name := Dependency_Name + (File_Name, Lang_Id.Config.Dependency_Kind); + Id.Naming_Exception := Naming_Exception; + Id.Object := Object_Name + (File_Name, Config.Object_File_Suffix); + Id.Switches := Switches_Name (File_Name); -- Add the source id to the Unit_Sources_HT hash table, if the unit name -- is not null. if Unit /= No_Name then - Unit_Sources_Htable.Set (In_Tree.Unit_Sources_HT, Unit, Id); - -- ??? Record_Unit has already fetched that earlier, so this isn't - -- the most efficient way. But we can't really pass a parameter since - -- Process_Exceptions_Unit_Based and Check_File haven't looked it up. + -- Note: we might be creating a dummy unit here, when we in fact have + -- a separate. For instance, file file-bar.adb will initially be + -- assumed to be the IMPL of unit "file.bar". Only later on (in + -- Check_Object_Files) will we parse those units that only have an + -- impl and no spec to make sure whether we have a Separate in fact + -- (that significantly reduces the number of times we need to parse + -- the files, since we are then only interested in those with no + -- spec). We still need those dummy units in the table, since that's + -- the name we find in the ALI file - UData := Units_Htable.Get (In_Tree.Units_HT, Unit); + UData := Units_Htable.Get (Data.Tree.Units_HT, Unit); if UData = No_Unit_Index then UData := new Unit_Data; UData.Name := Unit; - Units_Htable.Set (In_Tree.Units_HT, Unit, UData); + Units_Htable.Set (Data.Tree.Units_HT, Unit, UData); end if; Id.Unit := UData; @@ -753,21 +857,13 @@ package body Prj.Nmsc is Override_Kind (Id, Kind); end if; - Id.Index := Index; - Id.File := File_Name; - Id.Display_File := Display_File; - Id.Dep_Name := Dependency_Name - (File_Name, Lang_Id.Config.Dependency_Kind); - Id.Naming_Exception := Naming_Exception; - - if Is_Compilable (Id) and then Config.Object_Generated then - Id.Object := Object_Name (File_Name, Config.Object_File_Suffix); - Id.Switches := Switches_Name (File_Name); - end if; - if Path /= No_Path_Information then Id.Path := Path; - Source_Paths_Htable.Set (In_Tree.Source_Paths_HT, Path.Name, Id); + Source_Paths_Htable.Set (Data.Tree.Source_Paths_HT, Path.Name, Id); + end if; + + if Index /= 0 then + Project.Has_Multi_Unit_Sources := True; end if; -- Add the source to the language list @@ -778,26 +874,9 @@ package body Prj.Nmsc is if Source_To_Replace /= No_Source then Remove_Source (Source_To_Replace, Id); end if; - end Add_Source; - - ------------------- - -- ALI_File_Name -- - ------------------- - - function ALI_File_Name (Source : String) return String is - begin - -- If the source name has extension, replace it with the ALI suffix - - for Index in reverse Source'First + 1 .. Source'Last loop - if Source (Index) = '.' then - return Source (Source'First .. Index - 1) & ALI_Suffix; - end if; - end loop; - - -- If no dot, or if it is the first character, just add the ALI suffix - return Source & ALI_Suffix; - end ALI_File_Name; + Files_Htable.Set (Data.File_To_Source, File_Name, Id); + end Add_Source; ------------------------------ -- Canonical_Case_File_Name -- @@ -814,197 +893,123 @@ package body Prj.Nmsc is end if; end Canonical_Case_File_Name; - ----------- - -- Check -- - ----------- + ----------------------------- + -- Check_Aggregate_Project -- + ----------------------------- - procedure Check - (Project : Project_Id; - In_Tree : Project_Tree_Ref; - Report_Error : Put_Line_Access; - When_No_Sources : Error_Warning; - Current_Dir : String; - Proc_Data : in out Processing_Data; - Is_Config_File : Boolean; - Compiler_Driver_Mandatory : Boolean; - Allow_Duplicate_Basenames : Boolean) + procedure Check_Aggregate_Project + (Project : Project_Id; + Data : in out Tree_Processing_Data) is - Specs : Array_Element_Id; - Bodies : Array_Element_Id; - Extending : Boolean := False; - + Project_Files : constant Prj.Variable_Value := + Prj.Util.Value_Of + (Snames.Name_Project_Files, + Project.Decl.Attributes, + Data.Tree); begin - Nmsc.When_No_Sources := When_No_Sources; - Error_Report := Report_Error; - - Recursive_Dirs.Reset; - - Check_If_Externally_Built (Project, In_Tree); - - -- Object, exec and source directories - - Get_Directories (Project, In_Tree, Current_Dir); - - -- Get the programming languages - - Check_Programming_Languages (In_Tree, Project); - - if Project.Qualifier = Dry - and then Project.Source_Dirs /= Nil_String - then - declare - Source_Dirs : constant Variable_Value := - Util.Value_Of - (Name_Source_Dirs, - Project.Decl.Attributes, In_Tree); - Source_Files : constant Variable_Value := - Util.Value_Of - (Name_Source_Files, - Project.Decl.Attributes, In_Tree); - Source_List_File : constant Variable_Value := - Util.Value_Of - (Name_Source_List_File, - Project.Decl.Attributes, In_Tree); - Languages : constant Variable_Value := - Util.Value_Of - (Name_Languages, - Project.Decl.Attributes, In_Tree); - - begin - if Source_Dirs.Values = Nil_String - and then Source_Files.Values = Nil_String - and then Languages.Values = Nil_String - and then Source_List_File.Default - then - Project.Source_Dirs := Nil_String; - - else - Error_Msg - (Project, In_Tree, - "at least one of Source_Files, Source_Dirs or Languages " - & "must be declared empty for an abstract project", - Project.Location); - end if; - end; + if Project_Files.Default then + Error_Msg_Name_1 := Snames.Name_Project_Files; + Error_Msg + (Data.Flags, + "Attribute %% must be specified in aggregate project", + Project.Location, Project); end if; + end Check_Aggregate_Project; - -- Check configuration in multi language mode - - if Must_Check_Configuration then - Check_Configuration - (Project, In_Tree, - Compiler_Driver_Mandatory => Compiler_Driver_Mandatory); - end if; + ---------------------------- + -- Check_Abstract_Project -- + ---------------------------- - -- Library attributes + procedure Check_Abstract_Project + (Project : Project_Id; + Data : in out Tree_Processing_Data) + is + Source_Dirs : constant Variable_Value := + Util.Value_Of + (Name_Source_Dirs, + Project.Decl.Attributes, Data.Tree); + Source_Files : constant Variable_Value := + Util.Value_Of + (Name_Source_Files, + Project.Decl.Attributes, Data.Tree); + Source_List_File : constant Variable_Value := + Util.Value_Of + (Name_Source_List_File, + Project.Decl.Attributes, Data.Tree); + Languages : constant Variable_Value := + Util.Value_Of + (Name_Languages, + Project.Decl.Attributes, Data.Tree); - Check_Library_Attributes (Project, In_Tree); + begin + if Project.Source_Dirs /= Nil_String then + if Source_Dirs.Values = Nil_String + and then Source_Files.Values = Nil_String + and then Languages.Values = Nil_String + and then Source_List_File.Default + then + Project.Source_Dirs := Nil_String; - if Current_Verbosity = High then - Show_Source_Dirs (Project, In_Tree); + else + Error_Msg + (Data.Flags, + "at least one of Source_Files, Source_Dirs or Languages " + & "must be declared empty for an abstract project", + Project.Location, Project); + end if; end if; + end Check_Abstract_Project; + + ----------- + -- Check -- + ----------- - Extending := Project.Extends /= No_Project; + procedure Check + (Project : Project_Id; + Data : in out Tree_Processing_Data) + is + Prj_Data : Project_Processing_Data; - Check_Package_Naming (Project, In_Tree, Is_Config_File, Bodies, Specs); + begin + Initialize (Prj_Data, Project); - if Get_Mode = Ada_Only then - Prepare_Ada_Naming_Exceptions (Bodies, In_Tree, Impl); - Prepare_Ada_Naming_Exceptions (Specs, In_Tree, Spec); - end if; + Check_If_Externally_Built (Project, Data); + Get_Directories (Project, Data); + Check_Programming_Languages (Project, Data); - -- Find the sources + case Project.Qualifier is + when Aggregate => Check_Aggregate_Project (Project, Data); + when Dry => Check_Abstract_Project (Project, Data); + when others => null; + end case; - if Project.Source_Dirs /= Nil_String then - Look_For_Sources - (Project, In_Tree, Proc_Data, Allow_Duplicate_Basenames); - - if Get_Mode = Ada_Only then - - -- Check that all individual naming conventions apply to sources - -- of this project file. - - Warn_If_Not_Sources - (Project, In_Tree, Bodies, - Specs => False, - Extending => Extending); - Warn_If_Not_Sources - (Project, In_Tree, Specs, - Specs => True, - Extending => Extending); - - elsif Get_Mode = Multi_Language and then - (not Project.Externally_Built) and then - (not Extending) - then - declare - Language : Language_Ptr; - Source : Source_Id; - Alt_Lang : Language_List; - Continuation : Boolean := False; - Iter : Source_Iterator; + -- Check configuration. This must be done even for gnatmake (even though + -- no user configuration file was provided) since the default config we + -- generate indicates whether libraries are supported for instance. - begin - Language := Project.Languages; - while Language /= No_Language_Index loop - - -- If there are no sources for this language, check if there - -- are sources for which this is an alternate language. - - if Language.First_Source = No_Source then - Iter := For_Each_Source (In_Tree => In_Tree, - Project => Project); - Source_Loop : loop - Source := Element (Iter); - exit Source_Loop when Source = No_Source - or else Source.Language = Language; - - Alt_Lang := Source.Alternate_Languages; - while Alt_Lang /= null loop - exit Source_Loop when Alt_Lang.Language = Language; - Alt_Lang := Alt_Lang.Next; - end loop; + Check_Configuration (Project, Data); - Next (Iter); - end loop Source_Loop; - - if Source = No_Source then - Report_No_Sources - (Project, - Get_Name_String (Language.Display_Name), - In_Tree, - Project.Location, - Continuation); - Continuation := True; - end if; - end if; + Check_Library_Attributes (Project, Data); - Language := Language.Next; - end loop; - end; - end if; + if Current_Verbosity = High then + Show_Source_Dirs (Project, Data.Tree); end if; - if Get_Mode = Multi_Language then + Check_Package_Naming (Project, Data); - -- If a list of sources is specified in attribute Interfaces, set - -- In_Interfaces only for the sources specified in the list. - - Check_Interfaces (Project, In_Tree); + if Project.Qualifier /= Aggregate then + Look_For_Sources (Prj_Data, Data); end if; - -- If it is a library project file, check if it is a standalone library + Check_Interfaces (Project, Data); if Project.Library then - Check_Stand_Alone_Library - (Project, In_Tree, Current_Dir, Extending); + Check_Stand_Alone_Library (Project, Data); end if; - -- Put the list of Mains, if any, in the project data - - Get_Mains (Project, In_Tree); + Get_Mains (Project, Data); - Free_Ada_Naming_Exceptions; + Free (Prj_Data); end Check; -------------------- @@ -1197,9 +1202,8 @@ package body Prj.Nmsc is ------------------------- procedure Check_Configuration - (Project : Project_Id; - In_Tree : Project_Tree_Ref; - Compiler_Driver_Mandatory : Boolean) + (Project : Project_Id; + Data : in out Tree_Processing_Data) is Dot_Replacement : File_Name_Type := No_File; Casing : Casing_Type := All_Lower_Case; @@ -1262,11 +1266,11 @@ package body Prj.Nmsc is Current_Array_Id := Arrays; while Current_Array_Id /= No_Array loop - Current_Array := In_Tree.Arrays.Table (Current_Array_Id); + Current_Array := Data.Tree.Arrays.Table (Current_Array_Id); Element_Id := Current_Array.Value; while Element_Id /= No_Array_Element loop - Element := In_Tree.Array_Elements.Table (Element_Id); + Element := Data.Tree.Array_Elements.Table (Element_Id); if Element.Index /= All_Other_Names then @@ -1290,7 +1294,7 @@ package body Prj.Nmsc is (Into_List => Lang_Index.Config.Binder_Required_Switches, From_List => Element.Value.Values, - In_Tree => In_Tree); + In_Tree => Data.Tree); when Name_Prefix => @@ -1340,7 +1344,7 @@ package body Prj.Nmsc is Attribute_Id := Attributes; while Attribute_Id /= No_Variable loop Attribute := - In_Tree.Variable_Elements.Table (Attribute_Id); + Data.Tree.Variable_Elements.Table (Attribute_Id); if not Attribute.Value.Default then if Attribute.Name = Name_Executable_Suffix then @@ -1373,11 +1377,11 @@ package body Prj.Nmsc is Current_Array_Id := Arrays; while Current_Array_Id /= No_Array loop - Current_Array := In_Tree.Arrays.Table (Current_Array_Id); + Current_Array := Data.Tree.Arrays.Table (Current_Array_Id); Element_Id := Current_Array.Value; while Element_Id /= No_Array_Element loop - Element := In_Tree.Array_Elements.Table (Element_Id); + Element := Data.Tree.Array_Elements.Table (Element_Id); if Element.Index /= All_Other_Names then @@ -1402,7 +1406,7 @@ package body Prj.Nmsc is Put (Into_List => Lang_Index.Config.Dependency_Option, From_List => List, - In_Tree => In_Tree); + In_Tree => Data.Tree); end if; when Name_Dependency_Driver => @@ -1419,7 +1423,7 @@ package body Prj.Nmsc is Put (Into_List => Lang_Index.Config.Compute_Dependency, From_List => List, - In_Tree => In_Tree); + In_Tree => Data.Tree); end if; when Name_Include_Switches => @@ -1430,16 +1434,13 @@ package body Prj.Nmsc is if List = Nil_String then Error_Msg - (Project, - In_Tree, - "include option cannot be null", - Element.Value.Location); + (Data.Flags, "include option cannot be null", + Element.Value.Location, Project); end if; - Put (Into_List => - Lang_Index.Config.Include_Option, + Put (Into_List => Lang_Index.Config.Include_Option, From_List => List, - In_Tree => In_Tree); + In_Tree => Data.Tree); when Name_Include_Path => @@ -1468,36 +1469,63 @@ package body Prj.Nmsc is Lang_Index.Config. Compiler_Leading_Required_Switches, From_List => Element.Value.Values, - In_Tree => In_Tree); + In_Tree => Data.Tree); when Name_Trailing_Required_Switches => Put (Into_List => Lang_Index.Config. Compiler_Trailing_Required_Switches, From_List => Element.Value.Values, - In_Tree => In_Tree); + In_Tree => Data.Tree); - when Name_Path_Syntax => - begin - Lang_Index.Config.Path_Syntax := - Path_Syntax_Kind'Value - (Get_Name_String (Element.Value.Value)); + when Name_Multi_Unit_Switches => + Put (Into_List => + Lang_Index.Config.Multi_Unit_Switches, + From_List => Element.Value.Values, + In_Tree => Data.Tree); - exception + when Name_Multi_Unit_Object_Separator => + Get_Name_String (Element.Value.Value); + + if Name_Len /= 1 then + Error_Msg + (Data.Flags, + "multi-unit object separator must have " & + "a single character", + Element.Value.Location, Project); + + elsif Name_Buffer (1) = ' ' then + Error_Msg + (Data.Flags, + "multi-unit object separator cannot be " & + "a space", + Element.Value.Location, Project); + + else + Lang_Index.Config.Multi_Unit_Object_Separator := + Name_Buffer (1); + end if; + + when Name_Path_Syntax => + begin + Lang_Index.Config.Path_Syntax := + Path_Syntax_Kind'Value + (Get_Name_String (Element.Value.Value)); + + exception when Constraint_Error => Error_Msg - (Project, - In_Tree, + (Data.Flags, "invalid value for Path_Syntax", - Element.Value.Location); + Element.Value.Location, Project); end; when Name_Object_File_Suffix => if Get_Name_String (Element.Value.Value) = "" then Error_Msg - (Project, In_Tree, + (Data.Flags, "object file suffix cannot be empty", - Element.Value.Location); + Element.Value.Location, Project); else Lang_Index.Config.Object_File_Suffix := @@ -1508,7 +1536,7 @@ package body Prj.Nmsc is Put (Into_List => Lang_Index.Config.Object_File_Switches, From_List => Element.Value.Values, - In_Tree => In_Tree); + In_Tree => Data.Tree); when Name_Pic_Option => @@ -1518,16 +1546,15 @@ package body Prj.Nmsc is if List = Nil_String then Error_Msg - (Project, - In_Tree, + (Data.Flags, "compiler PIC option cannot be null", - Element.Value.Location); + Element.Value.Location, Project); end if; Put (Into_List => Lang_Index.Config.Compilation_PIC_Option, From_List => List, - In_Tree => In_Tree); + In_Tree => Data.Tree); when Name_Mapping_File_Switches => @@ -1537,16 +1564,15 @@ package body Prj.Nmsc is if List = Nil_String then Error_Msg - (Project, - In_Tree, + (Data.Flags, "mapping file switches cannot be null", - Element.Value.Location); + Element.Value.Location, Project); end if; Put (Into_List => - Lang_Index.Config.Mapping_File_Switches, + Lang_Index.Config.Mapping_File_Switches, From_List => List, - In_Tree => In_Tree); + In_Tree => Data.Tree); when Name_Mapping_Spec_Suffix => @@ -1570,16 +1596,15 @@ package body Prj.Nmsc is if List = Nil_String then Error_Msg - (Project, - In_Tree, + (Data.Flags, "config file switches cannot be null", - Element.Value.Location); + Element.Value.Location, Project); end if; Put (Into_List => Lang_Index.Config.Config_File_Switches, From_List => List, - In_Tree => In_Tree); + In_Tree => Data.Tree); when Name_Objects_Path => @@ -1602,10 +1627,18 @@ package body Prj.Nmsc is Lang_Index.Config.Config_Body := Element.Value.Value; + when Name_Config_Body_File_Name_Index => + + -- Attribute Config_Body_File_Name_Index + -- ( < Language > ) + + Lang_Index.Config.Config_Body_Index := + Element.Value.Value; + when Name_Config_Body_File_Name_Pattern => -- Attribute Config_Body_File_Name_Pattern - -- () + -- () Lang_Index.Config.Config_Body_Pattern := Element.Value.Value; @@ -1617,10 +1650,18 @@ package body Prj.Nmsc is Lang_Index.Config.Config_Spec := Element.Value.Value; + when Name_Config_Spec_File_Name_Index => + + -- Attribute Config_Spec_File_Name_Index + -- ( < Language > ) + + Lang_Index.Config.Config_Spec_Index := + Element.Value.Value; + when Name_Config_Spec_File_Name_Pattern => -- Attribute Config_Spec_File_Name_Pattern - -- () + -- () Lang_Index.Config.Config_Spec_Pattern := Element.Value.Value; @@ -1636,10 +1677,9 @@ package body Prj.Nmsc is exception when Constraint_Error => Error_Msg - (Project, - In_Tree, + (Data.Flags, "illegal value for Config_File_Unique", - Element.Value.Location); + Element.Value.Location, Project); end; when others => @@ -1668,7 +1708,7 @@ package body Prj.Nmsc is Attribute_Id := Attributes; while Attribute_Id /= No_Variable loop - Attribute := In_Tree.Variable_Elements.Table (Attribute_Id); + Attribute := Data.Tree.Variable_Elements.Table (Attribute_Id); if not Attribute.Value.Default then if Attribute.Name = Name_Separate_Suffix then @@ -1690,10 +1730,9 @@ package body Prj.Nmsc is exception when Constraint_Error => Error_Msg - (Project, - In_Tree, + (Data.Flags, "invalid value for Casing", - Attribute.Value.Location); + Attribute.Value.Location, Project); end; elsif Attribute.Name = Name_Dot_Replacement then @@ -1720,11 +1759,11 @@ package body Prj.Nmsc is Current_Array_Id := Arrays; while Current_Array_Id /= No_Array loop - Current_Array := In_Tree.Arrays.Table (Current_Array_Id); + Current_Array := Data.Tree.Arrays.Table (Current_Array_Id); Element_Id := Current_Array.Value; while Element_Id /= No_Array_Element loop - Element := In_Tree.Array_Elements.Table (Element_Id); + Element := Data.Tree.Array_Elements.Table (Element_Id); -- Get the name of the language @@ -1782,7 +1821,7 @@ package body Prj.Nmsc is Attribute_Id := Attributes; while Attribute_Id /= No_Variable loop Attribute := - In_Tree.Variable_Elements.Table (Attribute_Id); + Data.Tree.Variable_Elements.Table (Attribute_Id); if not Attribute.Value.Default then if Attribute.Name = Name_Driver then @@ -1803,12 +1842,13 @@ package body Prj.Nmsc is elsif Attribute.Name = Name_Required_Switches then - -- Attribute Required_Switches: the minimum + -- Attribute Required_Switches: the minimum trailing -- options to use when invoking the linker - Put (Into_List => Project.Config.Minimum_Linker_Options, + Put (Into_List => + Project.Config.Trailing_Linker_Required_Switches, From_List => Attribute.Value.Values, - In_Tree => In_Tree); + In_Tree => Data.Tree); elsif Attribute.Name = Name_Map_File_Option then Project.Config.Map_File_Option := Attribute.Value.Value; @@ -1822,10 +1862,9 @@ package body Prj.Nmsc is exception when Constraint_Error => Error_Msg - (Project, - In_Tree, + (Data.Flags, "value must be positive or equal to 0", - Attribute.Value.Location); + Attribute.Value.Location, Project); end; elsif Attribute.Name = Name_Response_File_Format then @@ -1849,19 +1888,34 @@ package body Prj.Nmsc is elsif Name = Name_Option_List then Project.Config.Resp_File_Format := Option_List; + elsif Name_Buffer (1 .. Name_Len) = "gcc" then + Project.Config.Resp_File_Format := GCC; + + elsif Name_Buffer (1 .. Name_Len) = "gcc_gnu" then + Project.Config.Resp_File_Format := GCC_GNU; + + elsif + Name_Buffer (1 .. Name_Len) = "gcc_option_list" + then + Project.Config.Resp_File_Format := GCC_Option_List; + + elsif + Name_Buffer (1 .. Name_Len) = "gcc_object_list" + then + Project.Config.Resp_File_Format := GCC_Object_List; + else Error_Msg - (Project, - In_Tree, + (Data.Flags, "illegal response file format", - Attribute.Value.Location); + Attribute.Value.Location, Project); end if; end; elsif Attribute.Name = Name_Response_File_Switches then Put (Into_List => Project.Config.Resp_File_Options, From_List => Attribute.Value.Values, - In_Tree => In_Tree); + In_Tree => Data.Tree); end if; end if; @@ -1874,7 +1928,7 @@ package body Prj.Nmsc is begin Packages := Project.Decl.Packages; while Packages /= No_Package loop - Element := In_Tree.Packages.Table (Packages); + Element := Data.Tree.Packages.Table (Packages); case Element.Name is when Name_Binder => @@ -1931,7 +1985,7 @@ package body Prj.Nmsc is Attribute_Id := Project.Decl.Attributes; while Attribute_Id /= No_Variable loop Attribute := - In_Tree.Variable_Elements.Table (Attribute_Id); + Data.Tree.Variable_Elements.Table (Attribute_Id); if not Attribute.Value.Default then if Attribute.Name = Name_Target then @@ -1957,15 +2011,14 @@ package body Prj.Nmsc is if List = Nil_String then Error_Msg - (Project, - In_Tree, + (Data.Flags, "archive builder cannot be null", - Attribute.Value.Location); + Attribute.Value.Location, Project); end if; Put (Into_List => Project.Config.Archive_Builder, From_List => List, - In_Tree => In_Tree); + In_Tree => Data.Tree); elsif Attribute.Name = Name_Archive_Builder_Append_Option then @@ -1979,7 +2032,7 @@ package body Prj.Nmsc is (Into_List => Project.Config.Archive_Builder_Append_Option, From_List => List, - In_Tree => In_Tree); + In_Tree => Data.Tree); end if; elsif Attribute.Name = Name_Archive_Indexer then @@ -1992,15 +2045,14 @@ package body Prj.Nmsc is if List = Nil_String then Error_Msg - (Project, - In_Tree, + (Data.Flags, "archive indexer cannot be null", - Attribute.Value.Location); + Attribute.Value.Location, Project); end if; Put (Into_List => Project.Config.Archive_Indexer, From_List => List, - In_Tree => In_Tree); + In_Tree => Data.Tree); elsif Attribute.Name = Name_Library_Partial_Linker then @@ -2012,25 +2064,23 @@ package body Prj.Nmsc is if List = Nil_String then Error_Msg - (Project, - In_Tree, + (Data.Flags, "partial linker cannot be null", - Attribute.Value.Location); + Attribute.Value.Location, Project); end if; Put (Into_List => Project.Config.Lib_Partial_Linker, From_List => List, - In_Tree => In_Tree); + In_Tree => Data.Tree); elsif Attribute.Name = Name_Library_GCC then Project.Config.Shared_Lib_Driver := File_Name_Type (Attribute.Value.Value); Error_Msg - (Project, - In_Tree, + (Data.Flags, "?Library_'G'C'C is an obsolescent attribute, " & "use Linker''Driver instead", - Attribute.Value.Location); + Attribute.Value.Location, Project); elsif Attribute.Name = Name_Archive_Suffix then Project.Config.Archive_Suffix := @@ -2045,15 +2095,14 @@ package body Prj.Nmsc is if List = Nil_String then Error_Msg - (Project, - In_Tree, + (Data.Flags, "linker executable option cannot be null", - Attribute.Value.Location); + Attribute.Value.Location, Project); end if; Put (Into_List => Project.Config.Linker_Executable_Option, From_List => List, - In_Tree => In_Tree); + In_Tree => Data.Tree); elsif Attribute.Name = Name_Linker_Lib_Dir_Option then @@ -2065,10 +2114,9 @@ package body Prj.Nmsc is if Name_Len = 0 then Error_Msg - (Project, - In_Tree, + (Data.Flags, "linker library directory option cannot be empty", - Attribute.Value.Location); + Attribute.Value.Location, Project); end if; Project.Config.Linker_Lib_Dir_Option := @@ -2084,10 +2132,9 @@ package body Prj.Nmsc is if Name_Len = 0 then Error_Msg - (Project, - In_Tree, + (Data.Flags, "linker library name option cannot be empty", - Attribute.Value.Location); + Attribute.Value.Location, Project); end if; Project.Config.Linker_Lib_Name_Option := @@ -2103,9 +2150,25 @@ package body Prj.Nmsc is if List /= Nil_String then Put (Into_List => Project.Config.Run_Path_Option, From_List => List, - In_Tree => In_Tree); + In_Tree => Data.Tree); + end if; + + elsif Attribute.Name = Name_Run_Path_Origin then + Get_Name_String (Attribute.Value.Value); + + if Name_Len = 0 then + Error_Msg + (Data.Flags, + "run path origin cannot be empty", + Attribute.Value.Location, Project); end if; + Project.Config.Run_Path_Origin := Attribute.Value.Value; + + elsif Attribute.Name = Name_Library_Install_Name_Option then + Project.Config.Library_Install_Name_Option := + Attribute.Value.Value; + elsif Attribute.Name = Name_Separate_Run_Path_Options then declare pragma Unsuppress (All_Checks); @@ -2115,12 +2178,11 @@ package body Prj.Nmsc is exception when Constraint_Error => Error_Msg - (Project, - In_Tree, + (Data.Flags, "invalid value """ & Get_Name_String (Attribute.Value.Value) & """ for Separate_Run_Path_Options", - Attribute.Value.Location); + Attribute.Value.Location, Project); end; elsif Attribute.Name = Name_Library_Support then @@ -2133,12 +2195,11 @@ package body Prj.Nmsc is exception when Constraint_Error => Error_Msg - (Project, - In_Tree, + (Data.Flags, "invalid value """ & Get_Name_String (Attribute.Value.Value) & """ for Library_Support", - Attribute.Value.Location); + Attribute.Value.Location, Project); end; elsif Attribute.Name = Name_Shared_Library_Prefix then @@ -2159,12 +2220,11 @@ package body Prj.Nmsc is exception when Constraint_Error => Error_Msg - (Project, - In_Tree, + (Data.Flags, "invalid value """ & Get_Name_String (Attribute.Value.Value) & """ for Symbolic_Link_Supported", - Attribute.Value.Location); + Attribute.Value.Location, Project); end; elsif @@ -2179,12 +2239,11 @@ package body Prj.Nmsc is exception when Constraint_Error => Error_Msg - (Project, - In_Tree, + (Data.Flags, "invalid value """ & Get_Name_String (Attribute.Value.Value) & """ for Library_Major_Minor_Id_Supported", - Attribute.Value.Location); + Attribute.Value.Location, Project); end; elsif Attribute.Name = Name_Library_Auto_Init_Supported then @@ -2196,12 +2255,11 @@ package body Prj.Nmsc is exception when Constraint_Error => Error_Msg - (Project, - In_Tree, + (Data.Flags, "invalid value """ & Get_Name_String (Attribute.Value.Value) & """ for Library_Auto_Init_Supported", - Attribute.Value.Location); + Attribute.Value.Location, Project); end; elsif Attribute.Name = Name_Shared_Library_Minimum_Switches then @@ -2210,7 +2268,7 @@ package body Prj.Nmsc is if List /= Nil_String then Put (Into_List => Project.Config.Shared_Lib_Min_Options, From_List => List, - In_Tree => In_Tree); + In_Tree => Data.Tree); end if; elsif Attribute.Name = Name_Library_Version_Switches then @@ -2219,7 +2277,7 @@ package body Prj.Nmsc is if List /= Nil_String then Put (Into_List => Project.Config.Lib_Version_Options, From_List => List, - In_Tree => In_Tree); + In_Tree => Data.Tree); end if; end if; end if; @@ -2244,11 +2302,11 @@ package body Prj.Nmsc is Current_Array_Id := Project.Decl.Arrays; while Current_Array_Id /= No_Array loop - Current_Array := In_Tree.Arrays.Table (Current_Array_Id); + Current_Array := Data.Tree.Arrays.Table (Current_Array_Id); Element_Id := Current_Array.Value; while Element_Id /= No_Array_Element loop - Element := In_Tree.Array_Elements.Table (Element_Id); + Element := Data.Tree.Array_Elements.Table (Element_Id); -- Get the name of the language @@ -2266,7 +2324,7 @@ package body Prj.Nmsc is (Into_List => Lang_Index.Config.Include_Compatible_Languages, From_List => List, - In_Tree => In_Tree, + In_Tree => Data.Tree, Lower_Case => True); end if; @@ -2320,12 +2378,11 @@ package body Prj.Nmsc is exception when Constraint_Error => Error_Msg - (Project, - In_Tree, + (Data.Flags, "invalid value """ & Get_Name_String (Element.Value.Value) & """ for Object_Generated", - Element.Value.Location); + Element.Value.Location, Project); end; when Name_Objects_Linked => @@ -2348,12 +2405,11 @@ package body Prj.Nmsc is exception when Constraint_Error => Error_Msg - (Project, - In_Tree, + (Data.Flags, "invalid value """ & Get_Name_String (Element.Value.Value) & """ for Objects_Linked", - Element.Value.Location); + Element.Value.Location, Project); end; when others => null; @@ -2415,16 +2471,15 @@ 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 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; Error_Msg - (Project, - In_Tree, + (Data.Flags, "?no compiler specified for language %%" & ", ignoring all its sources", - No_Location); + No_Location, Project); if Lang_Index = Project.Languages then Project.Languages := Lang_Index.Next; @@ -2440,26 +2495,23 @@ package body Prj.Nmsc is if Lang_Index.Config.Naming_Data.Dot_Replacement = No_File then Error_Msg - (Project, - In_Tree, + (Data.Flags, "Dot_Replacement not specified for Ada", - No_Location); + No_Location, Project); end if; if Lang_Index.Config.Naming_Data.Spec_Suffix = No_File then Error_Msg - (Project, - In_Tree, + (Data.Flags, "Spec_Suffix not specified for Ada", - No_Location); + No_Location, Project); end if; if Lang_Index.Config.Naming_Data.Body_Suffix = No_File then Error_Msg - (Project, - In_Tree, + (Data.Flags, "Body_Suffix not specified for Ada", - No_Location); + No_Location, Project); end if; else @@ -2468,15 +2520,15 @@ package body Prj.Nmsc is -- For file based languages, either Spec_Suffix or Body_Suffix -- need to be specified. - if Lang_Index.Config.Naming_Data.Spec_Suffix = No_File and then - Lang_Index.Config.Naming_Data.Body_Suffix = No_File + if Data.Flags.Require_Sources_Other_Lang + and then Lang_Index.Config.Naming_Data.Spec_Suffix = No_File + and then Lang_Index.Config.Naming_Data.Body_Suffix = No_File then Error_Msg_Name_1 := Lang_Index.Display_Name; Error_Msg - (Project, - In_Tree, + (Data.Flags, "no suffixes specified for %%", - No_Location); + No_Location, Project); end if; end if; @@ -2490,12 +2542,12 @@ package body Prj.Nmsc is procedure Check_If_Externally_Built (Project : Project_Id; - In_Tree : Project_Tree_Ref) + Data : in out Tree_Processing_Data) is Externally_Built : constant Variable_Value := Util.Value_Of (Name_Externally_Built, - Project.Decl.Attributes, In_Tree); + Project.Decl.Attributes, Data.Tree); begin if not Externally_Built.Default then @@ -2506,9 +2558,9 @@ package body Prj.Nmsc is Project.Externally_Built := True; elsif Name_Buffer (1 .. Name_Len) /= "false" then - Error_Msg (Project, In_Tree, + Error_Msg (Data.Flags, "Externally_Built may only be true or false", - Externally_Built.Location); + Externally_Built.Location, Project); end if; end if; @@ -2536,13 +2588,19 @@ package body Prj.Nmsc is procedure Check_Interfaces (Project : Project_Id; - In_Tree : Project_Tree_Ref) + Data : in out Tree_Processing_Data) is Interfaces : constant Prj.Variable_Value := Prj.Util.Value_Of (Snames.Name_Interfaces, Project.Decl.Attributes, - In_Tree); + Data.Tree); + + Library_Interface : constant Prj.Variable_Value := + Prj.Util.Value_Of + (Snames.Name_Library_Interface, + Project.Decl.Attributes, + Data.Tree); List : String_List_Id; Element : String_Element; @@ -2560,7 +2618,7 @@ package body Prj.Nmsc is Project_2 := Project; while Project_2 /= No_Project loop - Iter := For_Each_Source (In_Tree, Project_2); + Iter := For_Each_Source (Data.Tree, Project_2); loop Source := Prj.Element (Iter); exit when Source = No_Source; @@ -2573,13 +2631,13 @@ package body Prj.Nmsc is List := Interfaces.Values; while List /= Nil_String loop - Element := In_Tree.String_Elements.Table (List); + Element := Data.Tree.String_Elements.Table (List); Name := Canonical_Case_File_Name (Element.Value); Project_2 := Project; Big_Loop : while Project_2 /= No_Project loop - Iter := For_Each_Source (In_Tree, Project_2); + Iter := For_Each_Source (Data.Tree, Project_2); loop Source := Prj.Element (Iter); @@ -2617,11 +2675,10 @@ package body Prj.Nmsc is Error_Msg_Name_1 := Project.Name; Error_Msg - (Project, - In_Tree, + (Data.Flags, "{ cannot be an interface of project %% " & "as it is not one of its sources", - Element.Location); + Element.Location, Project); end if; List := Element.Next; @@ -2629,101 +2686,110 @@ package body Prj.Nmsc is Project.Interfaces_Defined := True; - elsif Project.Extends /= No_Project then - Project.Interfaces_Defined := Project.Extends.Interfaces_Defined; + elsif Project.Library and then not Library_Interface.Default then - if Project.Interfaces_Defined then - Iter := For_Each_Source (In_Tree, Project); + -- Set In_Interfaces to False for all sources. It will be set to True + -- later for the sources in the Library_Interface list. + + Project_2 := Project; + while Project_2 /= No_Project loop + Iter := For_Each_Source (Data.Tree, Project_2); loop Source := Prj.Element (Iter); exit when Source = No_Source; - - if not Source.Declared_In_Interfaces then - Source.In_Interfaces := False; - end if; - + Source.In_Interfaces := False; Next (Iter); end loop; - end if; - end if; - end Check_Interfaces; - ------------------------------------ - -- Check_And_Normalize_Unit_Names -- - ------------------------------------ + Project_2 := Project_2.Extends; + end loop; - procedure Check_And_Normalize_Unit_Names - (Project : Project_Id; - In_Tree : Project_Tree_Ref; - List : Array_Element_Id; - Debug_Name : String) - is - Current : Array_Element_Id; - Element : Array_Element; - Unit_Name : Name_Id; + List := Library_Interface.Values; + while List /= Nil_String loop + Element := Data.Tree.String_Elements.Table (List); + Get_Name_String (Element.Value); + To_Lower (Name_Buffer (1 .. Name_Len)); + Name := Name_Find; - begin - if Current_Verbosity = High then - Write_Line (" Checking unit names in " & Debug_Name); - end if; + Project_2 := Project; + Big_Loop_2 : + while Project_2 /= No_Project loop + Iter := For_Each_Source (Data.Tree, Project_2); - Current := List; - while Current /= No_Array_Element loop - Element := In_Tree.Array_Elements.Table (Current); - Element.Value.Value := - Name_Id (Canonical_Case_File_Name (Element.Value.Value)); + loop + Source := Prj.Element (Iter); + exit when Source = No_Source; - -- Check that it contains a valid unit name + if Source.Unit /= No_Unit_Index and then + Source.Unit.Name = Name_Id (Name) + then + if not Source.Locally_Removed then + Source.In_Interfaces := True; + Source.Declared_In_Interfaces := True; - Get_Name_String (Element.Index); - Check_Ada_Name (Name_Buffer (1 .. Name_Len), Unit_Name); + Other := Other_Part (Source); - if Unit_Name = No_Name then - Err_Vars.Error_Msg_Name_1 := Element.Index; - Error_Msg - (Project, In_Tree, - "%% is not a valid unit name.", - Element.Value.Location); + if Other /= No_Source then + Other.In_Interfaces := True; + Other.Declared_In_Interfaces := True; + end if; - else - if Current_Verbosity = High then - Write_Str (" for unit: "); - Write_Line (Get_Name_String (Unit_Name)); - end if; + if Current_Verbosity = High then + Write_Str (" interface: "); + Write_Line (Get_Name_String (Source.Path.Name)); + end if; + end if; - Element.Index := Unit_Name; - In_Tree.Array_Elements.Table (Current) := Element; - end if; + exit Big_Loop_2; + end if; - Current := Element.Next; - end loop; - end Check_And_Normalize_Unit_Names; + Next (Iter); + end loop; + + Project_2 := Project_2.Extends; + end loop Big_Loop_2; + + List := Element.Next; + end loop; + + Project.Interfaces_Defined := True; + + elsif Project.Extends /= No_Project + and then Project.Extends.Interfaces_Defined + then + Project.Interfaces_Defined := True; + + Iter := For_Each_Source (Data.Tree, Project); + loop + Source := Prj.Element (Iter); + exit when Source = No_Source; + + if not Source.Declared_In_Interfaces then + Source.In_Interfaces := False; + end if; + + Next (Iter); + end loop; + end if; + end Check_Interfaces; -------------------------- -- Check_Package_Naming -- -------------------------- procedure Check_Package_Naming - (Project : Project_Id; - In_Tree : Project_Tree_Ref; - Is_Config_File : Boolean; - Bodies : out Array_Element_Id; - Specs : out Array_Element_Id) + (Project : Project_Id; + Data : in out Tree_Processing_Data) is Naming_Id : constant Package_Id := - Util.Value_Of (Name_Naming, Project.Decl.Packages, In_Tree); + Util.Value_Of + (Name_Naming, Project.Decl.Packages, Data.Tree); Naming : Package_Element; Ada_Body_Suffix_Loc : Source_Ptr := No_Location; - Ada_Spec_Suffix_Loc : Source_Ptr := No_Location; - - procedure Check_Naming_Ada_Only; - -- Does Check_Naming_Schemes processing in Ada_Only mode. - -- If there is a package Naming, puts in Data.Naming the contents of - -- this package. - 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; @@ -2731,7 +2797,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; @@ -2739,8 +2805,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 @@ -2760,17 +2825,17 @@ package body Prj.Nmsc is Util.Value_Of (Name_Dot_Replacement, Naming.Decl.Attributes, - In_Tree); + Data.Tree); Casing_String : constant Variable_Value := Util.Value_Of (Name_Casing, Naming.Decl.Attributes, - In_Tree); + Data.Tree); Sep_Suffix : constant Variable_Value := Util.Value_Of (Name_Separate_Suffix, Naming.Decl.Attributes, - In_Tree); + Data.Tree); Dot_Repl_Loc : Source_Ptr; begin @@ -2782,9 +2847,8 @@ package body Prj.Nmsc is if Length_Of_Name (Dot_Repl.Value) = 0 then Error_Msg - (Project, In_Tree, - "Dot_Replacement cannot be empty", - Dot_Repl.Location); + (Data.Flags, "Dot_Replacement cannot be empty", + Dot_Repl.Location, Project); end if; Dot_Replacement := Canonical_Case_File_Name (Dot_Repl.Value); @@ -2814,10 +2878,10 @@ package body Prj.Nmsc is Index (Source => Repl, Pattern => ".") /= 0) then Error_Msg - (Project, In_Tree, + (Data.Flags, '"' & Repl & """ is illegal for Dot_Replacement.", - Dot_Repl_Loc); + Dot_Repl_Loc, Project); end if; end; end if; @@ -2840,9 +2904,9 @@ package body Prj.Nmsc is begin if Casing_Image'Length = 0 then Error_Msg - (Project, In_Tree, + (Data.Flags, "Casing cannot be an empty string", - Casing_String.Location); + Casing_String.Location, Project); end if; Casing := Value (Casing_Image); @@ -2854,9 +2918,9 @@ package body Prj.Nmsc is Name_Buffer (1 .. Name_Len) := Casing_Image; Err_Vars.Error_Msg_Name_1 := Name_Find; Error_Msg - (Project, In_Tree, + (Data.Flags, "%% is not a correct Casing", - Casing_String.Location); + Casing_String.Location, Project); end; end if; @@ -2865,21 +2929,18 @@ package body Prj.Nmsc is if not Sep_Suffix.Default then if Length_Of_Name (Sep_Suffix.Value) = 0 then Error_Msg - (Project, In_Tree, + (Data.Flags, "Separate_Suffix cannot be empty", - Sep_Suffix.Location); + Sep_Suffix.Location, Project); else Separate_Suffix := Canonical_Case_File_Name (Sep_Suffix.Value); Sep_Suffix_Loc := Sep_Suffix.Location; - if Is_Illegal_Suffix (Separate_Suffix, Dot_Replacement) then - Err_Vars.Error_Msg_File_1 := Separate_Suffix; - Error_Msg - (Project, In_Tree, - "{ is illegal for Separate_Suffix", - Sep_Suffix.Location); - end if; + Check_Illegal_Suffix + (Project, Separate_Suffix, + Dot_Replacement, "Separate_Suffix", Sep_Suffix.Location, + Data); end if; end if; @@ -2913,28 +2974,28 @@ package body Prj.Nmsc is Value_Of (Name_Implementation_Exceptions, In_Arrays => Naming.Decl.Arrays, - In_Tree => In_Tree); + In_Tree => Data.Tree); when Spec => Exceptions := Value_Of (Name_Specification_Exceptions, In_Arrays => Naming.Decl.Arrays, - In_Tree => In_Tree); + In_Tree => Data.Tree); end case; Exception_List := Value_Of (Index => Lang, In_Array => Exceptions, - In_Tree => In_Tree); + In_Tree => Data.Tree); if Exception_List /= Nil_Variable_Value then Element_Id := Exception_List.Values; while Element_Id /= Nil_String loop - Element := In_Tree.String_Elements.Table (Element_Id); + Element := Data.Tree.String_Elements.Table (Element_Id); File_Name := Canonical_Case_File_Name (Element.Value); - Iter := For_Each_Source (In_Tree, Project); + Iter := For_Each_Source (Data.Tree, Project); loop Source := Prj.Element (Iter); exit when Source = No_Source or else Source.File = File_Name; @@ -2944,13 +3005,15 @@ package body Prj.Nmsc is if Source = No_Source then Add_Source (Id => Source, - In_Tree => In_Tree, + Data => Data, Project => Project, + Source_Dir_Rank => 0, Lang_Id => Lang_Id, Kind => Kind, File_Name => File_Name, Display_File => File_Name_Type (Element.Value), - Naming_Exception => True); + Naming_Exception => True, + Location => Element.Location); else -- Check if the file name is already recorded for another @@ -2958,17 +3021,15 @@ package body Prj.Nmsc is if Source.Language /= Lang_Id then Error_Msg - (Project, - In_Tree, + (Data.Flags, "the same file cannot be a source of two languages", - Element.Location); + Element.Location, Project); elsif Source.Kind /= Kind then Error_Msg - (Project, - In_Tree, + (Data.Flags, "the same file cannot be a source and a template", - Element.Location); + Element.Location, Project); end if; -- If the file is already recorded for the same @@ -2990,31 +3051,29 @@ 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; - Source_To_Replace : Source_Id := No_Source; - Other_Project : Project_Id; - Iter : Source_Iterator; + 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 => In_Tree); + Exceptions := + Value_Of + (Name_Body, + In_Arrays => Naming.Decl.Arrays, + In_Tree => Data.Tree); if Exceptions = No_Array_Element then Exceptions := Value_Of (Name_Implementation, In_Arrays => Naming.Decl.Arrays, - In_Tree => In_Tree); + In_Tree => Data.Tree); end if; when Spec => @@ -3022,18 +3081,19 @@ package body Prj.Nmsc is Value_Of (Name_Spec, In_Arrays => Naming.Decl.Arrays, - In_Tree => In_Tree); + In_Tree => Data.Tree); if Exceptions = No_Array_Element then - Exceptions := Value_Of - (Name_Spec, - In_Arrays => Naming.Decl.Arrays, - In_Tree => In_Tree); + Exceptions := + Value_Of + (Name_Spec, + In_Arrays => Naming.Decl.Arrays, + In_Tree => Data.Tree); end if; end case; while Exceptions /= No_Array_Element loop - Element := In_Tree.Array_Elements.Table (Exceptions); + Element := Data.Tree.Array_Elements.Table (Exceptions); File_Name := Canonical_Case_File_Name (Element.Value.Value); Get_Name_String (Element.Index); @@ -3050,189 +3110,40 @@ package body Prj.Nmsc is if Unit = No_Name then Err_Vars.Error_Msg_Name_1 := Element.Index; Error_Msg - (Project, In_Tree, + (Data.Flags, "%% is not a valid unit name.", - Element.Value.Location); + Element.Value.Location, Project); end if; end if; if Unit /= No_Name then - - -- Check if the source already exists - -- ??? In Ada_Only mode (Record_Unit), we use a htable for - -- efficiency - - Source_To_Replace := No_Source; - Iter := For_Each_Source (In_Tree); - - loop - Source := Prj.Element (Iter); - exit when Source = No_Source - or else (Source.Unit /= null - and then Source.Unit.Name = Unit - and then Source.Index = Index); - Next (Iter); - end loop; - - if Source /= No_Source then - if Source.Kind /= Kind then - loop - Next (Iter); - Source := Prj.Element (Iter); - - exit when Source = No_Source - or else (Source.Unit /= null - and then Source.Unit.Name = Unit - and then Source.Index = Index); - end loop; - end if; - - if Source /= No_Source then - Other_Project := Source.Project; - - if Is_Extending (Project, Other_Project) then - Source_To_Replace := Source; - Source := No_Source; - - else - Error_Msg_Name_1 := Unit; - Error_Msg_Name_2 := Other_Project.Name; - Error_Msg - (Project, - In_Tree, - "%% is already a source of project %%", - Element.Value.Location); - end if; - end if; - end if; - - if Source = No_Source then - Add_Source - (Id => Source, - In_Tree => In_Tree, - Project => Project, - Lang_Id => Lang_Id, - Kind => Kind, - File_Name => File_Name, - Display_File => File_Name_Type (Element.Value.Value), - Unit => Unit, - Index => Index, - Naming_Exception => True, - Source_To_Replace => Source_To_Replace); - end if; + Add_Source + (Id => Source, + Data => Data, + Project => Project, + Source_Dir_Rank => 0, + Lang_Id => Lang_Id, + Kind => Kind, + File_Name => File_Name, + Display_File => File_Name_Type (Element.Value.Value), + Unit => Unit, + Index => Index, + Location => Element.Value.Location, + Naming_Exception => True); end if; Exceptions := Element.Next; end loop; end Process_Exceptions_Unit_Based; - --------------------------- - -- Check_Naming_Ada_Only -- - --------------------------- - - procedure Check_Naming_Ada_Only is - Ada : constant Language_Ptr := - Get_Language_From_Name (Project, "ada"); - - Casing_Defined : Boolean; - Sep_Suffix_Loc : Source_Ptr; - - begin - -- If no language, then nothing to do - - if Ada = null then - return; - end if; - - declare - Data : Lang_Naming_Data renames Ada.Config.Naming_Data; - - begin - -- The default value of separate suffix should be the same as the - -- body suffix, so we need to compute that first. - - Data.Separate_Suffix := Data.Body_Suffix; - Write_Attr ("Body_Suffix", Get_Name_String (Data.Body_Suffix)); - - -- We'll need the dot replacement below, so compute it now - - Check_Common - (Dot_Replacement => Data.Dot_Replacement, - Casing => Data.Casing, - Casing_Defined => Casing_Defined, - Separate_Suffix => Data.Separate_Suffix, - Sep_Suffix_Loc => Sep_Suffix_Loc); - - Bodies := Util.Value_Of (Name_Body, Naming.Decl.Arrays, In_Tree); - - if Bodies /= No_Array_Element then - Check_And_Normalize_Unit_Names - (Project, In_Tree, Bodies, "Naming.Bodies"); - end if; - - Specs := Util.Value_Of (Name_Spec, Naming.Decl.Arrays, In_Tree); - - if Specs /= No_Array_Element then - Check_And_Normalize_Unit_Names - (Project, In_Tree, Specs, "Naming.Specs"); - end if; - - -- Check Spec_Suffix - - if Is_Illegal_Suffix (Data.Spec_Suffix, Data.Dot_Replacement) then - Err_Vars.Error_Msg_File_1 := Data.Spec_Suffix; - Error_Msg - (Project, In_Tree, - "{ is illegal for Spec_Suffix", - Ada_Spec_Suffix_Loc); - end if; - - Write_Attr ("Spec_Suffix", Get_Name_String (Data.Spec_Suffix)); - - -- Check Body_Suffix - - if Is_Illegal_Suffix (Data.Body_Suffix, Data.Dot_Replacement) then - Err_Vars.Error_Msg_File_1 := Data.Body_Suffix; - Error_Msg - (Project, In_Tree, - "{ is illegal for Body_Suffix", - Ada_Body_Suffix_Loc); - end if; - - -- Spec_Suffix cannot be equal to Body_Suffix or Separate_Suffix, - -- since that would cause a clear ambiguity. Note that we do allow - -- a Spec_Suffix to have the same termination as one of these, - -- which causes a potential ambiguity, but we resolve that my - -- matching the longest possible suffix. - - if Data.Spec_Suffix = Data.Body_Suffix then - Error_Msg - (Project, In_Tree, - "Body_Suffix (""" - & Get_Name_String (Data.Body_Suffix) - & """) cannot be the same as Spec_Suffix.", - Ada_Body_Suffix_Loc); - end if; - - if Data.Body_Suffix /= Data.Separate_Suffix - and then Data.Spec_Suffix = Data.Separate_Suffix - then - Error_Msg - (Project, In_Tree, - "Separate_Suffix (""" - & Get_Name_String (Data.Separate_Suffix) - & """) cannot be the same as Spec_Suffix.", - Sep_Suffix_Loc); - end if; - end; - end Check_Naming_Ada_Only; - - ----------------------------- - -- Check_Naming_Multi_Lang -- - ----------------------------- + ------------------ + -- Check_Naming -- + ------------------ - procedure Check_Naming_Multi_Lang is - Dot_Replacement : File_Name_Type := No_File; + procedure Check_Naming is + Dot_Replacement : File_Name_Type := + File_Name_Type + (First_Name_Id + Character'Pos ('-')); Separate_Suffix : File_Name_Type := No_File; Casing : Casing_Type := All_Lower_Case; Casing_Defined : Boolean; @@ -3269,11 +3180,6 @@ package body Prj.Nmsc is if Casing_Defined then Lang_Id.Config.Naming_Data.Casing := Casing; end if; - - if Separate_Suffix /= No_File then - Lang_Id.Config.Naming_Data.Separate_Suffix := - Separate_Suffix; - end if; end if; Lang_Id := Lang_Id.Next; @@ -3292,68 +3198,134 @@ package body Prj.Nmsc is (Name => Lang, Attribute_Or_Array_Name => Name_Spec_Suffix, In_Package => Naming_Id, - In_Tree => In_Tree); + In_Tree => Data.Tree); if Suffix = Nil_Variable_Value then Suffix := Value_Of (Name => Lang, - Attribute_Or_Array_Name => Name_Spec_Suffix, + Attribute_Or_Array_Name => Name_Specification_Suffix, In_Package => Naming_Id, - In_Tree => In_Tree); + In_Tree => Data.Tree); end if; if Suffix /= Nil_Variable_Value then Lang_Id.Config.Naming_Data.Spec_Suffix := File_Name_Type (Suffix.Value); + + Check_Illegal_Suffix + (Project, + Lang_Id.Config.Naming_Data.Spec_Suffix, + Lang_Id.Config.Naming_Data.Dot_Replacement, + "Spec_Suffix", Suffix.Location, Data); + + Write_Attr + ("Spec_Suffix", + Get_Name_String (Lang_Id.Config.Naming_Data.Spec_Suffix)); end if; -- Body_Suffix - Suffix := Value_Of - (Name => Lang, - Attribute_Or_Array_Name => Name_Body_Suffix, - In_Package => Naming_Id, - In_Tree => In_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 => In_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 Lang_Id.Config.Naming_Data.Body_Suffix := - File_Name_Type (Suffix.Value); + File_Name_Type (Suffix.Value); + + -- The default value of separate suffix should be the same as + -- the body suffix, so we need to compute that first. + + if Separate_Suffix = No_File then + Lang_Id.Config.Naming_Data.Separate_Suffix := + Lang_Id.Config.Naming_Data.Body_Suffix; + Write_Attr + ("Sep_Suffix", + Get_Name_String + (Lang_Id.Config.Naming_Data.Separate_Suffix)); + else + Lang_Id.Config.Naming_Data.Separate_Suffix := + Separate_Suffix; + end if; + + Check_Illegal_Suffix + (Project, + Lang_Id.Config.Naming_Data.Body_Suffix, + Lang_Id.Config.Naming_Data.Dot_Replacement, + "Body_Suffix", Suffix.Location, Data); + + Write_Attr + ("Body_Suffix", + Get_Name_String (Lang_Id.Config.Naming_Data.Body_Suffix)); + + elsif Separate_Suffix /= No_File then + Lang_Id.Config.Naming_Data.Separate_Suffix := Separate_Suffix; + end if; + + -- Spec_Suffix cannot be equal to Body_Suffix or Separate_Suffix, + -- since that would cause a clear ambiguity. Note that we do allow + -- a Spec_Suffix to have the same termination as one of these, + -- which causes a potential ambiguity, but we resolve that my + -- matching the longest possible suffix. + + if 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 + then + Error_Msg + (Data.Flags, + "Body_Suffix (""" + & Get_Name_String (Lang_Id.Config.Naming_Data.Body_Suffix) + & """) cannot be the same as Spec_Suffix.", + Ada_Body_Suffix_Loc, Project); end if; - -- ??? As opposed to what is done in Check_Naming_Ada_Only, - -- we do not check whether spec_suffix=body_suffix, which - -- should be illegal. Best would be to share this code into - -- Check_Common, but we access the attributes from the project - -- files slightly differently apparently. + if Lang_Id.Config.Naming_Data.Body_Suffix /= + Lang_Id.Config.Naming_Data.Separate_Suffix + and then Lang_Id.Config.Naming_Data.Spec_Suffix = + Lang_Id.Config.Naming_Data.Separate_Suffix + then + Error_Msg + (Data.Flags, + "Separate_Suffix (""" + & Get_Name_String + (Lang_Id.Config.Naming_Data.Separate_Suffix) + & """) cannot be the same as Spec_Suffix.", + Sep_Suffix_Loc, Project); + end if; Lang_Id := Lang_Id.Next; end loop; -- Get the naming exceptions for all languages - for Kind in Spec .. Impl loop + for Kind in Spec_Or_Body loop 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 -- @@ -3364,13 +3336,13 @@ package body Prj.Nmsc is Util.Value_Of (Name_Spec_Suffix, Naming.Decl.Arrays, - In_Tree); + Data.Tree); Impls : Array_Element_Id := Util.Value_Of (Name_Body_Suffix, Naming.Decl.Arrays, - In_Tree); + Data.Tree); Lang : Language_Ptr; Lang_Name : Name_Id; @@ -3383,16 +3355,16 @@ package body Prj.Nmsc is -- user project, and they override the default. while Specs /= No_Array_Element loop - Lang_Name := In_Tree.Array_Elements.Table (Specs).Index; - Lang := Get_Language_From_Name - (Project, Name => Get_Name_String (Lang_Name)); + Lang_Name := Data.Tree.Array_Elements.Table (Specs).Index; + 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)); @@ -3418,12 +3390,9 @@ package body Prj.Nmsc is & Get_Name_String (Lang_Name) & " since language is not defined for this project"); end if; - else - Value := In_Tree.Array_Elements.Table (Specs).Value; - if Lang.Name = Name_Ada then - Ada_Spec_Suffix_Loc := Value.Location; - end if; + else + Value := Data.Tree.Array_Elements.Table (Specs).Value; if Value.Kind = Single then Lang.Config.Naming_Data.Spec_Suffix := @@ -3431,13 +3400,14 @@ package body Prj.Nmsc is end if; end if; - Specs := In_Tree.Array_Elements.Table (Specs).Next; + Specs := Data.Tree.Array_Elements.Table (Specs).Next; end loop; while Impls /= No_Array_Element loop - Lang_Name := In_Tree.Array_Elements.Table (Impls).Index; - Lang := Get_Language_From_Name - (Project, Name => Get_Name_String (Lang_Name)); + Lang_Name := Data.Tree.Array_Elements.Table (Impls).Index; + Lang := + Get_Language_From_Name + (Project, Name => Get_Name_String (Lang_Name)); if Lang = null then if Current_Verbosity = High then @@ -3447,7 +3417,7 @@ package body Prj.Nmsc is & " since language is not defined for this project"); end if; else - Value := In_Tree.Array_Elements.Table (Impls).Value; + Value := Data.Tree.Array_Elements.Table (Impls).Value; if Lang.Name = Name_Ada then Ada_Body_Suffix_Loc := Value.Location; @@ -3459,20 +3429,19 @@ package body Prj.Nmsc is end if; end if; - Impls := In_Tree.Array_Elements.Table (Impls).Next; + Impls := Data.Tree.Array_Elements.Table (Impls).Next; end loop; end Initialize_Naming_Data; -- Start of processing for Check_Naming_Schemes begin - Specs := No_Array_Element; - Bodies := No_Array_Element; - -- No Naming package or parsing a configuration file? nothing to do - if Naming_Id /= No_Package and not Is_Config_File then - Naming := In_Tree.Packages.Table (Naming_Id); + if Naming_Id /= No_Package + and then Project.Qualifier /= Configuration + then + Naming := Data.Tree.Packages.Table (Naming_Id); if Current_Verbosity = High then Write_Line ("Checking package Naming for project " @@ -3480,13 +3449,7 @@ package body Prj.Nmsc is end if; Initialize_Naming_Data; - - case Get_Mode is - when Ada_Only => - Check_Naming_Ada_Only; - when Multi_Language => - Check_Naming_Multi_Lang; - end case; + Check_Naming; end if; end Check_Package_Naming; @@ -3495,34 +3458,34 @@ package body Prj.Nmsc is ------------------------------ procedure Check_Library_Attributes - (Project : Project_Id; - In_Tree : Project_Tree_Ref) + (Project : Project_Id; + Data : in out Tree_Processing_Data) is Attributes : constant Prj.Variable_Id := Project.Decl.Attributes; Lib_Dir : constant Prj.Variable_Value := Prj.Util.Value_Of - (Snames.Name_Library_Dir, Attributes, In_Tree); + (Snames.Name_Library_Dir, Attributes, Data.Tree); Lib_Name : constant Prj.Variable_Value := Prj.Util.Value_Of - (Snames.Name_Library_Name, Attributes, In_Tree); + (Snames.Name_Library_Name, Attributes, Data.Tree); Lib_Version : constant Prj.Variable_Value := Prj.Util.Value_Of - (Snames.Name_Library_Version, Attributes, In_Tree); + (Snames.Name_Library_Version, Attributes, Data.Tree); Lib_ALI_Dir : constant Prj.Variable_Value := Prj.Util.Value_Of - (Snames.Name_Library_Ali_Dir, Attributes, In_Tree); + (Snames.Name_Library_Ali_Dir, Attributes, Data.Tree); Lib_GCC : constant Prj.Variable_Value := Prj.Util.Value_Of - (Snames.Name_Library_GCC, Attributes, In_Tree); + (Snames.Name_Library_GCC, Attributes, Data.Tree); The_Lib_Kind : constant Prj.Variable_Value := Prj.Util.Value_Of - (Snames.Name_Library_Kind, Attributes, In_Tree); + (Snames.Name_Library_Kind, Attributes, Data.Tree); Imported_Project_List : Project_List; @@ -3540,8 +3503,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 @@ -3551,7 +3514,7 @@ package body Prj.Nmsc is -- have no sources. However, header files from non-Ada -- languages are OK, as there is nothing to compile. - Iter := For_Each_Source (In_Tree, Proj); + Iter := For_Each_Source (Data.Tree, Proj); loop Src_Id := Prj.Element (Iter); exit when Src_Id = No_Source @@ -3567,11 +3530,11 @@ package body Prj.Nmsc is if Extends then if Project.Library_Kind /= Static then Error_Msg - (Project, In_Tree, + (Data.Flags, Continuation.all & "shared library project %% cannot extend " & "project %% that is not a library project", - Project.Location); + Project.Location, Project); Continuation := Continuation_String'Access; end if; @@ -3579,11 +3542,11 @@ package body Prj.Nmsc is and then Project.Library_Kind /= Static then Error_Msg - (Project, In_Tree, + (Data.Flags, Continuation.all & "shared library project %% cannot import project %% " & "that is not a shared library project", - Project.Location); + Project.Location, Project); Continuation := Continuation_String'Access; end if; end if; @@ -3596,20 +3559,20 @@ package body Prj.Nmsc is if Extends then Error_Msg - (Project, In_Tree, + (Data.Flags, Continuation.all & "shared library project %% cannot extend static " & "library project %%", - Project.Location); + Project.Location, Project); Continuation := Continuation_String'Access; elsif not Unchecked_Shared_Lib_Imports then Error_Msg - (Project, In_Tree, + (Data.Flags, Continuation.all & "shared library project %% cannot import static " & "library project %%", - Project.Location); + Project.Location, Project); Continuation := Continuation_String'Access; end if; @@ -3635,9 +3598,9 @@ package body Prj.Nmsc is if Project.Extends.Library then if Project.Qualifier = Standard then Error_Msg - (Project, In_Tree, + (Data.Flags, "a standard project cannot extend a library project", - Project.Location); + Project.Location, Project); else if Lib_Name.Default then @@ -3647,10 +3610,10 @@ package body Prj.Nmsc is if Lib_Dir.Default then if not Project.Virtual then Error_Msg - (Project, In_Tree, + (Data.Flags, "a project extending a library project must " & "specify an attribute Library_Dir", - Project.Location); + Project.Location, Project); else -- For a virtual project extending a library project, @@ -3698,10 +3661,10 @@ package body Prj.Nmsc is if Project.Library_Dir = No_Path_Information then Locate_Directory (Project, - In_Tree, File_Name_Type (Lib_Dir.Value), Path => Project.Library_Dir, Dir_Exists => Dir_Exists, + Data => Data, Create => "library", Must_Exist => False, Location => Lib_Dir.Location, @@ -3722,103 +3685,107 @@ package body Prj.Nmsc is Err_Vars.Error_Msg_File_1 := File_Name_Type (Project.Library_Dir.Display_Name); Error_Msg - (Project, In_Tree, + (Data.Flags, "library directory { does not exist", - Lib_Dir.Location); + Lib_Dir.Location, Project); + + elsif not Project.Externally_Built then -- The library directory cannot be the same as the Object -- directory. - elsif Project.Library_Dir.Name = Project.Object_Directory.Name then - Error_Msg - (Project, In_Tree, - "library directory cannot be the same " & - "as object directory", - Lib_Dir.Location); - Project.Library_Dir := No_Path_Information; - - else - declare - OK : Boolean := True; - Dirs_Id : String_List_Id; - Dir_Elem : String_Element; - Pid : Project_List; + if Project.Library_Dir.Name = Project.Object_Directory.Name then + Error_Msg + (Data.Flags, + "library directory cannot be the same " & + "as object directory", + Lib_Dir.Location, Project); + Project.Library_Dir := No_Path_Information; - begin - -- The library directory cannot be the same as a source - -- directory of the current project. + else + declare + OK : Boolean := True; + Dirs_Id : String_List_Id; + Dir_Elem : String_Element; + Pid : Project_List; - Dirs_Id := Project.Source_Dirs; - while Dirs_Id /= Nil_String loop - Dir_Elem := In_Tree.String_Elements.Table (Dirs_Id); - Dirs_Id := Dir_Elem.Next; + begin + -- The library directory cannot be the same as a source + -- directory of the current project. - if Project.Library_Dir.Name = - Path_Name_Type (Dir_Elem.Value) - then - Err_Vars.Error_Msg_File_1 := - File_Name_Type (Dir_Elem.Value); - Error_Msg - (Project, In_Tree, - "library directory cannot be the same " & - "as source directory {", - Lib_Dir.Location); - OK := False; - exit; - end if; - end loop; + Dirs_Id := Project.Source_Dirs; + while Dirs_Id /= Nil_String loop + Dir_Elem := Data.Tree.String_Elements.Table (Dirs_Id); + Dirs_Id := Dir_Elem.Next; - if OK then + if Project.Library_Dir.Name = + Path_Name_Type (Dir_Elem.Value) + then + Err_Vars.Error_Msg_File_1 := + File_Name_Type (Dir_Elem.Value); + Error_Msg + (Data.Flags, + "library directory cannot be the same " & + "as source directory {", + Lib_Dir.Location, Project); + OK := False; + exit; + end if; + end loop; - -- The library directory cannot be the same as a source - -- directory of another project either. + if OK then - Pid := In_Tree.Projects; - Project_Loop : loop - exit Project_Loop when Pid = null; + -- The library directory cannot be the same as a + -- source directory of another project either. - if Pid.Project /= Project then - Dirs_Id := Pid.Project.Source_Dirs; + Pid := Data.Tree.Projects; + Project_Loop : loop + exit Project_Loop when Pid = null; - Dir_Loop : while Dirs_Id /= Nil_String loop - Dir_Elem := - In_Tree.String_Elements.Table (Dirs_Id); - Dirs_Id := Dir_Elem.Next; + if Pid.Project /= Project then + Dirs_Id := Pid.Project.Source_Dirs; - if Project.Library_Dir.Name = - Path_Name_Type (Dir_Elem.Value) - then - Err_Vars.Error_Msg_File_1 := - File_Name_Type (Dir_Elem.Value); - Err_Vars.Error_Msg_Name_1 := Pid.Project.Name; + Dir_Loop : while Dirs_Id /= Nil_String loop + Dir_Elem := + Data.Tree.String_Elements.Table (Dirs_Id); + Dirs_Id := Dir_Elem.Next; - Error_Msg - (Project, In_Tree, - "library directory cannot be the same " & - "as source directory { of project %%", - Lib_Dir.Location); - OK := False; - exit Project_Loop; - end if; - end loop Dir_Loop; - end if; + if Project.Library_Dir.Name = + Path_Name_Type (Dir_Elem.Value) + then + Err_Vars.Error_Msg_File_1 := + File_Name_Type (Dir_Elem.Value); + Err_Vars.Error_Msg_Name_1 := + Pid.Project.Name; + + Error_Msg + (Data.Flags, + "library directory cannot be the same" & + " as source directory { of project %%", + Lib_Dir.Location, Project); + OK := False; + exit Project_Loop; + end if; + end loop Dir_Loop; + end if; - Pid := Pid.Next; - end loop Project_Loop; - end if; + Pid := Pid.Next; + end loop Project_Loop; + end if; - if not OK then - Project.Library_Dir := No_Path_Information; + if not OK then + Project.Library_Dir := No_Path_Information; - elsif Current_Verbosity = High then + elsif Current_Verbosity = High then - -- Display the Library directory in high verbosity + -- Display the Library directory in high verbosity - Write_Attr - ("Library directory", - Get_Name_String (Project.Library_Dir.Display_Name)); - end if; - end; + Write_Attr + ("Library directory", + Get_Name_String (Project.Library_Dir.Display_Name)); + end if; + end; + end if; end if; end if; @@ -3833,25 +3800,25 @@ package body Prj.Nmsc is when Standard => if Project.Library then Error_Msg - (Project, In_Tree, + (Data.Flags, "a standard project cannot be a library project", - Lib_Name.Location); + Lib_Name.Location, Project); end if; when Library => if not Project.Library then if Project.Library_Dir = No_Path_Information then Error_Msg - (Project, In_Tree, + (Data.Flags, "\attribute Library_Dir not declared", - Project.Location); + Project.Location, Project); end if; if Project.Library_Name = No_Name then Error_Msg - (Project, In_Tree, + (Data.Flags, "\attribute Library_Name not declared", - Project.Location); + Project.Location, Project); end if; end if; @@ -3862,18 +3829,13 @@ package body Prj.Nmsc is end if; if Project.Library then - if Get_Mode = Multi_Language then - Support_For_Libraries := Project.Config.Lib_Support; - - else - Support_For_Libraries := MLib.Tgt.Support_For_Libraries; - end if; + Support_For_Libraries := Project.Config.Lib_Support; if Support_For_Libraries = Prj.None then Error_Msg - (Project, In_Tree, + (Data.Flags, "?libraries are not supported on this platform", - Lib_Name.Location); + Lib_Name.Location, Project); Project.Library := False; else @@ -3889,11 +3851,11 @@ package body Prj.Nmsc is Locate_Directory (Project, - In_Tree, File_Name_Type (Lib_ALI_Dir.Value), Path => Project.Library_ALI_Dir, Create => "library ALI", Dir_Exists => Dir_Exists, + Data => Data, Must_Exist => False, Location => Lib_ALI_Dir.Location, Externally_Built => Project.Externally_Built); @@ -3906,22 +3868,23 @@ package body Prj.Nmsc is Err_Vars.Error_Msg_File_1 := File_Name_Type (Project.Library_ALI_Dir.Display_Name); Error_Msg - (Project, In_Tree, + (Data.Flags, "library 'A'L'I directory { does not exist", - Lib_ALI_Dir.Location); + Lib_ALI_Dir.Location, Project); end if; - if Project.Library_ALI_Dir /= Project.Library_Dir then - + if (not Project.Externally_Built) and then + Project.Library_ALI_Dir /= Project.Library_Dir + then -- The library ALI directory cannot be the same as the -- Object directory. if Project.Library_ALI_Dir = Project.Object_Directory then Error_Msg - (Project, In_Tree, + (Data.Flags, "library 'A'L'I directory cannot be the same " & "as object directory", - Lib_ALI_Dir.Location); + Lib_ALI_Dir.Location, Project); Project.Library_ALI_Dir := No_Path_Information; else @@ -3937,7 +3900,8 @@ package body Prj.Nmsc is Dirs_Id := Project.Source_Dirs; while Dirs_Id /= Nil_String loop - Dir_Elem := In_Tree.String_Elements.Table (Dirs_Id); + Dir_Elem := + Data.Tree.String_Elements.Table (Dirs_Id); Dirs_Id := Dir_Elem.Next; if Project.Library_ALI_Dir.Name = @@ -3946,10 +3910,10 @@ package body Prj.Nmsc is Err_Vars.Error_Msg_File_1 := File_Name_Type (Dir_Elem.Value); Error_Msg - (Project, In_Tree, + (Data.Flags, "library 'A'L'I directory cannot be " & "the same as source directory {", - Lib_ALI_Dir.Location); + Lib_ALI_Dir.Location, Project); OK := False; exit; end if; @@ -3960,7 +3924,7 @@ package body Prj.Nmsc is -- The library ALI directory cannot be the same as -- a source directory of another project either. - Pid := In_Tree.Projects; + Pid := Data.Tree.Projects; ALI_Project_Loop : loop exit ALI_Project_Loop when Pid = null; @@ -3970,7 +3934,8 @@ package body Prj.Nmsc is ALI_Dir_Loop : while Dirs_Id /= Nil_String loop Dir_Elem := - In_Tree.String_Elements.Table (Dirs_Id); + Data.Tree.String_Elements.Table + (Dirs_Id); Dirs_Id := Dir_Elem.Next; if Project.Library_ALI_Dir.Name = @@ -3982,11 +3947,11 @@ package body Prj.Nmsc is Pid.Project.Name; Error_Msg - (Project, In_Tree, + (Data.Flags, "library 'A'L'I directory cannot " & "be the same as source directory " & "{ of project %%", - Lib_ALI_Dir.Location); + Lib_ALI_Dir.Location, Project); OK := False; exit ALI_Project_Loop; end if; @@ -4052,9 +4017,9 @@ package body Prj.Nmsc is else Error_Msg - (Project, In_Tree, + (Data.Flags, "illegal value for Library_Kind", - The_Lib_Kind.Location); + The_Lib_Kind.Location, Project); OK := False; end if; @@ -4065,10 +4030,10 @@ package body Prj.Nmsc is if Project.Library_Kind /= Static then if Support_For_Libraries = Prj.Static_Only then Error_Msg - (Project, In_Tree, + (Data.Flags, "only static libraries are supported " & "on this platform", - The_Lib_Kind.Location); + The_Lib_Kind.Location, Project); Project.Library := False; else @@ -4077,11 +4042,10 @@ package body Prj.Nmsc is if Lib_GCC.Value /= Empty_String then Error_Msg - (Project, - In_Tree, + (Data.Flags, "?Library_'G'C'C is an obsolescent attribute, " & "use Linker''Driver instead", - Lib_GCC.Location); + Lib_GCC.Location, Project); Project.Config.Shared_Lib_Driver := File_Name_Type (Lib_GCC.Value); @@ -4091,15 +4055,14 @@ package body Prj.Nmsc is Value_Of (Name_Linker, Project.Decl.Packages, - In_Tree); + Data.Tree); Driver : constant Variable_Value := Value_Of - (Name => No_Name, + (Name => No_Name, Attribute_Or_Array_Name => Name_Driver, - In_Package => Linker, - In_Tree => - In_Tree); + In_Package => Linker, + In_Tree => Data.Tree); begin if Driver /= Nil_Variable_Value @@ -4120,17 +4083,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; @@ -4145,42 +4106,79 @@ package body Prj.Nmsc is Linker_Package_Id : constant Package_Id := Util.Value_Of (Name_Linker, - Project.Decl.Packages, In_Tree); + Project.Decl.Packages, Data.Tree); Linker_Package : Package_Element; Switches : Array_Element_Id := No_Array_Element; begin if Linker_Package_Id /= No_Package then - Linker_Package := In_Tree.Packages.Table (Linker_Package_Id); + Linker_Package := Data.Tree.Packages.Table (Linker_Package_Id); Switches := Value_Of (Name => Name_Switches, In_Arrays => Linker_Package.Decl.Arrays, - In_Tree => In_Tree); + In_Tree => Data.Tree); if Switches = No_Array_Element then Switches := Value_Of (Name => Name_Default_Switches, In_Arrays => Linker_Package.Decl.Arrays, - In_Tree => In_Tree); + In_Tree => Data.Tree); end if; if Switches /= No_Array_Element then Error_Msg - (Project, In_Tree, + (Data.Flags, "?Linker switches not taken into account in library " & "projects", - No_Location); + No_Location, Project); end if; end if; end; end if; - if Project.Extends /= No_Project then + if Project.Extends /= No_Project and then Project.Extends.Library then + + -- Remove the library name from Lib_Data_Table + + for J in 1 .. Lib_Data_Table.Last loop + if Lib_Data_Table.Table (J).Proj = Project.Extends then + Lib_Data_Table.Table (J) := + Lib_Data_Table.Table (Lib_Data_Table.Last); + Lib_Data_Table.Set_Last (Lib_Data_Table.Last - 1); + exit; + end if; + end loop; + Project.Extends.Library := False; end if; + + if Project.Library and then not Lib_Name.Default then + + -- Check if the same library name is used in an other library project + + for J in 1 .. Lib_Data_Table.Last loop + if Lib_Data_Table.Table (J).Name = Project.Library_Name then + Error_Msg_Name_1 := Lib_Data_Table.Table (J).Proj.Name; + Error_Msg + (Data.Flags, + "Library name cannot be the same as in project %%", + Lib_Name.Location, Project); + Project.Library := False; + exit; + end if; + end loop; + end if; + + if Project.Library then + + -- Record the library name + + Lib_Data_Table.Append + ((Name => Project.Library_Name, Proj => Project)); + end if; end Check_Library_Attributes; --------------------------------- @@ -4188,8 +4186,8 @@ package body Prj.Nmsc is --------------------------------- procedure Check_Programming_Languages - (In_Tree : Project_Tree_Ref; - Project : Project_Id) + (Project : Project_Id; + Data : in out Tree_Processing_Data) is Languages : Variable_Value := Nil_Variable_Value; Def_Lang : Variable_Value := Nil_Variable_Value; @@ -4219,29 +4217,12 @@ 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 - Lang.Config.Kind := Unit_Based; + Lang.Config.Kind := Unit_Based; Lang.Config.Dependency_Kind := ALI_File; - - if Get_Mode = Ada_Only then - - -- Create a default config for Ada (since there is no - -- configuration file to create it for us). - - -- ??? 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 ('-')), - Casing => All_Lower_Case, - Separate_Suffix => Default_Ada_Body_Suffix, - Spec_Suffix => Default_Ada_Spec_Suffix, - Body_Suffix => Default_Ada_Body_Suffix); - end if; - else Lang.Config.Kind := File_Based; end if; @@ -4252,13 +4233,10 @@ package body Prj.Nmsc is begin Project.Languages := null; Languages := - Prj.Util.Value_Of (Name_Languages, Project.Decl.Attributes, In_Tree); + Prj.Util.Value_Of (Name_Languages, Project.Decl.Attributes, Data.Tree); Def_Lang := Prj.Util.Value_Of - (Name_Default_Language, Project.Decl.Attributes, In_Tree); - - -- Shouldn't these be set to False by default, and only set to True when - -- we actually find some source file??? + (Name_Default_Language, Project.Decl.Attributes, Data.Tree); if Project.Source_Dirs /= Nil_String then @@ -4266,32 +4244,19 @@ package body Prj.Nmsc is if Languages.Default then - -- In Ada_Only mode, the default language is Ada + -- Fail if there is no default language defined - if Get_Mode = Ada_Only then - Def_Lang_Id := Name_Ada; + if Def_Lang.Default then + Error_Msg + (Data.Flags, + "no languages defined for this project", + Project.Location, Project); + Def_Lang_Id := No_Name; else - -- Fail if there is no default language defined - - if Def_Lang.Default then - if not Default_Language_Is_Ada then - Error_Msg - (Project, - In_Tree, - "no languages defined for this project", - Project.Location); - Def_Lang_Id := No_Name; - - else - Def_Lang_Id := Name_Ada; - end if; - - else - Get_Name_String (Def_Lang.Value); - To_Lower (Name_Buffer (1 .. Name_Len)); - Def_Lang_Id := Name_Find; - end if; + Get_Name_String (Def_Lang.Value); + To_Lower (Name_Buffer (1 .. Name_Len)); + Def_Lang_Id := Name_Find; end if; if Def_Lang_Id /= No_Name then @@ -4315,10 +4280,9 @@ package body Prj.Nmsc is if Project.Qualifier = Standard then Error_Msg - (Project, - In_Tree, + (Data.Flags, "a standard project must have at least one language", - Languages.Location); + Languages.Location, Project); end if; else @@ -4326,7 +4290,7 @@ package body Prj.Nmsc is -- Languages. while Current /= Nil_String loop - Element := In_Tree.String_Elements.Table (Current); + Element := Data.Tree.String_Elements.Table (Current); Get_Name_String (Element.Value); To_Lower (Name_Buffer (1 .. Name_Len)); @@ -4342,80 +4306,49 @@ package body Prj.Nmsc is end if; end Check_Programming_Languages; - ------------------- - -- Check_Project -- - ------------------- - - function Check_Project - (P : Project_Id; - Root_Project : Project_Id; - Extending : Boolean) return Boolean - is - Prj : Project_Id; - - begin - if P = Root_Project then - return True; - - elsif Extending then - Prj := Root_Project; - while Prj.Extends /= No_Project loop - if P = Prj.Extends then - return True; - end if; - - Prj := Prj.Extends; - end loop; - end if; - - return False; - end Check_Project; - ------------------------------- -- Check_Stand_Alone_Library -- ------------------------------- procedure Check_Stand_Alone_Library - (Project : Project_Id; - In_Tree : Project_Tree_Ref; - Current_Dir : String; - Extending : Boolean) + (Project : Project_Id; + Data : in out Tree_Processing_Data) is Lib_Interfaces : constant Prj.Variable_Value := Prj.Util.Value_Of (Snames.Name_Library_Interface, Project.Decl.Attributes, - In_Tree); + Data.Tree); Lib_Auto_Init : constant Prj.Variable_Value := Prj.Util.Value_Of (Snames.Name_Library_Auto_Init, Project.Decl.Attributes, - In_Tree); + Data.Tree); Lib_Src_Dir : constant Prj.Variable_Value := Prj.Util.Value_Of (Snames.Name_Library_Src_Dir, Project.Decl.Attributes, - In_Tree); + Data.Tree); Lib_Symbol_File : constant Prj.Variable_Value := Prj.Util.Value_Of (Snames.Name_Library_Symbol_File, Project.Decl.Attributes, - In_Tree); + Data.Tree); Lib_Symbol_Policy : constant Prj.Variable_Value := Prj.Util.Value_Of (Snames.Name_Library_Symbol_Policy, Project.Decl.Attributes, - In_Tree); + Data.Tree); Lib_Ref_Symbol_File : constant Prj.Variable_Value := Prj.Util.Value_Of (Snames.Name_Library_Reference_Symbol_File, Project.Decl.Attributes, - In_Tree); + Data.Tree); Auto_Init_Supported : Boolean; OK : Boolean := True; @@ -4424,12 +4357,7 @@ package body Prj.Nmsc is Iter : Source_Iterator; begin - if Get_Mode = Multi_Language then - Auto_Init_Supported := Project.Config.Auto_Init_Supported; - else - Auto_Init_Supported := - MLib.Tgt.Standalone_Library_Auto_Init_Is_Supported; - end if; + Auto_Init_Supported := Project.Config.Auto_Init_Supported; pragma Assert (Lib_Interfaces.Kind = List); @@ -4437,52 +4365,10 @@ package body Prj.Nmsc is -- Library_Interface is defined. if not Lib_Interfaces.Default then - SAL_Library : declare + declare Interfaces : String_List_Id := Lib_Interfaces.Values; Interface_ALIs : String_List_Id := Nil_String; Unit : Name_Id; - UData : Unit_Index; - - procedure Add_ALI_For (Source : File_Name_Type); - -- Add an ALI file name to the list of Interface ALIs - - ----------------- - -- Add_ALI_For -- - ----------------- - - procedure Add_ALI_For (Source : File_Name_Type) is - begin - Get_Name_String (Source); - - declare - ALI : constant String := - ALI_File_Name (Name_Buffer (1 .. Name_Len)); - ALI_Name_Id : Name_Id; - - begin - Name_Len := ALI'Length; - Name_Buffer (1 .. Name_Len) := ALI; - ALI_Name_Id := Name_Find; - - String_Element_Table.Increment_Last - (In_Tree.String_Elements); - In_Tree.String_Elements.Table - (String_Element_Table.Last - (In_Tree.String_Elements)) := - (Value => ALI_Name_Id, - Index => 0, - Display_Value => ALI_Name_Id, - Location => - In_Tree.String_Elements.Table - (Interfaces).Location, - Flag => False, - Next => Interface_ALIs); - Interface_ALIs := String_Element_Table.Last - (In_Tree.String_Elements); - end; - end Add_ALI_For; - - -- Start of processing for SAL_Library begin Project.Standalone_Library := True; @@ -4491,9 +4377,9 @@ package body Prj.Nmsc is if Interfaces = Nil_String then Error_Msg - (Project, In_Tree, + (Data.Flags, "Library_Interface cannot be an empty list", - Lib_Interfaces.Location); + Lib_Interfaces.Location, Project); end if; -- Process each unit name specified in the attribute @@ -4501,184 +4387,94 @@ package body Prj.Nmsc is while Interfaces /= Nil_String loop Get_Name_String - (In_Tree.String_Elements.Table (Interfaces).Value); + (Data.Tree.String_Elements.Table (Interfaces).Value); To_Lower (Name_Buffer (1 .. Name_Len)); if Name_Len = 0 then Error_Msg - (Project, In_Tree, + (Data.Flags, "an interface cannot be an empty string", - In_Tree.String_Elements.Table (Interfaces).Location); + Data.Tree.String_Elements.Table (Interfaces).Location, + Project); else Unit := Name_Find; Error_Msg_Name_1 := Unit; - if Get_Mode = Ada_Only then - UData := Units_Htable.Get (In_Tree.Units_HT, Unit); - - if UData = No_Unit_Index then - Error_Msg - (Project, In_Tree, - "unknown unit %%", - In_Tree.String_Elements.Table - (Interfaces).Location); - - 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 - 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, In_Tree, - "%% is a subunit; " & - "it cannot be an interface", - In_Tree. - String_Elements.Table - (Interfaces).Location); - end if; - end; - end if; - - -- 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 (Impl).File); - - else - Error_Msg - (Project, In_Tree, - "%% is not an unit of this project", - In_Tree.String_Elements.Table - (Interfaces).Location); - 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. - - Add_ALI_For - (UData.File_Names (Spec).File); - - else - Error_Msg - (Project, In_Tree, - "%% is not an unit of this project", - In_Tree.String_Elements.Table - (Interfaces).Location); - end if; - end if; - - else - -- Multi_Language mode - - Next_Proj := Project.Extends; - Iter := For_Each_Source (In_Tree, Project); + Next_Proj := Project.Extends; + Iter := For_Each_Source (Data.Tree, Project); + loop + while Prj.Element (Iter) /= No_Source + and then + (Prj.Element (Iter).Unit = null + or else Prj.Element (Iter).Unit.Name /= Unit) loop - while Prj.Element (Iter) /= No_Source - and then - (Prj.Element (Iter).Unit = null - or else Prj.Element (Iter).Unit.Name /= Unit) - loop - Next (Iter); - end loop; + Next (Iter); + end loop; - Source := Prj.Element (Iter); - exit when Source /= No_Source - or else Next_Proj = No_Project; + Source := Prj.Element (Iter); + exit when Source /= No_Source + or else Next_Proj = No_Project; - Iter := For_Each_Source (In_Tree, Next_Proj); - Next_Proj := Next_Proj.Extends; - end loop; + Iter := For_Each_Source (Data.Tree, Next_Proj); + Next_Proj := Next_Proj.Extends; + end loop; - if Source /= No_Source then - if Source.Kind = Sep then - Source := No_Source; + if Source /= No_Source then + if Source.Kind = Sep then + Source := No_Source; - elsif Source.Kind = Spec - and then Other_Part (Source) /= No_Source - then - Source := Other_Part (Source); - end if; + elsif Source.Kind = Spec + and then Other_Part (Source) /= No_Source + then + Source := Other_Part (Source); end if; + end if; - if Source /= No_Source then - if Source.Project /= Project - and then not Is_Extending (Project, Source.Project) - then - Source := No_Source; - end if; + if Source /= No_Source then + if Source.Project /= Project + and then not Is_Extending (Project, Source.Project) + then + Source := No_Source; end if; + end if; - if Source = No_Source then - Error_Msg - (Project, In_Tree, - "%% is not an unit of this project", - In_Tree.String_Elements.Table - (Interfaces).Location); - - else - if Source.Kind = Spec - and then Other_Part (Source) /= No_Source - then - Source := Other_Part (Source); - end if; + if Source = No_Source then + Error_Msg + (Data.Flags, + "%% is not a unit of this project", + Data.Tree.String_Elements.Table + (Interfaces).Location, Project); - String_Element_Table.Increment_Last - (In_Tree.String_Elements); - - In_Tree.String_Elements.Table - (String_Element_Table.Last - (In_Tree.String_Elements)) := - (Value => Name_Id (Source.Dep_Name), - Index => 0, - Display_Value => Name_Id (Source.Dep_Name), - Location => - In_Tree.String_Elements.Table - (Interfaces).Location, - Flag => False, - Next => Interface_ALIs); - - Interface_ALIs := - String_Element_Table.Last (In_Tree.String_Elements); + else + if Source.Kind = Spec + and then Other_Part (Source) /= No_Source + then + Source := Other_Part (Source); end if; + String_Element_Table.Increment_Last + (Data.Tree.String_Elements); + + 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); + + Interface_ALIs := + String_Element_Table.Last + (Data.Tree.String_Elements); end if; - end if; - Interfaces := - In_Tree.String_Elements.Table (Interfaces).Next; + Interfaces := Data.Tree.String_Elements.Table (Interfaces).Next; end loop; -- Put the list of Interface ALIs in the project data @@ -4711,20 +4507,20 @@ package body Prj.Nmsc is -- supported. Error_Msg - (Project, In_Tree, + (Data.Flags, "library auto init not supported " & "on this platform", - Lib_Auto_Init.Location); + Lib_Auto_Init.Location, Project); end if; else Error_Msg - (Project, In_Tree, + (Data.Flags, "invalid value for attribute Library_Auto_Init", - Lib_Auto_Init.Location); + Lib_Auto_Init.Location, Project); end if; end if; - end SAL_Library; + end; -- If attribute Library_Src_Dir is defined and not the empty string, -- check if the directory exist and is not the object directory or @@ -4741,10 +4537,10 @@ package body Prj.Nmsc is begin Locate_Directory (Project, - In_Tree, Dir_Id, Path => Project.Library_Src_Dir, Dir_Exists => Dir_Exists, + Data => Data, Must_Exist => False, Create => "library source copy", Location => Lib_Src_Dir.Location, @@ -4760,18 +4556,18 @@ package body Prj.Nmsc is Err_Vars.Error_Msg_File_1 := File_Name_Type (Project.Library_Src_Dir.Display_Name); Error_Msg - (Project, In_Tree, + (Data.Flags, "Directory { does not exist", - Lib_Src_Dir.Location); + Lib_Src_Dir.Location, Project); -- Report error if it is the same as the object directory elsif Project.Library_Src_Dir = Project.Object_Directory then Error_Msg - (Project, In_Tree, + (Data.Flags, "directory to copy interfaces cannot be " & "the object directory", - Lib_Src_Dir.Location); + Lib_Src_Dir.Location, Project); Project.Library_Src_Dir := No_Path_Information; else @@ -4786,18 +4582,18 @@ package body Prj.Nmsc is Src_Dirs := Project.Source_Dirs; while Src_Dirs /= Nil_String loop - Src_Dir := In_Tree.String_Elements.Table (Src_Dirs); + Src_Dir := Data.Tree.String_Elements.Table (Src_Dirs); -- Report error if it is one of the source directories if Project.Library_Src_Dir.Name = - Path_Name_Type (Src_Dir.Value) + Path_Name_Type (Src_Dir.Value) then Error_Msg - (Project, In_Tree, + (Data.Flags, "directory to copy interfaces cannot " & "be one of the source directories", - Lib_Src_Dir.Location); + Lib_Src_Dir.Location, Project); Project.Library_Src_Dir := No_Path_Information; exit; end if; @@ -4810,17 +4606,17 @@ package body Prj.Nmsc is -- It cannot be a source directory of any other -- project either. - Pid := In_Tree.Projects; + Pid := Data.Tree.Projects; Project_Loop : loop exit Project_Loop when Pid = null; Src_Dirs := Pid.Project.Source_Dirs; Dir_Loop : while Src_Dirs /= Nil_String loop Src_Dir := - In_Tree.String_Elements.Table (Src_Dirs); + Data.Tree.String_Elements.Table (Src_Dirs); -- Report error if it is one of the source - -- directories + -- directories. if Project.Library_Src_Dir.Name = Path_Name_Type (Src_Dir.Value) @@ -4829,11 +4625,11 @@ package body Prj.Nmsc is File_Name_Type (Src_Dir.Value); Error_Msg_Name_1 := Pid.Project.Name; Error_Msg - (Project, In_Tree, + (Data.Flags, "directory to copy interfaces cannot " & "be the same as source directory { of " & "project %%", - Lib_Src_Dir.Location); + Lib_Src_Dir.Location, Project); Project.Library_Src_Dir := No_Path_Information; exit Project_Loop; @@ -4868,8 +4664,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 @@ -4891,9 +4687,9 @@ package body Prj.Nmsc is else Error_Msg - (Project, In_Tree, + (Data.Flags, "illegal value for Library_Symbol_Policy", - Lib_Symbol_Policy.Location); + Lib_Symbol_Policy.Location, Project); end if; end; end if; @@ -4904,10 +4700,10 @@ package body Prj.Nmsc is if Lib_Symbol_File.Default then if Project.Symbol_Data.Symbol_Policy = Restricted then Error_Msg - (Project, In_Tree, + (Data.Flags, "Library_Symbol_File needs to be defined when " & "symbol policy is Restricted", - Lib_Symbol_Policy.Location); + Lib_Symbol_Policy.Location, Project); end if; else @@ -4920,9 +4716,9 @@ package body Prj.Nmsc is if Name_Len = 0 then Error_Msg - (Project, In_Tree, + (Data.Flags, "symbol file name cannot be an empty string", - Lib_Symbol_File.Location); + Lib_Symbol_File.Location, Project); else OK := not Is_Absolute_Path (Name_Buffer (1 .. Name_Len)); @@ -4941,10 +4737,10 @@ package body Prj.Nmsc is if not OK then Error_Msg_File_1 := File_Name_Type (Lib_Symbol_File.Value); Error_Msg - (Project, In_Tree, + (Data.Flags, "symbol file name { is illegal. " & "Name cannot include directory info.", - Lib_Symbol_File.Location); + Lib_Symbol_File.Location, Project); end if; end if; end if; @@ -4957,9 +4753,9 @@ package body Prj.Nmsc is or else Project.Symbol_Data.Symbol_Policy = Controlled then Error_Msg - (Project, In_Tree, + (Data.Flags, "a reference symbol file needs to be defined", - Lib_Symbol_Policy.Location); + Lib_Symbol_Policy.Location, Project); end if; else @@ -4972,23 +4768,22 @@ package body Prj.Nmsc is if Name_Len = 0 then Error_Msg - (Project, In_Tree, + (Data.Flags, "reference symbol file name cannot be an empty string", - Lib_Symbol_File.Location); + Lib_Symbol_File.Location, Project); else if not Is_Absolute_Path (Name_Buffer (1 .. Name_Len)) then Name_Len := 0; Add_Str_To_Name_Buffer (Get_Name_String (Project.Directory.Name)); - Add_Char_To_Name_Buffer (Directory_Separator); Add_Str_To_Name_Buffer (Get_Name_String (Lib_Ref_Symbol_File.Value)); Project.Symbol_Data.Reference := Name_Find; 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); @@ -5002,9 +4797,9 @@ package body Prj.Nmsc is and then Project.Symbol_Data.Symbol_Policy /= Direct; Error_Msg - (Project, In_Tree, + (Data.Flags, " 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) & - Directory_Separator & 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 if Symb_Path = Ref_Path then Error_Msg - (Project, In_Tree, + (Data.Flags, "library reference symbol file and library" & " symbol file cannot be the same file", - Lib_Ref_Symbol_File.Location); + Lib_Ref_Symbol_File.Location, Project); end if; end; end if; @@ -5066,7 +4864,8 @@ package body Prj.Nmsc is begin if Dir'Length > 1 and then (Dir (Dir'Last - 1) = Directory_Separator - or else Dir (Dir'Last - 1) = '/') + or else + Dir (Dir'Last - 1) = '/') then return Dir'Last - 1; else @@ -5074,650 +4873,197 @@ package body Prj.Nmsc is end if; end Compute_Directory_Last; - --------------- - -- Error_Msg -- - --------------- + --------------------- + -- Get_Directories -- + --------------------- - procedure Error_Msg - (Project : Project_Id; - In_Tree : Project_Tree_Ref; - Msg : String; - Flag_Location : Source_Ptr) + procedure Get_Directories + (Project : Project_Id; + Data : in out Tree_Processing_Data) is - Real_Location : Source_Ptr := Flag_Location; - Error_Buffer : String (1 .. 5_000); - Error_Last : Natural := 0; - Name_Number : Natural := 0; - File_Number : Natural := 0; - First : Positive := Msg'First; - Index : Positive; + Object_Dir : constant Variable_Value := + Util.Value_Of + (Name_Object_Dir, Project.Decl.Attributes, Data.Tree); - procedure Add (C : Character); - -- Add a character to the buffer + Exec_Dir : constant Variable_Value := + Util.Value_Of + (Name_Exec_Dir, Project.Decl.Attributes, Data.Tree); - procedure Add (S : String); - -- Add a string to the buffer + Source_Dirs : constant Variable_Value := + Util.Value_Of + (Name_Source_Dirs, Project.Decl.Attributes, Data.Tree); - procedure Add_Name; - -- Add a name to the buffer + Excluded_Source_Dirs : constant Variable_Value := + Util.Value_Of + (Name_Excluded_Source_Dirs, + Project.Decl.Attributes, + Data.Tree); - procedure Add_File; - -- Add a file name to the buffer + Source_Files : constant Variable_Value := + Util.Value_Of + (Name_Source_Files, + Project.Decl.Attributes, Data.Tree); - --------- - -- Add -- - --------- + Last_Source_Dir : String_List_Id := Nil_String; + Last_Src_Dir_Rank : Number_List_Index := No_Number_List; - procedure Add (C : Character) is - begin - Error_Last := Error_Last + 1; - Error_Buffer (Error_Last) := C; - end Add; + Languages : constant Variable_Value := + Prj.Util.Value_Of + (Name_Languages, Project.Decl.Attributes, Data.Tree); - procedure Add (S : String) is - begin - Error_Buffer (Error_Last + 1 .. Error_Last + S'Length) := S; - Error_Last := Error_Last + S'Length; - end Add; + Remove_Source_Dirs : Boolean := False; - -------------- - -- Add_File -- - -------------- + procedure Add_To_Or_Remove_From_Source_Dirs + (Path_Id : Path_Name_Type; + Display_Path_Id : Path_Name_Type; + Rank : Natural); + -- When Removed = False, the directory Path_Id to the list of + -- source_dirs if not already in the list. When Removed = True, + -- removed directory Path_Id if in the list. - procedure Add_File is - File : File_Name_Type; + procedure Find_Source_Dirs is new Expand_Subdirectory_Pattern + (Add_To_Or_Remove_From_Source_Dirs); - begin - Add ('"'); - File_Number := File_Number + 1; - - case File_Number is - when 1 => - File := Err_Vars.Error_Msg_File_1; - when 2 => - File := Err_Vars.Error_Msg_File_2; - when 3 => - File := Err_Vars.Error_Msg_File_3; - when others => - null; - end case; + --------------------------------------- + -- Add_To_Or_Remove_From_Source_Dirs -- + --------------------------------------- - Get_Name_String (File); - Add (Name_Buffer (1 .. Name_Len)); - Add ('"'); - end Add_File; + procedure Add_To_Or_Remove_From_Source_Dirs + (Path_Id : Path_Name_Type; + Display_Path_Id : Path_Name_Type; + Rank : Natural) + is + List : String_List_Id; + Prev : String_List_Id; + Rank_List : Number_List_Index; + Prev_Rank : Number_List_Index; + Element : String_Element; - -------------- - -- Add_Name -- - -------------- + begin + Prev := Nil_String; + Prev_Rank := No_Number_List; + List := Project.Source_Dirs; + Rank_List := Project.Source_Dir_Ranks; + while List /= Nil_String loop + Element := Data.Tree.String_Elements.Table (List); + exit when Element.Value = Name_Id (Path_Id); + Prev := List; + List := Element.Next; + Prev_Rank := Rank_List; + Rank_List := Data.Tree.Number_Lists.Table (Prev_Rank).Next; + end loop; - procedure Add_Name is - Name : Name_Id; + -- The directory is in the list if List is not Nil_String - begin - Add ('"'); - Name_Number := Name_Number + 1; - - case Name_Number is - when 1 => - Name := Err_Vars.Error_Msg_Name_1; - when 2 => - Name := Err_Vars.Error_Msg_Name_2; - when 3 => - Name := Err_Vars.Error_Msg_Name_3; - when others => - null; - end case; + if not Remove_Source_Dirs and then List = Nil_String then + if Current_Verbosity = High then + Write_Str (" Adding Source Dir="); + Write_Line (Get_Name_String (Display_Path_Id)); + end if; - Get_Name_String (Name); - Add (Name_Buffer (1 .. Name_Len)); - Add ('"'); - end Add_Name; + String_Element_Table.Increment_Last (Data.Tree.String_Elements); + Element := + (Value => Name_Id (Path_Id), + Index => 0, + Display_Value => Name_Id (Display_Path_Id), + Location => No_Location, + Flag => False, + Next => Nil_String); - -- Start of processing for Error_Msg + Number_List_Table.Increment_Last (Data.Tree.Number_Lists); - begin - -- If location of error is unknown, use the location of the project + if Last_Source_Dir = Nil_String then - if Real_Location = No_Location then - Real_Location := Project.Location; - end if; + -- This is the first source directory - if Error_Report = null then - Prj.Err.Error_Msg (Msg, Real_Location); - return; - end if; + Project.Source_Dirs := + String_Element_Table.Last (Data.Tree.String_Elements); + Project.Source_Dir_Ranks := + Number_List_Table.Last (Data.Tree.Number_Lists); - -- Ignore continuation character + else + -- We already have source directories, link the previous + -- last to the new one. - if Msg (First) = '\' then - First := First + 1; - end if; + Data.Tree.String_Elements.Table (Last_Source_Dir).Next := + String_Element_Table.Last (Data.Tree.String_Elements); + Data.Tree.Number_Lists.Table (Last_Src_Dir_Rank).Next := + Number_List_Table.Last (Data.Tree.Number_Lists); + end if; - -- Warning character is always the first one in this package - -- this is an undocumented kludge??? + -- And register this source directory as the new last - if Msg (First) = '?' then - First := First + 1; - Add ("Warning: "); + Last_Source_Dir := + String_Element_Table.Last (Data.Tree.String_Elements); + Data.Tree.String_Elements.Table (Last_Source_Dir) := Element; + Last_Src_Dir_Rank := + Number_List_Table.Last (Data.Tree.Number_Lists); + Data.Tree.Number_Lists.Table (Last_Src_Dir_Rank) := + (Number => Rank, Next => No_Number_List); - elsif Msg (First) = '<' then - First := First + 1; + elsif Remove_Source_Dirs and then List /= Nil_String then - if Err_Vars.Error_Msg_Warn then - Add ("Warning: "); - end if; - end if; + -- Remove source dir, if present - Index := First; - while Index <= Msg'Last loop - if Msg (Index) = '{' then - Add_File; + if Prev = Nil_String then + Project.Source_Dirs := + Data.Tree.String_Elements.Table (List).Next; + Project.Source_Dir_Ranks := + Data.Tree.Number_Lists.Table (Rank_List).Next; - elsif Msg (Index) = '%' then - if Index < Msg'Last and then Msg (Index + 1) = '%' then - Index := Index + 1; + else + Data.Tree.String_Elements.Table (Prev).Next := + Data.Tree.String_Elements.Table (List).Next; + Data.Tree.Number_Lists.Table (Prev_Rank).Next := + Data.Tree.Number_Lists.Table (Rank_List).Next; end if; - - Add_Name; - else - Add (Msg (Index)); end if; - Index := Index + 1; + end Add_To_Or_Remove_From_Source_Dirs; - end loop; + -- Local declarations + + Dir_Exists : Boolean; - Error_Report (Error_Buffer (1 .. Error_Last), Project, In_Tree); - end Error_Msg; + No_Sources : constant Boolean := + ((not Source_Files.Default + and then Source_Files.Values = Nil_String) + or else + (not Source_Dirs.Default + and then Source_Dirs.Values = Nil_String) + or else + (not Languages.Default + and then Languages.Values = Nil_String)) + and then Project.Extends = No_Project; - -------------------------------- - -- Free_Ada_Naming_Exceptions -- - -------------------------------- + -- Start of processing for Get_Directories - procedure Free_Ada_Naming_Exceptions is begin - Ada_Naming_Exception_Table.Set_Last (0); - Ada_Naming_Exceptions.Reset; - Reverse_Ada_Naming_Exceptions.Reset; - end Free_Ada_Naming_Exceptions; + if Current_Verbosity = High then + Write_Line ("Starting to look for directories"); + end if; - --------------------- - -- Get_Directories -- - --------------------- + -- Set the object directory to its default which may be nil, if there + -- is no sources in the project. - procedure Get_Directories - (Project : Project_Id; - In_Tree : Project_Tree_Ref; - Current_Dir : String) - is - Object_Dir : constant Variable_Value := - Util.Value_Of - (Name_Object_Dir, Project.Decl.Attributes, In_Tree); + if No_Sources then + Project.Object_Directory := No_Path_Information; + else + Project.Object_Directory := Project.Directory; + end if; - Exec_Dir : constant Variable_Value := - Util.Value_Of - (Name_Exec_Dir, Project.Decl.Attributes, In_Tree); - - Source_Dirs : constant Variable_Value := - Util.Value_Of - (Name_Source_Dirs, Project.Decl.Attributes, In_Tree); - - Excluded_Source_Dirs : constant Variable_Value := - Util.Value_Of - (Name_Excluded_Source_Dirs, - Project.Decl.Attributes, - In_Tree); - - Source_Files : constant Variable_Value := - Util.Value_Of - (Name_Source_Files, Project.Decl.Attributes, In_Tree); - - Last_Source_Dir : String_List_Id := Nil_String; - - Languages : constant Variable_Value := - Prj.Util.Value_Of - (Name_Languages, Project.Decl.Attributes, In_Tree); - - procedure Find_Source_Dirs - (From : File_Name_Type; - Location : Source_Ptr; - Removed : Boolean := False); - -- Find one or several source directories, and add (or remove, if - -- Removed is True) them to list of source directories of the project. - - ---------------------- - -- Find_Source_Dirs -- - ---------------------- - - procedure Find_Source_Dirs - (From : File_Name_Type; - Location : Source_Ptr; - Removed : Boolean := False) - is - Directory : constant String := Get_Name_String (From); - Element : String_Element; - - procedure Recursive_Find_Dirs (Path : Name_Id); - -- Find all the subdirectories (recursively) of Path and add them - -- to the list of source directories of the project. - - ------------------------- - -- Recursive_Find_Dirs -- - ------------------------- - - procedure Recursive_Find_Dirs (Path : Name_Id) is - Dir : Dir_Type; - Name : String (1 .. 250); - Last : Natural; - List : String_List_Id; - Prev : String_List_Id; - Element : String_Element; - Found : Boolean := False; - - Non_Canonical_Path : Name_Id := No_Name; - Canonical_Path : Name_Id := No_Name; - - The_Path : constant String := - Normalize_Pathname - (Get_Name_String (Path), - Directory => Current_Dir, - Resolve_Links => Opt.Follow_Links_For_Dirs) & - Directory_Separator; - - The_Path_Last : constant Natural := - Compute_Directory_Last (The_Path); - - begin - Name_Len := The_Path_Last - The_Path'First + 1; - Name_Buffer (1 .. Name_Len) := - The_Path (The_Path'First .. The_Path_Last); - Non_Canonical_Path := Name_Find; - Canonical_Path := - Name_Id (Canonical_Case_File_Name (Non_Canonical_Path)); - - -- To avoid processing the same directory several times, check - -- if the directory is already in Recursive_Dirs. If it is, then - -- there is nothing to do, just return. If it is not, put it there - -- and continue recursive processing. - - if not Removed then - if Recursive_Dirs.Get (Canonical_Path) then - return; - else - Recursive_Dirs.Set (Canonical_Path, True); - end if; - end if; - - -- Check if directory is already in list - - List := Project.Source_Dirs; - Prev := Nil_String; - while List /= Nil_String loop - Element := In_Tree.String_Elements.Table (List); - - if Element.Value /= No_Name then - Found := Element.Value = Canonical_Path; - exit when Found; - end if; - - Prev := List; - List := Element.Next; - end loop; - - -- If directory is not already in list, put it there - - if (not Removed) and (not Found) then - if Current_Verbosity = High then - Write_Str (" "); - Write_Line (The_Path (The_Path'First .. The_Path_Last)); - end if; - - String_Element_Table.Increment_Last (In_Tree.String_Elements); - Element := - (Value => Canonical_Path, - Display_Value => Non_Canonical_Path, - Location => No_Location, - Flag => False, - Next => Nil_String, - Index => 0); - - -- Case of first source directory - - if Last_Source_Dir = Nil_String then - Project.Source_Dirs := - String_Element_Table.Last (In_Tree.String_Elements); - - -- Here we already have source directories - - else - -- Link the previous last to the new one - - In_Tree.String_Elements.Table - (Last_Source_Dir).Next := - String_Element_Table.Last (In_Tree.String_Elements); - end if; - - -- And register this source directory as the new last - - Last_Source_Dir := - String_Element_Table.Last (In_Tree.String_Elements); - In_Tree.String_Elements.Table (Last_Source_Dir) := Element; - - elsif Removed and Found then - if Prev = Nil_String then - Project.Source_Dirs := - In_Tree.String_Elements.Table (List).Next; - else - In_Tree.String_Elements.Table (Prev).Next := - In_Tree.String_Elements.Table (List).Next; - end if; - end if; - - -- Now look for subdirectories. We do that even when this - -- directory is already in the list, because some of its - -- subdirectories may not be in the list yet. - - Open (Dir, The_Path (The_Path'First .. The_Path_Last)); - - loop - Read (Dir, Name, Last); - exit when Last = 0; - - if Name (1 .. Last) /= "." - and then Name (1 .. Last) /= ".." - then - -- Avoid . and .. directories - - if Current_Verbosity = High then - Write_Str (" Checking "); - Write_Line (Name (1 .. Last)); - end if; - - declare - Path_Name : constant String := - Normalize_Pathname - (Name => Name (1 .. Last), - Directory => - The_Path (The_Path'First .. The_Path_Last), - Resolve_Links => Opt.Follow_Links_For_Dirs, - Case_Sensitive => True); - - begin - if Is_Directory (Path_Name) then - -- We have found a new subdirectory, call self - - Name_Len := Path_Name'Length; - Name_Buffer (1 .. Name_Len) := Path_Name; - Recursive_Find_Dirs (Name_Find); - end if; - end; - end if; - end loop; - - Close (Dir); - - exception - when Directory_Error => - null; - end Recursive_Find_Dirs; - - -- Start of processing for Find_Source_Dirs - - begin - if Current_Verbosity = High and then not Removed then - Write_Str ("Find_Source_Dirs ("""); - Write_Str (Directory); - Write_Line (""")"); - end if; - - -- First, check if we are looking for a directory tree, indicated - -- by "/**" at the end. - - if Directory'Length >= 3 - and then Directory (Directory'Last - 1 .. Directory'Last) = "**" - and then (Directory (Directory'Last - 2) = '/' - or else - Directory (Directory'Last - 2) = Directory_Separator) - then - if not Removed then - Project.Known_Order_Of_Source_Dirs := False; - end if; - - Name_Len := Directory'Length - 3; - - if Name_Len = 0 then - - -- Case of "/**": all directories in file system - - Name_Len := 1; - Name_Buffer (1) := Directory (Directory'First); - - else - Name_Buffer (1 .. Name_Len) := - Directory (Directory'First .. Directory'Last - 3); - end if; - - if Current_Verbosity = High then - Write_Str ("Looking for all subdirectories of """); - Write_Str (Name_Buffer (1 .. Name_Len)); - Write_Line (""""); - end if; - - declare - Base_Dir : constant File_Name_Type := Name_Find; - Root_Dir : constant String := - Normalize_Pathname - (Name => Get_Name_String (Base_Dir), - Directory => - Get_Name_String - (Project.Directory.Display_Name), - Resolve_Links => False, - Case_Sensitive => True); - - begin - if Root_Dir'Length = 0 then - Err_Vars.Error_Msg_File_1 := Base_Dir; - - if Location = No_Location then - Error_Msg - (Project, In_Tree, - "{ is not a valid directory.", - Project.Location); - else - Error_Msg - (Project, In_Tree, - "{ is not a valid directory.", - Location); - end if; - - else - -- We have an existing directory, we register it and all of - -- its subdirectories. - - if Current_Verbosity = High then - Write_Line ("Looking for source directories:"); - end if; - - Name_Len := Root_Dir'Length; - Name_Buffer (1 .. Name_Len) := Root_Dir; - Recursive_Find_Dirs (Name_Find); - - if Current_Verbosity = High then - Write_Line ("End of looking for source directories."); - end if; - end if; - end; - - -- We have a single directory - - else - declare - Path_Name : Path_Information; - List : String_List_Id; - Prev : String_List_Id; - Dir_Exists : Boolean; - - begin - Locate_Directory - (Project => Project, - In_Tree => In_Tree, - Name => From, - Path => Path_Name, - Dir_Exists => Dir_Exists, - Must_Exist => False); - - if not Dir_Exists then - Err_Vars.Error_Msg_File_1 := From; - - if Location = No_Location then - Error_Msg - (Project, In_Tree, - "{ is not a valid directory", - Project.Location); - else - Error_Msg - (Project, In_Tree, - "{ is not a valid directory", - Location); - end if; - - else - declare - Path : constant String := - Get_Name_String (Path_Name.Name) & - Directory_Separator; - Last_Path : constant Natural := - Compute_Directory_Last (Path); - Path_Id : Name_Id; - Display_Path : constant String := - Get_Name_String - (Path_Name.Display_Name) & - Directory_Separator; - Last_Display_Path : constant Natural := - Compute_Directory_Last - (Display_Path); - Display_Path_Id : Name_Id; - - begin - Name_Len := 0; - Add_Str_To_Name_Buffer (Path (Path'First .. Last_Path)); - Path_Id := Name_Find; - Name_Len := 0; - Add_Str_To_Name_Buffer - (Display_Path - (Display_Path'First .. Last_Display_Path)); - Display_Path_Id := Name_Find; - - if not Removed then - - -- As it is an existing directory, we add it to the - -- list of directories. - - String_Element_Table.Increment_Last - (In_Tree.String_Elements); - Element := - (Value => Path_Id, - Index => 0, - Display_Value => Display_Path_Id, - Location => No_Location, - Flag => False, - Next => Nil_String); - - if Last_Source_Dir = Nil_String then - - -- This is the first source directory - - Project.Source_Dirs := String_Element_Table.Last - (In_Tree.String_Elements); - - else - -- We already have source directories, link the - -- previous last to the new one. - - In_Tree.String_Elements.Table - (Last_Source_Dir).Next := - String_Element_Table.Last - (In_Tree.String_Elements); - end if; - - -- And register this source directory as the new last - - Last_Source_Dir := String_Element_Table.Last - (In_Tree.String_Elements); - In_Tree.String_Elements.Table - (Last_Source_Dir) := Element; - - else - -- Remove source dir, if present - - Prev := Nil_String; - - -- Look for source dir in current list - - List := Project.Source_Dirs; - while List /= Nil_String loop - Element := In_Tree.String_Elements.Table (List); - exit when Element.Value = Path_Id; - Prev := List; - List := Element.Next; - end loop; - - if List /= Nil_String then - -- Source dir was found, remove it from the list - - if Prev = Nil_String then - Project.Source_Dirs := - In_Tree.String_Elements.Table (List).Next; - - else - In_Tree.String_Elements.Table (Prev).Next := - In_Tree.String_Elements.Table (List).Next; - end if; - end if; - end if; - end; - end if; - end; - end if; - end Find_Source_Dirs; - - -- Start of processing for Get_Directories - - Dir_Exists : Boolean; - - begin - if Current_Verbosity = High then - Write_Line ("Starting to look for directories"); - end if; - - -- Set the object directory to its default which may be nil, if there - -- is no sources in the project. - - if (((not Source_Files.Default) - and then Source_Files.Values = Nil_String) - or else - ((not Source_Dirs.Default) and then Source_Dirs.Values = Nil_String) - or else - ((not Languages.Default) and then Languages.Values = Nil_String)) - and then Project.Extends = No_Project - then - Project.Object_Directory := No_Path_Information; - else - Project.Object_Directory := Project.Directory; - end if; - - -- Check the object directory + -- Check the object directory if Object_Dir.Value /= Empty_String then Get_Name_String (Object_Dir.Value); if Name_Len = 0 then Error_Msg - (Project, In_Tree, + (Data.Flags, "Object_Dir cannot be empty", - Object_Dir.Location); + Object_Dir.Location, Project); + + elsif not No_Sources then - else -- We check that the specified object directory does exist. -- However, even when it doesn't exist, we set it to a default -- value. This is for the benefit of tools that recover from @@ -5726,11 +5072,11 @@ package body Prj.Nmsc is Locate_Directory (Project, - In_Tree, File_Name_Type (Object_Dir.Value), Path => Project.Object_Directory, Create => "object", Dir_Exists => Dir_Exists, + Data => Data, Location => Object_Dir.Location, Must_Exist => False, Externally_Built => Project.Externally_Built); @@ -5738,30 +5084,27 @@ package body Prj.Nmsc is if not Dir_Exists and then not Project.Externally_Built then - -- The object directory does not exist, report an error if - -- the project is not externally built. + -- The object directory does not exist, report an error if the + -- project is not externally built. Err_Vars.Error_Msg_File_1 := File_Name_Type (Object_Dir.Value); - Error_Msg - (Project, In_Tree, - "object directory { not found", - Project.Location); + Error_Or_Warning + (Data.Flags, Data.Flags.Require_Obj_Dirs, + "object directory { not found", Project.Location, Project); end if; end if; - elsif Project.Object_Directory /= No_Path_Information - and then Subdirs /= null - then + elsif not No_Sources and then Subdirs /= null then Name_Len := 1; Name_Buffer (1) := '.'; Locate_Directory (Project, - In_Tree, Name_Find, Path => Project.Object_Directory, Create => "object", Dir_Exists => Dir_Exists, + Data => Data, Location => Object_Dir.Location, Externally_Built => Project.Externally_Built); end if; @@ -5787,29 +5130,29 @@ package body Prj.Nmsc is if Name_Len = 0 then Error_Msg - (Project, In_Tree, + (Data.Flags, "Exec_Dir cannot be empty", - Exec_Dir.Location); + Exec_Dir.Location, Project); + + elsif not No_Sources then - else -- We check that the specified exec directory does exist Locate_Directory (Project, - In_Tree, File_Name_Type (Exec_Dir.Value), Path => Project.Exec_Directory, Dir_Exists => Dir_Exists, + Data => Data, Create => "exec", Location => Exec_Dir.Location, Externally_Built => Project.Externally_Built); if not Dir_Exists then Err_Vars.Error_Msg_File_1 := File_Name_Type (Exec_Dir.Value); - Error_Msg - (Project, In_Tree, - "exec directory { not found", - Project.Location); + Error_Or_Warning + (Data.Flags, Data.Flags.Missing_Source_Files, + "exec directory { not found", Project.Location, Project); end if; end if; end if; @@ -5832,89 +5175,57 @@ package body Prj.Nmsc is pragma Assert (Source_Dirs.Kind = List, "Source_Dirs is not a list"); - if (not Source_Files.Default) + if not Source_Files.Default and then Source_Files.Values = Nil_String then Project.Source_Dirs := Nil_String; if Project.Qualifier = Standard then Error_Msg - (Project, - In_Tree, + (Data.Flags, "a standard project cannot have no sources", - Source_Files.Location); + Source_Files.Location, Project); end if; elsif Source_Dirs.Default then - -- No Source_Dirs specified: the single source directory is the one -- containing the project file. - String_Element_Table.Append (In_Tree.String_Elements, - (Value => Name_Id (Project.Directory.Name), - Display_Value => Name_Id (Project.Directory.Display_Name), - Location => No_Location, - Flag => False, - Next => Nil_String, - Index => 0)); - Project.Source_Dirs := - String_Element_Table.Last (In_Tree.String_Elements); + Remove_Source_Dirs := False; + Add_To_Or_Remove_From_Source_Dirs + (Path_Id => Project.Directory.Name, + Display_Path_Id => Project.Directory.Display_Name, + Rank => 1); - if Current_Verbosity = High then - Write_Attr - ("Default source directory", - Get_Name_String (Project.Directory.Display_Name)); - end if; - - elsif Source_Dirs.Values = Nil_String then - if Project.Qualifier = Standard then + else + Remove_Source_Dirs := False; + Find_Source_Dirs + (Project => Project, + Data => Data, + Patterns => Source_Dirs.Values, + Search_For => Search_Directories, + Resolve_Links => Opt.Follow_Links_For_Dirs); + + if Project.Source_Dirs = Nil_String + and then Project.Qualifier = Standard + then Error_Msg - (Project, - In_Tree, + (Data.Flags, "a standard project cannot have no source directories", - Source_Dirs.Location); + Source_Dirs.Location, Project); end if; - - Project.Source_Dirs := Nil_String; - - else - declare - Source_Dir : String_List_Id; - Element : String_Element; - - begin - -- Process the source directories for each element of the list - - Source_Dir := Source_Dirs.Values; - while Source_Dir /= Nil_String loop - Element := In_Tree.String_Elements.Table (Source_Dir); - Find_Source_Dirs - (File_Name_Type (Element.Value), Element.Location); - Source_Dir := Element.Next; - end loop; - end; end if; if not Excluded_Source_Dirs.Default and then Excluded_Source_Dirs.Values /= Nil_String then - declare - Source_Dir : String_List_Id; - Element : String_Element; - - begin - -- Process the source directories for each element of the list - - Source_Dir := Excluded_Source_Dirs.Values; - while Source_Dir /= Nil_String loop - Element := In_Tree.String_Elements.Table (Source_Dir); - Find_Source_Dirs - (File_Name_Type (Element.Value), - Element.Location, - Removed => True); - Source_Dir := Element.Next; - end loop; - end; + Remove_Source_Dirs := True; + Find_Source_Dirs + (Project => Project, + Data => Data, + Patterns => Excluded_Source_Dirs.Values, + Search_For => Search_Directories, + Resolve_Links => Opt.Follow_Links_For_Dirs); end if; if Current_Verbosity = High then @@ -5927,11 +5238,11 @@ package body Prj.Nmsc is begin while Current /= Nil_String loop - Element := In_Tree.String_Elements.Table (Current); + Element := Data.Tree.String_Elements.Table (Current); if Element.Value /= No_Name then Element.Value := - Name_Id (Canonical_Case_File_Name (Name_Id (Element.Value))); - In_Tree.String_Elements.Table (Current) := Element; + Name_Id (Canonical_Case_File_Name (Element.Value)); + Data.Tree.String_Elements.Table (Current) := Element; end if; Current := Element.Next; @@ -5945,10 +5256,11 @@ package body Prj.Nmsc is procedure Get_Mains (Project : Project_Id; - In_Tree : Project_Tree_Ref) + Data : in out Tree_Processing_Data) is Mains : constant Variable_Value := - Prj.Util.Value_Of (Name_Main, Project.Decl.Attributes, In_Tree); + Prj.Util.Value_Of + (Name_Main, Project.Decl.Attributes, Data.Tree); List : String_List_Id; Elem : String_Element; @@ -5967,20 +5279,20 @@ package body Prj.Nmsc is elsif Project.Library then Error_Msg - (Project, In_Tree, + (Data.Flags, "a library project file cannot have Main specified", - Mains.Location); + Mains.Location, Project); else List := Mains.Values; while List /= Nil_String loop - Elem := In_Tree.String_Elements.Table (List); + Elem := Data.Tree.String_Elements.Table (List); if Length_Of_Name (Elem.Value) = 0 then Error_Msg - (Project, In_Tree, + (Data.Flags, "?a main cannot have an empty name", - Elem.Location); + Elem.Location, Project); exit; end if; @@ -5996,8 +5308,8 @@ package body Prj.Nmsc is procedure Get_Sources_From_File (Path : String; Location : Source_Ptr; - Project : Project_Id; - In_Tree : Project_Tree_Ref) + Project : in out Project_Processing_Data; + Data : in out Tree_Processing_Data) is File : Prj.Util.Text_File; Line : String (1 .. 250); @@ -6006,10 +5318,6 @@ package body Prj.Nmsc is Name_Loc : Name_Location; begin - if Get_Mode = Ada_Only then - Source_Names.Reset; - end if; - if Current_Verbosity = High then Write_Str ("Opening """); Write_Str (Path); @@ -6021,7 +5329,8 @@ package body Prj.Nmsc is Prj.Util.Open (File, Path); if not Prj.Util.Is_Valid (File) then - Error_Msg (Project, In_Tree, "file does not exist", Location); + Error_Msg + (Data.Flags, "file does not exist", Location, Project.Project); else -- Read the lines one by one @@ -6045,26 +5354,30 @@ package body Prj.Nmsc is if Line (J) = '/' or else Line (J) = Directory_Separator then Error_Msg_File_1 := Source_Name; Error_Msg - (Project, - In_Tree, + (Data.Flags, "file name cannot include directory information ({)", - Location); + Location, Project.Project); exit; end if; end loop; - Name_Loc := Source_Names.Get (Source_Name); + Name_Loc := Source_Names_Htable.Get + (Project.Source_Names, Source_Name); if Name_Loc = No_Name_Location then Name_Loc := (Name => Source_Name, Location => Location, Source => No_Source, - Except => False, + Listed => True, Found => False); + + else + Name_Loc.Listed := True; end if; - Source_Names.Set (Source_Name, Name_Loc); + Source_Names_Htable.Set + (Project.Source_Names, Source_Name, Name_Loc); end if; end loop; @@ -6082,21 +5395,14 @@ package body Prj.Nmsc is Naming : Lang_Naming_Data; Kind : out Source_Kind; Unit : out Name_Id; + Project : Project_Processing_Data; In_Tree : Project_Tree_Ref) is Filename : constant String := Get_Name_String (File_Name); Last : Integer := Filename'Last; - Sep_Len : constant Integer := - Integer (Length_Of_Name (Naming.Separate_Suffix)); - Body_Len : constant Integer := - Integer (Length_Of_Name (Naming.Body_Suffix)); - Spec_Len : constant Integer := - Integer (Length_Of_Name (Naming.Spec_Suffix)); - - Standard_GNAT : constant Boolean := - Naming.Spec_Suffix = Default_Ada_Spec_Suffix - and then - Naming.Body_Suffix = Default_Ada_Body_Suffix; + Sep_Len : Integer; + Body_Len : Integer; + Spec_Len : Integer; Unit_Except : Unit_Exception; Masked : Boolean := False; @@ -6105,6 +5411,13 @@ package body Prj.Nmsc is Unit := No_Name; Kind := Spec; + if Naming.Separate_Suffix = No_File + or else Naming.Body_Suffix = No_File + or else Naming.Spec_Suffix = No_File + then + return; + end if; + if Naming.Dot_Replacement = No_File then if Current_Verbosity = High then Write_Line (" No dot_replacement specified"); @@ -6113,6 +5426,10 @@ package body Prj.Nmsc is return; end if; + Sep_Len := Integer (Length_Of_Name (Naming.Separate_Suffix)); + Spec_Len := Integer (Length_Of_Name (Naming.Spec_Suffix)); + Body_Len := Integer (Length_Of_Name (Naming.Body_Suffix)); + -- Choose the longest suffix that matches. If there are several matches, -- give priority to specs, then bodies, then separates. @@ -6139,7 +5456,7 @@ package body Prj.Nmsc is if Last = Filename'Last then if Current_Verbosity = High then - Write_Line (" No matching suffix"); + Write_Line (" no matching suffix"); end if; return; @@ -6214,7 +5531,9 @@ package body Prj.Nmsc is -- In the standard GNAT naming scheme, check for special cases: children -- or separates of A, G, I or S, and run time sources. - if Standard_GNAT and then Name_Len >= 3 then + if Is_Standard_GNAT_Naming (Naming) + and then Name_Len >= 3 + then declare S1 : constant Character := Name_Buffer (1); S2 : constant Character := Name_Buffer (2); @@ -6243,10 +5562,9 @@ package body Prj.Nmsc is elsif S2 = '.' then - -- If it is potentially a run time source, disable filling - -- of the mapping file to avoid warnings. + -- If it is potentially a run time source - Set_Mapping_File_Initial_State_To_Empty (In_Tree); + null; end if; end if; end; @@ -6258,11 +5576,11 @@ package body Prj.Nmsc is Check_Ada_Name (Name_Buffer (1 .. Name_Len), Unit); -- If there is a naming exception for the same unit, the file is not - -- a source for the unit. Currently, this only applies in multi_lang - -- mode, since Unit_Exceptions is no set in ada_only mode. + -- a source for the unit. if Unit /= No_Name then - Unit_Except := Unit_Exceptions.Get (Unit); + Unit_Except := + Unit_Exceptions_Htable.Get (Project.Unit_Exceptions, Unit); if Kind = Spec then Masked := Unit_Except.Spec /= No_File @@ -6306,114 +5624,64 @@ package body Prj.Nmsc is end if; end Compute_Unit_Name; - -------------- - -- Get_Unit -- - -------------- + -------------------------- + -- Check_Illegal_Suffix -- + -------------------------- - procedure Get_Unit - (In_Tree : Project_Tree_Ref; - Canonical_File_Name : File_Name_Type; - Project : Project_Id; - Exception_Id : out Ada_Naming_Exception_Id; - Unit_Name : out Name_Id; - Unit_Kind : out Spec_Or_Body) + procedure Check_Illegal_Suffix + (Project : Project_Id; + Suffix : File_Name_Type; + Dot_Replacement : File_Name_Type; + Attribute_Name : String; + Location : Source_Ptr; + Data : in out Tree_Processing_Data) is - Info_Id : Ada_Naming_Exception_Id := - Ada_Naming_Exceptions.Get (Canonical_File_Name); - VMS_Name : File_Name_Type; - Kind : Source_Kind; - Lang : Language_Ptr; + Suffix_Str : constant String := Get_Name_String (Suffix); begin - if Info_Id = No_Ada_Naming_Exception - and then Hostparm.OpenVMS - then - VMS_Name := Canonical_File_Name; - Get_Name_String (VMS_Name); + if Suffix_Str'Length = 0 then - if Name_Buffer (Name_Len) = '.' then - Name_Len := Name_Len - 1; - VMS_Name := Name_Find; - end if; + -- Always valid + + return; - Info_Id := Ada_Naming_Exceptions.Get (VMS_Name); + elsif Index (Suffix_Str, ".") = 0 then + Err_Vars.Error_Msg_File_1 := Suffix; + Error_Msg + (Data.Flags, + "{ is illegal for " & Attribute_Name & ": must have a dot", + Location, Project); + return; end if; - if Info_Id /= No_Ada_Naming_Exception then - Exception_Id := Info_Id; - Unit_Name := No_Name; - Unit_Kind := Spec; + -- Case of dot replacement is a single dot, and first character of + -- suffix is also a dot. - else - Exception_Id := No_Ada_Naming_Exception; - Lang := Get_Language_From_Name (Project, "ada"); + if Dot_Replacement /= No_File + and then Get_Name_String (Dot_Replacement) = "." + and then Suffix_Str (Suffix_Str'First) = '.' + then + for Index in Suffix_Str'First + 1 .. Suffix_Str'Last loop - if Lang = null then - Unit_Name := No_Name; - Unit_Kind := Spec; - else - Compute_Unit_Name - (File_Name => Canonical_File_Name, - Naming => Lang.Config.Naming_Data, - Kind => Kind, - Unit => Unit_Name, - In_Tree => In_Tree); - - case Kind is - when Spec => Unit_Kind := Spec; - when Impl | Sep => Unit_Kind := Impl; - end case; - end if; - end if; - end Get_Unit; - - ---------- - -- Hash -- - ---------- - - function Hash (Unit : Unit_Info) return Header_Num is - begin - return Header_Num (Unit.Unit mod 2048); - end Hash; - - ----------------------- - -- Is_Illegal_Suffix -- - ----------------------- - - function Is_Illegal_Suffix - (Suffix : File_Name_Type; - Dot_Replacement : File_Name_Type) return Boolean - is - Suffix_Str : constant String := Get_Name_String (Suffix); - - begin - if Suffix_Str'Length = 0 then - return False; - elsif Index (Suffix_Str, ".") = 0 then - return True; - end if; - - -- Case of dot replacement is a single dot, and first character of - -- suffix is also a dot. - - if Get_Name_String (Dot_Replacement) = "." - and then Suffix_Str (Suffix_Str'First) = '.' - then - for Index in Suffix_Str'First + 1 .. Suffix_Str'Last loop - - -- Case of following dot + -- If there are multiple dots in the name if Suffix_Str (Index) = '.' then -- It is illegal to have a letter following the initial dot - return Is_Letter (Suffix_Str (Suffix_Str'First + 1)); + if Is_Letter (Suffix_Str (Suffix_Str'First + 1)) then + Err_Vars.Error_Msg_File_1 := Suffix; + Error_Msg + (Data.Flags, + "{ is illegal for " & Attribute_Name + & ": ambiguous prefix when Dot_Replacement is a dot", + Location, Project); + end if; + return; end if; end loop; end if; - - return False; - end Is_Illegal_Suffix; + end Check_Illegal_Suffix; ---------------------- -- Locate_Directory -- @@ -6421,10 +5689,10 @@ package body Prj.Nmsc is procedure Locate_Directory (Project : Project_Id; - In_Tree : Project_Tree_Ref; Name : File_Name_Type; Path : out Path_Information; Dir_Exists : out Boolean; + Data : in out Tree_Processing_Data; Create : String := ""; Location : Source_Ptr := No_Location; Must_Exist : Boolean := True; @@ -6433,7 +5701,7 @@ package body Prj.Nmsc is Parent : constant Path_Name_Type := Project.Directory.Display_Name; The_Parent : constant String := - Get_Name_String (Parent) & Directory_Separator; + Get_Name_String (Parent); The_Parent_Last : constant Natural := Compute_Directory_Last (The_Parent); Full_Name : File_Name_Type; @@ -6526,10 +5794,10 @@ package body Prj.Nmsc is exception when Use_Error => Error_Msg - (Project, In_Tree, + (Data.Flags, "could not create " & Create & " directory " & Full_Path_Name.all, - Location); + Location, Project); end; end if; end if; @@ -6560,10 +5828,22 @@ package body Prj.Nmsc is begin Name_Len := Normed'Length; Name_Buffer (1 .. Name_Len) := Normed; + + -- Directories should always end with a directory separator + + if Name_Buffer (Name_Len) /= Directory_Separator then + Add_Char_To_Name_Buffer (Directory_Separator); + end if; + Path.Display_Name := Name_Find; Name_Len := Canonical_Path'Length; Name_Buffer (1 .. Name_Len) := Canonical_Path; + + if Name_Buffer (Name_Len) /= Directory_Separator then + Add_Char_To_Name_Buffer (Directory_Separator); + end if; + Path.Name := Name_Find; end; end if; @@ -6577,20 +5857,18 @@ package body Prj.Nmsc is --------------------------- procedure Find_Excluded_Sources - (Project : Project_Id; - In_Tree : Project_Tree_Ref; - Excluded : in out Excluded_Sources_Htable.Instance) + (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.Decl.Attributes, - In_Tree); - + Project.Project.Decl.Attributes, + Data.Tree); Excluded_Sources : Variable_Value := Util.Value_Of (Name_Excluded_Source_Files, - Project.Decl.Attributes, - In_Tree); + Project.Project.Decl.Attributes, + Data.Tree); Current : String_List_Id; Element : String_Element; @@ -6608,33 +5886,32 @@ package body Prj.Nmsc is Locally_Removed := True; Excluded_Sources := Util.Value_Of - (Name_Locally_Removed_Files, Project.Decl.Attributes, In_Tree); + (Name_Locally_Removed_Files, + Project.Project.Decl.Attributes, Data.Tree); end if; - Excluded_Sources_Htable.Reset (Excluded); - -- If there are excluded sources, put them in the table if not Excluded_Sources.Default then if not Excluded_Source_List_File.Default then if Locally_Removed then Error_Msg - (Project, In_Tree, + (Data.Flags, "?both attributes Locally_Removed_Files and " & "Excluded_Source_List_File are present", - Excluded_Source_List_File.Location); + Excluded_Source_List_File.Location, Project.Project); else Error_Msg - (Project, In_Tree, + (Data.Flags, "?both attributes Excluded_Source_Files and " & "Excluded_Source_List_File are present", - Excluded_Source_List_File.Location); + Excluded_Source_List_File.Location, Project.Project); end if; end if; Current := Excluded_Sources.Values; while Current /= Nil_String loop - Element := In_Tree.String_Elements.Table (Current); + Element := Data.Tree.String_Elements.Table (Current); Name := Canonical_Case_File_Name (Element.Value); -- If the element has no location, then use the location of @@ -6647,7 +5924,7 @@ package body Prj.Nmsc is end if; Excluded_Sources_Htable.Set - (Excluded, Name, (Name, False, Location)); + (Project.Excluded, Name, (Name, False, Location)); Current := Element.Next; end loop; @@ -6659,16 +5936,16 @@ package body Prj.Nmsc is Path_Name_Of (File_Name_Type (Excluded_Source_List_File.Value), - Project.Directory.Name); + Project.Project.Directory.Name); begin if Source_File_Path_Name'Length = 0 then Err_Vars.Error_Msg_File_1 := File_Name_Type (Excluded_Source_List_File.Value); Error_Msg - (Project, In_Tree, + (Data.Flags, "file with excluded sources { does not exist", - Excluded_Source_List_File.Location); + Excluded_Source_List_File.Location, Project.Project); else -- Open the file @@ -6677,7 +5954,8 @@ package body Prj.Nmsc is if not Prj.Util.Is_Valid (File) then Error_Msg - (Project, In_Tree, "file does not exist", Location); + (Data.Flags, "file does not exist", + Location, Project.Project); else -- Read the lines one by one @@ -6702,17 +5980,16 @@ package body Prj.Nmsc is then Error_Msg_File_1 := Name; Error_Msg - (Project, - In_Tree, + (Data.Flags, "file name cannot include " & "directory information ({)", - Location); + Location, Project.Project); exit; end if; end loop; Excluded_Sources_Htable.Set - (Excluded, Name, (Name, False, Location)); + (Project.Excluded, Name, (Name, False, Location)); end if; end loop; @@ -6728,23 +6005,20 @@ package body Prj.Nmsc is ------------------ procedure Find_Sources - (Project : Project_Id; - In_Tree : Project_Tree_Ref; - Proc_Data : in out Processing_Data; - Allow_Duplicate_Basenames : Boolean; - Excluded : in out Excluded_Sources_Htable.Instance) + (Project : in out Project_Processing_Data; + Data : in out Tree_Processing_Data) is Sources : constant Variable_Value := Util.Value_Of (Name_Source_Files, - Project.Decl.Attributes, - In_Tree); + Project.Project.Decl.Attributes, + Data.Tree); Source_List_File : constant Variable_Value := Util.Value_Of (Name_Source_List_File, - Project.Decl.Attributes, - In_Tree); + Project.Project.Decl.Attributes, + Data.Tree); Name_Loc : Name_Location; Has_Explicit_Sources : Boolean; @@ -6755,15 +6029,17 @@ package body Prj.Nmsc is (Source_List_File.Kind = Single, "Source_List_File is not a single string"); + Project.Source_List_File_Location := Source_List_File.Location; + -- If the user has specified a Source_Files attribute if not Sources.Default then if not Source_List_File.Default then Error_Msg - (Project, In_Tree, + (Data.Flags, "?both attributes source_files and " & "source_list_file are present", - Source_List_File.Location); + Source_List_File.Location, Project.Project); end if; -- Sources is a list of file names @@ -6775,24 +6051,23 @@ package body Prj.Nmsc is Name : File_Name_Type; begin - if Get_Mode = Multi_Language then - if Current = Nil_String then - Project.Languages := No_Language_Index; + if Current = Nil_String then + Project.Project.Languages := No_Language_Index; - -- This project contains no source. For projects that don't - -- extend other projects, this also means that there is no - -- need for an object directory, if not specified. + -- This project contains no source. For projects that don't + -- extend other projects, this also means that there is no + -- need for an object directory, if not specified. - if Project.Extends = No_Project - and then Project.Object_Directory = Project.Directory - then - Project.Object_Directory := No_Path_Information; - end if; + if Project.Project.Extends = No_Project + and then Project.Project.Object_Directory = + Project.Project.Directory + then + Project.Project.Object_Directory := No_Path_Information; end if; end if; while Current /= Nil_String loop - Element := In_Tree.String_Elements.Table (Current); + Element := Data.Tree.String_Elements.Table (Current); Name := Canonical_Case_File_Name (Element.Value); Get_Name_String (Element.Value); @@ -6813,37 +6088,36 @@ package body Prj.Nmsc is then Error_Msg_File_1 := Name; Error_Msg - (Project, - In_Tree, + (Data.Flags, "file name cannot include directory " & "information ({)", - Location); + Location, Project.Project); exit; end if; end loop; - -- In Multi_Language mode, check whether the file is already - -- there: the same file name may be in the list. If the source - -- is missing, the error will be on the first mention of the - -- source file name. + -- Check whether the file is already there: the same file name + -- may be in the list. If the source is missing, the error will + -- be on the first mention of the source file name. - case Get_Mode is - when Ada_Only => - Name_Loc := No_Name_Location; - when Multi_Language => - Name_Loc := Source_Names.Get (Name); - end case; + Name_Loc := Source_Names_Htable.Get + (Project.Source_Names, Name); if Name_Loc = No_Name_Location then Name_Loc := (Name => Name, Location => Location, Source => No_Source, - Except => False, + Listed => True, Found => False); - Source_Names.Set (Name, Name_Loc); + + else + Name_Loc.Listed := True; end if; + Source_Names_Htable.Set + (Project.Source_Names, Name, Name_Loc); + Current := Element.Next; end loop; @@ -6862,7 +6136,7 @@ package body Prj.Nmsc is Source_File_Path_Name : constant String := Path_Name_Of (File_Name_Type (Source_List_File.Value), - Project.Directory.Name); + Project.Project.Directory.Name); begin Has_Explicit_Sources := True; @@ -6871,14 +6145,14 @@ package body Prj.Nmsc is Err_Vars.Error_Msg_File_1 := File_Name_Type (Source_List_File.Value); Error_Msg - (Project, In_Tree, + (Data.Flags, "file with sources { does not exist", - Source_List_File.Location); + Source_List_File.Location, Project.Project); else Get_Sources_From_File (Source_File_Path_Name, Source_List_File.Location, - Project, In_Tree); + Project, Data); end if; end; @@ -6890,31 +6164,72 @@ package body Prj.Nmsc is Has_Explicit_Sources := False; end if; - if Get_Mode = Ada_Only then - Find_Ada_Sources - (Project, In_Tree, - Explicit_Sources_Only => Has_Explicit_Sources, - Proc_Data => Proc_Data); + -- Remove any exception that is not in the specified list of sources - else - Search_Directories - (Project, In_Tree, - For_All_Sources => - Sources.Default and then Source_List_File.Default, - Allow_Duplicate_Basenames => Allow_Duplicate_Basenames, - Excluded => Excluded); + if Has_Explicit_Sources then + declare + Source : Source_Id; + Iter : Source_Iterator; + NL : Name_Location; + Again : Boolean; + begin + Iter_Loop : + loop + Again := False; + Iter := For_Each_Source (Data.Tree, Project.Project); + + Source_Loop : + loop + Source := Prj.Element (Iter); + exit Source_Loop when Source = No_Source; + + if Source.Naming_Exception then + NL := Source_Names_Htable.Get + (Project.Source_Names, Source.File); + + if NL /= No_Name_Location and then not NL.Listed then + -- Remove the exception + Source_Names_Htable.Set + (Project.Source_Names, + Source.File, + No_Name_Location); + Remove_Source (Source, No_Source); + + Error_Msg_Name_1 := Name_Id (Source.File); + Error_Msg + (Data.Flags, + "? unknown source file %%", + NL.Location, + Project.Project); + + Again := True; + exit Source_Loop; + end if; + end if; + + Next (Iter); + end loop Source_Loop; + + exit Iter_Loop when not Again; + end loop Iter_Loop; + end; end if; - -- Check if all exceptions have been found. For Ada, it is an error if - -- an exception is not found. For other language, the source is simply - -- removed. + Search_Directories + (Project, + Data => Data, + For_All_Sources => Sources.Default and then Source_List_File.Default); + + -- Check if all exceptions have been found declare Source : Source_Id; Iter : Source_Iterator; + Found : Boolean := False; + Path : Path_Information; begin - Iter := For_Each_Source (In_Tree, Project); + Iter := For_Each_Source (Data.Tree, Project.Project); loop Source := Prj.Element (Iter); exit when Source = No_Source; @@ -6923,24 +6238,47 @@ package body Prj.Nmsc is and then Source.Path = No_Path_Information then if Source.Unit /= No_Unit_Index then + Found := False; - -- ??? Current limitation of gprbuild will display this - -- error message for multi-unit source files, because not - -- all instances of the file have had their path fully set. + -- For multi-unit source files, source_id gets duplicated + -- once for every unit. Only the first source_id got its + -- full path set. - if Source.Index = 0 - or else Source.Index = 1 - then + if Source.Index /= 0 then + Path := Files_Htable.Get + (Data.File_To_Source, Source.File).Path; + + if Path /= No_Path_Information then + Found := True; + end if; + end if; + + if not Found then Error_Msg_Name_1 := Name_Id (Source.Display_File); - Error_Msg_Name_2 := Name_Id (Source.Unit.Name); - Error_Msg - (Project, In_Tree, + Error_Msg_Name_2 := Source.Unit.Name; + Error_Or_Warning + (Data.Flags, Data.Flags.Missing_Source_Files, "source file %% for unit %% not found", - No_Location); + No_Location, Project.Project); + + else + Source.Path := Path; + + if Current_Verbosity = High then + if Source.Path /= No_Path_Information then + Write_Line ("Setting full path for " + & Get_Name_String (Source.File) + & " at" & Source.Index'Img + & " to " + & Get_Name_String (Path.Name)); + end if; + end if; end if; end if; - Remove_Source (Source, No_Source); + if Source.Path = No_Path_Information then + Remove_Source (Source, No_Source); + end if; end if; Next (Iter); @@ -6956,209 +6294,79 @@ package body Prj.Nmsc is First_Error : Boolean; begin - NL := Source_Names.Get_First; + NL := Source_Names_Htable.Get_First (Project.Source_Names); First_Error := True; while NL /= No_Name_Location loop if not NL.Found then Err_Vars.Error_Msg_File_1 := NL.Name; - if First_Error then - Error_Msg - (Project, In_Tree, + Error_Or_Warning + (Data.Flags, Data.Flags.Missing_Source_Files, "source file { not found", - NL.Location); + NL.Location, Project.Project); First_Error := False; - else - Error_Msg - (Project, In_Tree, + Error_Or_Warning + (Data.Flags, Data.Flags.Missing_Source_Files, "\source file { not found", - NL.Location); + NL.Location, Project.Project); end if; end if; - NL := Source_Names.Get_Next; + NL := Source_Names_Htable.Get_Next (Project.Source_Names); end loop; end; end if; - - if Get_Mode = Ada_Only - and then Project.Extends = No_Project - then - -- We should have found at least one source, if not report an error - - if not Has_Ada_Sources (Project) then - Report_No_Sources - (Project, "Ada", In_Tree, Source_List_File.Location); - end if; - end if; end Find_Sources; ---------------- -- Initialize -- ---------------- - procedure Initialize (Proc_Data : in out Processing_Data) is + procedure Initialize + (Data : out Tree_Processing_Data; + Tree : Project_Tree_Ref; + Node_Tree : Prj.Tree.Project_Node_Tree_Ref; + Flags : Prj.Processing_Flags) + is begin - Files_Htable.Reset (Proc_Data.Units); + Files_Htable.Reset (Data.File_To_Source); + Data.Tree := Tree; + Data.Node_Tree := Node_Tree; + Data.Flags := Flags; end Initialize; ---------- -- Free -- ---------- - procedure Free (Proc_Data : in out Processing_Data) is + procedure Free (Data : in out Tree_Processing_Data) is begin - Files_Htable.Reset (Proc_Data.Units); + Files_Htable.Reset (Data.File_To_Source); end Free; - ---------------------- - -- Find_Ada_Sources -- - ---------------------- + ---------------- + -- Initialize -- + ---------------- - procedure Find_Ada_Sources - (Project : Project_Id; - In_Tree : Project_Tree_Ref; - Explicit_Sources_Only : Boolean; - Proc_Data : in out Processing_Data) + procedure Initialize + (Data : in out Project_Processing_Data; + Project : Project_Id) is - Source_Dir : String_List_Id; - Element : String_Element; - Dir : Dir_Type; - Dir_Has_Source : Boolean := False; - NL : Name_Location; - Ada_Language : Language_Ptr; - begin - if Current_Verbosity = High then - Write_Line ("Looking for Ada sources:"); - end if; - - Ada_Language := Project.Languages; - while Ada_Language /= No_Language_Index - and then Ada_Language.Name /= Name_Ada - loop - Ada_Language := Ada_Language.Next; - end loop; - - -- We look in all source directories for the file names in the hash - -- table Source_Names. - - Source_Dir := Project.Source_Dirs; - while Source_Dir /= Nil_String loop - Dir_Has_Source := False; - Element := In_Tree.String_Elements.Table (Source_Dir); - - declare - Dir_Path : constant String := - Get_Name_String (Element.Display_Value) & - Directory_Separator; - Dir_Last : constant Natural := Compute_Directory_Last (Dir_Path); - - begin - if Current_Verbosity = High then - Write_Line ("checking directory """ & Dir_Path & """"); - end if; - - -- Look for all files in the current source directory - - Open (Dir, Dir_Path (Dir_Path'First .. Dir_Last)); - - loop - Read (Dir, Name_Buffer, Name_Len); - exit when Name_Len = 0; - - if Current_Verbosity = High then - Write_Line (" Checking " & Name_Buffer (1 .. Name_Len)); - end if; - - declare - Name : constant File_Name_Type := Name_Find; - Canonical_Name : File_Name_Type; - - -- ??? We could probably optimize the following call: we - -- need to resolve links only once for the directory itself, - -- and then do a single call to readlink() for each file. - -- Unfortunately that would require Normalize_Pathname to - -- be changed so that it has the option of not resolving - -- links for its Directory parameter, only for Name. - - Path : constant String := - Normalize_Pathname - (Name => Name_Buffer (1 .. Name_Len), - Directory => Dir_Path (Dir_Path'First .. Dir_Last), - Resolve_Links => Opt.Follow_Links_For_Files, - Case_Sensitive => True); -- no case folding - - Path_Name : Path_Name_Type; - To_Record : Boolean := False; - Location : Source_Ptr; - - begin - -- If the file was listed in the explicit list of sources, - -- mark it as such (since we'll need to report an error when - -- an explicit source was not found) - - if Explicit_Sources_Only then - Canonical_Name := - Canonical_Case_File_Name (Name_Id (Name)); - NL := Source_Names.Get (Canonical_Name); - To_Record := NL /= No_Name_Location and then not NL.Found; - - if To_Record then - NL.Found := True; - Location := NL.Location; - Source_Names.Set (Canonical_Name, NL); - end if; - - else - To_Record := True; - Location := No_Location; - end if; - - if To_Record then - Name_Len := Path'Length; - Name_Buffer (1 .. Name_Len) := Path; - Path_Name := Name_Find; - - if Current_Verbosity = High then - Write_Line (" recording " & Get_Name_String (Name)); - end if; - - -- Register the source if it is an Ada compilation unit - - Record_Ada_Source - (File_Name => Name, - Path_Name => Path_Name, - Project => Project, - In_Tree => In_Tree, - Proc_Data => Proc_Data, - Ada_Language => Ada_Language, - Location => Location, - Source_Recorded => Dir_Has_Source); - end if; - end; - end loop; - - Close (Dir); - - exception - when others => - Close (Dir); - raise; - end; - - if Dir_Has_Source then - In_Tree.String_Elements.Table (Source_Dir).Flag := True; - end if; + Data.Project := Project; + end Initialize; - Source_Dir := Element.Next; - end loop; + ---------- + -- Free -- + ---------- - if Current_Verbosity = High then - Write_Line ("End looking for sources"); - end if; - end Find_Ada_Sources; + procedure Free (Data : in out Project_Processing_Data) is + begin + Source_Names_Htable.Reset (Data.Source_Names); + Unit_Exceptions_Htable.Reset (Data.Unit_Exceptions); + Excluded_Sources_Htable.Reset (Data.Excluded); + end Free; ------------------------------- -- Check_File_Naming_Schemes -- @@ -7166,7 +6374,7 @@ package body Prj.Nmsc is procedure Check_File_Naming_Schemes (In_Tree : Project_Tree_Ref; - Project : Project_Id; + Project : Project_Processing_Data; File_Name : File_Name_Type; Alternate_Languages : out Language_List; Language : out Language_Ptr; @@ -7243,7 +6451,7 @@ package body Prj.Nmsc is Lang_Kind := File_Based; Kind := Spec; - Tmp_Lang := Project.Languages; + Tmp_Lang := Project.Project.Languages; while Tmp_Lang /= No_Language_Index loop if Current_Verbosity = High then Write_Line @@ -7272,6 +6480,7 @@ package body Prj.Nmsc is Naming => Config.Naming_Data, Kind => Kind, Unit => Unit, + Project => Project, In_Tree => In_Tree); if Unit /= No_Name then @@ -7316,6 +6525,14 @@ package body Prj.Nmsc is Source.Kind := Kind; + if Current_Verbosity = High + and then Source.File /= No_File + then + Write_Line ("Override kind for " + & Get_Name_String (Source.File) + & " kind=" & Source.Kind'Img); + end if; + if Source.Kind in Spec_Or_Body and then Source.Unit /= null then Source.Unit.File_Names (Source.Kind) := Source; end if; @@ -7326,69 +6543,70 @@ package body Prj.Nmsc is ---------------- procedure Check_File - (Project : Project_Id; - In_Tree : Project_Tree_Ref; - Path : Path_Name_Type; - File_Name : File_Name_Type; - Display_File_Name : File_Name_Type; - For_All_Sources : Boolean; - Allow_Duplicate_Basenames : Boolean) + (Project : in out Project_Processing_Data; + Data : in out Tree_Processing_Data; + Source_Dir_Rank : Natural; + Path : Path_Name_Type; + Display_Path : Path_Name_Type; + File_Name : File_Name_Type; + Display_File_Name : File_Name_Type; + Locally_Removed : Boolean; + For_All_Sources : Boolean) is - Canonical_Path : constant Path_Name_Type := - Path_Name_Type - (Canonical_Case_File_Name (Name_Id (Path))); - - Name_Loc : Name_Location := Source_Names.Get (File_Name); + Name_Loc : Name_Location := + Source_Names_Htable.Get + (Project.Source_Names, File_Name); Check_Name : Boolean := False; Alternate_Languages : Language_List; Language : Language_Ptr; Source : Source_Id; - Add_Src : Boolean; Src_Ind : Source_File_Index; Unit : Name_Id; - Source_To_Replace : Source_Id := No_Source; Display_Language_Name : Name_Id; Lang_Kind : Language_Kind; Kind : Source_Kind := Spec; - Iter : Source_Iterator; begin + if Current_Verbosity = High then + Write_Line ("Checking file:"); + Write_Str (" Path = "); + Write_Line (Get_Name_String (Path)); + Write_Str (" Rank ="); + Write_Line (Source_Dir_Rank'Img); + end if; + if Name_Loc = No_Name_Location then Check_Name := For_All_Sources; else if Name_Loc.Found then + -- Check if it is OK to have the same file name in several -- source directories. - if not Project.Known_Order_Of_Source_Dirs then + if Source_Dir_Rank = Name_Loc.Source.Source_Dir_Rank then Error_Msg_File_1 := File_Name; Error_Msg - (Project, In_Tree, + (Data.Flags, "{ is found in several source directories", - Name_Loc.Location); + Name_Loc.Location, Project.Project); end if; else Name_Loc.Found := True; - Source_Names.Set (File_Name, Name_Loc); + Source_Names_Htable.Set + (Project.Source_Names, File_Name, Name_Loc); if Name_Loc.Source = No_Source then Check_Name := True; else - -- ??? Issue: there could be several entries for the same - -- source file in the list of sources, in case the file - -- contains multiple units. We should share the data as much - -- as possible, and more importantly set the path for all - -- instances. - - Name_Loc.Source.Path := (Canonical_Path, Path); + Name_Loc.Source.Path := (Path, Display_Path); Source_Paths_Htable.Set - (In_Tree.Source_Paths_HT, - Canonical_Path, + (Data.Tree.Source_Paths_HT, + Path, Name_Loc.Source); -- Check if this is a subunit @@ -7397,19 +6615,22 @@ package body Prj.Nmsc is and then Name_Loc.Source.Kind = Impl then Src_Ind := Sinput.P.Load_Project_File - (Get_Name_String (Canonical_Path)); + (Get_Name_String (Display_Path)); if Sinput.P.Source_File_Is_Subunit (Src_Ind) then Override_Kind (Name_Loc.Source, Sep); end if; end if; + + Files_Htable.Set + (Data.File_To_Source, File_Name, Name_Loc.Source); end if; end if; end if; if Check_Name then Check_File_Naming_Schemes - (In_Tree => In_Tree, + (In_Tree => Data.Tree, Project => Project, File_Name => File_Name, Alternate_Languages => Alternate_Languages, @@ -7423,193 +6644,347 @@ package body Prj.Nmsc is -- A file name in a list must be a source of a language - if Name_Loc.Found then + if Data.Flags.Error_On_Unknown_Language + and then Name_Loc.Found + then Error_Msg_File_1 := File_Name; Error_Msg - (Project, - In_Tree, + (Data.Flags, "language unknown for {", - Name_Loc.Location); + Name_Loc.Location, Project.Project); end if; else - -- Check if the same file name or unit is used in the prj tree + Add_Source + (Id => Source, + Project => Project.Project, + Source_Dir_Rank => Source_Dir_Rank, + Lang_Id => Language, + Kind => Kind, + Data => Data, + Alternate_Languages => Alternate_Languages, + File_Name => File_Name, + Display_File => Display_File_Name, + Unit => Unit, + Locally_Removed => Locally_Removed, + Path => (Path, Display_Path)); + + -- If it is a source specified in a list, update the entry in + -- the Source_Names table. + + if Name_Loc.Found and then Name_Loc.Source = No_Source then + Name_Loc.Source := Source; + Source_Names_Htable.Set + (Project.Source_Names, File_Name, Name_Loc); + end if; + end if; + end if; + end Check_File; - Iter := For_Each_Source (In_Tree); - Add_Src := True; - loop - Source := Prj.Element (Iter); - exit when Source = No_Source; + --------------------------------- + -- Expand_Subdirectory_Pattern -- + --------------------------------- - if Unit /= No_Name - and then Source.Unit /= No_Unit_Index - and then Source.Unit.Name = Unit - and then - ((Source.Kind = Spec and then Kind = Impl) - or else - (Source.Kind = Impl and then Kind = Spec)) - then - -- We found the "other_part (source)" + procedure Expand_Subdirectory_Pattern + (Project : Project_Id; + Data : in out Tree_Processing_Data; + Patterns : String_List_Id; + Search_For : Search_Type; + Resolve_Links : Boolean) + is + pragma Unreferenced (Search_For); + package Recursive_Dirs is new GNAT.Dynamic_HTables.Simple_HTable + (Header_Num => Header_Num, + Element => Boolean, + No_Element => False, + Key => Path_Name_Type, + Hash => Hash, + Equal => "="); + -- Hash table stores recursive source directories, to avoid looking + -- several times, and to avoid cycles that may be introduced by symbolic + -- links. + + Visited : Recursive_Dirs.Instance; + + procedure Find_Pattern + (Pattern : String; Rank : Natural; Location : Source_Ptr); + -- Find a specific pattern + + procedure Recursive_Find_Dirs (Normalized_Path : String; Rank : Natural); + -- Search all the subdirectories (recursively) of Path + + procedure Check_Directory_And_Subdirs + (Directory : String; + Include_Subdirs : Boolean; + Rank : Natural; + Location : Source_Ptr); + -- Make sur that Directory exists (and if not report an error/warning + -- message depending on the flags. + -- Calls Callback for Directory itself and all its subdirectories if + -- Include_Subdirs is True). + + ------------------------- + -- Recursive_Find_Dirs -- + ------------------------- + + procedure Recursive_Find_Dirs + (Normalized_Path : String; Rank : Natural) + is + Dir : Dir_Type; + Name : String (1 .. 250); + Last : Natural; - null; + Non_Canonical_Path : Path_Name_Type := No_Path; + Canonical_Path : Path_Name_Type := No_Path; - elsif (Unit /= No_Name - and then Source.Unit /= No_Unit_Index - and then Source.Unit.Name = Unit - and then - (Source.Kind = Kind - or else - (Source.Kind = Sep and then Kind = Impl) - or else - (Source.Kind = Impl and then Kind = Sep))) - or else - (Unit = No_Name and then Source.File = File_Name) - then - -- Duplication of file/unit in same project is only allowed - -- if order of source directories is known. - - if Project = Source.Project then - if Unit = No_Name then - if 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 - (Project, In_Tree, "duplicate source file name {", - No_Location); - Add_Src := False; - end if; + The_Path_Last : constant Natural := + Compute_Directory_Last (Normalized_Path); - else - if Project.Known_Order_Of_Source_Dirs then - Add_Src := False; - else - Error_Msg_Name_1 := Unit; - Error_Msg - (Project, In_Tree, "duplicate unit %%", - No_Location); - Add_Src := False; - end if; - end if; + begin + Name_Len := 0; + Add_Str_To_Name_Buffer + (Normalized_Path (Normalized_Path'First .. The_Path_Last)); + Non_Canonical_Path := Name_Find; - -- Do not allow the same unit name in different projects, - -- except if one is extending the other. + Canonical_Path := + Path_Name_Type + (Canonical_Case_File_Name (Name_Id (Non_Canonical_Path))); - -- For a file based language, the same file name replaces - -- a file in a project being extended, but it is allowed - -- to have the same file name in unrelated projects. + if Recursive_Dirs.Get (Visited, Canonical_Path) then + return; + end if; - elsif Is_Extending (Project, Source.Project) then - Source_To_Replace := Source; + Recursive_Dirs.Set (Visited, Canonical_Path, True); - elsif Unit /= No_Name - and then not Source.Locally_Removed - then - Error_Msg_Name_1 := Unit; - Error_Msg - (Project, In_Tree, - "unit %% cannot belong to several projects", - No_Location); + Callback (Canonical_Path, Non_Canonical_Path, Rank); - Error_Msg_Name_1 := Project.Name; - Error_Msg_Name_2 := Name_Id (Path); - Error_Msg - (Project, In_Tree, "\ project %%, %%", No_Location); + Open (Dir, Normalized_Path (Normalized_Path'First .. The_Path_Last)); - Error_Msg_Name_1 := Source.Project.Name; - Error_Msg_Name_2 := Name_Id (Source.Path.Display_Name); - Error_Msg - (Project, In_Tree, "\ project %%, %%", No_Location); + loop + Read (Dir, Name, Last); + exit when Last = 0; - Add_Src := False; - end if; + if Name (1 .. Last) /= "." + and then Name (1 .. Last) /= ".." + then + if Current_Verbosity = High then + Write_Str (" Checking "); + Write_Line (Name (1 .. Last)); end if; - Next (Iter); - end loop; - - if Add_Src then - Add_Source - (Id => Source, - In_Tree => In_Tree, - Project => Project, - Lang_Id => Language, - Kind => Kind, - Alternate_Languages => Alternate_Languages, - File_Name => File_Name, - Display_File => Display_File_Name, - Unit => Unit, - Path => (Canonical_Path, Path), - Source_To_Replace => Source_To_Replace); + declare + Path_Name : constant String := + Normalize_Pathname + (Name => Name (1 .. Last), + Directory => + Normalized_Path + (Normalized_Path'First .. The_Path_Last), + Resolve_Links => Resolve_Links) + & Directory_Separator; + begin + if Is_Directory (Path_Name) then + Recursive_Find_Dirs (Path_Name, Rank); + end if; + end; end if; - end if; - end if; - end Check_File; + end loop; - ------------------------ - -- Search_Directories -- - ------------------------ + Close (Dir); - procedure Search_Directories - (Project : Project_Id; - In_Tree : Project_Tree_Ref; - For_All_Sources : Boolean; - Allow_Duplicate_Basenames : Boolean; - Excluded : in out Excluded_Sources_Htable.Instance) - is - Source_Dir : String_List_Id; - Element : String_Element; - Dir : Dir_Type; - Name : String (1 .. 1_000); - Last : Natural; - File_Name : File_Name_Type; - Display_File_Name : File_Name_Type; + exception + when Directory_Error => + null; + end Recursive_Find_Dirs; - begin - if Current_Verbosity = High then - Write_Line ("Looking for sources:"); - end if; + --------------------------------- + -- Check_Directory_And_Subdirs -- + --------------------------------- - -- Loop through subdirectories + procedure Check_Directory_And_Subdirs + (Directory : String; + Include_Subdirs : Boolean; + Rank : Natural; + Location : Source_Ptr) + is + Dir : File_Name_Type; + Path_Name : Path_Information; + Dir_Exists : Boolean; + Has_Error : Boolean := False; + begin + Name_Len := Directory'Length; + Name_Buffer (1 .. Name_Len) := Directory; + Dir := Name_Find; - Source_Dir := Project.Source_Dirs; - while Source_Dir /= Nil_String loop - begin - Element := In_Tree.String_Elements.Table (Source_Dir); - if Element.Value /= No_Name then - Get_Name_String (Element.Display_Value); + Locate_Directory + (Project => Project, + Name => Dir, + Path => Path_Name, + Dir_Exists => Dir_Exists, + Data => Data, + Must_Exist => False); + + if not Dir_Exists then + Err_Vars.Error_Msg_File_1 := Dir; + Error_Or_Warning + (Data.Flags, Data.Flags.Missing_Source_Files, + "{ is not a valid directory", Location, Project); + Has_Error := Data.Flags.Missing_Source_Files = Error; + end if; - declare - Source_Directory : constant String := - Name_Buffer (1 .. Name_Len) & - Directory_Separator; + if not Has_Error then + -- Links have been resolved if necessary, and Path_Name + -- always ends with a directory separator. - Dir_Last : constant Natural := - Compute_Directory_Last - (Source_Directory); + if Include_Subdirs then + if Current_Verbosity = High then + Write_Str ("Looking for all subdirectories of """); + Write_Str (Directory); + Write_Line (""""); + end if; - begin + Recursive_Find_Dirs (Get_Name_String (Path_Name.Name), Rank); + + if Current_Verbosity = High then + Write_Line ("End of looking for source directories."); + end if; + + else + Callback (Path_Name.Name, Path_Name.Display_Name, Rank); + end if; + end if; + end Check_Directory_And_Subdirs; + + ------------------ + -- Find_Pattern -- + ------------------ + + procedure Find_Pattern + (Pattern : String; Rank : Natural; Location : Source_Ptr) is + begin + if Current_Verbosity = High then + Write_Str ("Expand_Subdirectory_Pattern ("""); + Write_Str (Pattern); + Write_Line (""")"); + end if; + + -- First, check if we are looking for a directory tree, indicated + -- by "/**" at the end. + + if Pattern'Length >= 3 + and then Pattern (Pattern'Last - 1 .. Pattern'Last) = "**" + and then (Pattern (Pattern'Last - 2) = '/' + or else Pattern (Pattern'Last - 2) = Directory_Separator) + then + if Pattern'Length = 3 then + -- Case of "/**": all directories in file system + Check_Directory_And_Subdirs + (Pattern (Pattern'First .. Pattern'First), + True, Rank, Location); + else + Check_Directory_And_Subdirs + (Pattern (Pattern'First .. Pattern'Last - 3), + True, Rank, Location); + end if; + else + Check_Directory_And_Subdirs (Pattern, False, Rank, Location); + end if; + end Find_Pattern; + + -- Start of processing for Expand_Subdirectory_Pattern + + Pattern_Id : String_List_Id := Patterns; + Element : String_Element; + Rank : Natural := 1; + begin + while Pattern_Id /= Nil_String loop + Element := Data.Tree.String_Elements.Table (Pattern_Id); + Find_Pattern + (Get_Name_String (Element.Value), Rank, Element.Location); + Rank := Rank + 1; + Pattern_Id := Element.Next; + end loop; + + Recursive_Dirs.Reset (Visited); + end Expand_Subdirectory_Pattern; + + ------------------------ + -- Search_Directories -- + ------------------------ + + procedure Search_Directories + (Project : in out Project_Processing_Data; + Data : in out Tree_Processing_Data; + For_All_Sources : Boolean) + is + Source_Dir : String_List_Id; + Element : String_Element; + Src_Dir_Rank : Number_List_Index; + Num_Nod : Number_Node; + Dir : Dir_Type; + Name : String (1 .. 1_000); + Last : Natural; + File_Name : File_Name_Type; + Display_File_Name : File_Name_Type; + + begin + if Current_Verbosity = High then + Write_Line ("Looking for sources:"); + end if; + + -- Loop through subdirectories + + Source_Dir := Project.Project.Source_Dirs; + Src_Dir_Rank := Project.Project.Source_Dir_Ranks; + while Source_Dir /= Nil_String loop + begin + Num_Nod := Data.Tree.Number_Lists.Table (Src_Dir_Rank); + Element := Data.Tree.String_Elements.Table (Source_Dir); + + -- Use Element.Value in this test, not Display_Value, because we + -- want the symbolic links to be resolved when appropriate. + + if Element.Value /= No_Name then + declare + Source_Directory : constant String := + Get_Name_String (Element.Value) + & Directory_Separator; + + Dir_Last : constant Natural := + Compute_Directory_Last (Source_Directory); + + Display_Source_Directory : constant String := + Get_Name_String + (Element.Display_Value) + & Directory_Separator; + -- Display_Source_Directory is to allow us to open a UTF-8 + -- encoded directory on Windows. + + begin if Current_Verbosity = High then - Write_Attr ("Source_Dir", Source_Directory); + Write_Attr + ("Source_Dir", + Source_Directory (Source_Directory'First .. Dir_Last)); + Write_Line (Num_Nod.Number'Img); end if; -- We look to every entry in the source directory - Open (Dir, Source_Directory); + Open (Dir, Display_Source_Directory); loop Read (Dir, Name, Last); exit when Last = 0; - -- ??? Duplicate system call here, we just did a a - -- similar one. Maybe Ada.Directories would be more - -- appropriate here. + -- In fast project loading mode (without -eL), the user + -- guarantees that no directory has a name which is a + -- valid source name, so we can avoid doing a system call + -- here. This provides a very significant speed up on + -- slow file systems (remote files for instance). - if Is_Regular_File - (Source_Directory & Name (1 .. Last)) + if not Opt.Follow_Links_For_Files + or else Is_Regular_File + (Display_Source_Directory & Name (1 .. Last)) then if Current_Verbosity = High then Write_Str (" Checking "); @@ -7639,42 +7014,66 @@ package body Prj.Nmsc is Resolve_Links => Opt.Follow_Links_For_Files, Case_Sensitive => True); - -- Case_Sensitive set True (no folding) - Path : Path_Name_Type; - FF : File_Found := Excluded_Sources_Htable.Get - (Excluded, File_Name); + Path : Path_Name_Type; + FF : File_Found := + Excluded_Sources_Htable.Get + (Project.Excluded, File_Name); + To_Remove : Boolean := False; begin Name_Len := Path_Name'Length; Name_Buffer (1 .. Name_Len) := Path_Name; - Path := Name_Find; + + if Osint.File_Names_Case_Sensitive then + Path := Name_Find; + else + Canonical_Case_File_Name + (Name_Buffer (1 .. Name_Len)); + Path := Name_Find; + end if; if FF /= No_File_Found then if not FF.Found then FF.Found := True; Excluded_Sources_Htable.Set - (Excluded, File_Name, FF); + (Project.Excluded, File_Name, FF); if Current_Verbosity = High then Write_Str (" excluded source """); - Write_Str (Get_Name_String (File_Name)); + Write_Str + (Get_Name_String (Display_File_Name)); Write_Line (""""); end if; - end if; - else - Check_File - (Project => Project, - In_Tree => In_Tree, - Path => Path, - File_Name => File_Name, - Display_File_Name => - Display_File_Name, - For_All_Sources => For_All_Sources, - Allow_Duplicate_Basenames => - Allow_Duplicate_Basenames); + -- Will mark the file as removed, but we + -- still need to add it to the list: if we + -- don't, the file will not appear in the + -- mapping file and will cause the compiler + -- to fail. + + To_Remove := True; + end if; end if; + + -- Preserve the user's original casing and use of + -- links. The display_value (a directory) already + -- ends with a directory separator by construction, + -- so no need to add one. + + Get_Name_String (Element.Display_Value); + Get_Name_String_And_Append (Display_File_Name); + + Check_File + (Project => Project, + Source_Dir_Rank => Num_Nod.Number, + Data => Data, + Path => Path, + Display_Path => Name_Find, + File_Name => File_Name, + Locally_Removed => To_Remove, + Display_File_Name => Display_File_Name, + For_All_Sources => For_All_Sources); end; end if; end loop; @@ -7689,6 +7088,7 @@ package body Prj.Nmsc is end; Source_Dir := Element.Next; + Src_Dir_Rank := Num_Nod.Next; end loop; if Current_Verbosity = High then @@ -7701,31 +7101,28 @@ package body Prj.Nmsc is ---------------------------- procedure Load_Naming_Exceptions - (Project : Project_Id; - In_Tree : Project_Tree_Ref; - Excluded : in out Excluded_Sources_Htable.Instance) + (Project : in out Project_Processing_Data; + Data : in out Tree_Processing_Data) is Source : Source_Id; Iter : Source_Iterator; begin - Unit_Exceptions.Reset; - - Iter := For_Each_Source (In_Tree, Project); + Iter := For_Each_Source (Data.Tree, Project.Project); loop Source := Prj.Element (Iter); exit when Source = No_Source; -- An excluded file cannot also be an exception file name - if Excluded_Sources_Htable.Get (Excluded, Source.File) /= - No_File_Found + if Excluded_Sources_Htable.Get (Project.Excluded, Source.File) /= + No_File_Found then Error_Msg_File_1 := Source.File; Error_Msg - (Project, In_Tree, + (Data.Flags, "{ cannot be both excluded and an exception file name", - No_Location); + No_Location, Project.Project); end if; if Current_Verbosity = High then @@ -7734,21 +7131,23 @@ package body Prj.Nmsc is Write_Line (" in Source_Names"); end if; - Source_Names.Set - (K => Source.File, + Source_Names_Htable.Set + (Project.Source_Names, + K => Source.File, E => Name_Location' - (Name => Source.File, - Location => No_Location, - Source => Source, - Except => Source.Unit /= No_Unit_Index, - Found => False)); + (Name => Source.File, + Location => Source.Location, + Source => Source, + Listed => False, + Found => False)); -- If this is an Ada exception, record in table Unit_Exceptions if Source.Unit /= No_Unit_Index then declare Unit_Except : Unit_Exception := - Unit_Exceptions.Get (Source.Unit.Name); + Unit_Exceptions_Htable.Get + (Project.Unit_Exceptions, Source.Unit.Name); begin Unit_Except.Name := Source.Unit.Name; @@ -7759,7 +7158,8 @@ package body Prj.Nmsc is Unit_Except.Impl := Source.File; end if; - Unit_Exceptions.Set (Source.Unit.Name, Unit_Except); + Unit_Exceptions_Htable.Set + (Project.Unit_Exceptions, Source.Unit.Name, Unit_Except); end; end if; @@ -7772,21 +7172,118 @@ package body Prj.Nmsc is ---------------------- procedure Look_For_Sources - (Project : Project_Id; - In_Tree : Project_Tree_Ref; - Proc_Data : in out Processing_Data; - Allow_Duplicate_Basenames : Boolean) + (Project : in out Project_Processing_Data; + Data : in out Tree_Processing_Data) is - Iter : Source_Iterator; - Src : Source_Id; - Excluded_Sources : Excluded_Sources_Htable.Instance; + Object_Files : Object_File_Names_Htable.Instance; + Iter : Source_Iterator; + Src : Source_Id; + + 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 Process_Sources_In_Multi_Language_Mode; - -- Find all source files when in multi language mode + 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 + procedure Check_Missing_Sources; + -- Check whether one of the languages has no sources, and report an + -- error when appropriate + + procedure Get_Sources_From_Source_Info; + -- Get the source information from the tabes that were created when a + -- source info fie was read. + + --------------------------- + -- Check_Missing_Sources -- + --------------------------- + + procedure Check_Missing_Sources is + Extending : constant Boolean := + Project.Project.Extends /= No_Project; + Language : Language_Ptr; + Source : Source_Id; + Alt_Lang : Language_List; + Continuation : Boolean := False; + Iter : Source_Iterator; + begin + if not Project.Project.Externally_Built + and then not Extending + then + Language := Project.Project.Languages; + while Language /= No_Language_Index loop + + -- If there are no sources for this language, check if there + -- are sources for which this is an alternate language. + + if Language.First_Source = No_Source + and then (Data.Flags.Require_Sources_Other_Lang + or else Language.Name = Name_Ada) + then + Iter := For_Each_Source (In_Tree => Data.Tree, + Project => Project.Project); + Source_Loop : loop + Source := Element (Iter); + exit Source_Loop when Source = No_Source + or else Source.Language = Language; + + Alt_Lang := Source.Alternate_Languages; + while Alt_Lang /= null loop + exit Source_Loop when Alt_Lang.Language = Language; + Alt_Lang := Alt_Lang.Next; + end loop; + + Next (Iter); + end loop Source_Loop; + + if Source = No_Source then + Report_No_Sources + (Project.Project, + Get_Name_String (Language.Display_Name), + Data, + Project.Source_List_File_Location, + Continuation); + Continuation := True; + end if; + end if; + + Language := Language.Next; + end loop; + end if; + end Check_Missing_Sources; + + ------------------ + -- 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 + (Data.Flags, + "{ and { have the same object file name", + No_Location, Project.Project); + + else + Object_File_Names_Htable.Set (Object_Files, Src.Object, Src); + end if; + end Check_Object; + --------------------------- -- Mark_Excluded_Sources -- --------------------------- @@ -7795,190 +7292,264 @@ package body Prj.Nmsc is Source : Source_Id := No_Source; Excluded : File_Found; Proj : Project_Id; + begin - Proj := Project; - while Proj /= No_Project loop - Iter := For_Each_Source (In_Tree, Proj); - while Prj.Element (Iter) /= No_Source loop - Source := Prj.Element (Iter); - Excluded := Excluded_Sources_Htable.Get - (Excluded_Sources, Source.File); - - if Excluded /= No_File_Found then - Source.Locally_Removed := True; - Source.In_Interfaces := False; + -- Minor optimization: if there are no excluded files, no need to + -- traverse the list of sources. We cannot however also check whether + -- the existing exceptions have ".Found" set to True (indicating we + -- found them before) because we need to do some final processing on + -- them in any case. + + if Excluded_Sources_Htable.Get_First (Project.Excluded) /= + No_File_Found + then + Proj := Project.Project; + while Proj /= No_Project loop + Iter := For_Each_Source (Data.Tree, Proj); + while Prj.Element (Iter) /= No_Source loop + Source := Prj.Element (Iter); + Excluded := Excluded_Sources_Htable.Get + (Project.Excluded, Source.File); + + if Excluded /= No_File_Found then + Source.Locally_Removed := True; + Source.In_Interfaces := False; - if Current_Verbosity = High then - Write_Str ("Removing file "); - Write_Line - (Get_Name_String (Excluded.File) - & " " & Get_Name_String (Source.Project.Name)); + if Current_Verbosity = High then + Write_Str ("Removing file "); + Write_Line + (Get_Name_String (Excluded.File) + & " " & Get_Name_String (Source.Project.Name)); + end if; + + Excluded_Sources_Htable.Remove + (Project.Excluded, Source.File); end if; - Excluded_Sources_Htable.Remove - (Excluded_Sources, Source.File); - end if; + Next (Iter); + end loop; - Next (Iter); + Proj := Proj.Extends; end loop; - - Proj := Proj.Extends; - end loop; + end if; -- If we have any excluded element left, that means we did not find -- the source file - Excluded := Excluded_Sources_Htable.Get_First (Excluded_Sources); + Excluded := Excluded_Sources_Htable.Get_First (Project.Excluded); while Excluded /= No_File_Found loop + if not Excluded.Found then - -- Check if the file belongs to another imported project to - -- provide a better error message. + -- Check if the file belongs to another imported project to + -- provide a better error message. - Src := Find_Source - (In_Tree => In_Tree, - Project => Project, - In_Imported_Only => True, - Base_Name => Excluded.File); + Src := Find_Source + (In_Tree => Data.Tree, + Project => Project.Project, + In_Imported_Only => True, + Base_Name => Excluded.File); - Err_Vars.Error_Msg_File_1 := Excluded.File; + Err_Vars.Error_Msg_File_1 := Excluded.File; - if Src = No_Source then - Error_Msg - (Project, In_Tree, "unknown file {", Excluded.Location); - else - Error_Msg - (Project, In_Tree, - "cannot remove a source from an imported project: {", - Excluded.Location); + if Src = No_Source then + Error_Msg + (Data.Flags, + "unknown file {", Excluded.Location, Project.Project); + else + Error_Msg + (Data.Flags, + "cannot remove a source from an imported project: {", + Excluded.Location, Project.Project); + end if; end if; - Excluded := Excluded_Sources_Htable.Get_Next (Excluded_Sources); + Excluded := Excluded_Sources_Htable.Get_Next (Project.Excluded); 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. + Iter := For_Each_Source (Data.Tree); + loop + Src_Id := Prj.Element (Iter); + exit when Src_Id = No_Source; - Check_Object_File_Names : declare - Src_Id : Source_Id; - Source_Name : File_Name_Type; + 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; - 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. + else + case Src_Id.Kind is + when Spec => + if Other_Part (Src_Id) = No_Source then + Check_Object (Src_Id); + end if; - ------------------ - -- Check_Object -- - ------------------ + when Sep => + null; - procedure Check_Object (Src : Source_Id) is - begin - Source_Name := Object_File_Names.Get (Src.Object); + when Impl => + if Other_Part (Src_Id) /= No_Source then + Check_Object (Src_Id); - if Source_Name /= No_File then - Error_Msg_File_1 := Src.File; - Error_Msg_File_2 := Source_Name; - Error_Msg - (Project, - In_Tree, - "{ and { have the same object file name", - No_Location); + else + -- Check if it is a subunit - else - Object_File_Names.Set (Src.Object, Src.File); + Src_Ind := + Sinput.P.Load_Project_File + (Get_Name_String (Src_Id.Path.Display_Name)); + + if Sinput.P.Source_File_Is_Subunit (Src_Ind) then + Override_Kind (Src_Id, Sep); + else + Check_Object (Src_Id); + end if; + end if; + end case; end if; - end Check_Object; + end if; - -- Start of processing for Check_Object_File_Names + Next (Iter); + end loop; + end Check_Object_Files; - begin - Object_File_Names.Reset; - Iter := For_Each_Source (In_Tree); + ---------------------------------- + -- Get_Sources_From_Source_Info -- + ---------------------------------- + + procedure Get_Sources_From_Source_Info is + Iter : Source_Info_Iterator; + Src : Source_Info; + Id : Source_Id; + Lang_Id : Language_Ptr; + begin + Initialize (Iter, Project.Project.Name); + + loop + Src := Source_Info_Of (Iter); + + exit when Src = No_Source_Info; + + Id := new Source_Data; + + Id.Project := Project.Project; + + Lang_Id := Project.Project.Languages; + while Lang_Id /= No_Language_Index and then + Lang_Id.Name /= Src.Language loop - Src_Id := Prj.Element (Iter); - exit when Src_Id = No_Source; + Lang_Id := Lang_Id.Next; + end loop; - if Is_Compilable (Src_Id) - and then Src_Id.Language.Config.Object_Generated - and then Is_Extending (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; + if Lang_Id = No_Language_Index then + Prj.Com.Fail + ("unknown language " & + Get_Name_String (Src.Language) & + " for project " & + Get_Name_String (Src.Project) & + " in source info file"); + end if; - else - case Src_Id.Kind is - when Spec => - if Other_Part (Src_Id) = No_Source then - Check_Object (Src_Id); - end if; + Id.Language := Lang_Id; + Id.Kind := Src.Kind; - when Sep => - null; + Id.Index := Src.Index; - when Impl => - if Other_Part (Src_Id) /= No_Source then - Check_Object (Src_Id); + Id.Path := + (Path_Name_Type (Src.Display_Path_Name), + Path_Name_Type (Src.Path_Name)); - 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; - end if; - end case; + Name_Len := 0; + Add_Str_To_Name_Buffer + (Ada.Directories.Simple_Name + (Get_Name_String (Src.Path_Name))); + Id.File := Name_Find; + + Name_Len := 0; + Add_Str_To_Name_Buffer + (Ada.Directories.Simple_Name + (Get_Name_String (Src.Display_Path_Name))); + Id.Display_File := Name_Find; + + Id.Dep_Name := Dependency_Name + (Id.File, Id.Language.Config.Dependency_Kind); + Id.Naming_Exception := Src.Naming_Exception; + Id.Object := Object_Name + (Id.File, Id.Language.Config.Object_File_Suffix); + Id.Switches := Switches_Name (Id.File); + + -- Add the source id to the Unit_Sources_HT hash table, if the + -- unit name is not null. + + if Src.Kind /= Sep and then Src.Unit_Name /= No_Name then + + declare + UData : Unit_Index := + Units_Htable.Get (Data.Tree.Units_HT, Src.Unit_Name); + begin + if UData = No_Unit_Index then + UData := new Unit_Data; + UData.Name := Src.Unit_Name; + Units_Htable.Set + (Data.Tree.Units_HT, Src.Unit_Name, UData); end if; - end if; - Next (Iter); - end loop; - end Check_Object_File_Names; - end Process_Sources_In_Multi_Language_Mode; + Id.Unit := UData; + end; + + -- Note that this updates Unit information as well + + Override_Kind (Id, Id.Kind); + end if; + + if Src.Index /= 0 then + Project.Project.Has_Multi_Unit_Sources := True; + end if; + + -- Add the source to the language list + + Id.Next_In_Lang := Id.Language.First_Source; + Id.Language.First_Source := Id; + + Files_Htable.Set (Data.File_To_Source, Id.File, Id); + + Next (Iter); + end loop; + end Get_Sources_From_Source_Info; -- Start of processing for Look_For_Sources begin - Source_Names.Reset; - Find_Excluded_Sources (Project, In_Tree, Excluded_Sources); + if Data.Tree.Source_Info_File_Exists then + Get_Sources_From_Source_Info; - if (Get_Mode = Ada_Only and then Is_A_Language (Project, Name_Ada)) - or else (Get_Mode = Multi_Language - and then Project.Languages /= No_Language_Index) - then - if Get_Mode = Multi_Language then - Load_Naming_Exceptions (Project, In_Tree, Excluded_Sources); + else + if Project.Project.Source_Dirs /= Nil_String then + Find_Excluded_Sources (Project, Data); + + if Project.Project.Languages /= No_Language_Index then + Load_Naming_Exceptions (Project, Data); + Find_Sources (Project, Data); + Mark_Excluded_Sources; + Check_Object_Files; + Check_Missing_Sources; + end if; end if; - Find_Sources - (Project, In_Tree, Proc_Data, Allow_Duplicate_Basenames, - Excluded => Excluded_Sources); - Mark_Excluded_Sources; - - if Get_Mode = Multi_Language then - Process_Sources_In_Multi_Language_Mode; - end if; + Object_File_Names_Htable.Reset (Object_Files); end if; end Look_For_Sources; @@ -8013,280 +7584,6 @@ package body Prj.Nmsc is end if; end Path_Name_Of; - ----------------------------------- - -- Prepare_Ada_Naming_Exceptions -- - ----------------------------------- - - procedure Prepare_Ada_Naming_Exceptions - (List : Array_Element_Id; - In_Tree : Project_Tree_Ref; - Kind : Spec_Or_Body) - is - Current : Array_Element_Id; - Element : Array_Element; - Unit : Unit_Info; - - begin - -- Traverse the list - - Current := List; - while Current /= No_Array_Element loop - Element := In_Tree.Array_Elements.Table (Current); - - if Element.Index /= No_Name then - Unit := - (Kind => Kind, - Unit => Element.Index, - Next => No_Ada_Naming_Exception); - Reverse_Ada_Naming_Exceptions.Set - (Unit, (Element.Value.Value, Element.Value.Index)); - Unit.Next := - Ada_Naming_Exceptions.Get (File_Name_Type (Element.Value.Value)); - Ada_Naming_Exception_Table.Increment_Last; - Ada_Naming_Exception_Table.Table - (Ada_Naming_Exception_Table.Last) := Unit; - Ada_Naming_Exceptions.Set - (File_Name_Type (Element.Value.Value), - Ada_Naming_Exception_Table.Last); - end if; - - Current := Element.Next; - end loop; - end Prepare_Ada_Naming_Exceptions; - - ----------------------- - -- Record_Ada_Source -- - ----------------------- - - procedure Record_Ada_Source - (File_Name : File_Name_Type; - Path_Name : Path_Name_Type; - Project : Project_Id; - In_Tree : Project_Tree_Ref; - Proc_Data : in out Processing_Data; - Ada_Language : Language_Ptr; - Location : Source_Ptr; - Source_Recorded : in out Boolean) - is - Canonical_File : File_Name_Type; - Canonical_Path : Path_Name_Type; - - File_Recorded : Boolean := False; - -- True when at least one file has been recorded - - procedure Record_Unit - (Unit_Name : Name_Id; - Unit_Ind : Int := 0; - Unit_Kind : Spec_Or_Body; - Needs_Pragma : Boolean); - -- Register of the units contained in the source file (there is in - -- general a single such unit except when exceptions to the naming - -- scheme indicate there are several such units) - - ----------------- - -- Record_Unit -- - ----------------- - - procedure Record_Unit - (Unit_Name : Name_Id; - Unit_Ind : Int := 0; - Unit_Kind : Spec_Or_Body; - Needs_Pragma : Boolean) - is - UData : constant Unit_Index := - Units_Htable.Get (In_Tree.Units_HT, Unit_Name); - -- ??? Add_Source will look it up again, can we do that only once ? - - Source : Source_Id; - To_Record : Boolean := False; - The_Location : Source_Ptr := Location; - Unit_Prj : Project_Id; - - begin - if Current_Verbosity = High then - Write_Str (" Putting "); - Write_Str (Get_Name_String (Unit_Name)); - Write_Line (" in the unit list."); - end if; - - -- The unit is already in the list, but may be it is only the other - -- unit kind (spec or body), or what is in the unit list is a unit of - -- a project we are extending. - - if UData /= No_Unit_Index then - if UData.File_Names (Unit_Kind) = null - or else - (UData.File_Names (Unit_Kind).File = Canonical_File - and then UData.File_Names (Unit_Kind).Locally_Removed) - or else Is_Extending - (Project.Extends, UData.File_Names (Unit_Kind).Project) - then - To_Record := True; - - -- If the same file is already in the list, do not add it again - - elsif UData.File_Names (Unit_Kind).Project = Project - and then - (Project.Known_Order_Of_Source_Dirs - or else - UData.File_Names (Unit_Kind).Path.Name = Canonical_Path) - then - To_Record := False; - - -- Else, same unit but not same file => It is an error to have two - -- units with the same name and the same kind (spec or body). - - else - if The_Location = No_Location then - The_Location := Project.Location; - end if; - - Err_Vars.Error_Msg_Name_1 := Unit_Name; - Error_Msg - (Project, In_Tree, "duplicate unit %%", The_Location); - - Err_Vars.Error_Msg_Name_1 := - UData.File_Names (Unit_Kind).Project.Name; - Err_Vars.Error_Msg_File_1 := - File_Name_Type (UData.File_Names (Unit_Kind).Path.Name); - Error_Msg - (Project, In_Tree, "\ project file %%, {", The_Location); - - Err_Vars.Error_Msg_Name_1 := Project.Name; - Err_Vars.Error_Msg_File_1 := File_Name_Type (Canonical_Path); - Error_Msg - (Project, In_Tree, "\ project file %%, {", The_Location); - - To_Record := False; - end if; - - -- It is a new unit, create a new record - - else - -- First, check if there is no other unit with this file name in - -- another project. If it is, report error but note we do that - -- only for the first unit in the source file. - - Unit_Prj := Files_Htable.Get (Proc_Data.Units, Canonical_File); - - if not File_Recorded - and then Unit_Prj /= No_Project - then - Error_Msg_File_1 := File_Name; - Error_Msg_Name_1 := Unit_Prj.Name; - Error_Msg - (Project, In_Tree, - "{ is already a source of project %%", - Location); - - else - To_Record := True; - end if; - end if; - - if To_Record then - Files_Htable.Set (Proc_Data.Units, Canonical_File, Project); - Add_Source - (Id => Source, - In_Tree => In_Tree, - Project => Project, - Lang_Id => Ada_Language, - File_Name => Canonical_File, - Display_File => File_Name, - Unit => Unit_Name, - Path => (Canonical_Path, Path_Name), - Naming_Exception => Needs_Pragma, - Kind => Unit_Kind, - Index => Unit_Ind); - Source_Recorded := True; - end if; - end Record_Unit; - - Exception_Id : Ada_Naming_Exception_Id; - Unit_Name : Name_Id; - Unit_Kind : Spec_Or_Body; - Unit_Ind : Int := 0; - Info : Unit_Info; - Name_Index : Name_And_Index; - Except_Name : Name_And_Index := No_Name_And_Index; - Needs_Pragma : Boolean; - - begin - Canonical_File := Canonical_Case_File_Name (Name_Id (File_Name)); - Canonical_Path := - Path_Name_Type (Canonical_Case_File_Name (Name_Id (Path_Name))); - - -- Check the naming scheme to get extra file properties - - Get_Unit - (In_Tree => In_Tree, - Canonical_File_Name => Canonical_File, - Project => Project, - Exception_Id => Exception_Id, - Unit_Name => Unit_Name, - Unit_Kind => Unit_Kind); - - Needs_Pragma := Exception_Id /= No_Ada_Naming_Exception; - - if Exception_Id = No_Ada_Naming_Exception - and then Unit_Name = No_Name - then - if Current_Verbosity = High then - Write_Str (" """); - Write_Str (Get_Name_String (Canonical_File)); - Write_Line (""" is not a valid source file name (ignored)."); - end if; - return; - end if; - - -- Check to see if the source has been hidden by an exception, - -- but only if it is not an exception. - - if not Needs_Pragma then - Except_Name := - Reverse_Ada_Naming_Exceptions.Get - ((Unit_Kind, Unit_Name, No_Ada_Naming_Exception)); - - if Except_Name /= No_Name_And_Index then - if Current_Verbosity = High then - Write_Str (" """); - Write_Str (Get_Name_String (Canonical_File)); - Write_Str (""" contains a unit that is found in """); - Write_Str (Get_Name_String (Except_Name.Name)); - Write_Line (""" (ignored)."); - end if; - - -- The file is not included in the source of the project since it - -- is hidden by the exception. So, nothing else to do. - - return; - end if; - end if; - - -- The following loop registers the unit in the appropriate table. It - -- will be executed multiple times when the file is a multi-unit file, - -- in which case Exception_Id initially points to the first file and - -- then to each other unit in the file. - - loop - if Exception_Id /= No_Ada_Naming_Exception then - Info := Ada_Naming_Exception_Table.Table (Exception_Id); - Exception_Id := Info.Next; - Info.Next := No_Ada_Naming_Exception; - Name_Index := Reverse_Ada_Naming_Exceptions.Get (Info); - - Unit_Name := Info.Unit; - Unit_Ind := Name_Index.Index; - Unit_Kind := Info.Kind; - end if; - - Record_Unit (Unit_Name, Unit_Ind, Unit_Kind, Needs_Pragma); - File_Recorded := True; - - exit when Exception_Id = No_Ada_Naming_Exception; - end loop; - end Record_Ada_Source; - ------------------- -- Remove_Source -- ------------------- @@ -8300,7 +7597,13 @@ package body Prj.Nmsc is begin if Current_Verbosity = High then Write_Str ("Removing source "); - Write_Line (Get_Name_String (Id.File)); + Write_Str (Get_Name_String (Id.File)); + + if Id.Index /= 0 then + Write_Str (" at" & Id.Index'Img); + end if; + + Write_Eol; end if; if Replaced_By /= No_Source then @@ -8339,12 +7642,12 @@ package body Prj.Nmsc is procedure Report_No_Sources (Project : Project_Id; Lang_Name : String; - In_Tree : Project_Tree_Ref; + Data : Tree_Processing_Data; Location : Source_Ptr; Continuation : Boolean := False) is begin - case When_No_Sources is + case Data.Flags.When_No_Sources is when Silent => null; @@ -8356,12 +7659,12 @@ package body Prj.Nmsc is " sources in this project"; begin - Error_Msg_Warn := When_No_Sources = Warning; + Error_Msg_Warn := Data.Flags.When_No_Sources = Warning; if Continuation then - Error_Msg (Project, In_Tree, "\" & Msg, Location); + Error_Msg (Data.Flags, "\" & Msg, Location, Project); else - Error_Msg (Project, In_Tree, Msg, Location); + Error_Msg (Data.Flags, Msg, Location, Project); end if; end; end case; @@ -8385,78 +7688,96 @@ package body Prj.Nmsc is while Current /= Nil_String loop Element := In_Tree.String_Elements.Table (Current); Write_Str (" "); - Write_Line (Get_Name_String (Element.Value)); + Write_Line (Get_Name_String (Element.Display_Value)); Current := Element.Next; end loop; Write_Line ("end Source_Dirs."); end Show_Source_Dirs; - ------------------------- - -- Warn_If_Not_Sources -- - ------------------------- - - -- comments needed in this body ??? + --------------------------- + -- Process_Naming_Scheme -- + --------------------------- - procedure Warn_If_Not_Sources - (Project : Project_Id; - In_Tree : Project_Tree_Ref; - Conventions : Array_Element_Id; - Specs : Boolean; - Extending : Boolean) + procedure Process_Naming_Scheme + (Tree : Project_Tree_Ref; + Root_Project : Project_Id; + Node_Tree : Prj.Tree.Project_Node_Tree_Ref; + Flags : Processing_Flags) is - Conv : Array_Element_Id; - Unit : Name_Id; - The_Unit_Data : Unit_Index; - Location : Source_Ptr; + 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; + + -- Start of processing for Process_Naming_Scheme begin - Conv := Conventions; - while Conv /= No_Array_Element loop - Unit := In_Tree.Array_Elements.Table (Conv).Index; - Error_Msg_Name_1 := Unit; - Get_Name_String (Unit); - To_Lower (Name_Buffer (1 .. Name_Len)); - Unit := Name_Find; - The_Unit_Data := Units_Htable.Get (In_Tree.Units_HT, Unit); - Location := In_Tree.Array_Elements.Table (Conv).Value.Location; + Lib_Data_Table.Init; + Initialize (Data, Tree => Tree, Node_Tree => Node_Tree, Flags => Flags); + Check_All_Projects (Root_Project, Data, Imported_First => True); + Free (Data); - if The_Unit_Data = No_Unit_Index then - Error_Msg (Project, In_Tree, "?unknown unit %%", Location); + -- Adjust language configs for projects that are extended - else - Error_Msg_Name_2 := - In_Tree.Array_Elements.Table (Conv).Value.Value; + declare + List : Project_List; + Proj : Project_Id; + Exte : Project_Id; + Lang : Language_Ptr; + Elng : Language_Ptr; - if Specs then - if not Check_Project - (The_Unit_Data.File_Names (Spec).Project, - Project, Extending) - then - Error_Msg - (Project, In_Tree, - "?source of spec of unit %% (%%)" & - " not found in this project", - Location); - end if; + begin + List := Tree.Projects; + while List /= null loop + Proj := List.Project; + Exte := Proj; + while Exte.Extended_By /= No_Project loop + Exte := Exte.Extended_By; + end loop; - else - if The_Unit_Data.File_Names (Impl) = null - or else not Check_Project - (The_Unit_Data.File_Names (Impl).Project, - Project, Extending) - then - Error_Msg - (Project, In_Tree, - "?source of body of unit %% (%%)" & - " not found in this project", - Location); + if Exte /= Proj then + Lang := Proj.Languages; + + if Lang /= No_Language_Index then + loop + Elng := Get_Language_From_Name + (Exte, Get_Name_String (Lang.Name)); + exit when Elng /= No_Language_Index; + Exte := Exte.Extends; + end loop; + + if Elng /= Lang then + Lang.Config := Elng.Config; + end if; end if; end if; - end if; - Conv := In_Tree.Array_Elements.Table (Conv).Next; - end loop; - end Warn_If_Not_Sources; + List := List.Next; + end loop; + end; + end Process_Naming_Scheme; end Prj.Nmsc;