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