From: Arnaud Charlet Date: Wed, 8 Dec 2004 11:25:51 +0000 (+0100) Subject: make.adb (Check_Mains, [...]): Adapt to name changes in package Prj (Current_Spec_Suf... X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=44e1918abd19b6012e27acc89c85230797a2fc79;p=gcc.git make.adb (Check_Mains, [...]): Adapt to name changes in package Prj (Current_Spec_Suffix => Ada_Spec_Suffix... * make.adb (Check_Mains, Switches_Of): Adapt to name changes in package Prj (Current_Spec_Suffix => Ada_Spec_Suffix, Current_Body_Suffix => Ada_Body_Suffix). Take into account Externally_Built attribute. * clean.adb (In_Extension_Chain): Always return False when one of the parameter is No_Project. (Clean_Project): Adapt to changes in package Prj (Lang_Ada => Ada_Language_Index). (Gnatclean): Adapt to change in package Prj.Pars (no parameter Process_Languages for procedure Parse). * gnatcmd.adb (Carg_Switches): New table. (GNATCmd): Put all switches following -cargs in the Carg_Switches table. Adapt to name changes in package Prj (Current_Spec_Suffix => Ada_Spec_Suffix, Current_Body_Suffix => Ada_Body_Suffix). * mlib-prj.adb: Adapt to changes in packages Prj and Prj.Com: type Header_Num and function Hash are now declared in package Prj, not Prj.Com. * prj.adb (Suffix_Of): New function. (Set (Suffix)): New procedure. (Hash): One function moved from Prj.Com (Is_Present, Language_Processing_Data_Of): New functions (Set): Two new procedures (Add_Language_Name, Display_Language_Name): New procedures * prj.ads: (Suffix_Of): New function (Set (Suffix)): New procedure Add several types and tables for multi-language support. (Header_Num): Type moved from Prj.Com (Hash): Two functions moved from Prj.Com (Is_Present, Language_Processing_Data_Of): New functions (Set): Two new procedures (Add_Language_Name, Display_Language_Name): New procedures (Naming): Component name changes: Current_Spec_Suffix => Ada_Spec_Suffix, Current_Body_Suffix => Ada_Body_Suffix. Add new components: Impl_Suffixes, Supp_Suffixes. (Project_Data): New components: Externally_Built, Supp_Languages, First_Language_Processing, Supp_Language_Processing, Default_Linker, Default_Linker_Path. * prj-attr.adb: Add new attributes Ada_Roots and Externally_Built and new package Language_Processing with its attributes (Compiler_Driver, Compiler_Kind, Dependency_Option, Compute_Dependency, Include_Option, Binder_Driver, Default_Linker). * prj-com.ads, prj-com.adb (Hash): Function moved to package Prj. (Header_Num): Type moved to package Prj * prj-env.adb: Adapt to name changes in package Prj (Current_Spec_Suffix => Ada_Spec_Suffix, Current_Body_Suffix => Ada_Body_Suffix). * prj-ext.adb: Add the default project dir (/log/gnat) by default to the project path, except the "-" is one of the directories in env var ADA_PROJECT_PATH. (Current_Project_Path): Global variable, replacing Project_Path that was in the body of Prj.Part. (Project_Path): New function (Set_Project_Path): New procedure Initialize Current_Project_Path during elaboration of the package Remove dependency on Prj.Com, no longer needed * prj-ext.ads (Project_Path): New function (Set_Project_Path): New procedure * prj-nmsc.adb (Body_Suffix_Of): New function. Returns . when no suffix is defined for language . (Find_Sources, Record_Other_Sources): Use Body_Suffix_Of, instead of accessing directly the components of Naming. (Look_For_Sources): Use Set (Suffix) to set the suffix of a language. Reorganise of this package. Break procedure Check in several procedures. * prj-nmsc.ads: Replace all procedures (Ada_Check, Other_Languages_Check and Language_Independent_Check) with a single procedure Check. * prj-pars.ads, prj-pars.adb (Parse): Remove parameter Process_Languages, no longer needed. * prj-part.adb (Project_Path): Move to the body of Prj.Ext as Current_Project_Path. Remove elaboration code, moved to the body of Prj.Ext Use new function Prj.Ext.Project_Path instead of old variable Project_Path. (Post_Parse_Context_Clause): Get Resolved_Path as a case-sensitive path. When comparing with project paths on the stack, first put the resolved path in canonical case. (Parse_Single_Project): Set the path name of the project file in the tree to the normalized path. * prj-proc.ads, prj-proc.adb (Check, Recursive_Check, Process): Remove parameter Process_Languages, no longer needed. (Recursive_Check): Call Prj.Nmsc.Check, instead of Ada_Check and Other_Languages_Check. * prj-tree.ads (Project_Name_And_Node): New component Canonical_Path to store the resolved canonical path of the project file. Remove dependency to Prj.Com, no longer needed * prj-util.adb: Adapt to name changes in package Prj (Current_Spec_Suffix => Ada_Spec_Suffix, Current_Body_Suffix => Ada_Body_Suffix). * snames.ads, snames.adb: New standard names: Ada_Roots, Binder_Driver, Compiler_Driver, Compiler_Kind, Compute_Dependency, Default_Linker, Externally_Built, Include_Option, Language_Processing. * makegpr.adb: Numerous changes due to changes in packages Prj and Prj.Nmsc. * gnatls.adb: Add the default project dir (/log/gnat) by default to the project path, except whe "-" is one of the directories in env var ADA_PROJECT_PATH. (Gnatls): In verbose mode, add the new section "Project Search Path:" From-SVN: r91877 --- diff --git a/gcc/ada/clean.adb b/gcc/ada/clean.adb index 1abfc801647..3af321115ea 100644 --- a/gcc/ada/clean.adb +++ b/gcc/ada/clean.adb @@ -30,7 +30,7 @@ with ALI; use ALI; with Csets; with Gnatvsn; with Hostparm; -with Makeutl; use Makeutl; +with Makeutl; with MLib.Tgt; use MLib.Tgt; with Namet; use Namet; with Opt; use Opt; @@ -593,7 +593,7 @@ package body Clean is Put_Line (""""); end if; - -- Add project to the list of proceesed projects + -- Add project to the list of processed projects Processed_Projects.Increment_Last; Processed_Projects.Table (Processed_Projects.Last) := Project; @@ -611,7 +611,7 @@ package body Clean is -- Look through the units to find those that are either immediate -- sources or inherited sources of the project. - if Data.Languages (Lang_Ada) then + if Data.Languages (Ada_Language_Index) then for Unit in 1 .. Prj.Com.Units.Last loop U_Data := Prj.Com.Units.Table (Unit); File_Name1 := No_Name; @@ -787,7 +787,9 @@ package body Clean is -- If it is a library with only non Ada sources, delete -- the fake archive and the dependency file, if they exist. - if Data.Library and then not Data.Languages (Lang_Ada) then + if Data.Library + and then not Data.Languages (Ada_Language_Index) + then Clean_Archive (Project); end if; end if; @@ -1105,8 +1107,7 @@ package body Clean is Prj.Pars.Parse (Project => Main_Project, Project_File_Name => Project_File_Name.all, - Packages_To_Check => Packages_To_Check_By_Gnatmake, - Process_Languages => All_Languages); + Packages_To_Check => Packages_To_Check_By_Gnatmake); if Main_Project = No_Project then Fail ("""" & Project_File_Name.all & """ processing failed"); @@ -1202,6 +1203,10 @@ package body Clean is Data : Project_Data; begin + if Prj = No_Project or else Of_Project = No_Project then + return False; + end if; + if Of_Project = Prj then return True; end if; @@ -1276,13 +1281,13 @@ package body Clean is begin -- Do not insert an empty name or an already marked source - if Lib_File /= No_Name and then not Is_Marked (Lib_File) then + if Lib_File /= No_Name and then not Makeutl.Is_Marked (Lib_File) then Q.Table (Q.Last) := Lib_File; Q.Increment_Last; -- Mark the source that has been just added to the Q - Mark (Lib_File); + Makeutl.Mark (Lib_File); end if; end Insert_Q; diff --git a/gcc/ada/gnatcmd.adb b/gcc/ada/gnatcmd.adb index 91b582a7331..0a836043071 100644 --- a/gcc/ada/gnatcmd.adb +++ b/gcc/ada/gnatcmd.adb @@ -74,8 +74,6 @@ procedure GNATCmd is -- files to pass to a tool, when there are more than -- Max_Files_On_The_Command_Line files. - -- A table to keep the switches from the project file - package First_Switches is new Table.Table (Table_Component_Type => String_Access, Table_Index_Type => Integer, @@ -83,6 +81,16 @@ procedure GNATCmd is Table_Initial => 20, Table_Increment => 100, Table_Name => "Gnatcmd.First_Switches"); + -- A table to keep the switches from the project file + + package Carg_Switches is new Table.Table + (Table_Component_Type => String_Access, + Table_Index_Type => Integer, + Table_Low_Bound => 1, + Table_Initial => 20, + Table_Increment => 100, + Table_Name => "Gnatcmd.Carg_Switches"); + -- A table to keep the switches following -cargs for ASIS tools package Library_Paths is new Table.Table ( Table_Component_Type => String_Access, @@ -152,6 +160,10 @@ procedure GNATCmd is -- Local Subprograms -- ----------------------- + procedure Add_To_Carg_Switches (Switch : String_Access); + -- Add a switch to the Carg_Switches table. If it is the first one, + -- put the switch "-cargs" at the beginning of the table. + procedure Check_Files; -- For GNAT LIST, GNAT PRETTY and GNAT METRIC, check if a project -- file is specified, without any file arguments. If it is the case, @@ -209,6 +221,23 @@ procedure GNATCmd is -- If it is and it includes directory information, prepend the path with -- Parent.This subprogram is only called when using project files. + -------------------------- + -- Add_To_Carg_Switches -- + -------------------------- + + procedure Add_To_Carg_Switches (Switch : String_Access) is + begin + -- If the Carg_Switches table is empty, put "-cargs" at the beginning + + if Carg_Switches.Last = 0 then + Carg_Switches.Increment_Last; + Carg_Switches.Table (Carg_Switches.Last) := new String'("-cargs"); + end if; + + Carg_Switches.Increment_Last; + Carg_Switches.Table (Carg_Switches.Last) := Switch; + end Add_To_Carg_Switches; + ----------------- -- Check_Files -- ----------------- @@ -966,6 +995,8 @@ begin First_Switches.Init; First_Switches.Set_Last (0); + Carg_Switches.Init; + Carg_Switches.Set_Last (0); VMS_Conv.Initialize; @@ -1626,20 +1657,40 @@ begin or else The_Command = Stub or else The_Command = Elim then + -- If -cargs is one of the switches, move the following + -- switches to the Carg_Switches table. + + for J in 1 .. First_Switches.Last loop + if First_Switches.Table (J).all = "-cargs" then + for K in J + 1 .. First_Switches.Last loop + Add_To_Carg_Switches (First_Switches.Table (K)); + end loop; + First_Switches.Set_Last (J - 1); + exit; + end if; + end loop; + + for J in 1 .. Last_Switches.Last loop + if Last_Switches.Table (J).all = "-cargs" then + for K in J + 1 .. Last_Switches.Last loop + Add_To_Carg_Switches (Last_Switches.Table (K)); + end loop; + Last_Switches.Set_Last (J - 1); + exit; + end if; + end loop; + declare CP_File : constant Name_Id := Configuration_Pragmas_File; - begin if CP_File /= No_Name then - First_Switches.Increment_Last; - if The_Command = Elim then + First_Switches.Increment_Last; First_Switches.Table (First_Switches.Last) := new String'("-C" & Get_Name_String (CP_File)); - else - First_Switches.Table (First_Switches.Last) := - new String'("-gnatec=" & Get_Name_String (CP_File)); + Add_To_Carg_Switches + (new String'("-gnatec=" & Get_Name_String (CP_File))); end if; end if; end; @@ -1698,7 +1749,7 @@ begin -- indicate to gnatstub the name of the body file with -- a -o switch. - if Data.Naming.Current_Spec_Suffix /= + if Data.Naming.Ada_Spec_Suffix /= Prj.Default_Ada_Spec_Suffix then if File_Index /= 0 then @@ -1708,14 +1759,14 @@ begin Last : Natural := Spec'Last; begin - Get_Name_String (Data.Naming.Current_Spec_Suffix); + Get_Name_String (Data.Naming.Ada_Spec_Suffix); if Spec'Length > Name_Len and then Spec (Last - Name_Len + 1 .. Last) = Name_Buffer (1 .. Name_Len) then Last := Last - Name_Len; - Get_Name_String (Data.Naming.Current_Body_Suffix); + Get_Name_String (Data.Naming.Ada_Body_Suffix); Last_Switches.Increment_Last; Last_Switches.Table (Last_Switches.Last) := new String'("-o"); @@ -1753,7 +1804,7 @@ begin end if; -- For gnatmetric, the generated files should be put in the - -- object directory. This must be the first dwitch, because it may + -- object directory. This must be the first switch, because it may -- be overriden by a switch in package Metrics in the project file -- or by a command line option. @@ -1783,7 +1834,9 @@ begin declare The_Args : Argument_List - (1 .. First_Switches.Last + Last_Switches.Last); + (1 .. First_Switches.Last + + Last_Switches.Last + + Carg_Switches.Last); Arg_Num : Natural := 0; begin @@ -1797,6 +1850,11 @@ begin The_Args (Arg_Num) := Last_Switches.Table (J); end loop; + for J in 1 .. Carg_Switches.Last loop + Arg_Num := Arg_Num + 1; + The_Args (Arg_Num) := Carg_Switches.Table (J); + end loop; + -- If Display_Command is on, only display the generated command if Display_Command then diff --git a/gcc/ada/gnatls.adb b/gcc/ada/gnatls.adb index a2dd0a1ac49..f8fec48d0e4 100644 --- a/gcc/ada/gnatls.adb +++ b/gcc/ada/gnatls.adb @@ -38,6 +38,7 @@ with Osint; use Osint; with Osint.L; use Osint.L; with Output; use Output; with Rident; use Rident; +with Sdefault; with Snames; with Targparm; use Targparm; with Types; use Types; @@ -47,6 +48,18 @@ with GNAT.Case_Util; use GNAT.Case_Util; procedure Gnatls is pragma Ident (Gnat_Static_Version_String); + Ada_Project_Path : constant String := "ADA_PROJECT_PATH"; + -- Name of the env. variable that contains path name(s) of directories + -- where project files may reside. + + Project_Search_Path : constant String := "Project Search Path:"; + -- Label displayed in verbose mode before the directories in the project + -- search path. + -- NOTE: This string may be used by other tools, such as GPS; so, it + -- should not be modified inconsiderately. + + No_Project_Default_Dir : constant String := "-"; + Max_Column : constant := 80; No_Obj : aliased String := ""; @@ -1522,6 +1535,105 @@ begin Write_Eol; end loop; + Write_Eol; + Write_Eol; + Write_Str (Project_Search_Path); + Write_Eol; + Write_Str (" "); + Write_Eol; + + declare + Project_Path : constant String_Access := Getenv (Ada_Project_Path); + + Lib : constant String := + Directory_Separator & "lib" & Directory_Separator; + + First : Natural; + Last : Natural; + + Add_Default_Dir : Boolean := True; + + begin + -- If there is a project path, display each directory in the path + + if Project_Path.all /= "" then + First := Project_Path'First; + + loop + while First <= Project_Path'Last + and then (Project_Path (First) = Path_Separator) + loop + First := First + 1; + end loop; + + exit when First > Project_Path'Last; + + Last := First; + + while Last < Project_Path'Last + and then Project_Path (Last + 1) /= Path_Separator + loop + Last := Last + 1; + end loop; + + -- If the directory is No_Default_Project_Dir, set + -- Add_Default_Dir to False + + if Project_Path (First .. Last) = No_Project_Default_Dir then + Add_Default_Dir := False; + + elsif First /= Last or else Project_Path (First) /= '.' then + -- If the directory is ".", skip it as it is the current + -- directory and it is already the first directory in the + -- project path. + + Write_Str (" "); + Write_Str (Project_Path (First .. Last)); + Write_Eol; + end if; + + First := Last + 1; + end loop; + end if; + + -- Add the default dir, except if "-" was one of the "directories" + -- specified in ADA_PROJECT_DIR. + + if Add_Default_Dir then + Name_Len := 0; + Add_Str_To_Name_Buffer (Sdefault.Search_Dir_Prefix.all); + + -- On Windows, make sure that all directory separators are '\' + + if Directory_Separator /= '/' then + for J in 1 .. Name_Len loop + if Name_Buffer (J) = '/' then + Name_Buffer (J) := Directory_Separator; + end if; + end loop; + end if; + + -- Find the sequence "/lib/" + + while Name_Len >= Lib'Length + and then Name_Buffer (Name_Len - 4 .. Name_Len) /= Lib + loop + Name_Len := Name_Len - 1; + end loop; + + -- If the sequence "/lib"/ was found, display the default + -- directory /lib/gnat/. + + if Name_Len >= 5 then + Write_Str (" "); + Write_Str (Name_Buffer (1 .. Name_Len)); + Write_Str ("gnat"); + Write_Char (Directory_Separator); + Write_Eol; + end if; + end if; + end; + Write_Eol; end if; diff --git a/gcc/ada/make.adb b/gcc/ada/make.adb index 473c73cdfe0..7d9be713f8c 100644 --- a/gcc/ada/make.adb +++ b/gcc/ada/make.adb @@ -43,7 +43,6 @@ with Namet; use Namet; with Opt; use Opt; with Osint.M; use Osint.M; with Osint; use Osint; -with Gnatvsn; with Output; use Output; with Prj; use Prj; with Prj.Com; @@ -120,7 +119,7 @@ package body Make is -- reinitialized, the elements between Q.First and Q.Last - 1 are unmarked. procedure Init_Q; - -- Must be called to (re)initialize the Q. + -- Must be called to (re)initialize the Q procedure Insert_Q (Source_File : File_Name_Type; @@ -130,13 +129,13 @@ package body Make is -- for external use (gnatdist). Provide index for multi-unit sources. function Empty_Q return Boolean; - -- Returns True if Q is empty. + -- Returns True if Q is empty procedure Extract_From_Q (Source_File : out File_Name_Type; Source_Unit : out Unit_Name_Type; Source_Index : out Int); - -- Extracts the first element from the Q. + -- Extracts the first element from the Q procedure Insert_Project_Sources (The_Project : Project_Id; @@ -151,10 +150,10 @@ package body Make is -- from projects being extended. First_Q_Initialization : Boolean := True; - -- Will be set to false after Init_Q has been called once. + -- Will be set to false after Init_Q has been called once Q_Front : Natural; - -- Points to the first valid element in the Q. + -- Points to the first valid element in the Q Unique_Compile : Boolean := False; -- Set to True if -u or -U or a project file with no main is used @@ -182,7 +181,7 @@ package body Make is Table_Initial => 4000, Table_Increment => 100, Table_Name => "Make.Q"); - -- This is the actual Q. + -- This is the actual Q -- The following instantiations and variables are necessary to save what -- is found on the command line, in case there is a project file specified. @@ -284,7 +283,7 @@ package body Make is -- Avoid calling Change_Dir if the current working directory is already -- this directory - -- Packages of project files where unknown attributes are errors. + -- Packages of project files where unknown attributes are errors Naming_String : aliased String := "naming"; Builder_String : aliased String := "builder"; @@ -338,7 +337,7 @@ package body Make is Table_Initial => 20, Table_Increment => 100, Table_Name => "Make.Bad_Compilation"); - -- Full name of all the source files for which compilation fails. + -- Full name of all the source files for which compilation fails Do_Compile_Step : Boolean := True; Do_Bind_Step : Boolean := True; @@ -411,7 +410,7 @@ package body Make is This : Name_Id; Depends_On : Name_Id; end record; - -- Components of table Dependencies below. + -- Components of table Dependencies below package Dependencies is new Table.Table ( Table_Component_Type => Dependency, @@ -473,10 +472,10 @@ package body Make is -- between the call to Compile_Sources and List_Depend.) procedure Inform (N : Name_Id := No_Name; Msg : String); - -- Prints out the program name followed by a colon, N and S. + -- Prints out the program name followed by a colon, N and S procedure List_Bad_Compilations; - -- Prints out the list of all files for which the compilation failed. + -- Prints out the list of all files for which the compilation failed procedure Verbose_Msg (N1 : Name_Id; @@ -485,9 +484,8 @@ package body Make is S2 : String := ""; Prefix : String := " -> "); -- If the verbose flag (Verbose_Mode) is set then print Prefix to standard - -- output followed by N1 and S1. If N2 /= No_Name then N2 is then printed - -- after S1. S2 is printed last. Both N1 and N2 are printed in quotation - -- marks. + -- output followed by N1 and S1. If N2 /= No_Name then N2 is printed after + -- S1. S2 is printed last. Both N1 and N2 are printed in quotation marks. Usage_Needed : Boolean := True; -- Flag used to make sure Makeusg is call at most once @@ -497,7 +495,7 @@ package body Make is -- Set Usage_Needed to False. procedure Debug_Msg (S : String; N : Name_Id); - -- If Debug.Debug_Flag_W is set outputs string S followed by name N. + -- If Debug.Debug_Flag_W is set outputs string S followed by name N procedure Recursive_Compute_Depth (Project : Project_Id; @@ -587,7 +585,7 @@ package body Make is Saved_Gcc : String_Access := null; Saved_Gnatbind : String_Access := null; Saved_Gnatlink : String_Access := null; - -- Given by the command line. Will be used, if non null. + -- Given by the command line. Will be used, if non null Gcc_Path : String_Access := GNAT.OS_Lib.Locate_Exec_On_Path (Gcc.all); @@ -613,7 +611,7 @@ package body Make is -- Set to True when compiling with -gnats Display_Executed_Programs : Boolean := True; - -- Set to True if name of commands should be output on stderr. + -- Set to True if name of commands should be output on stderr Output_File_Name_Seen : Boolean := False; -- Set to True after having scanned the file_name for @@ -624,14 +622,14 @@ package body Make is -- switch "-D obj_dir". Object_Directory_Path : String_Access := null; - -- The path name of the object directory, set with switch -D. + -- The path name of the object directory, set with switch -D type Make_Program_Type is (None, Compiler, Binder, Linker); Program_Args : Make_Program_Type := None; -- Used to indicate if we are scanning gnatmake, gcc, gnatbind, or gnatbind - -- options within the gnatmake command line. - -- Used in Scan_Make_Arg only, but must be a global variable. + -- options within the gnatmake command line. Used in Scan_Make_Arg only, + -- but must be global since value preserved from one call to another. Temporary_Config_File : Boolean := False; -- Set to True when there is a temporary config file used for a project @@ -1209,13 +1207,13 @@ package body Make is -- Full name of current library file Full_Obj_File : File_Name_Type; - -- Full name of the object file corresponding to Lib_File. + -- Full name of the object file corresponding to Lib_File Lib_Stamp : Time_Stamp_Type; - -- Time stamp of the current ada library file. + -- Time stamp of the current ada library file Obj_Stamp : Time_Stamp_Type; - -- Time stamp of the current object file. + -- Time stamp of the current object file Modified_Source : File_Name_Type; -- The first source in Lib_File whose current time stamp differs @@ -1640,13 +1638,13 @@ package body Make is O_File := No_File; O_Stamp := (others => ' '); - -- Process linker options from the ALI files. + -- Process linker options from the ALI files for Opt in 1 .. Linker_Options.Last loop Check_File (Linker_Options.Table (Opt).Name); end loop; - -- Process options given on the command line. + -- Process options given on the command line for Opt in Linker_Switches.First .. Linker_Switches.Last loop @@ -1907,7 +1905,7 @@ package body Make is end record; Running_Compile : array (1 .. Max_Process) of Compilation_Data; - -- Used to save information about outstanding compilations. + -- Used to save information about outstanding compilations Outstanding_Compiles : Natural := 0; -- Current number of outstanding compiles @@ -1928,10 +1926,10 @@ package body Make is -- Full name of the current library file Obj_File : File_Name_Type; - -- Full name of the object file corresponding to Lib_File. + -- Full name of the object file corresponding to Lib_File Obj_Stamp : Time_Stamp_Type; - -- Time stamp of the current object file. + -- Time stamp of the current object file Sfile : File_Name_Type; -- Contains the source file of the units withed by Source_File @@ -1939,6 +1937,8 @@ package body Make is ALI : ALI_Id; -- ALI Id of the current ALI file + -- Comment following declarations ??? + Read_Only : Boolean := False; Compilation_OK : Boolean; @@ -1950,10 +1950,13 @@ package body Make is Mfile : Natural := No_Mapping_File; Need_To_Check_Standard_Library : Boolean := - Check_Readonly_Files and not Unique_Compile; + Check_Readonly_Files + and not Unique_Compile; Mapping_File_Arg : String_Access; + Process_Created : Boolean := False; + procedure Add_Process (Pid : Process_Id; Sfile : File_Name_Type; @@ -1982,7 +1985,7 @@ package body Make is -- to wait for. function Bad_Compilation_Count return Natural; - -- Returns the number of compilation failures. + -- Returns the number of compilation failures procedure Check_Standard_Library; -- Check if s-stalib.adb needs to be compiled @@ -2008,17 +2011,17 @@ package body Make is Table_Initial => 50, Table_Increment => 100, Table_Name => "Make.Good_ALI"); - -- Contains the set of valid ALI files that have not yet been scanned. + -- Contains the set of valid ALI files that have not yet been scanned function Good_ALI_Present return Boolean; - -- Returns True if any ALI file was recorded in the previous set. + -- Returns True if any ALI file was recorded in the previous set procedure Get_Mapping_File (Project : Project_Id); -- Get a mapping file name. If there is one to be reused, reuse it. -- Otherwise, create a new mapping file. function Get_Next_Good_ALI return ALI_Id; - -- Returns the next good ALI_Id record; + -- Returns the next good ALI_Id record procedure Record_Failure (File : File_Name_Type; @@ -2029,7 +2032,7 @@ package body Make is -- could not find it. Records also Unit when possible. procedure Record_Good_ALI (A : ALI_Id); - -- Records in the previous set the Id of an ALI file. + -- Records in the previous set the Id of an ALI file ----------------- -- Add_Process -- @@ -2197,9 +2200,12 @@ package body Make is (Source_File : File_Name_Type; Source_Index : Int) is begin + -- Process_Created will be set True if an attempt is made to compile + -- the source, that is if it is not in an externally built project. + + Process_Created := False; - -- If arguments have not yet been collected (in Check), collect them - -- now. + -- If arguments not yet collected (in Check), collect them now if not Arguments_Collected then Collect_Arguments (Source_File, Source_Index, Args); @@ -2215,50 +2221,53 @@ package body Make is -- check for an eventual library project, and use the full path. if Arguments_Project /= No_Project then - Prj.Env.Set_Ada_Paths (Arguments_Project, True); + if not Projects.Table (Arguments_Project).Externally_Built then + Prj.Env.Set_Ada_Paths (Arguments_Project, True); - if MLib.Tgt.Support_For_Libraries /= MLib.Tgt.None then - declare - The_Data : Project_Data := - Projects.Table (Arguments_Project); - Prj : Project_Id := Arguments_Project; + if MLib.Tgt.Support_For_Libraries /= MLib.Tgt.None then + declare + The_Data : Project_Data := + Projects.Table (Arguments_Project); - begin - while The_Data.Extended_By /= No_Project loop - Prj := The_Data.Extended_By; - The_Data := Projects.Table (Prj); - end loop; + Prj : Project_Id := Arguments_Project; - if The_Data.Library - and then not The_Data.Need_To_Build_Lib - then - -- Add to the Q all sources of the project that - -- have not been marked + begin + while The_Data.Extended_By /= No_Project loop + Prj := The_Data.Extended_By; + The_Data := Projects.Table (Prj); + end loop; - Insert_Project_Sources - (The_Project => Prj, - All_Projects => False, - Into_Q => True); + if The_Data.Library + and then not The_Data.Need_To_Build_Lib + then + -- Add to the Q all sources of the project that + -- have not been marked - -- Now mark the project as processed + Insert_Project_Sources + (The_Project => Prj, + All_Projects => False, + Into_Q => True); - Projects.Table (Prj).Need_To_Build_Lib := True; - end if; - end; - end if; + -- Now mark the project as processed - -- Change to the object directory of the project file, - -- if necessary. + Projects.Table (Prj).Need_To_Build_Lib := True; + end if; + end; + end if; - Change_To_Object_Directory (Arguments_Project); + -- Change to the object directory of the project file, + -- if necessary. - Pid := Compile (Arguments_Path_Name, Lib_File, Source_Index, - Arguments (1 .. Last_Argument)); + Change_To_Object_Directory (Arguments_Project); + + Pid := Compile (Arguments_Path_Name, Lib_File, Source_Index, + Arguments (1 .. Last_Argument)); + Process_Created := True; + end if; else - -- If this is a source outside of any project file, make sure - -- it will be compiled in the object directory of the main project - -- file. + -- If this is a source outside of any project file, make sure it + -- will be compiled in object directory of the main project file. if Main_Project /= No_Project then Change_To_Object_Directory (Arguments_Project); @@ -2266,6 +2275,7 @@ package body Make is Pid := Compile (Full_Source_File, Lib_File, Source_Index, Arguments (1 .. Last_Argument)); + Process_Created := True; end if; end Collect_Arguments_And_Compile; @@ -2403,8 +2413,7 @@ package body Make is L /= Strip_Directory (L) or else Object_Directory_Path /= null then - - -- Build -o argument. + -- Build -o argument Get_Name_String (L); @@ -2542,7 +2551,7 @@ package body Make is begin pragma Assert (Args'First = 1); - -- Package and Queue initializations. + -- Package and Queue initializations Good_ALI.Init; Output.Set_Standard_Error; @@ -2690,7 +2699,7 @@ package body Make is if not Need_To_Compile then - -- The ALI file is up-to-date. Record its Id. + -- The ALI file is up-to-date. Record its Id Record_Good_ALI (ALI); @@ -2742,15 +2751,17 @@ package body Make is -- Make sure we could successfully start the compilation - if Pid = Invalid_Pid then - Record_Failure (Full_Source_File, Source_Unit); - else - Add_Process - (Pid, - Full_Source_File, - Lib_File, - Source_Unit, - Mfile); + if Process_Created then + if Pid = Invalid_Pid then + Record_Failure (Full_Source_File, Source_Unit); + else + Add_Process + (Pid, + Full_Source_File, + Lib_File, + Source_Unit, + Mfile); + end if; end if; end if; end if; @@ -2970,7 +2981,7 @@ package body Make is function Absolute_Path (Path : Name_Id; Project : Project_Id) return String; - -- Returns an absolute path for a configuration pragmas file. + -- Returns an absolute path for a configuration pragmas file ------------------- -- Absolute_Path -- @@ -3455,14 +3466,14 @@ package body Make is Locate_Regular_File (Main & Get_Name_String - (Data.Naming.Current_Body_Suffix), + (Data.Naming.Ada_Body_Suffix), ""); if Real_Path = null then Real_Path := Locate_Regular_File (Main & Get_Name_String - (Data.Naming.Current_Spec_Suffix), + (Data.Naming.Ada_Spec_Suffix), ""); end if; @@ -3970,6 +3981,13 @@ package body Make is Write_Eol; end if; + if Main_Project /= No_Project + and then Projects.Table (Main_Project).Externally_Built + then + Make_Failed + ("nothing to do for a main project that is externally built"); + end if; + if Osint.Number_Of_Files = 0 then if Main_Project /= No_Project and then Projects.Table (Main_Project).Library @@ -4338,12 +4356,13 @@ package body Make is for Proj in Projects.First .. Projects.Last loop if Projects.Table (Proj).Library then Projects.Table (Proj).Need_To_Build_Lib := - not MLib.Tgt.Library_Exists_For (Proj); + (not MLib.Tgt.Library_Exists_For (Proj)) + and then (not Projects.Table (Proj).Externally_Built); if Projects.Table (Proj).Need_To_Build_Lib then + -- If there is no object directory, then it will be - -- impossible to build the library. So, we fail - -- immediately. + -- impossible to build the library. So fail immediately. if Projects.Table (Proj).Object_Directory = No_Name then Make_Failed @@ -4640,13 +4659,13 @@ package body Make is Name_Buffer (Name_Len + 1 .. Name_Len + Exec_File_Name'Length) := - Exec_File_Name; + Exec_File_Name; + Name_Len := Name_Len + Exec_File_Name'Length; Executable := Name_Find; Non_Std_Executable := True; end if; end; - end if; if Do_Compile_Step then @@ -4658,7 +4677,7 @@ package body Make is Youngest_Obj_Stamp : Time_Stamp_Type; Executable_Stamp : Time_Stamp_Type; - -- Executable is the final executable program. + -- Executable is the final executable program Library_Rebuilt : Boolean := False; @@ -4701,7 +4720,6 @@ package body Make is if Total_Compilation_Failures /= 0 then if Keep_Going then goto Next_Main; - else List_Bad_Compilations; raise Compilation_Failed; @@ -4736,6 +4754,7 @@ package body Make is if Projects.Table (Proj1).Library and then not Projects.Table (Proj1).Need_To_Build_Lib + and then not Projects.Table (Proj1).Externally_Built then MLib.Prj.Check_Library (Proj1); end if; @@ -5289,7 +5308,7 @@ package body Make is end Link_Step; end if; - -- We go to here when we skip the bind and link steps. + -- We go to here when we skip the bind and link steps <> @@ -5631,7 +5650,7 @@ package body Make is Check_Object_Consistency := True; - -- Package initializations. The order of calls is important here. + -- Package initializations. The order of calls is important here Output.Set_Standard_Error; @@ -6270,7 +6289,7 @@ package body Make is B : Byte; begin - -- Dir last character is supposed to be a directory separator. + -- Dir last character is supposed to be a directory separator Name_Len := Dir'Length; Name_Buffer (1 .. Name_Len) := Dir; @@ -6971,9 +6990,9 @@ package body Make is Name : String (1 .. Source_File_Name'Length + 3); Last : Positive := Source_File_Name'Length; Spec_Suffix : constant String := - Get_Name_String (Naming.Current_Spec_Suffix); + Get_Name_String (Naming.Ada_Spec_Suffix); Body_Suffix : constant String := - Get_Name_String (Naming.Current_Body_Suffix); + Get_Name_String (Naming.Ada_Body_Suffix); Truncated : Boolean := False; begin diff --git a/gcc/ada/makegpr.adb b/gcc/ada/makegpr.adb index fc6768caa85..4806a9a7300 100644 --- a/gcc/ada/makegpr.adb +++ b/gcc/ada/makegpr.adb @@ -105,15 +105,27 @@ package body Makegpr is Last_Source : Natural := 0; -- The index of the last valid component of Source_Indexes - Compiler_Names : array (Programming_Language) of String_Access; + Compiler_Names : array (First_Language_Indexes) of String_Access; -- The names of the compilers to be used. Set up by Get_Compiler. -- Used to display the commands spawned. - Compiler_Paths : array (Programming_Language) of String_Access; + Gnatmake_String : constant String_Access := new String'("gnatmake"); + GCC_String : constant String_Access := new String'("gcc"); + G_Plus_Plus_String : constant String_Access := new String'("g++"); + + Default_Compiler_Names : constant array + (First_Language_Indexes range + Ada_Language_Index .. C_Plus_Plus_Language_Index) + of String_Access := + (Ada_Language_Index => Gnatmake_String, + C_Language_Index => GCC_String, + C_Plus_Plus_Language_Index => G_Plus_Plus_String); + + Compiler_Paths : array (First_Language_Indexes) of String_Access; -- The path names of the compiler to be used. Set up by Get_Compiler. -- Used to spawn compiling/linking processes. - Compiler_Is_Gcc : array (Programming_Language) of Boolean; + Compiler_Is_Gcc : array (First_Language_Indexes) of Boolean; -- An indication that a compiler is a GCC compiler, to be able to use -- specific GCC switches. @@ -163,7 +175,7 @@ package body Makegpr is Current_Processor : Processor := None; -- This variable changes when switches -*args are used - Current_Language : Programming_Language := Lang_Ada; + Current_Language : Language_Index := Ada_Language_Index; -- The compiler language to consider when Processor is Compiler package Comp_Opts is new GNAT.Dynamic_Tables @@ -172,7 +184,7 @@ package body Makegpr is Table_Low_Bound => 1, Table_Initial => 20, Table_Increment => 100); - Options : array (Programming_Language) of Comp_Opts.Instance; + Options : array (First_Language_Indexes) of Comp_Opts.Instance; -- Tables to store compiling options for the different compilers package Linker_Options is new Table.Table @@ -300,7 +312,7 @@ package body Makegpr is -- The environment variable to set when compiler is a GCC compiler -- to indicate the include directory path. - Current_Include_Paths : array (Programming_Language) of String_Access; + Current_Include_Paths : array (First_Language_Indexes) of String_Access; -- A cache for the paths of included directories, to avoid setting -- env var CPATH unnecessarily. @@ -357,7 +369,7 @@ package body Makegpr is procedure Add_Search_Directories (Data : Project_Data; - Language : Programming_Language); + Language : First_Language_Indexes); -- Either add to the Arguments the necessary -I switches needed to -- compile, or, when compiler is gcc/g++, set up the C*INCLUDE_PATH -- environment variable, if necessary. @@ -368,7 +380,7 @@ package body Makegpr is procedure Add_Switches (Data : Project_Data; Proc : Processor; - Language : Other_Programming_Language; + Language : Language_Index; File_Name : Name_Id); -- Add to Arguments the switches, if any, for a source (attribute Switches) -- or language (attribute Default_Switches), coming from package Compiler @@ -435,7 +447,7 @@ package body Makegpr is -- Display the command for a spawned process, if in Verbose_Mode or -- not in Quiet_Output. - procedure Get_Compiler (For_Language : Programming_Language); + procedure Get_Compiler (For_Language : First_Language_Indexes); -- Find the compiler name and path name for a specified programming -- language, if not already done. Results are in the corresponding -- elements of arrays Compiler_Names and Compiler_Paths. Name of compiler @@ -877,7 +889,7 @@ package body Makegpr is procedure Add_Search_Directories (Data : Project_Data; - Language : Programming_Language) + Language : First_Language_Indexes) is begin -- If a GNU compiler is used, set the CPATH environment variable, @@ -901,7 +913,7 @@ package body Makegpr is procedure Add_Switches (Data : Project_Data; Proc : Processor; - Language : Other_Programming_Language; + Language : Language_Index; File_Name : Name_Id) is Switches : Variable_Value; @@ -953,7 +965,7 @@ package body Makegpr is (Name => Name_Default_Switches, In_Arrays => Packages.Table (Pkg).Decl.Arrays); Switches := Prj.Util.Value_Of - (Index => Lang_Name_Ids (Language), + (Index => Language_Names.Table (Language), Src_Index => 0, In_Array => Defaults); end if; @@ -1546,7 +1558,7 @@ package body Makegpr is -- If there are sources in Ada, then gnatmake will build the -- library, so nothing to do. - if not Data.Languages (Lang_Ada) then + if not Data.Languages (Ada_Language_Index) then -- Get all the object files of the project @@ -1574,14 +1586,14 @@ package body Makegpr is -- building the library may fail with unresolved symbols. if C_Plus_Plus_Is_Used then - if Compiler_Names (Lang_C_Plus_Plus) = null then - Get_Compiler (Lang_C_Plus_Plus); + if Compiler_Names (C_Plus_Plus_Language_Index) = null then + Get_Compiler (C_Plus_Plus_Language_Index); end if; - if Compiler_Is_Gcc (Lang_C_Plus_Plus) then + if Compiler_Is_Gcc (C_Plus_Plus_Language_Index) then Name_Len := 0; Add_Str_To_Name_Buffer - (Compiler_Names (Lang_C_Plus_Plus).all); + (Compiler_Names (C_Plus_Plus_Language_Index).all); Driver_Name := Name_Find; end if; end if; @@ -2022,7 +2034,9 @@ package body Makegpr is C_Plus_Plus_Is_Used := False; for Project in 1 .. Projects.Last loop - if Projects.Table (Project).Languages (Lang_C_Plus_Plus) then + if + Projects.Table (Project).Languages (C_Plus_Plus_Language_Index) + then C_Plus_Plus_Is_Used := True; exit; end if; @@ -2171,7 +2185,8 @@ package body Makegpr is if Compiler_Is_Gcc (Source.Language) then Add_Argument (Dash_x, Verbose_Mode); Add_Argument - (Lang_Names (Source.Language), Verbose_Mode); + (Get_Name_String (Language_Names.Table (Source.Language)), + Verbose_Mode); end if; Add_Argument (Dash_c, True); @@ -2293,7 +2308,8 @@ package body Makegpr is Project_Name : String := Get_Name_String (Data.Name); Dummy : Boolean := False; - Ada_Is_A_Language : constant Boolean := Data.Languages (Lang_Ada); + Ada_Is_A_Language : constant Boolean := + Data.Languages (Ada_Language_Index); begin Ada_Mains.Init; @@ -2398,7 +2414,7 @@ package body Makegpr is -- Get the gnatmake to invoke - Get_Compiler (Lang_Ada); + Get_Compiler (Ada_Language_Index); -- Specify the project file @@ -2480,11 +2496,11 @@ package body Makegpr is -- If there are compiling options for Ada, transmit them to gnatmake - if Comp_Opts.Last (Options (Lang_Ada)) /= 0 then + if Comp_Opts.Last (Options (Ada_Language_Index)) /= 0 then Add_Argument (Dash_cargs, True); - for Arg in 1 .. Comp_Opts.Last (Options (Lang_Ada)) loop - Add_Argument (Options (Lang_Ada).Table (Arg), True); + for Arg in 1 .. Comp_Opts.Last (Options (Ada_Language_Index)) loop + Add_Argument (Options (Ada_Language_Index).Table (Arg), True); end loop; end if; @@ -2513,10 +2529,11 @@ package body Makegpr is -- And invoke gnatmake Display_Command - (Compiler_Names (Lang_Ada).all, Compiler_Paths (Lang_Ada)); + (Compiler_Names (Ada_Language_Index).all, + Compiler_Paths (Ada_Language_Index)); Spawn - (Compiler_Paths (Lang_Ada).all, + (Compiler_Paths (Ada_Language_Index).all, Arguments (1 .. Last_Argument), Success); @@ -2524,7 +2541,9 @@ package body Makegpr is if not Success then Report_Error - ("invocation of ", Compiler_Names (Lang_Ada).all, " failed"); + ("invocation of ", + Compiler_Names (Ada_Language_Index).all, + " failed"); end if; end Compile_Link_With_Gnatmake; @@ -2612,7 +2631,7 @@ package body Makegpr is if not Local_Errors and then Data.Library - and then not Data.Languages (Lang_Ada) + and then not Data.Languages (Ada_Language_Index) and then not Compile_Only then Build_Library (Project, Need_To_Rebuild_Archive); @@ -2770,7 +2789,7 @@ package body Makegpr is -- Get_Compiler -- ------------------ - procedure Get_Compiler (For_Language : Programming_Language) is + procedure Get_Compiler (For_Language : First_Language_Indexes) is Data : constant Project_Data := Projects.Table (Main_Project); Ide : constant Package_Id := @@ -2779,7 +2798,7 @@ package body Makegpr is Compiler : constant Variable_Value := Value_Of - (Name => Lang_Name_Ids (For_Language), + (Name => Language_Names.Table (For_Language), Index => 0, Attribute_Or_Array_Name => Name_Compiler_Command, In_Package => Ide); @@ -2794,8 +2813,16 @@ package body Makegpr is -- IDE, use the default compiler for this language. if Compiler = Nil_Variable_Value then - Compiler_Names (For_Language) := - Default_Compiler_Names (For_Language); + if For_Language in Default_Compiler_Names'Range then + Compiler_Names (For_Language) := + Default_Compiler_Names (For_Language); + + else + Osint.Fail + ("unknow compiler name for language """, + Get_Name_String (Language_Names.Table (For_Language)), + """"); + end if; else Compiler_Names (For_Language) := @@ -2825,7 +2852,7 @@ package body Makegpr is -- Fail if compiler cannot be found if Compiler_Paths (For_Language) = null then - if For_Language = Lang_Ada then + if For_Language = Ada_Language_Index then Osint.Fail ("unable to locate """, Compiler_Names (For_Language).all, @@ -2833,7 +2860,8 @@ package body Makegpr is else Osint.Fail - ("unable to locate " & Lang_Display_Names (For_Language).all, + ("unable to locate " & + Get_Name_String (Language_Names.Table (For_Language)), " compiler """, Compiler_Names (For_Language).all & '"'); end if; end if; @@ -3031,8 +3059,7 @@ package body Makegpr is Prj.Pars.Parse (Project => Main_Project, Project_File_Name => Project_File_Name.all, - Packages_To_Check => Packages_To_Check, - Process_Languages => Other_Languages); + Packages_To_Check => Packages_To_Check); -- Fail if parsing/processing was unsuccessful @@ -3238,9 +3265,9 @@ package body Makegpr is procedure Add_C_Plus_Plus_Link_For_Gnatmake is begin - if Compiler_Is_Gcc (Lang_C_Plus_Plus) then + if Compiler_Is_Gcc (C_Plus_Plus_Language_Index) then Add_Argument - ("--LINK=" & Compiler_Names (Lang_C_Plus_Plus).all, + ("--LINK=" & Compiler_Names (C_Plus_Plus_Language_Index).all, Verbose_Mode); else @@ -3313,11 +3340,11 @@ package body Makegpr is procedure Choose_C_Plus_Plus_Link_Process is begin - if Compiler_Names (Lang_C_Plus_Plus) = null then - Get_Compiler (Lang_C_Plus_Plus); + if Compiler_Names (C_Plus_Plus_Language_Index) = null then + Get_Compiler (C_Plus_Plus_Language_Index); end if; - if not Compiler_Is_Gcc (Lang_C_Plus_Plus) then + if not Compiler_Is_Gcc (C_Plus_Plus_Language_Index) then Change_Dir (Object_Dir); declare @@ -3332,7 +3359,7 @@ package body Makegpr is Put_Line (File, "LIBGCC=`gcc -print-libgcc-file-name`"); Put_Line (File, - Compiler_Names (Lang_C_Plus_Plus).all & + Compiler_Names (C_Plus_Plus_Language_Index).all & " $* ${LIBGCC}"); Close (File); @@ -3538,7 +3565,7 @@ package body Makegpr is -- Only Ada sources in the main project, and even maybe not - if not Data.Languages (Lang_Ada) then + if not Data.Languages (Ada_Language_Index) then -- Fail if the main project has no source of any language @@ -3568,7 +3595,7 @@ package body Makegpr is -- There are other language sources. First check if there are also -- sources in Ada. - if Data.Languages (Lang_Ada) then + if Data.Languages (Ada_Language_Index) then -- There is a mix of Ada and other language sources in the main -- project. Any main that is not a source of the other languages @@ -3694,7 +3721,7 @@ package body Makegpr is -- If C++ is one of the languages, add the --LINK switch to -- the linking switches. - if Data.Languages (Lang_C_Plus_Plus) then + if Data.Languages (C_Plus_Plus_Language_Index) then Add_Argument (Dash_largs, Verbose_Mode); Add_C_Plus_Plus_Link_For_Gnatmake; Add_Argument (Dash_margs, Verbose_Mode); @@ -3710,15 +3737,15 @@ package body Makegpr is -- First, get the linker to invoke - if Data.Languages (Lang_C_Plus_Plus) then - Get_Compiler (Lang_C_Plus_Plus); - Linker_Name := Compiler_Names (Lang_C_Plus_Plus); - Linker_Path := Compiler_Paths (Lang_C_Plus_Plus); + if Data.Languages (C_Plus_Plus_Language_Index) then + Get_Compiler (C_Plus_Plus_Language_Index); + Linker_Name := Compiler_Names (C_Plus_Plus_Language_Index); + Linker_Path := Compiler_Paths (C_Plus_Plus_Language_Index); else - Get_Compiler (Lang_C); - Linker_Name := Compiler_Names (Lang_C); - Linker_Path := Compiler_Paths (Lang_C); + Get_Compiler (C_Language_Index); + Linker_Name := Compiler_Names (C_Language_Index); + Linker_Path := Compiler_Paths (C_Language_Index); end if; Link_Done := False; @@ -3883,31 +3910,28 @@ package body Makegpr is -- Set the processor/language for the following switches - -- -c???args: Compiler arguments + -- -cargs: Ada compiler arguments - elsif Arg'Length >= 6 - and then Arg (Arg'First .. Arg'First + 1) = "-c" - and then Arg (Arg'Last - 3 .. Arg'Last) = "args" - then - declare - OK : Boolean := False; - Args_String : constant String := - Arg (Arg'First + 2 .. Arg'Last - 4); + elsif Arg = "-cargs" then + Current_Language := Ada_Language_Index; + Current_Processor := Compiler; + + elsif Arg'Length > 7 and then Arg (1 .. 7) = "-cargs:" then + Name_Len := 0; + Add_Str_To_Name_Buffer (Arg (8 .. Arg'Last)); + To_Lower (Name_Buffer (1 .. Name_Len)); + declare + Lang : constant Name_Id := Name_Find; begin - for Lang in Programming_Language loop - if Args_String = Lang_Args (Lang).all then - OK := True; - Current_Language := Lang; - exit; - end if; - end loop; + Current_Language := Language_Indexes.Get (Lang); - if OK then - Current_Processor := Compiler; - else - Osint.Fail ("illegal option """, Arg, """"); + if Current_Language = No_Language_Index then + Add_Language_Name (Lang); + Current_Language := Last_Language_Index; end if; + + Current_Processor := Compiler; end; elsif Arg = "-largs" then @@ -4045,10 +4069,8 @@ package body Makegpr is Osint.Write_Program_Name; Write_Str (" -P [opts] [name] {"); - for Lang in Programming_Language loop - Write_Str ("[-c"); - Write_Str (Lang_Args (Lang).all); - Write_Str ("args opts] "); + for Lang in First_Language_Indexes loop + Write_Str ("[-cargs:lang opts] "); end loop; Write_Str ("[-largs opts] [-gargs opts]}"); @@ -4116,30 +4138,15 @@ package body Makegpr is Write_Eol; Write_Eol; - -- Lines for -c*args - - for Lang in Programming_Language loop - declare - Column : Positive := 13 + Lang_Args (Lang)'Length; - -- " -cargs opts" is the minimum and is 13 character long + -- Line for -cargs - begin - Write_Str (" -c"); - Write_Str (Lang_Args (Lang).all); - Write_Str ("args opts"); + Write_Line (" -cargs opts opts are passed to the Ada compiler"); - loop - Write_Char (' '); - Column := Column + 1; - exit when Column >= 17; - end loop; + -- Line for -cargs:lang - Write_Str ("opts are passed to the "); - Write_Str (Lang_Display_Names (Lang).all); - Write_Str (" compiler"); - Write_Eol; - end; - end loop; + Write_Line (" -cargs: opts"); + Write_Line (" opts are passed to the compiler " & + "for language < lang > "); -- Line for -largs diff --git a/gcc/ada/mlib-prj.adb b/gcc/ada/mlib-prj.adb index 0af9b8f3205..c33559c3968 100644 --- a/gcc/ada/mlib-prj.adb +++ b/gcc/ada/mlib-prj.adb @@ -109,11 +109,11 @@ package body MLib.Prj is Table_Increment => 100); package Objects_Htable is new GNAT.HTable.Simple_HTable - (Header_Num => Com.Header_Num, + (Header_Num => Header_Num, Element => Boolean, No_Element => False, Key => Name_Id, - Hash => Com.Hash, + Hash => Hash, Equal => "="); -- List of non-Ada object files @@ -155,42 +155,42 @@ package body MLib.Prj is -- All the ALI file in the library package Library_ALIs is new GNAT.HTable.Simple_HTable - (Header_Num => Com.Header_Num, + (Header_Num => Header_Num, Element => Boolean, No_Element => False, Key => Name_Id, - Hash => Com.Hash, + Hash => Hash, Equal => "="); -- The ALI files in the interface sets package Interface_ALIs is new GNAT.HTable.Simple_HTable - (Header_Num => Com.Header_Num, + (Header_Num => Header_Num, Element => Boolean, No_Element => False, Key => Name_Id, - Hash => Com.Hash, + Hash => Hash, Equal => "="); -- The ALI files that have been processed to check if the corresponding -- library unit is in the interface set. package Processed_ALIs is new GNAT.HTable.Simple_HTable - (Header_Num => Com.Header_Num, + (Header_Num => Header_Num, Element => Boolean, No_Element => False, Key => Name_Id, - Hash => Com.Hash, + Hash => Hash, Equal => "="); -- The projects imported directly or indirectly. package Processed_Projects is new GNAT.HTable.Simple_HTable - (Header_Num => Com.Header_Num, + (Header_Num => Header_Num, Element => Boolean, No_Element => False, Key => Name_Id, - Hash => Com.Hash, + Hash => Hash, Equal => "="); -- The library projects imported directly or indirectly. diff --git a/gcc/ada/prj-attr.adb b/gcc/ada/prj-attr.adb index 324b7dcde30..349a0d445d1 100644 --- a/gcc/ada/prj-attr.adb +++ b/gcc/ada/prj-attr.adb @@ -82,6 +82,8 @@ package body Prj.Attr is "lVmain#" & "LVlanguages#" & "SVmain_language#" & + "LVada_roots#" & + "SVexternally_built#" & -- package Naming @@ -184,6 +186,17 @@ package body Prj.Attr is "SVvcs_file_check#" & "SVvcs_log_check#" & + -- package Language_Processing + + "Planguage_processing#" & + "Lacompiler_driver#" & + "Sacompiler_kind#" & + "Ladependency_option#" & + "Lacompute_dependency#" & + "Lainclude_option#" & + "Sabinder_driver#" & + "SVdefault_linker#" & + "#"; Initialized : Boolean := False; diff --git a/gcc/ada/prj-com.adb b/gcc/ada/prj-com.adb index 6610fdf1c2f..bc2583fc007 100644 --- a/gcc/ada/prj-com.adb +++ b/gcc/ada/prj-com.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2000-2003 Free Software Foundation, Inc. -- +-- Copyright (C) 2000-2004 Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -33,11 +33,6 @@ package body Prj.Com is -- Hash -- ---------- - function Hash (Name : Name_Id) return Header_Num is - begin - return Hash (Get_Name_String (Name)); - end Hash; - function Hash (Name : String_Id) return Header_Num is begin String_To_Name_Buffer (Name); diff --git a/gcc/ada/prj-com.ads b/gcc/ada/prj-com.ads index e4e73d92209..f5f692fc5bf 100644 --- a/gcc/ada/prj-com.ads +++ b/gcc/ada/prj-com.ads @@ -84,12 +84,6 @@ package Prj.Com is Table_Increment => 100, Table_Name => "Prj.Com.Units"); - type Header_Num is range 0 .. 2047; - - function Hash is new GNAT.HTable.Hash (Header_Num => Header_Num); - - function Hash (Name : Name_Id) return Header_Num; - function Hash (Name : String_Id) return Header_Num; package Units_Htable is new GNAT.HTable.Simple_HTable diff --git a/gcc/ada/prj-env.adb b/gcc/ada/prj-env.adb index 517a2ee57c4..1ce1209b82b 100644 --- a/gcc/ada/prj-env.adb +++ b/gcc/ada/prj-env.adb @@ -703,7 +703,7 @@ package body Prj.Env is (File, "pragma Source_File_Name_Project"); Put_Line (File, " (Spec_File_Name => ""*" & - Namet.Get_Name_String (Data.Naming.Current_Spec_Suffix) & + Namet.Get_Name_String (Data.Naming.Ada_Spec_Suffix) & ""","); Put_Line (File, " Casing => " & @@ -719,7 +719,7 @@ package body Prj.Env is (File, "pragma Source_File_Name_Project"); Put_Line (File, " (Body_File_Name => ""*" & - Namet.Get_Name_String (Data.Naming.Current_Body_Suffix) & + Namet.Get_Name_String (Data.Naming.Ada_Body_Suffix) & ""","); Put_Line (File, " Casing => " & @@ -732,7 +732,7 @@ package body Prj.Env is -- and maybe separate if - Data.Naming.Current_Body_Suffix /= Data.Naming.Separate_Suffix + Data.Naming.Ada_Body_Suffix /= Data.Naming.Separate_Suffix then Put_Line (File, "pragma Source_File_Name_Project"); @@ -1186,10 +1186,10 @@ package body Prj.Env is Extended_Spec_Name : String := Name & Namet.Get_Name_String - (Data.Naming.Current_Spec_Suffix); + (Data.Naming.Ada_Spec_Suffix); Extended_Body_Name : String := Name & Namet.Get_Name_String - (Data.Naming.Current_Body_Suffix); + (Data.Naming.Ada_Body_Suffix); Unit : Unit_Data; @@ -1674,10 +1674,10 @@ package body Prj.Env is Extended_Spec_Name : String := Name & Namet.Get_Name_String - (Data.Naming.Current_Spec_Suffix); + (Data.Naming.Ada_Spec_Suffix); Extended_Body_Name : String := Name & Namet.Get_Name_String - (Data.Naming.Current_Body_Suffix); + (Data.Naming.Ada_Body_Suffix); First : Unit_Id := Units.First; Current : Unit_Id; @@ -1862,10 +1862,10 @@ package body Prj.Env is Extended_Spec_Name : String := Name & Namet.Get_Name_String - (Data.Naming.Current_Spec_Suffix); + (Data.Naming.Ada_Spec_Suffix); Extended_Body_Name : String := Name & Namet.Get_Name_String - (Data.Naming.Current_Body_Suffix); + (Data.Naming.Ada_Body_Suffix); Unit : Unit_Data; diff --git a/gcc/ada/prj-ext.adb b/gcc/ada/prj-ext.adb index 5d8368f145a..118534b7c33 100644 --- a/gcc/ada/prj-ext.adb +++ b/gcc/ada/prj-ext.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2000-2003 Free Software Foundation, Inc. -- +-- Copyright (C) 2000-2004 Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -26,7 +26,7 @@ with Namet; use Namet; with Osint; use Osint; -with Prj.Com; use Prj.Com; +with Sdefault; with Types; use Types; with GNAT.HTable; @@ -34,6 +34,20 @@ with GNAT.OS_Lib; use GNAT.OS_Lib; package body Prj.Ext is + Ada_Project_Path : constant String := "ADA_PROJECT_PATH"; + -- Name of the env. variable that contains path name(s) of directories + -- where project files may reside. + + Prj_Path : constant String_Access := Getenv (Ada_Project_Path); + -- The path name(s) of directories where project files may reside. + -- May be empty. + + No_Project_Default_Dir : constant String := "-"; + + Current_Project_Path : String_Access; + -- The project path; initialized during elaboration of package + -- Contains at least the current working directory. + package Htable is new GNAT.HTable.Simple_HTable (Header_Num => Header_Num, Element => Name_Id, @@ -91,6 +105,15 @@ package body Prj.Ext is return False; end Check; + ------------------ + -- Project_Path -- + ------------------ + + function Project_Path return String is + begin + return Current_Project_Path.all; + end Project_Path; + ----------- -- Reset -- ----------- @@ -100,6 +123,16 @@ package body Prj.Ext is Htable.Reset; end Reset; + ---------------------- + -- Set_Project_Path -- + ---------------------- + + procedure Set_Project_Path (New_Path : String) is + begin + Free (Current_Project_Path); + Current_Project_Path := new String'(New_Path); + end Set_Project_Path; + -------------- -- Value_Of -- -------------- @@ -144,4 +177,77 @@ package body Prj.Ext is end; end Value_Of; +begin + -- Initialize Current_Project_Path during package elaboration + + declare + Add_Default_Dir : Boolean := True; + First : Positive; + Last : Positive; + + begin + -- The current directory is always first + + Name_Len := 1; + Name_Buffer (Name_Len) := '.'; + + -- If env. var. is defined and not empty, add its content + + if Prj_Path.all /= "" then + Name_Len := Name_Len + 1; + Name_Buffer (Name_Len) := Path_Separator; + + Add_Str_To_Name_Buffer (Prj_Path.all); + + -- Scan the directory path to see if "-" is one of the directories. + -- Remove each occurence of "-" and set Add_Default_Dir to False. + + First := 3; + loop + while First <= Name_Len + and then (Name_Buffer (First) = Path_Separator) + loop + First := First + 1; + end loop; + + exit when First > Name_Len; + + Last := First; + + while Last < Name_Len + and then Name_Buffer (Last + 1) /= Path_Separator + loop + Last := Last + 1; + end loop; + + -- If the directory is "-", set Add_Default_Dir to False and + -- remove from path. + + if Name_Buffer (First .. Last) = No_Project_Default_Dir then + Add_Default_Dir := False; + + for J in Last + 1 .. Name_Len loop + Name_Buffer (J - No_Project_Default_Dir'Length - 1) := + Name_Buffer (J); + end loop; + + Name_Len := Name_Len - No_Project_Default_Dir'Length - 1; + end if; + + First := Last + 1; + end loop; + end if; + + -- Set the initial value of Current_Project_Path + + if Add_Default_Dir then + Current_Project_Path := + new String'(Name_Buffer (1 .. Name_Len) & Path_Separator & + Sdefault.Search_Dir_Prefix.all & ".." & + Directory_Separator & ".." & Directory_Separator & + ".." & Directory_Separator & "gnat"); + else + Current_Project_Path := new String'(Name_Buffer (1 .. Name_Len)); + end if; + end; end Prj.Ext; diff --git a/gcc/ada/prj-ext.ads b/gcc/ada/prj-ext.ads index 5fc2f4b01eb..8b7dbf7dbde 100644 --- a/gcc/ada/prj-ext.ads +++ b/gcc/ada/prj-ext.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2000-2003 Free Software Foundation, Inc. -- +-- Copyright (C) 2000-2004 Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -31,6 +31,16 @@ with Types; use Types; package Prj.Ext is + function Project_Path return String; + -- Return the current value of the project path, either the value set + -- during elaboration of the package or, if procedure Set_Project_Path has + -- been called, the value set by the last call to Set_Project_Path. + + procedure Set_Project_Path (New_Path : String); + -- Give a new value to the project path. The new value New_Path should + -- always start with the current directory (".") and the path separators + -- should be the correct ones for the platform. + procedure Add (External_Name : String; Value : String); diff --git a/gcc/ada/prj-nmsc.adb b/gcc/ada/prj-nmsc.adb index 8bca19c660a..b56bdcc5678 100644 --- a/gcc/ada/prj-nmsc.adb +++ b/gcc/ada/prj-nmsc.adb @@ -69,8 +69,7 @@ package body Prj.Nmsc is end record; -- Information about file names found in string list attribute -- Source_Files or in a source list file, stored in hash table - -- Source_Names, used by procedure - -- Ada_Check.Get_Path_Names_And_Record_Sources. + -- Source_Names, used by procedure Get_Path_Names_And_Record_Sources. No_Name_Location : constant Name_Location := (Name => No_Name, Location => No_Location, Found => False); @@ -84,8 +83,7 @@ package body Prj.Nmsc is Equal => "="); -- Hash table to store file names found in string list attribute -- Source_Files or in a source list file, stored in hash table - -- Source_Names, used by procedure - -- Ada_Check.Get_Path_Names_And_Record_Sources. + -- Source_Names, used by procedure Get_Path_Names_And_Record_Sources. package Recursive_Dirs is new GNAT.HTable.Simple_HTable (Header_Num => Header_Num, @@ -147,14 +145,14 @@ package body Prj.Nmsc is -- a source with a file name following the naming convention. function ALI_File_Name (Source : String) return String; - -- Return the ALI file name corresponding to a source. + -- Return the ALI file name corresponding to a source procedure Check_Ada_Name (Name : String; Unit : out Name_Id); - -- Check that a name is a valid Ada unit name. + -- Check that a name is a valid Ada unit name - procedure Check_Ada_Naming_Scheme + procedure Check_Naming_Scheme (Data : in out Project_Data; Project : Project_Id); -- Check the naming scheme part of Data @@ -162,7 +160,7 @@ package body Prj.Nmsc is procedure Check_Ada_Naming_Scheme_Validity (Project : Project_Id; Naming : Naming_Data); - -- Check that the package Naming is correct. + -- Check that the package Naming is correct procedure Check_For_Source (File_Name : Name_Id; @@ -170,11 +168,29 @@ package body Prj.Nmsc is Project : Project_Id; Data : in out Project_Data; Location : Source_Ptr; - Language : Other_Programming_Language; + Language : Language_Index; Suffix : String; Naming_Exception : Boolean); -- Check if a file in a source directory is a source for a specific - -- language other than Ada. + -- language other than Ada. Comments required for parameters ??? + + procedure Check_If_Externally_Built + (Project : Project_Id; + Data : in out Project_Data); + -- ??? comment required + + procedure Check_Library_Attributes + (Project : Project_Id; + Data : in out Project_Data); + -- ??? comment required + + procedure Check_Package_Naming + (Project : Project_Id; + Data : in out Project_Data); + -- ??? comment required + + procedure Check_Programming_Languages (Data : in out Project_Data); + -- ??? comment required function Check_Project (P : Project_Id; @@ -183,10 +199,19 @@ package body Prj.Nmsc is -- Returns True if P is Root_Project or, if Extending is True, a project -- extended by Root_Project. + procedure Check_Stand_Alone_Library + (Project : Project_Id; + Data : in out Project_Data; + Extending : Boolean); + function Compute_Directory_Last (Dir : String) return Natural; -- Return the index of the last significant character in Dir. This is used -- to avoid duplicates '/' at the end of directory names + function Body_Suffix_Of + (Language : Language_Index; In_Project : Project_Data) + return String; + procedure Error_Msg (Project : Project_Id; Msg : String; @@ -198,7 +223,7 @@ package body Prj.Nmsc is procedure Find_Sources (Project : Project_Id; Data : in out Project_Data; - For_Language : Programming_Language; + For_Language : Language_Index; Follow_Links : Boolean := False); -- Find all the sources in all of the source directories of a project for -- a specified language. @@ -206,6 +231,12 @@ package body Prj.Nmsc is procedure Free_Ada_Naming_Exceptions; -- Free the internal hash tables used for checking naming exceptions + procedure Get_Directories + (Project : Project_Id; + Data : in out Project_Data); + -- Get the object directory, the exec directory and the source directories + -- of a project. + procedure Get_Mains (Project : Project_Id; Data : in out Project_Data); -- Get the mains of a project from attribute Main, if it exists, and put -- them in the project data. @@ -247,6 +278,12 @@ package body Prj.Nmsc is -- path name of the directory, Display is the directory path name for -- display purposes. + procedure Look_For_Sources + (Project : Project_Id; + Data : in out Project_Data; + Follow_Links : Boolean); + -- Comment required ??? + function Path_Name_Of (File_Name : Name_Id; Directory : Name_Id) return String; @@ -262,7 +299,8 @@ package body Prj.Nmsc is function Project_Extends (Extending : Project_Id; Extended : Project_Id) return Boolean; - -- Returns True if Extending is extending directly or indirectly Extended. + -- Returns True if Extending is extending Extended either directly or + -- indirectly. procedure Record_Ada_Source (File_Name : Name_Id; @@ -279,2006 +317,2078 @@ package body Prj.Nmsc is procedure Record_Other_Sources (Project : Project_Id; Data : in out Project_Data; - Language : Programming_Language; + Language : Language_Index; Naming_Exceptions : Boolean); -- Record the sources of a language in a project. -- When Naming_Exceptions is True, mark the found sources as such, to -- later remove those that are not named in a list of sources. procedure Show_Source_Dirs (Project : Project_Id); - -- List all the source directories of a project. + -- List all the source directories of a project function Suffix_For - (Language : Programming_Language; + (Language : Language_Index; Naming : Naming_Data) return Name_Id; -- Get the suffix for the source of a language from a package naming. -- If not specified, return the default for the language. - --------------- - -- Ada_Check -- - --------------- + procedure Warn_If_Not_Sources + (Project : Project_Id; + Conventions : Array_Element_Id; + Specs : Boolean; + Extending : Boolean); + -- Check that individual naming conventions apply to immediate + -- sources of the project; if not, issue a warning. + + ------------------- + -- ALI_File_Name -- + ------------------- + + function ALI_File_Name (Source : String) return String is + begin + -- If the source name has an extension, then replace it with + -- the ALI suffix. + + for Index in reverse Source'First + 1 .. Source'Last loop + if Source (Index) = '.' then + return Source (Source'First .. Index - 1) & ALI_Suffix; + end if; + end loop; + + -- If there is no dot, or if it is the first character, just add the + -- ALI suffix. + + return Source & ALI_Suffix; + end ALI_File_Name; - procedure Ada_Check + ----------- + -- Check -- + ----------- + + procedure Check (Project : Project_Id; Report_Error : Put_Line_Access; Follow_Links : Boolean) is - Data : Project_Data; - Languages : Variable_Value := Nil_Variable_Value; + Data : Project_Data := Projects.Table (Project); Extending : Boolean := False; - procedure Get_Path_Names_And_Record_Sources; - -- 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 Warn_If_Not_Sources - (Conventions : Array_Element_Id; - Specs : Boolean); - -- Check that individual naming conventions apply to immediate - -- sources of the project; if not, issue a warning. - - --------------------------------------- - -- Get_Path_Names_And_Record_Sources -- - --------------------------------------- + begin + Error_Report := Report_Error; - procedure Get_Path_Names_And_Record_Sources is - Source_Dir : String_List_Id := Data.Source_Dirs; - Element : String_Element; - Path : Name_Id; + Recursive_Dirs.Reset; - Dir : Dir_Type; - Name : Name_Id; - Canonical_Name : Name_Id; - Name_Str : String (1 .. 1_024); - Last : Natural := 0; - NL : Name_Location; + -- Object, exec and source directories - Current_Source : String_List_Id := Nil_String; + Get_Directories (Project, Data); - First_Error : Boolean := True; + -- Get the programming languages - Source_Recorded : Boolean := False; + Check_Programming_Languages (Data); - begin - -- We look in all source directories for the file names in the - -- hash table Source_Names + -- Library attributes - while Source_Dir /= Nil_String loop - Source_Recorded := False; - Element := String_Elements.Table (Source_Dir); + Check_Library_Attributes (Project, Data); - declare - Dir_Path : constant String := Get_Name_String (Element.Value); - begin - if Current_Verbosity = High then - Write_Str ("checking directory """); - Write_Str (Dir_Path); - Write_Line (""""); - end if; + Check_If_Externally_Built (Project, Data); - Open (Dir, Dir_Path); + if Current_Verbosity = High then + Show_Source_Dirs (Project); + end if; - loop - Read (Dir, Name_Str, Last); - exit when Last = 0; - Name_Len := Last; - Name_Buffer (1 .. Name_Len) := Name_Str (1 .. Last); - Name := Name_Find; - Canonical_Case_File_Name (Name_Str (1 .. Last)); - Name_Len := Last; - Name_Buffer (1 .. Name_Len) := Name_Str (1 .. Last); - Canonical_Name := Name_Find; - NL := Source_Names.Get (Canonical_Name); + Check_Package_Naming (Project, Data); - 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; + Extending := Data.Extends /= No_Project; - if Name_Buffer (Name_Len) /= Directory_Separator then - Add_Char_To_Name_Buffer (Directory_Separator); - end if; + Check_Naming_Scheme (Data, Project); - Add_Str_To_Name_Buffer (Name_Str (1 .. Last)); - Path := Name_Find; + Prepare_Ada_Naming_Exceptions (Data.Naming.Bodies, Body_Part); + Prepare_Ada_Naming_Exceptions (Data.Naming.Specs, Specification); - if Current_Verbosity = High then - Write_Str (" found "); - Write_Line (Get_Name_String (Name)); - end if; + -- Find the sources - -- Register the source if it is an Ada compilation unit. + if Data.Source_Dirs /= Nil_String then + Look_For_Sources (Project, Data, Follow_Links); + end if; - Record_Ada_Source - (File_Name => Name, - Path_Name => Path, - Project => Project, - Data => Data, - Location => NL.Location, - Current_Source => Current_Source, - Source_Recorded => Source_Recorded, - Follow_Links => Follow_Links); - end if; - end loop; + if Data.Ada_Sources_Present then - Close (Dir); - end; + -- Check that all individual naming conventions apply to sources of + -- this project file. + + Warn_If_Not_Sources + (Project, Data.Naming.Bodies, + Specs => False, + Extending => Extending); + Warn_If_Not_Sources + (Project, Data.Naming.Specs, + Specs => True, + Extending => Extending); + end if; - if Source_Recorded then - String_Elements.Table (Source_Dir).Flag := True; - end if; - Source_Dir := Element.Next; - end loop; + -- If it is a library project file, check if it is a standalone library - -- It is an error if a source file name in a source list or - -- in a source list file is not found. + if Data.Library then + Check_Stand_Alone_Library (Project, Data, Extending); + end if; - NL := Source_Names.Get_First; + -- Put the list of Mains, if any, in the project data - while NL /= No_Name_Location loop - if not NL.Found then - Err_Vars.Error_Msg_Name_1 := NL.Name; + Get_Mains (Project, Data); - if First_Error then - Error_Msg - (Project, - "source file { cannot be found", - NL.Location); - First_Error := False; + -- Update the project data in the Projects table - else - Error_Msg - (Project, - "\source file { cannot be found", - NL.Location); - end if; - end if; + Projects.Table (Project) := Data; - NL := Source_Names.Get_Next; - end loop; - end Get_Path_Names_And_Record_Sources; + Free_Ada_Naming_Exceptions; + end Check; - --------------------------- - -- Get_Sources_From_File -- - --------------------------- + -------------------- + -- Check_Ada_Name -- + -------------------- - 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. + procedure Check_Ada_Name + (Name : String; + Unit : out Name_Id) + is + The_Name : String := Name; + Real_Name : Name_Id; + Need_Letter : Boolean := True; + Last_Underscore : Boolean := False; + OK : Boolean := The_Name'Length > 0; - Get_Sources_From_File (Path, Location, Project); + begin + To_Lower (The_Name); - -- Look in the source directories to find those sources + Name_Len := The_Name'Length; + Name_Buffer (1 .. Name_Len) := The_Name; + Real_Name := Name_Find; - Get_Path_Names_And_Record_Sources; + -- Check first that the given name is not an Ada reserved word - -- We should have found at least one source. - -- If not, report an error. + if Get_Name_Table_Byte (Real_Name) /= 0 + and then Real_Name /= Name_Project + and then Real_Name /= Name_Extends + and then Real_Name /= Name_External + then + Unit := No_Name; - if Data.Sources = Nil_String then - Error_Msg (Project, - "there are no Ada sources in this project", - Location); + if Current_Verbosity = High then + Write_Str (The_Name); + Write_Line (" is an Ada reserved word."); end if; - end Get_Sources_From_File; - ------------------------- - -- Warn_If_Not_Sources -- - ------------------------- + return; + end if; - procedure Warn_If_Not_Sources - (Conventions : Array_Element_Id; - Specs : Boolean) - is - Conv : Array_Element_Id := Conventions; - Unit : Name_Id; - The_Unit_Id : Unit_Id; - The_Unit_Data : Unit_Data; - Location : Source_Ptr; + for Index in The_Name'Range loop + if Need_Letter then - begin - while Conv /= No_Array_Element loop - Unit := Array_Elements.Table (Conv).Index; - Error_Msg_Name_1 := Unit; - Get_Name_String (Unit); - To_Lower (Name_Buffer (1 .. Name_Len)); - Unit := Name_Find; - The_Unit_Id := Units_Htable.Get (Unit); - Location := Array_Elements.Table (Conv).Value.Location; - - if The_Unit_Id = Prj.Com.No_Unit then - Error_Msg - (Project, - "?unknown unit {", - Location); + -- We need a letter (at the beginning, and following a dot), + -- but we don't have one. - else - The_Unit_Data := Units.Table (The_Unit_Id); + if Is_Letter (The_Name (Index)) then + Need_Letter := False; - if Specs then - if not Check_Project - (The_Unit_Data.File_Names (Specification).Project, - Project, Extending) - then - Error_Msg - (Project, - "?unit{ has no spec in this project", - Location); - end if; + else + OK := False; - else - if not Check_Project - (The_Unit_Data.File_Names (Com.Body_Part).Project, - Project, Extending) - then - Error_Msg - (Project, - "?unit{ has no body in this project", - Location); - end if; + if Current_Verbosity = High then + Write_Int (Types.Int (Index)); + Write_Str (": '"); + Write_Char (The_Name (Index)); + Write_Line ("' is not a letter."); end if; + + exit; end if; - Conv := Array_Elements.Table (Conv).Next; - end loop; - end Warn_If_Not_Sources; + elsif Last_Underscore + and then (The_Name (Index) = '_' or else The_Name (Index) = '.') + then + -- Two underscores are illegal, and a dot cannot follow + -- an underscore. - -- Start of processing for Ada_Check + OK := False; - begin - Language_Independent_Check (Project, Report_Error); + if Current_Verbosity = High then + Write_Int (Types.Int (Index)); + Write_Str (": '"); + Write_Char (The_Name (Index)); + Write_Line ("' is illegal here."); + end if; - Error_Report := Report_Error; + exit; - Data := Projects.Table (Project); - Extending := Data.Extends /= No_Project; - Languages := Prj.Util.Value_Of (Name_Languages, Data.Decl.Attributes); + elsif The_Name (Index) = '.' then - Data.Naming.Current_Language := Name_Ada; - Data.Ada_Sources_Present := Data.Source_Dirs /= Nil_String; + -- We need a letter after a dot - if not Languages.Default then - declare - Current : String_List_Id := Languages.Values; - Element : String_Element; - Ada_Found : Boolean := False; + Need_Letter := True; - begin - Look_For_Ada : while Current /= Nil_String loop - Element := String_Elements.Table (Current); - Get_Name_String (Element.Value); - To_Lower (Name_Buffer (1 .. Name_Len)); + elsif The_Name (Index) = '_' then + Last_Underscore := True; - if Name_Buffer (1 .. Name_Len) = "ada" then - Ada_Found := True; - exit Look_For_Ada; - end if; + else + -- We need an letter or a digit - Current := Element.Next; - end loop Look_For_Ada; + Last_Underscore := False; - if not Ada_Found then + if not Is_Alphanumeric (The_Name (Index)) then + OK := False; - -- Mark the project file as having no sources for Ada + if Current_Verbosity = High then + Write_Int (Types.Int (Index)); + Write_Str (": '"); + Write_Char (The_Name (Index)); + Write_Line ("' is not alphanumeric."); + end if; - Data.Ada_Sources_Present := False; + exit; end if; - end; - end if; + end if; + end loop; - Check_Ada_Naming_Scheme (Data, Project); + -- Cannot end with an underscore or a dot - Prepare_Ada_Naming_Exceptions (Data.Naming.Bodies, Body_Part); - Prepare_Ada_Naming_Exceptions (Data.Naming.Specs, Specification); + OK := OK and then not Need_Letter and then not Last_Underscore; - -- If we have source directories, then find the sources + if OK then + Unit := Real_Name; - if Data.Ada_Sources_Present then - if Data.Source_Dirs = Nil_String then - Data.Ada_Sources_Present := False; + else + -- Signal a problem with No_Name - else - declare - Sources : constant Variable_Value := - Util.Value_Of - (Name_Source_Files, - Data.Decl.Attributes); + Unit := No_Name; + end if; + end Check_Ada_Name; - Source_List_File : constant Variable_Value := - Util.Value_Of - (Name_Source_List_File, - Data.Decl.Attributes); + -------------------------------------- + -- Check_Ada_Naming_Scheme_Validity -- + -------------------------------------- - Locally_Removed : constant Variable_Value := - Util.Value_Of - (Name_Locally_Removed_Files, - Data.Decl.Attributes); + procedure Check_Ada_Naming_Scheme_Validity + (Project : Project_Id; + Naming : Naming_Data) + is + begin + -- Only check if we are not using the standard naming scheme - begin - pragma Assert - (Sources.Kind = List, - "Source_Files is not a list"); + if Naming /= Standard_Naming_Data then + declare + Dot_Replacement : constant String := + Get_Name_String + (Naming.Dot_Replacement); - pragma Assert - (Source_List_File.Kind = Single, - "Source_List_File is not a single string"); + Spec_Suffix : constant String := + Get_Name_String + (Naming.Ada_Spec_Suffix); - if not Sources.Default then - if not Source_List_File.Default then - Error_Msg - (Project, - "?both variables source_files and " & - "source_list_file are present", - Source_List_File.Location); - end if; + Body_Suffix : constant String := + Get_Name_String + (Naming.Ada_Body_Suffix); - -- Sources is a list of file names + Separate_Suffix : constant String := + Get_Name_String + (Naming.Separate_Suffix); - declare - Current : String_List_Id := Sources.Values; - Element : String_Element; - Location : Source_Ptr; - Name : Name_Id; + begin + -- Dot_Replacement cannot + -- - be empty + -- - start or end with an alphanumeric + -- - be a single '_' + -- - start with an '_' followed by an alphanumeric + -- - contain a '.' except if it is "." - begin - Source_Names.Reset; + if Dot_Replacement'Length = 0 + or else Is_Alphanumeric + (Dot_Replacement (Dot_Replacement'First)) + or else Is_Alphanumeric + (Dot_Replacement (Dot_Replacement'Last)) + or else (Dot_Replacement (Dot_Replacement'First) = '_' + and then + (Dot_Replacement'Length = 1 + or else + Is_Alphanumeric + (Dot_Replacement (Dot_Replacement'First + 1)))) + or else (Dot_Replacement'Length > 1 + and then + Index (Source => Dot_Replacement, + Pattern => ".") /= 0) + then + Error_Msg + (Project, + '"' & Dot_Replacement & + """ is illegal for Dot_Replacement.", + Naming.Dot_Repl_Loc); + end if; - Data.Ada_Sources_Present := Current /= Nil_String; + -- Suffixes cannot + -- - be empty - while Current /= Nil_String loop - Element := String_Elements.Table (Current); - Get_Name_String (Element.Value); - Canonical_Case_File_Name - (Name_Buffer (1 .. Name_Len)); - Name := Name_Find; + if Is_Illegal_Suffix + (Spec_Suffix, Dot_Replacement = ".") + then + Err_Vars.Error_Msg_Name_1 := Naming.Ada_Spec_Suffix; + Error_Msg + (Project, + "{ is illegal for Spec_Suffix", + Naming.Spec_Suffix_Loc); + end if; - -- If the element has no location, then use the - -- location of Sources to report possible errors. + if Is_Illegal_Suffix + (Body_Suffix, Dot_Replacement = ".") + then + Err_Vars.Error_Msg_Name_1 := Naming.Ada_Body_Suffix; + Error_Msg + (Project, + "{ is illegal for Body_Suffix", + Naming.Body_Suffix_Loc); + end if; - if Element.Location = No_Location then - Location := Sources.Location; + if Body_Suffix /= Separate_Suffix then + if Is_Illegal_Suffix + (Separate_Suffix, Dot_Replacement = ".") + then + Err_Vars.Error_Msg_Name_1 := Naming.Separate_Suffix; + Error_Msg + (Project, + "{ is illegal for Separate_Suffix", + Naming.Sep_Suffix_Loc); + end if; + end if; - else - Location := Element.Location; - end if; + -- Spec_Suffix cannot have the same termination as + -- Body_Suffix or Separate_Suffix - Source_Names.Set - (K => Name, - E => - (Name => Name, - Location => Location, - Found => False)); + if Spec_Suffix'Length <= Body_Suffix'Length + and then + Body_Suffix (Body_Suffix'Last - + Spec_Suffix'Length + 1 .. + Body_Suffix'Last) = Spec_Suffix + then + Error_Msg + (Project, + "Body_Suffix (""" & + Body_Suffix & + """) cannot end with" & + " Spec_Suffix (""" & + Spec_Suffix & """).", + Naming.Body_Suffix_Loc); + end if; - Current := Element.Next; - end loop; + 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 + then + Error_Msg + (Project, + "Separate_Suffix (""" & + Separate_Suffix & + """) cannot end with" & + " Spec_Suffix (""" & + Spec_Suffix & """).", + Naming.Sep_Suffix_Loc); + end if; + end; + end if; + end Check_Ada_Naming_Scheme_Validity; - Get_Path_Names_And_Record_Sources; - end; + ---------------------- + -- Check_For_Source -- + ---------------------- - -- No source_files specified + procedure Check_For_Source + (File_Name : Name_Id; + Path_Name : Name_Id; + Project : Project_Id; + Data : in out Project_Data; + Location : Source_Ptr; + Language : Language_Index; + Suffix : String; + Naming_Exception : Boolean) + is + Name : String := Get_Name_String (File_Name); + Real_Location : Source_Ptr := Location; - -- We check Source_List_File has been specified. + begin + Canonical_Case_File_Name (Name); - elsif not Source_List_File.Default then + -- A file is a source of a language if Naming_Exception is True (case + -- of naming exceptions) or if its file name ends with the suffix. - -- Source_List_File is the name of the file - -- that contains the source file names + if Naming_Exception or else + (Name'Length > Suffix'Length and then + Name (Name'Last - Suffix'Length + 1 .. Name'Last) = Suffix) + then + if Real_Location = No_Location then + Real_Location := Data.Location; + end if; - declare - Source_File_Path_Name : constant String := - Path_Name_Of - (Source_List_File.Value, - Data.Directory); + declare + Path : String := Get_Name_String (Path_Name); - begin - if Source_File_Path_Name'Length = 0 then - Err_Vars.Error_Msg_Name_1 := Source_List_File.Value; - Error_Msg - (Project, - "file with sources { does not exist", - Source_List_File.Location); + Path_Id : Name_Id; + -- The path name id (in canonical case) - else - Get_Sources_From_File - (Source_File_Path_Name, - Source_List_File.Location); - end if; - end; + File_Id : Name_Id; + -- The file name id (in canonical case) - 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. + Obj_Id : Name_Id; + -- The object file name - Find_Sources (Project, Data, Lang_Ada, Follow_Links); - end if; + Obj_Path_Id : Name_Id; + -- The object path name - -- If there are sources that are locally removed, mark them as - -- such in the Units table. + Dep_Id : Name_Id; + -- The dependency file name - if not Locally_Removed.Default then + Dep_Path_Id : Name_Id; + -- The dependency path name - -- Sources can be locally removed only in extending - -- project files. + Dot_Pos : Natural := 0; + -- Position of the last dot in Name - if Data.Extends = No_Project then - Error_Msg - (Project, - "Locally_Removed_Files can only be used " & - "in an extending project file", - Locally_Removed.Location); + Source : Other_Source; + Source_Id : Other_Source_Id := Data.First_Other_Source; - else - declare - Current : String_List_Id := - Locally_Removed.Values; - Element : String_Element; - Location : Source_Ptr; - OK : Boolean; - Unit : Unit_Data; - Name : Name_Id; - Extended : Project_Id; + begin + Canonical_Case_File_Name (Path); - begin - while Current /= Nil_String loop - Element := String_Elements.Table (Current); - Get_Name_String (Element.Value); - Canonical_Case_File_Name - (Name_Buffer (1 .. Name_Len)); - Name := Name_Find; + -- Get the file name id - -- If the element has no location, then use the - -- location of Locally_Removed to report - -- possible errors. + Name_Len := Name'Length; + Name_Buffer (1 .. Name_Len) := Name; + File_Id := Name_Find; - if Element.Location = No_Location then - Location := Locally_Removed.Location; + -- Get the path name id - else - Location := Element.Location; - end if; + Name_Len := Path'Length; + Name_Buffer (1 .. Name_Len) := Path; + Path_Id := Name_Find; - OK := False; - - for Index in 1 .. Units.Last loop - Unit := Units.Table (Index); - - if - Unit.File_Names (Specification).Name = Name - then - OK := True; - - -- Check that this is from a project that - -- the current project extends, but not the - -- current project. - - Extended := Unit.File_Names - (Specification).Project; - - if Extended = Project then - Error_Msg - (Project, - "cannot remove a source " & - "of the same project", - Location); + -- Find the position of the last dot - elsif - Project_Extends (Project, Extended) - then - Unit.File_Names - (Specification).Path := Slash; - Unit.File_Names - (Specification).Needs_Pragma := False; - Units.Table (Index) := Unit; - Add_Forbidden_File_Name - (Unit.File_Names (Specification).Name); - exit; - - else - Error_Msg - (Project, - "cannot remove a source from " & - "another project", - Location); - end if; + for J in reverse Name'Range loop + if Name (J) = '.' then + Dot_Pos := J; + exit; + end if; + end loop; - elsif - Unit.File_Names (Body_Part).Name = Name - then - OK := True; + if Dot_Pos <= Name'First then + Dot_Pos := Name'Last + 1; + end if; - -- Check that this is from a project that - -- the current project extends, but not the - -- current project. + -- Compute the object file name - Extended := Unit.File_Names - (Body_Part).Project; + Get_Name_String (File_Id); + Name_Len := Dot_Pos - Name'First; - if Extended = Project then - Error_Msg - (Project, - "cannot remove a source " & - "of the same project", - Location); + for J in Object_Suffix'Range loop + Name_Len := Name_Len + 1; + Name_Buffer (Name_Len) := Object_Suffix (J); + end loop; - elsif - Project_Extends (Project, Extended) - then - Unit.File_Names (Body_Part).Path := Slash; - Unit.File_Names (Body_Part).Needs_Pragma - := False; - Units.Table (Index) := Unit; - Add_Forbidden_File_Name - (Unit.File_Names (Body_Part).Name); - exit; - end if; + Obj_Id := Name_Find; - end if; - end loop; + -- Compute the object path name - if not OK then - Err_Vars.Error_Msg_Name_1 := Name; - Error_Msg (Project, "unknown file {", Location); - end if; + Get_Name_String (Data.Object_Directory); - Current := Element.Next; - end loop; - end; - end if; - end if; - end; - end if; - end if; + if Name_Buffer (Name_Len) /= Directory_Separator and then + Name_Buffer (Name_Len) /= '/' + then + Name_Len := Name_Len + 1; + Name_Buffer (Name_Len) := Directory_Separator; + end if; - if Data.Ada_Sources_Present then + Add_Str_To_Name_Buffer (Get_Name_String (Obj_Id)); + Obj_Path_Id := Name_Find; - -- Check that all individual naming conventions apply to - -- sources of this project file. + -- Compute the dependency file name - Warn_If_Not_Sources (Data.Naming.Bodies, Specs => False); - Warn_If_Not_Sources (Data.Naming.Specs, Specs => True); - end if; + Get_Name_String (File_Id); + Name_Len := Dot_Pos - Name'First + 1; + Name_Buffer (Name_Len) := '.'; + Name_Len := Name_Len + 1; + Name_Buffer (Name_Len) := 'd'; + Dep_Id := Name_Find; - -- If it is a library project file, check if it is a standalone library + -- Compute the dependency path name - if Data.Library then - Standalone_Library : declare - Lib_Interfaces : constant Prj.Variable_Value := - Prj.Util.Value_Of - (Snames.Name_Library_Interface, - Data.Decl.Attributes); - Lib_Auto_Init : constant Prj.Variable_Value := - Prj.Util.Value_Of - (Snames.Name_Library_Auto_Init, - Data.Decl.Attributes); + Get_Name_String (Data.Object_Directory); - Lib_Src_Dir : constant Prj.Variable_Value := - Prj.Util.Value_Of - (Snames.Name_Library_Src_Dir, - Data.Decl.Attributes); + if Name_Buffer (Name_Len) /= Directory_Separator and then + Name_Buffer (Name_Len) /= '/' + then + Name_Len := Name_Len + 1; + Name_Buffer (Name_Len) := Directory_Separator; + end if; - Lib_Symbol_File : constant Prj.Variable_Value := - Prj.Util.Value_Of - (Snames.Name_Library_Symbol_File, - Data.Decl.Attributes); + Add_Str_To_Name_Buffer (Get_Name_String (Dep_Id)); + Dep_Path_Id := Name_Find; - Lib_Symbol_Policy : constant Prj.Variable_Value := - Prj.Util.Value_Of - (Snames.Name_Library_Symbol_Policy, - Data.Decl.Attributes); + -- Check if source is already in the list of source for this + -- project: it may have already been specified as a naming + -- exception for the same language or an other language, or + -- they may be two identical file names in different source + -- directories. - Lib_Ref_Symbol_File : constant Prj.Variable_Value := - Prj.Util.Value_Of - (Snames.Name_Library_Reference_Symbol_File, - Data.Decl.Attributes); + while Source_Id /= No_Other_Source loop + Source := Other_Sources.Table (Source_Id); + Source_Id := Source.Next; - Auto_Init_Supported : constant Boolean := - MLib.Tgt. - Standalone_Library_Auto_Init_Is_Supported; + if Source.File_Name = File_Id then - OK : Boolean := True; + -- Two sources of different languages cannot have the same + -- file name. - begin - pragma Assert (Lib_Interfaces.Kind = List); + if Source.Language /= Language then + Error_Msg_Name_1 := File_Name; + Error_Msg + (Project, + "{ cannot be a source of several languages", + Real_Location); + return; - -- It is a stand-alone library project file if attribute - -- Library_Interface is defined. + -- No problem if a file has already been specified as + -- a naming exception of this language. - if not Lib_Interfaces.Default then - declare - Interfaces : String_List_Id := Lib_Interfaces.Values; - Interface_ALIs : String_List_Id := Nil_String; - Unit : Name_Id; - The_Unit_Id : Unit_Id; - The_Unit_Data : Unit_Data; + elsif Source.Path_Name = Path_Id then - procedure Add_ALI_For (Source : Name_Id); - -- Add an ALI file name to the list of Interface ALIs + -- Reset the naming exception flag, if this is not a + -- naming exception. - ----------------- - -- Add_ALI_For -- - ----------------- + if not Naming_Exception then + Other_Sources.Table (Source_Id).Naming_Exception := + False; + end if; - procedure Add_ALI_For (Source : Name_Id) is - begin - Get_Name_String (Source); + return; - declare - ALI : constant String := - ALI_File_Name (Name_Buffer (1 .. Name_Len)); - ALI_Name_Id : Name_Id; - begin - Name_Len := ALI'Length; - Name_Buffer (1 .. Name_Len) := ALI; - ALI_Name_Id := Name_Find; - - String_Elements.Increment_Last; - String_Elements.Table (String_Elements.Last) := - (Value => ALI_Name_Id, - Index => 0, - Display_Value => ALI_Name_Id, - Location => String_Elements.Table - (Interfaces).Location, - Flag => False, - Next => Interface_ALIs); - Interface_ALIs := String_Elements.Last; - end; - end Add_ALI_For; + -- There are several files with the same names, but the + -- order of the source directories is known (no /**): + -- only the first one encountered is kept, the other ones + -- are ignored. - begin - Data.Standalone_Library := True; + elsif Data.Known_Order_Of_Source_Dirs then + return; - -- Library_Interface cannot be an empty list + -- But it is an error if the order of the source directories + -- is not known. - if Interfaces = Nil_String then + else + Error_Msg_Name_1 := File_Name; Error_Msg (Project, - "Library_Interface cannot be an empty list", - Lib_Interfaces.Location); + "{ is found in several source directories", + Real_Location); + return; end if; - -- Process each unit name specified in the attribute - -- Library_Interface. - - while Interfaces /= Nil_String loop - Get_Name_String - (String_Elements.Table (Interfaces).Value); - To_Lower (Name_Buffer (1 .. Name_Len)); - - if Name_Len = 0 then - Error_Msg - (Project, - "an interface cannot be an empty string", - String_Elements.Table (Interfaces).Location); - - else - Unit := Name_Find; - Error_Msg_Name_1 := Unit; - The_Unit_Id := Units_Htable.Get (Unit); + -- Two sources with different file names cannot have the same + -- object file name. - if The_Unit_Id = Prj.Com.No_Unit then - Error_Msg - (Project, - "unknown unit {", - String_Elements.Table (Interfaces).Location); + elsif Source.Object_Name = Obj_Id then + Error_Msg_Name_1 := File_Id; + Error_Msg_Name_2 := Source.File_Name; + Error_Msg_Name_3 := Obj_Id; + Error_Msg + (Project, + "{ and { have the same object file {", + Real_Location); + return; + end if; + end loop; - else - -- Check that the unit is part of the project + if Current_Verbosity = High then + Write_Str (" found "); + Display_Language_Name (Language); + Write_Str (" source """); + Write_Str (Get_Name_String (File_Name)); + Write_Line (""""); + Write_Str (" object path = "); + Write_Line (Get_Name_String (Obj_Path_Id)); + end if; - The_Unit_Data := Units.Table (The_Unit_Id); + -- Create the Other_Source record - if The_Unit_Data.File_Names - (Com.Body_Part).Name /= No_Name - and then The_Unit_Data.File_Names - (Com.Body_Part).Path /= Slash - then - if Check_Project - (The_Unit_Data.File_Names (Body_Part).Project, - Project, Extending) - then - -- There is a body for this unit. - -- If there is no spec, we need to check - -- that it is not a subunit. + Source := + (Language => Language, + File_Name => File_Id, + Path_Name => Path_Id, + Source_TS => File_Stamp (Path_Id), + Object_Name => Obj_Id, + Object_Path => Obj_Path_Id, + Object_TS => File_Stamp (Obj_Path_Id), + Dep_Name => Dep_Id, + Dep_Path => Dep_Path_Id, + Dep_TS => File_Stamp (Dep_Path_Id), + Naming_Exception => Naming_Exception, + Next => No_Other_Source); - if The_Unit_Data.File_Names - (Specification).Name = No_Name - then - declare - Src_Ind : Source_File_Index; - - begin - Src_Ind := Sinput.P.Load_Project_File - (Get_Name_String - (The_Unit_Data.File_Names - (Body_Part).Path)); - - if Sinput.P.Source_File_Is_Subunit - (Src_Ind) - then - Error_Msg - (Project, - "{ is a subunit; " & - "it cannot be an interface", - String_Elements.Table - (Interfaces).Location); - end if; - end; - end if; + -- And add it to the Other_Sources table - -- The unit is not a subunit, so we add - -- to the Interface ALIs the ALI file - -- corresponding to the body. + Other_Sources.Increment_Last; + Other_Sources.Table (Other_Sources.Last) := Source; - Add_ALI_For - (The_Unit_Data.File_Names (Body_Part).Name); + -- There are sources of languages other than Ada in this project - else - Error_Msg - (Project, - "{ is not an unit of this project", - String_Elements.Table - (Interfaces).Location); - end if; + Data.Other_Sources_Present := True; - elsif The_Unit_Data.File_Names - (Com.Specification).Name /= No_Name - and then The_Unit_Data.File_Names - (Com.Specification).Path /= Slash - and then Check_Project - (The_Unit_Data.File_Names - (Specification).Project, - Project, Extending) + -- And there are sources of this language in this project - then - -- The unit is part of the project, it has - -- a spec, but no body. We add to the Interface - -- ALIs the ALI file corresponding to the spec. + Set (Language, True, Data); - Add_ALI_For - (The_Unit_Data.File_Names (Specification).Name); + -- Add this source to the list of sources of languages other than + -- Ada of the project. - else - Error_Msg - (Project, - "{ is not an unit of this project", - String_Elements.Table (Interfaces).Location); - end if; - end if; + if Data.First_Other_Source = No_Other_Source then + Data.First_Other_Source := Other_Sources.Last; - end if; + else + Other_Sources.Table (Data.Last_Other_Source).Next := + Other_Sources.Last; + end if; - Interfaces := String_Elements.Table (Interfaces).Next; - end loop; + Data.Last_Other_Source := Other_Sources.Last; + end; + end if; + end Check_For_Source; - -- Put the list of Interface ALIs in the project data + ------------------------------- + -- Check_If_Externally_Built -- + ------------------------------- - Data.Lib_Interface_ALIs := Interface_ALIs; + procedure Check_If_Externally_Built + (Project : Project_Id; Data : in out Project_Data) + is + Externally_Built : constant Variable_Value := + Util.Value_Of + (Name_Externally_Built, Data.Decl.Attributes); - -- Check value of attribute Library_Auto_Init and set - -- Lib_Auto_Init accordingly. + begin + if not Externally_Built.Default then + Get_Name_String (Externally_Built.Value); + To_Lower (Name_Buffer (1 .. Name_Len)); - if Lib_Auto_Init.Default then + if Name_Buffer (1 .. Name_Len) = "true" then + Data.Externally_Built := True; - -- If no attribute Library_Auto_Init is declared, then - -- set auto init only if it is supported. + elsif Name_Buffer (1 .. Name_Len) /= "false" then + Error_Msg (Project, + "Externally_Built may only be true or false", + Externally_Built.Location); + end if; + end if; - Data.Lib_Auto_Init := Auto_Init_Supported; + if Current_Verbosity = High then + Write_Str ("Project is "); - else - Get_Name_String (Lib_Auto_Init.Value); - To_Lower (Name_Buffer (1 .. Name_Len)); + if not Data.Externally_Built then + Write_Str ("not "); + end if; - if Name_Buffer (1 .. Name_Len) = "false" then - Data.Lib_Auto_Init := False; + Write_Line ("externally built."); + end if; + end Check_If_Externally_Built; - elsif Name_Buffer (1 .. Name_Len) = "true" then - if Auto_Init_Supported then - Data.Lib_Auto_Init := True; + ----------------------------- + -- Check_Naming_Scheme -- + ----------------------------- - else - -- Library_Auto_Init cannot be "true" if auto init - -- is not supported + procedure Check_Naming_Scheme + (Data : in out Project_Data; + Project : Project_Id) + is + Naming_Id : constant Package_Id := + Util.Value_Of (Name_Naming, Data.Decl.Packages); - Error_Msg - (Project, - "library auto init not supported " & - "on this platform", - Lib_Auto_Init.Location); - end if; + Naming : Package_Element; - else - Error_Msg - (Project, - "invalid value for attribute Library_Auto_Init", - Lib_Auto_Init.Location); - end if; - end if; - end; + procedure Check_Unit_Names (List : Array_Element_Id); + -- Check that a list of unit names contains only valid names - -- If attribute Library_Src_Dir is defined and not the - -- empty string, check if the directory exist and is not - -- the object directory or one of the source directories. - -- This is the directory where copies of the interface - -- sources will be copied. Note that this directory may be - -- the library directory. + ---------------------- + -- Check_Unit_Names -- + ---------------------- - if Lib_Src_Dir.Value /= Empty_String then - declare - Dir_Id : constant Name_Id := Lib_Src_Dir.Value; + procedure Check_Unit_Names (List : Array_Element_Id) is + Current : Array_Element_Id := List; + Element : Array_Element; + Unit_Name : Name_Id; - begin - Locate_Directory - (Dir_Id, Data.Display_Directory, - Data.Library_Src_Dir, - Data.Display_Library_Src_Dir); + begin + -- Loop through elements of the string list - -- If directory does not exist, report an error + while Current /= No_Array_Element loop + Element := Array_Elements.Table (Current); - if Data.Library_Src_Dir = No_Name then + -- Put file name in canonical case - -- Get the absolute name of the library directory - -- that does not exist, to report an error. + Get_Name_String (Element.Value.Value); + Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len)); + Element.Value.Value := Name_Find; - declare - Dir_Name : constant String := - Get_Name_String (Dir_Id); + -- Check that it contains a valid unit name - begin - if Is_Absolute_Path (Dir_Name) then - Err_Vars.Error_Msg_Name_1 := Dir_Id; + Get_Name_String (Element.Index); + Check_Ada_Name (Name_Buffer (1 .. Name_Len), Unit_Name); - else - Get_Name_String (Data.Directory); + if Unit_Name = No_Name then + Err_Vars.Error_Msg_Name_1 := Element.Index; + Error_Msg + (Project, + "{ is not a valid unit name.", + Element.Value.Location); - if Name_Buffer (Name_Len) /= - Directory_Separator - then - Name_Len := Name_Len + 1; - Name_Buffer (Name_Len) := - Directory_Separator; - end if; + else + if Current_Verbosity = High then + Write_Str (" Unit ("""); + Write_Str (Get_Name_String (Unit_Name)); + Write_Line (""")"); + end if; - Name_Buffer - (Name_Len + 1 .. - Name_Len + Dir_Name'Length) := - Dir_Name; - Name_Len := Name_Len + Dir_Name'Length; - Err_Vars.Error_Msg_Name_1 := Name_Find; - end if; + Element.Index := Unit_Name; + Array_Elements.Table (Current) := Element; + end if; - -- Report the error + Current := Element.Next; + end loop; + end Check_Unit_Names; - Error_Msg - (Project, - "Directory { does not exist", - Lib_Src_Dir.Location); - end; + -- Start of processing for Check_Naming_Scheme - -- Report an error if it is the same as the object - -- directory. + begin + -- If there is a package Naming, we will put in Data.Naming what is in + -- this package Naming. - elsif Data.Library_Src_Dir = Data.Object_Directory then - Error_Msg - (Project, - "directory to copy interfaces cannot be " & - "the object directory", - Lib_Src_Dir.Location); - Data.Library_Src_Dir := No_Name; + if Naming_Id /= No_Package then + Naming := Packages.Table (Naming_Id); - -- Check if it is the same as one of the source - -- directories. + if Current_Verbosity = High then + Write_Line ("Checking ""Naming"" for Ada."); + end if; - else - declare - Src_Dirs : String_List_Id := Data.Source_Dirs; - Src_Dir : String_Element; + declare + Bodies : constant Array_Element_Id := + Util.Value_Of (Name_Body, Naming.Decl.Arrays); - begin - while Src_Dirs /= Nil_String loop - Src_Dir := String_Elements.Table (Src_Dirs); - Src_Dirs := Src_Dir.Next; + Specs : constant Array_Element_Id := + Util.Value_Of (Name_Spec, Naming.Decl.Arrays); - -- Report an error if it is one of the - -- source directories. + begin + if Bodies /= No_Array_Element then - if Data.Library_Src_Dir = Src_Dir.Value then - Error_Msg - (Project, - "directory to copy interfaces cannot " & - "be one of the source directories", - Lib_Src_Dir.Location); - Data.Library_Src_Dir := No_Name; - exit; - end if; - end loop; - end; + -- We have elements in the array Body_Part - if Data.Library_Src_Dir /= No_Name - and then Current_Verbosity = High - then - Write_Str ("Directory to copy interfaces ="""); - Write_Str (Get_Name_String (Data.Library_Dir)); - Write_Line (""""); - end if; - end if; - end; + if Current_Verbosity = High then + Write_Line ("Found Bodies."); end if; - if not Lib_Symbol_Policy.Default then - declare - Value : constant String := - To_Lower - (Get_Name_String (Lib_Symbol_Policy.Value)); + Data.Naming.Bodies := Bodies; + Check_Unit_Names (Bodies); - begin - if Value = "autonomous" or else Value = "default" then - Data.Symbol_Data.Symbol_Policy := Autonomous; + else + if Current_Verbosity = High then + Write_Line ("No Bodies."); + end if; + end if; + + if Specs /= No_Array_Element then - elsif Value = "compliant" then - Data.Symbol_Data.Symbol_Policy := Compliant; + -- We have elements in the array Specs - elsif Value = "controlled" then - Data.Symbol_Data.Symbol_Policy := Controlled; + if Current_Verbosity = High then + Write_Line ("Found Specs."); + end if; - elsif Value = "restricted" then - Data.Symbol_Data.Symbol_Policy := Restricted; + Data.Naming.Specs := Specs; + Check_Unit_Names (Specs); - else - Error_Msg - (Project, - "illegal value for Library_Symbol_Policy", - Lib_Symbol_Policy.Location); - end if; - end; + else + if Current_Verbosity = High then + Write_Line ("No Specs."); end if; + end if; + end; - if Lib_Symbol_File.Default then - if Data.Symbol_Data.Symbol_Policy = Restricted then - Error_Msg - (Project, - "Library_Symbol_File needs to be defined when " & - "symbol policy is Restricted", - Lib_Symbol_Policy.Location); - end if; + -- We are now checking if variables Dot_Replacement, Casing, + -- Spec_Suffix, Body_Suffix and/or Separate_Suffix + -- exist. - else - Data.Symbol_Data.Symbol_File := Lib_Symbol_File.Value; + -- For each variable, if it does not exist, we do nothing, + -- because we already have the default. - Get_Name_String (Lib_Symbol_File.Value); + -- Check Dot_Replacement - if Name_Len = 0 then - Error_Msg - (Project, - "symbol file name cannot be an empty string", - Lib_Symbol_File.Location); + declare + Dot_Replacement : constant Variable_Value := + Util.Value_Of + (Name_Dot_Replacement, + Naming.Decl.Attributes); - else - OK := not Is_Absolute_Path (Name_Buffer (1 .. Name_Len)); + begin + pragma Assert (Dot_Replacement.Kind = Single, + "Dot_Replacement is not a single string"); - if OK then - for J in 1 .. Name_Len loop - if Name_Buffer (J) = '/' - or else Name_Buffer (J) = Directory_Separator - then - OK := False; - exit; - end if; - end loop; - end if; + if not Dot_Replacement.Default then + Get_Name_String (Dot_Replacement.Value); - if not OK then - Error_Msg_Name_1 := Lib_Symbol_File.Value; - Error_Msg - (Project, - "symbol file name { is illegal. " & - "Name canot include directory info.", - Lib_Symbol_File.Location); - end if; - end if; + if Name_Len = 0 then + Error_Msg + (Project, + "Dot_Replacement cannot be empty", + Dot_Replacement.Location); + + else + Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len)); + Data.Naming.Dot_Replacement := Name_Find; + Data.Naming.Dot_Repl_Loc := Dot_Replacement.Location; end if; + end if; + end; - if Lib_Ref_Symbol_File.Default then - if Data.Symbol_Data.Symbol_Policy = Compliant - or else Data.Symbol_Data.Symbol_Policy = Controlled - then - Error_Msg - (Project, - "a reference symbol file need to be defined", - Lib_Symbol_Policy.Location); - end if; + if Current_Verbosity = High then + Write_Str (" Dot_Replacement = """); + Write_Str (Get_Name_String (Data.Naming.Dot_Replacement)); + Write_Char ('"'); + Write_Eol; + end if; - else - Data.Symbol_Data.Reference := Lib_Ref_Symbol_File.Value; + -- Check Casing - Get_Name_String (Lib_Ref_Symbol_File.Value); + declare + Casing_String : constant Variable_Value := + Util.Value_Of + (Name_Casing, Naming.Decl.Attributes); - if Name_Len = 0 then - Error_Msg - (Project, - "reference symbol file name cannot be an empty string", - Lib_Symbol_File.Location); + begin + pragma Assert (Casing_String.Kind = Single, + "Casing is not a single string"); - else - OK := not Is_Absolute_Path (Name_Buffer (1 .. Name_Len)); + if not Casing_String.Default then + declare + Casing_Image : constant String := + Get_Name_String (Casing_String.Value); + begin + declare + Casing_Value : constant Casing_Type := + Value (Casing_Image); + begin + -- Ignore Casing on platforms where file names are + -- case-insensitive. - if OK then - for J in 1 .. Name_Len loop - if Name_Buffer (J) = '/' - or else Name_Buffer (J) = Directory_Separator - then - OK := False; - exit; - end if; - end loop; + if not File_Names_Case_Sensitive then + Data.Naming.Casing := All_Lower_Case; + + else + Data.Naming.Casing := Casing_Value; end if; + end; - if not OK then - Error_Msg_Name_1 := Lib_Ref_Symbol_File.Value; + exception + when Constraint_Error => + if Casing_Image'Length = 0 then Error_Msg (Project, - "reference symbol file { name is illegal. " & - "Name canot include directory info.", - Lib_Ref_Symbol_File.Location); - end if; + "Casing cannot be an empty string", + Casing_String.Location); - if not Is_Regular_File - (Get_Name_String (Data.Object_Directory) & - Directory_Separator & - Get_Name_String (Lib_Ref_Symbol_File.Value)) - then - Error_Msg_Name_1 := Lib_Ref_Symbol_File.Value; + else + Name_Len := Casing_Image'Length; + Name_Buffer (1 .. Name_Len) := Casing_Image; + Err_Vars.Error_Msg_Name_1 := Name_Find; Error_Msg (Project, - "library reference symbol file { does not exist", - Lib_Ref_Symbol_File.Location); - end if; - - if Data.Symbol_Data.Symbol_File /= No_Name then - declare - Symbol : String := - Get_Name_String - (Data.Symbol_Data.Symbol_File); - - Reference : String := - Get_Name_String - (Data.Symbol_Data.Reference); - - begin - Canonical_Case_File_Name (Symbol); - Canonical_Case_File_Name (Reference); - - if Symbol = Reference then - Error_Msg - (Project, - "reference symbol file and symbol file " & - "cannot be the same file", - Lib_Ref_Symbol_File.Location); - end if; - end; + "{ is not a correct Casing", + Casing_String.Location); end if; - end if; - end if; + end; end if; - end Standalone_Library; - end if; - - -- Put the list of Mains, if any, in the project data + end; - Get_Mains (Project, Data); + if Current_Verbosity = High then + Write_Str (" Casing = "); + Write_Str (Image (Data.Naming.Casing)); + Write_Char ('.'); + Write_Eol; + end if; - Projects.Table (Project) := Data; + -- Check Spec_Suffix - Free_Ada_Naming_Exceptions; - end Ada_Check; + declare + Ada_Spec_Suffix : constant Variable_Value := + Prj.Util.Value_Of + (Index => Name_Ada, + Src_Index => 0, + In_Array => Data.Naming.Spec_Suffix); - ------------------- - -- ALI_File_Name -- - ------------------- + begin + if Ada_Spec_Suffix.Kind = Single + and then Get_Name_String (Ada_Spec_Suffix.Value) /= "" + then + Get_Name_String (Ada_Spec_Suffix.Value); + Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len)); + Data.Naming.Ada_Spec_Suffix := Name_Find; + Data.Naming.Spec_Suffix_Loc := Ada_Spec_Suffix.Location; - function ALI_File_Name (Source : String) return String is - begin - -- If the source name has an extension, then replace it with - -- the ALI suffix. + else + Data.Naming.Ada_Spec_Suffix := Default_Ada_Spec_Suffix; + end if; + end; - for Index in reverse Source'First + 1 .. Source'Last loop - if Source (Index) = '.' then - return Source (Source'First .. Index - 1) & ALI_Suffix; + if Current_Verbosity = High then + Write_Str (" Spec_Suffix = """); + Write_Str (Get_Name_String (Data.Naming.Ada_Spec_Suffix)); + Write_Char ('"'); + Write_Eol; end if; - end loop; - -- If there is no dot, or if it is the first character, just add the - -- ALI suffix. + -- Check Body_Suffix - return Source & ALI_Suffix; - end ALI_File_Name; + declare + Ada_Body_Suffix : constant Variable_Value := + Prj.Util.Value_Of + (Index => Name_Ada, + Src_Index => 0, + In_Array => Data.Naming.Body_Suffix); - -------------------- - -- Check_Ada_Name -- - -------------------- + begin + if Ada_Body_Suffix.Kind = Single + and then Get_Name_String (Ada_Body_Suffix.Value) /= "" + then + Get_Name_String (Ada_Body_Suffix.Value); + Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len)); + Data.Naming.Ada_Body_Suffix := Name_Find; + Data.Naming.Body_Suffix_Loc := Ada_Body_Suffix.Location; - procedure Check_Ada_Name - (Name : String; - Unit : out Name_Id) - is - The_Name : String := Name; - Real_Name : Name_Id; - Need_Letter : Boolean := True; - Last_Underscore : Boolean := False; - OK : Boolean := The_Name'Length > 0; + else + Data.Naming.Ada_Body_Suffix := Default_Ada_Body_Suffix; + end if; + end; - begin - To_Lower (The_Name); + if Current_Verbosity = High then + Write_Str (" Body_Suffix = """); + Write_Str (Get_Name_String (Data.Naming.Ada_Body_Suffix)); + Write_Char ('"'); + Write_Eol; + end if; - Name_Len := The_Name'Length; - Name_Buffer (1 .. Name_Len) := The_Name; - Real_Name := Name_Find; + -- Check Separate_Suffix - -- Check first that the given name is not an Ada reserved word + declare + Ada_Sep_Suffix : constant Variable_Value := + Prj.Util.Value_Of + (Variable_Name => Name_Separate_Suffix, + In_Variables => Naming.Decl.Attributes); - if Get_Name_Table_Byte (Real_Name) /= 0 - and then Real_Name /= Name_Project - and then Real_Name /= Name_Extends - and then Real_Name /= Name_External - then - Unit := No_Name; + begin + if Ada_Sep_Suffix.Default then + Data.Naming.Separate_Suffix := + Data.Naming.Ada_Body_Suffix; + + else + Get_Name_String (Ada_Sep_Suffix.Value); + + if Name_Len = 0 then + Error_Msg + (Project, + "Separate_Suffix cannot be empty", + Ada_Sep_Suffix.Location); + + else + Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len)); + Data.Naming.Separate_Suffix := Name_Find; + Data.Naming.Sep_Suffix_Loc := Ada_Sep_Suffix.Location; + end if; + end if; + end; if Current_Verbosity = High then - Write_Str (The_Name); - Write_Line (" is an Ada reserved word."); + Write_Str (" Separate_Suffix = """); + Write_Str (Get_Name_String (Data.Naming.Separate_Suffix)); + Write_Char ('"'); + Write_Eol; end if; - return; + -- Check if Data.Naming is valid + + Check_Ada_Naming_Scheme_Validity (Project, Data.Naming); + + else + Data.Naming.Ada_Spec_Suffix := Default_Ada_Spec_Suffix; + Data.Naming.Ada_Body_Suffix := Default_Ada_Body_Suffix; + Data.Naming.Separate_Suffix := Default_Ada_Body_Suffix; end if; + end Check_Naming_Scheme; - for Index in The_Name'Range loop - if Need_Letter then + ------------------------------ + -- Check_Library_Attributes -- + ------------------------------ - -- We need a letter (at the beginning, and following a dot), - -- but we don't have one. + procedure Check_Library_Attributes + (Project : Project_Id; Data : in out Project_Data) + is + Attributes : constant Prj.Variable_Id := Data.Decl.Attributes; - if Is_Letter (The_Name (Index)) then - Need_Letter := False; + Lib_Dir : constant Prj.Variable_Value := + Prj.Util.Value_Of (Snames.Name_Library_Dir, Attributes); - else - OK := False; + Lib_Name : constant Prj.Variable_Value := + Prj.Util.Value_Of (Snames.Name_Library_Name, Attributes); - if Current_Verbosity = High then - Write_Int (Types.Int (Index)); - Write_Str (": '"); - Write_Char (The_Name (Index)); - Write_Line ("' is not a letter."); - end if; + Lib_Version : constant Prj.Variable_Value := + Prj.Util.Value_Of + (Snames.Name_Library_Version, Attributes); - exit; - end if; + The_Lib_Kind : constant Prj.Variable_Value := + Prj.Util.Value_Of + (Snames.Name_Library_Kind, Attributes); - elsif Last_Underscore - and then (The_Name (Index) = '_' or else The_Name (Index) = '.') - then - -- Two underscores are illegal, and a dot cannot follow - -- an underscore. + begin + -- Special case of extending project - OK := False; + if Data.Extends /= No_Project then + declare + Extended_Data : constant Project_Data := + Projects.Table (Data.Extends); - if Current_Verbosity = High then - Write_Int (Types.Int (Index)); - Write_Str (": '"); - Write_Char (The_Name (Index)); - Write_Line ("' is illegal here."); + begin + -- If the project extended is a library project, we inherit + -- the library name, if it is not redefined; we check that + -- the library directory is specified; and we reset the + -- library flag for the extended project. + + if Extended_Data.Library then + if Lib_Name.Default then + Data.Library_Name := Extended_Data.Library_Name; + end if; + + if Lib_Dir.Default then + if not Data.Virtual then + Error_Msg + (Project, + "a project extending a library project must " & + "specify an attribute Library_Dir", + Data.Location); + end if; + end if; + + Projects.Table (Data.Extends).Library := False; end if; + end; + end if; - exit; + pragma Assert (Lib_Dir.Kind = Single); - elsif The_Name (Index) = '.' then + if Lib_Dir.Value = Empty_String then + if Current_Verbosity = High then + Write_Line ("No library directory"); + end if; - -- We need a letter after a dot + else + -- Find path name, check that it is a directory - Need_Letter := True; + Locate_Directory + (Lib_Dir.Value, Data.Display_Directory, + Data.Library_Dir, Data.Display_Library_Dir); - elsif The_Name (Index) = '_' then - Last_Underscore := True; + if Data.Library_Dir = No_Name then - else - -- We need an letter or a digit + -- Get the absolute name of the library directory that + -- does not exist, to report an error. - Last_Underscore := False; + declare + Dir_Name : constant String := Get_Name_String (Lib_Dir.Value); - if not Is_Alphanumeric (The_Name (Index)) then - OK := False; + begin + if Is_Absolute_Path (Dir_Name) then + Err_Vars.Error_Msg_Name_1 := Lib_Dir.Value; - if Current_Verbosity = High then - Write_Int (Types.Int (Index)); - Write_Str (": '"); - Write_Char (The_Name (Index)); - Write_Line ("' is not alphanumeric."); + else + Get_Name_String (Data.Display_Directory); + + if Name_Buffer (Name_Len) /= Directory_Separator then + Name_Len := Name_Len + 1; + Name_Buffer (Name_Len) := Directory_Separator; + end if; + + Name_Buffer + (Name_Len + 1 .. Name_Len + Dir_Name'Length) := + Dir_Name; + Name_Len := Name_Len + Dir_Name'Length; + Err_Vars.Error_Msg_Name_1 := Name_Find; end if; - exit; - end if; - end if; - end loop; + -- Report the error - -- Cannot end with an underscore or a dot + Error_Msg + (Project, + "library directory { does not exist", + Lib_Dir.Location); + end; - OK := OK and then not Need_Letter and then not Last_Underscore; + -- comment ??? - if OK then - Unit := Real_Name; + elsif Data.Library_Dir = Data.Object_Directory then + Error_Msg + (Project, + "library directory cannot be the same " & + "as object directory", + Lib_Dir.Location); + Data.Library_Dir := No_Name; + Data.Display_Library_Dir := No_Name; - else - -- Signal a problem with No_Name + -- comment ??? - Unit := No_Name; + else + if Current_Verbosity = High then + Write_Str ("Library directory ="""); + Write_Str (Get_Name_String (Data.Display_Library_Dir)); + Write_Line (""""); + end if; + end if; end if; - end Check_Ada_Name; - ---------------------- - -- Check_For_Source -- - ---------------------- + pragma Assert (Lib_Name.Kind = Single); - procedure Check_For_Source - (File_Name : Name_Id; - Path_Name : Name_Id; - Project : Project_Id; - Data : in out Project_Data; - Location : Source_Ptr; - Language : Other_Programming_Language; - Suffix : String; - Naming_Exception : Boolean) - is - Name : String := Get_Name_String (File_Name); - Real_Location : Source_Ptr := Location; + 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; - begin - Canonical_Case_File_Name (Name); + else + -- There is no restriction on the syntax of library names - -- A file is a source of a language if Naming_Exception is True (case - -- of naming exceptions) or if its file name ends with the suffix. + Data.Library_Name := Lib_Name.Value; + end if; - if Naming_Exception or else - (Name'Length > Suffix'Length and then - Name (Name'Last - Suffix'Length + 1 .. Name'Last) = Suffix) + if Data.Library_Name /= No_Name + and then Current_Verbosity = High then - if Real_Location = No_Location then - Real_Location := Data.Location; - end if; + Write_Str ("Library name = """); + Write_Str (Get_Name_String (Data.Library_Name)); + Write_Line (""""); + end if; - declare - Path : String := Get_Name_String (Path_Name); + Data.Library := + Data.Library_Dir /= No_Name + and then + Data.Library_Name /= No_Name; - Path_Id : Name_Id; - -- The path name id (in canonical case) + if Data.Library then + if MLib.Tgt.Support_For_Libraries = MLib.Tgt.None then + Error_Msg + (Project, + "?libraries are not supported on this platform", + Lib_Name.Location); + Data.Library := False; - File_Id : Name_Id; - -- The file name id (in canonical case) + else + pragma Assert (Lib_Version.Kind = Single); - Obj_Id : Name_Id; - -- The object file name + if Lib_Version.Value = Empty_String then + if Current_Verbosity = High then + Write_Line ("No library version specified"); + end if; - Obj_Path_Id : Name_Id; - -- The object path name + else + Data.Lib_Internal_Name := Lib_Version.Value; + end if; - Dep_Id : Name_Id; - -- The dependency file name + pragma Assert (The_Lib_Kind.Kind = Single); - Dep_Path_Id : Name_Id; - -- The dependency path name + if The_Lib_Kind.Value = Empty_String then + if Current_Verbosity = High then + Write_Line ("No library kind specified"); + end if; - Dot_Pos : Natural := 0; - -- Position of the last dot in Name + else + Get_Name_String (The_Lib_Kind.Value); - Source : Other_Source; - Source_Id : Other_Source_Id := Data.First_Other_Source; + declare + Kind_Name : constant String := + To_Lower (Name_Buffer (1 .. Name_Len)); - begin - Canonical_Case_File_Name (Path); + OK : Boolean := True; - -- Get the file name id + begin + if Kind_Name = "static" then + Data.Library_Kind := Static; - Name_Len := Name'Length; - Name_Buffer (1 .. Name_Len) := Name; - File_Id := Name_Find; + elsif Kind_Name = "dynamic" then + Data.Library_Kind := Dynamic; - -- Get the path name id + elsif Kind_Name = "relocatable" then + Data.Library_Kind := Relocatable; - Name_Len := Path'Length; - Name_Buffer (1 .. Name_Len) := Path; - Path_Id := Name_Find; + else + Error_Msg + (Project, + "illegal value for Library_Kind", + The_Lib_Kind.Location); + OK := False; + end if; - -- Find the position of the last dot + if Current_Verbosity = High and then OK then + Write_Str ("Library kind = "); + Write_Line (Kind_Name); + end if; - for J in reverse Name'Range loop - if Name (J) = '.' then - Dot_Pos := J; - exit; - end if; - end loop; + if Data.Library_Kind /= Static and then + MLib.Tgt.Support_For_Libraries = MLib.Tgt.Static_Only + then + Error_Msg + (Project, + "only static libraries are supported " & + "on this platform", + The_Lib_Kind.Location); + Data.Library := False; + end if; + end; + end if; - if Dot_Pos <= Name'First then - Dot_Pos := Name'Last + 1; + if Data.Library and then Current_Verbosity = High then + Write_Line ("This is a library project file"); end if; - -- Compute the object file name + end if; + end if; + end Check_Library_Attributes; - Get_Name_String (File_Id); - Name_Len := Dot_Pos - Name'First; + -------------------------- + -- Check_Package_Naming -- + -------------------------- - for J in Object_Suffix'Range loop - Name_Len := Name_Len + 1; - Name_Buffer (Name_Len) := Object_Suffix (J); - end loop; + procedure Check_Package_Naming + (Project : Project_Id; Data : in out Project_Data) + is + Naming_Id : constant Package_Id := + Util.Value_Of (Name_Naming, Data.Decl.Packages); - Obj_Id := Name_Find; + Naming : Package_Element; - -- Compute the object path name + begin + -- If there is a package Naming, we will put in Data.Naming + -- what is in this package Naming. - Get_Name_String (Data.Object_Directory); + if Naming_Id /= No_Package then + Naming := Packages.Table (Naming_Id); - if Name_Buffer (Name_Len) /= Directory_Separator and then - Name_Buffer (Name_Len) /= '/' - then - Name_Len := Name_Len + 1; - Name_Buffer (Name_Len) := Directory_Separator; - end if; + if Current_Verbosity = High then + Write_Line ("Checking ""Naming""."); + end if; - Add_Str_To_Name_Buffer (Get_Name_String (Obj_Id)); - Obj_Path_Id := Name_Find; + -- Check Spec_Suffix - -- Compute the dependency file name + declare + Spec_Suffixs : Array_Element_Id := + Util.Value_Of + (Name_Spec_Suffix, + Naming.Decl.Arrays); - Get_Name_String (File_Id); - Name_Len := Dot_Pos - Name'First + 1; - Name_Buffer (Name_Len) := '.'; - Name_Len := Name_Len + 1; - Name_Buffer (Name_Len) := 'd'; - Dep_Id := Name_Find; + Suffix : Array_Element_Id; + Element : Array_Element; + Suffix2 : Array_Element_Id; - -- Compute the dependency path name + begin + -- If some suffixs have been specified, we make sure that + -- for each language for which a default suffix has been + -- specified, there is a suffix specified, either the one + -- in the project file or if there were none, the default. + + if Spec_Suffixs /= No_Array_Element then + Suffix := Data.Naming.Spec_Suffix; + + while Suffix /= No_Array_Element loop + Element := Array_Elements.Table (Suffix); + Suffix2 := Spec_Suffixs; + + while Suffix2 /= No_Array_Element loop + exit when Array_Elements.Table (Suffix2).Index = + Element.Index; + Suffix2 := Array_Elements.Table (Suffix2).Next; + end loop; - Get_Name_String (Data.Object_Directory); + -- There is a registered default suffix, but no + -- suffix specified in the project file. + -- Add the default to the array. + + if Suffix2 = No_Array_Element then + Array_Elements.Increment_Last; + Array_Elements.Table (Array_Elements.Last) := + (Index => Element.Index, + Src_Index => Element.Src_Index, + Index_Case_Sensitive => False, + Value => Element.Value, + Next => Spec_Suffixs); + Spec_Suffixs := Array_Elements.Last; + end if; - if Name_Buffer (Name_Len) /= Directory_Separator and then - Name_Buffer (Name_Len) /= '/' - then - Name_Len := Name_Len + 1; - Name_Buffer (Name_Len) := Directory_Separator; + Suffix := Element.Next; + end loop; + + -- Put the resulting array as the specification suffixs + + Data.Naming.Spec_Suffix := Spec_Suffixs; end if; + end; - Add_Str_To_Name_Buffer (Get_Name_String (Dep_Id)); - Dep_Path_Id := Name_Find; + declare + Current : Array_Element_Id := Data.Naming.Spec_Suffix; + Element : Array_Element; - -- Check if source is already in the list of source for this - -- project: it may have already been specified as a naming - -- exception for the same language or an other language, or they - -- may be two identical file names in different source - -- directories. + begin + while Current /= No_Array_Element loop + Element := Array_Elements.Table (Current); + Get_Name_String (Element.Value.Value); - while Source_Id /= No_Other_Source loop - Source := Other_Sources.Table (Source_Id); - Source_Id := Source.Next; + if Name_Len = 0 then + Error_Msg + (Project, + "Spec_Suffix cannot be empty", + Element.Value.Location); + end if; - if Source.File_Name = File_Id then - -- Two sources of different languages cannot have the same - -- file name. + Array_Elements.Table (Current) := Element; + Current := Element.Next; + end loop; + end; - if Source.Language /= Language then - Error_Msg_Name_1 := File_Name; - Error_Msg - (Project, - "{ cannot be a source of several languages", - Real_Location); - return; + -- Check Body_Suffix - -- No problem if a file has already been specified as - -- a naming exception of this language. + declare + Impl_Suffixs : Array_Element_Id := + Util.Value_Of + (Name_Body_Suffix, + Naming.Decl.Arrays); - elsif Source.Path_Name = Path_Id then - -- Reset the naming exception flag, if this is not a - -- naming exception. + Suffix : Array_Element_Id; + Element : Array_Element; + Suffix2 : Array_Element_Id; - if not Naming_Exception then - Other_Sources.Table (Source_Id).Naming_Exception := - False; - end if; + begin + -- If some suffixes have been specified, we make sure that + -- for each language for which a default suffix has been + -- specified, there is a suffix specified, either the one + -- in the project file or if there were noe, the default. + + if Impl_Suffixs /= No_Array_Element then + Suffix := Data.Naming.Body_Suffix; + + while Suffix /= No_Array_Element loop + Element := Array_Elements.Table (Suffix); + Suffix2 := Impl_Suffixs; + + while Suffix2 /= No_Array_Element loop + exit when Array_Elements.Table (Suffix2).Index = + Element.Index; + Suffix2 := Array_Elements.Table (Suffix2).Next; + end loop; - return; + -- There is a registered default suffix, but no suffix was + -- specified in the project file. Add the default to the + -- array. + + if Suffix2 = No_Array_Element then + Array_Elements.Increment_Last; + Array_Elements.Table (Array_Elements.Last) := + (Index => Element.Index, + Src_Index => Element.Src_Index, + Index_Case_Sensitive => False, + Value => Element.Value, + Next => Impl_Suffixs); + Impl_Suffixs := Array_Elements.Last; + end if; - -- There are several files with the same names, but the - -- order of the source directories is known (no /**): - -- only the first one encountered is kept, the other ones - -- are ignored. + Suffix := Element.Next; + end loop; - elsif Data.Known_Order_Of_Source_Dirs then - return; + -- Put the resulting array as the implementation suffixs - -- But it is an error if the order of the source directories - -- is not known. + Data.Naming.Body_Suffix := Impl_Suffixs; + end if; + end; - else - Error_Msg_Name_1 := File_Name; - Error_Msg - (Project, - "{ is found in several source directories", - Real_Location); - return; - end if; + declare + Current : Array_Element_Id := Data.Naming.Body_Suffix; + Element : Array_Element; - -- Two sources with different file names cannot have the same - -- object file name. + begin + while Current /= No_Array_Element loop + Element := Array_Elements.Table (Current); + Get_Name_String (Element.Value.Value); - elsif Source.Object_Name = Obj_Id then - Error_Msg_Name_1 := File_Id; - Error_Msg_Name_2 := Source.File_Name; - Error_Msg_Name_3 := Obj_Id; + if Name_Len = 0 then Error_Msg - (Project, - "{ and { have the same object file {", - Real_Location); - return; + (Project, + "Body_Suffix cannot be empty", + Element.Value.Location); end if; + + Array_Elements.Table (Current) := Element; + Current := Element.Next; end loop; + end; - if Current_Verbosity = High then - Write_Str (" found "); - Write_Str (Lang_Display_Names (Language).all); - Write_Str (" source """); - Write_Str (Get_Name_String (File_Name)); - Write_Line (""""); - Write_Str (" object path = "); - Write_Line (Get_Name_String (Obj_Path_Id)); - end if; + -- Get the exceptions, if any - -- Create the Other_Source record - Source := - (Language => Language, - File_Name => File_Id, - Path_Name => Path_Id, - Source_TS => File_Stamp (Path_Id), - Object_Name => Obj_Id, - Object_Path => Obj_Path_Id, - Object_TS => File_Stamp (Obj_Path_Id), - Dep_Name => Dep_Id, - Dep_Path => Dep_Path_Id, - Dep_TS => File_Stamp (Dep_Path_Id), - Naming_Exception => Naming_Exception, - Next => No_Other_Source); + Data.Naming.Specification_Exceptions := + Util.Value_Of + (Name_Specification_Exceptions, + In_Arrays => Naming.Decl.Arrays); - -- And add it to the Other_Sources table + Data.Naming.Implementation_Exceptions := + Util.Value_Of + (Name_Implementation_Exceptions, + In_Arrays => Naming.Decl.Arrays); + end if; + end Check_Package_Naming; - Other_Sources.Increment_Last; - Other_Sources.Table (Other_Sources.Last) := Source; + --------------------------------- + -- Check_Programming_Languages -- + --------------------------------- - -- There are sources of languages other than Ada in this project + procedure Check_Programming_Languages (Data : in out Project_Data) is + Languages : Variable_Value := Nil_Variable_Value; - Data.Other_Sources_Present := True; + begin + Languages := Prj.Util.Value_Of (Name_Languages, Data.Decl.Attributes); + Data.Ada_Sources_Present := Data.Source_Dirs /= Nil_String; + Data.Other_Sources_Present := Data.Source_Dirs /= Nil_String; - -- And there are sources of this language in this project + if Data.Source_Dirs /= Nil_String then - Data.Languages (Language) := True; + -- Check if languages are specified in this project - -- Add this source to the list of sources of languages other than - -- Ada of the project. + if Languages.Default then - if Data.First_Other_Source = No_Other_Source then - Data.First_Other_Source := Other_Sources.Last; + -- Attribute Languages is not specified. So, it defaults to + -- a project of language Ada only. - else - Other_Sources.Table (Data.Last_Other_Source).Next := - Other_Sources.Last; - end if; + Data.Languages (Ada_Language_Index) := True; - Data.Last_Other_Source := Other_Sources.Last; - end; + -- No sources of languages other than Ada + + Data.Other_Sources_Present := False; + + else + declare + Current : String_List_Id := Languages.Values; + Element : String_Element; + Lang_Name : Name_Id; + Index : Language_Index; + + begin + -- Assume that there is no language specified yet + + Data.Other_Sources_Present := False; + Data.Ada_Sources_Present := False; + + -- Look through all the languages specified in attribute + -- Languages, if any + + while Current /= Nil_String loop + Element := String_Elements.Table (Current); + Get_Name_String (Element.Value); + To_Lower (Name_Buffer (1 .. Name_Len)); + Lang_Name := Name_Find; + Index := Language_Indexes.Get (Lang_Name); + + if Index = No_Language_Index then + Add_Language_Name (Lang_Name); + Index := Last_Language_Index; + end if; + + Set (Index, True, Data); + Set (Language_Processing => Default_Language_Processing_Data, + For_Language => Index, + In_Project => Data); + + if Index = Ada_Language_Index then + Data.Ada_Sources_Present := True; + + else + Data.Other_Sources_Present := True; + end if; + + Current := Element.Next; + end loop; + end; + end if; end if; - end Check_For_Source; + end Check_Programming_Languages; - -------------------------------------- - -- Check_Ada_Naming_Scheme_Validity -- - -------------------------------------- + ------------------- + -- Check_Project -- + ------------------- - procedure Check_Ada_Naming_Scheme_Validity - (Project : Project_Id; - Naming : Naming_Data) + function Check_Project + (P : Project_Id; + Root_Project : Project_Id; + Extending : Boolean) return Boolean is begin - -- Only check if we are not using the standard naming scheme + if P = Root_Project then + return True; - if Naming /= Standard_Naming_Data then + elsif Extending then declare - Dot_Replacement : constant String := - Get_Name_String - (Naming.Dot_Replacement); + Data : Project_Data := Projects.Table (Root_Project); - Spec_Suffix : constant String := - Get_Name_String - (Naming.Current_Spec_Suffix); + begin + while Data.Extends /= No_Project loop + if P = Data.Extends then + return True; + end if; - Body_Suffix : constant String := - Get_Name_String - (Naming.Current_Body_Suffix); + Data := Projects.Table (Data.Extends); + end loop; + end; + end if; - Separate_Suffix : constant String := - Get_Name_String - (Naming.Separate_Suffix); + return False; + end Check_Project; + + ------------------------------- + -- Check_Stand_Alone_Library -- + ------------------------------- + + procedure Check_Stand_Alone_Library + (Project : Project_Id; + Data : in out Project_Data; + Extending : Boolean) + is + Lib_Interfaces : constant Prj.Variable_Value := + Prj.Util.Value_Of + (Snames.Name_Library_Interface, + Data.Decl.Attributes); + + Lib_Auto_Init : constant Prj.Variable_Value := + Prj.Util.Value_Of + (Snames.Name_Library_Auto_Init, + Data.Decl.Attributes); + + Lib_Src_Dir : constant Prj.Variable_Value := + Prj.Util.Value_Of + (Snames.Name_Library_Src_Dir, + Data.Decl.Attributes); + + Lib_Symbol_File : constant Prj.Variable_Value := + Prj.Util.Value_Of + (Snames.Name_Library_Symbol_File, + Data.Decl.Attributes); + + Lib_Symbol_Policy : constant Prj.Variable_Value := + Prj.Util.Value_Of + (Snames.Name_Library_Symbol_Policy, + Data.Decl.Attributes); + + Lib_Ref_Symbol_File : constant Prj.Variable_Value := + Prj.Util.Value_Of + (Snames.Name_Library_Reference_Symbol_File, + Data.Decl.Attributes); + + Auto_Init_Supported : constant Boolean := + MLib.Tgt. + Standalone_Library_Auto_Init_Is_Supported; + + OK : Boolean := True; + + begin + pragma Assert (Lib_Interfaces.Kind = List); + + -- It is a stand-alone library project file if attribute + -- Library_Interface is defined. + + if not Lib_Interfaces.Default then + SAL_Library : declare + Interfaces : String_List_Id := Lib_Interfaces.Values; + Interface_ALIs : String_List_Id := Nil_String; + Unit : Name_Id; + The_Unit_Id : Unit_Id; + The_Unit_Data : Unit_Data; + + procedure Add_ALI_For (Source : Name_Id); + -- Add an ALI file name to the list of Interface ALIs + + ----------------- + -- Add_ALI_For -- + ----------------- + + procedure Add_ALI_For (Source : Name_Id) is + begin + Get_Name_String (Source); + + declare + ALI : constant String := + ALI_File_Name (Name_Buffer (1 .. Name_Len)); + ALI_Name_Id : Name_Id; + begin + Name_Len := ALI'Length; + Name_Buffer (1 .. Name_Len) := ALI; + ALI_Name_Id := Name_Find; + + String_Elements.Increment_Last; + String_Elements.Table (String_Elements.Last) := + (Value => ALI_Name_Id, + Index => 0, + Display_Value => ALI_Name_Id, + Location => String_Elements.Table + (Interfaces).Location, + Flag => False, + Next => Interface_ALIs); + Interface_ALIs := String_Elements.Last; + end; + end Add_ALI_For; + + -- Start of processing for SAL_Library begin - -- Dot_Replacement cannot - -- - be empty - -- - start or end with an alphanumeric - -- - be a single '_' - -- - start with an '_' followed by an alphanumeric - -- - contain a '.' except if it is "." + Data.Standalone_Library := True; - if Dot_Replacement'Length = 0 - or else Is_Alphanumeric - (Dot_Replacement (Dot_Replacement'First)) - or else Is_Alphanumeric - (Dot_Replacement (Dot_Replacement'Last)) - or else (Dot_Replacement (Dot_Replacement'First) = '_' - and then - (Dot_Replacement'Length = 1 - or else - Is_Alphanumeric - (Dot_Replacement (Dot_Replacement'First + 1)))) - or else (Dot_Replacement'Length > 1 - and then - Index (Source => Dot_Replacement, - Pattern => ".") /= 0) - then - Error_Msg - (Project, - '"' & Dot_Replacement & - """ is illegal for Dot_Replacement.", - Naming.Dot_Repl_Loc); - end if; - - -- Suffixes cannot - -- - be empty + -- Library_Interface cannot be an empty list - if Is_Illegal_Suffix - (Spec_Suffix, Dot_Replacement = ".") - then - Err_Vars.Error_Msg_Name_1 := Naming.Current_Spec_Suffix; + if Interfaces = Nil_String then Error_Msg (Project, - "{ is illegal for Spec_Suffix", - Naming.Spec_Suffix_Loc); + "Library_Interface cannot be an empty list", + Lib_Interfaces.Location); end if; - if Is_Illegal_Suffix - (Body_Suffix, Dot_Replacement = ".") - then - Err_Vars.Error_Msg_Name_1 := Naming.Current_Body_Suffix; - Error_Msg - (Project, - "{ is illegal for Body_Suffix", - Naming.Body_Suffix_Loc); - end if; + -- Process each unit name specified in the attribute + -- Library_Interface. - if Body_Suffix /= Separate_Suffix then - if Is_Illegal_Suffix - (Separate_Suffix, Dot_Replacement = ".") - then - Err_Vars.Error_Msg_Name_1 := Naming.Separate_Suffix; + while Interfaces /= Nil_String loop + Get_Name_String + (String_Elements.Table (Interfaces).Value); + To_Lower (Name_Buffer (1 .. Name_Len)); + + if Name_Len = 0 then Error_Msg (Project, - "{ is illegal for Separate_Suffix", - Naming.Sep_Suffix_Loc); - end if; - end if; - - -- Spec_Suffix cannot have the same termination as - -- Body_Suffix or Separate_Suffix + "an interface cannot be an empty string", + String_Elements.Table (Interfaces).Location); - if Spec_Suffix'Length <= Body_Suffix'Length - and then - Body_Suffix (Body_Suffix'Last - - Spec_Suffix'Length + 1 .. - Body_Suffix'Last) = Spec_Suffix - then - Error_Msg - (Project, - "Body_Suffix (""" & - Body_Suffix & - """) cannot end with" & - " Spec_Suffix (""" & - Spec_Suffix & """).", - Naming.Body_Suffix_Loc); - end if; + else + Unit := Name_Find; + Error_Msg_Name_1 := Unit; + The_Unit_Id := Units_Htable.Get (Unit); - 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 - then - Error_Msg - (Project, - "Separate_Suffix (""" & - Separate_Suffix & - """) cannot end with" & - " Spec_Suffix (""" & - Spec_Suffix & """).", - Naming.Sep_Suffix_Loc); - end if; - end; - end if; - end Check_Ada_Naming_Scheme_Validity; + if The_Unit_Id = Prj.Com.No_Unit then + Error_Msg + (Project, + "unknown unit {", + String_Elements.Table (Interfaces).Location); - ----------------------------- - -- Check_Ada_Naming_Scheme -- - ----------------------------- + else + -- Check that the unit is part of the project - procedure Check_Ada_Naming_Scheme - (Data : in out Project_Data; - Project : Project_Id) - is - Naming_Id : constant Package_Id := - Util.Value_Of (Name_Naming, Data.Decl.Packages); + The_Unit_Data := Units.Table (The_Unit_Id); - Naming : Package_Element; + if The_Unit_Data.File_Names + (Com.Body_Part).Name /= No_Name + and then The_Unit_Data.File_Names + (Com.Body_Part).Path /= Slash + then + if Check_Project + (The_Unit_Data.File_Names (Body_Part).Project, + Project, Extending) + then + -- There is a body for this unit. + -- If there is no spec, we need to check + -- that it is not a subunit. - procedure Check_Unit_Names (List : Array_Element_Id); - -- Check that a list of unit names contains only valid names. + if The_Unit_Data.File_Names + (Specification).Name = No_Name + then + declare + Src_Ind : Source_File_Index; - ---------------------- - -- Check_Unit_Names -- - ---------------------- + begin + Src_Ind := Sinput.P.Load_Project_File + (Get_Name_String + (The_Unit_Data.File_Names + (Body_Part).Path)); - procedure Check_Unit_Names (List : Array_Element_Id) is - Current : Array_Element_Id := List; - Element : Array_Element; - Unit_Name : Name_Id; + if Sinput.P.Source_File_Is_Subunit + (Src_Ind) + then + Error_Msg + (Project, + "{ is a subunit; " & + "it cannot be an interface", + String_Elements.Table + (Interfaces).Location); + end if; + end; + end if; - begin - -- Loop through elements of the string list + -- The unit is not a subunit, so we add + -- to the Interface ALIs the ALI file + -- corresponding to the body. - while Current /= No_Array_Element loop - Element := Array_Elements.Table (Current); + Add_ALI_For + (The_Unit_Data.File_Names (Body_Part).Name); - -- Put file name in canonical case + else + Error_Msg + (Project, + "{ is not an unit of this project", + String_Elements.Table + (Interfaces).Location); + end if; - Get_Name_String (Element.Value.Value); - Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len)); - Element.Value.Value := Name_Find; + elsif The_Unit_Data.File_Names + (Com.Specification).Name /= No_Name + and then The_Unit_Data.File_Names + (Com.Specification).Path /= Slash + and then Check_Project + (The_Unit_Data.File_Names + (Specification).Project, + Project, Extending) - -- Check that it contains a valid unit name + then + -- The unit is part of the project, it has + -- a spec, but no body. We add to the Interface + -- ALIs the ALI file corresponding to the spec. - Get_Name_String (Element.Index); - Check_Ada_Name (Name_Buffer (1 .. Name_Len), Unit_Name); + Add_ALI_For + (The_Unit_Data.File_Names (Specification).Name); - if Unit_Name = No_Name then - Err_Vars.Error_Msg_Name_1 := Element.Index; - Error_Msg - (Project, - "{ is not a valid unit name.", - Element.Value.Location); + else + Error_Msg + (Project, + "{ is not an unit of this project", + String_Elements.Table (Interfaces).Location); + end if; + end if; - else - if Current_Verbosity = High then - Write_Str (" Unit ("""); - Write_Str (Get_Name_String (Unit_Name)); - Write_Line (""")"); end if; - Element.Index := Unit_Name; - Array_Elements.Table (Current) := Element; - end if; + Interfaces := String_Elements.Table (Interfaces).Next; + end loop; - Current := Element.Next; - end loop; - end Check_Unit_Names; + -- Put the list of Interface ALIs in the project data - -- Start of processing for Check_Ada_Naming_Scheme + Data.Lib_Interface_ALIs := Interface_ALIs; - begin - -- If there is a package Naming, we will put in Data.Naming what is in - -- this package Naming. + -- Check value of attribute Library_Auto_Init and set + -- Lib_Auto_Init accordingly. - if Naming_Id /= No_Package then - Naming := Packages.Table (Naming_Id); + if Lib_Auto_Init.Default then - if Current_Verbosity = High then - Write_Line ("Checking ""Naming"" for Ada."); - end if; + -- If no attribute Library_Auto_Init is declared, then + -- set auto init only if it is supported. - declare - Bodies : constant Array_Element_Id := - Util.Value_Of (Name_Body, Naming.Decl.Arrays); + Data.Lib_Auto_Init := Auto_Init_Supported; - Specs : constant Array_Element_Id := - Util.Value_Of (Name_Spec, Naming.Decl.Arrays); + else + Get_Name_String (Lib_Auto_Init.Value); + To_Lower (Name_Buffer (1 .. Name_Len)); - begin - if Bodies /= No_Array_Element then + if Name_Buffer (1 .. Name_Len) = "false" then + Data.Lib_Auto_Init := False; - -- We have elements in the array Body_Part + elsif Name_Buffer (1 .. Name_Len) = "true" then + if Auto_Init_Supported then + Data.Lib_Auto_Init := True; - if Current_Verbosity = High then - Write_Line ("Found Bodies."); - end if; + else + -- Library_Auto_Init cannot be "true" if auto init + -- is not supported - Data.Naming.Bodies := Bodies; - Check_Unit_Names (Bodies); + Error_Msg + (Project, + "library auto init not supported " & + "on this platform", + Lib_Auto_Init.Location); + end if; - else - if Current_Verbosity = High then - Write_Line ("No Bodies."); + else + Error_Msg + (Project, + "invalid value for attribute Library_Auto_Init", + Lib_Auto_Init.Location); end if; end if; + end SAL_Library; - if Specs /= No_Array_Element then + -- If attribute Library_Src_Dir is defined and not the + -- empty string, check if the directory exist and is not + -- the object directory or one of the source directories. + -- This is the directory where copies of the interface + -- sources will be copied. Note that this directory may be + -- the library directory. - -- We have elements in the array Specs + if Lib_Src_Dir.Value /= Empty_String then + declare + Dir_Id : constant Name_Id := Lib_Src_Dir.Value; - if Current_Verbosity = High then - Write_Line ("Found Specs."); - end if; + begin + Locate_Directory + (Dir_Id, Data.Display_Directory, + Data.Library_Src_Dir, + Data.Display_Library_Src_Dir); - Data.Naming.Specs := Specs; - Check_Unit_Names (Specs); + -- If directory does not exist, report an error - else - if Current_Verbosity = High then - Write_Line ("No Specs."); - end if; - end if; - end; + if Data.Library_Src_Dir = No_Name then - -- We are now checking if variables Dot_Replacement, Casing, - -- Spec_Suffix, Body_Suffix and/or Separate_Suffix - -- exist. + -- Get the absolute name of the library directory + -- that does not exist, to report an error. - -- For each variable, if it does not exist, we do nothing, - -- because we already have the default. + declare + Dir_Name : constant String := + Get_Name_String (Dir_Id); - -- Check Dot_Replacement + begin + if Is_Absolute_Path (Dir_Name) then + Err_Vars.Error_Msg_Name_1 := Dir_Id; - declare - Dot_Replacement : constant Variable_Value := - Util.Value_Of - (Name_Dot_Replacement, - Naming.Decl.Attributes); + else + Get_Name_String (Data.Directory); - begin - pragma Assert (Dot_Replacement.Kind = Single, - "Dot_Replacement is not a single string"); + if Name_Buffer (Name_Len) /= + Directory_Separator + then + Name_Len := Name_Len + 1; + Name_Buffer (Name_Len) := + Directory_Separator; + end if; - if not Dot_Replacement.Default then - Get_Name_String (Dot_Replacement.Value); + Name_Buffer + (Name_Len + 1 .. + Name_Len + Dir_Name'Length) := + Dir_Name; + Name_Len := Name_Len + Dir_Name'Length; + Err_Vars.Error_Msg_Name_1 := Name_Find; + end if; - if Name_Len = 0 then + -- Report the error + + Error_Msg + (Project, + "Directory { does not exist", + Lib_Src_Dir.Location); + end; + + -- Report an error if it is the same as the object + -- directory. + + elsif Data.Library_Src_Dir = Data.Object_Directory then Error_Msg (Project, - "Dot_Replacement cannot be empty", - Dot_Replacement.Location); + "directory to copy interfaces cannot be " & + "the object directory", + Lib_Src_Dir.Location); + Data.Library_Src_Dir := No_Name; + + -- Check if it is same as one of the source directories else - Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len)); - Data.Naming.Dot_Replacement := Name_Find; - Data.Naming.Dot_Repl_Loc := Dot_Replacement.Location; - end if; - end if; - end; + declare + Src_Dirs : String_List_Id := Data.Source_Dirs; + Src_Dir : String_Element; - if Current_Verbosity = High then - Write_Str (" Dot_Replacement = """); - Write_Str (Get_Name_String (Data.Naming.Dot_Replacement)); - Write_Char ('"'); - Write_Eol; - end if; + begin + while Src_Dirs /= Nil_String loop + Src_Dir := String_Elements.Table (Src_Dirs); + Src_Dirs := Src_Dir.Next; - -- Check Casing + -- Report error if it is one of the source directories - declare - Casing_String : constant Variable_Value := - Util.Value_Of - (Name_Casing, Naming.Decl.Attributes); + if Data.Library_Src_Dir = Src_Dir.Value then + Error_Msg + (Project, + "directory to copy interfaces cannot " & + "be one of the source directories", + Lib_Src_Dir.Location); + Data.Library_Src_Dir := No_Name; + exit; + end if; + end loop; + end; - begin - pragma Assert (Casing_String.Kind = Single, - "Casing is not a single string"); + -- pages of code follow here with no comments at all ??? - if not Casing_String.Default then - declare - Casing_Image : constant String := - Get_Name_String (Casing_String.Value); - begin - declare - Casing_Value : constant Casing_Type := - Value (Casing_Image); - begin - -- Ignore Casing on platforms where file names are - -- case-insensitive. + if Data.Library_Src_Dir /= No_Name + and then Current_Verbosity = High + then + Write_Str ("Directory to copy interfaces ="""); + Write_Str (Get_Name_String (Data.Library_Dir)); + Write_Line (""""); + end if; + end if; + end; + end if; - if not File_Names_Case_Sensitive then - Data.Naming.Casing := All_Lower_Case; + if not Lib_Symbol_Policy.Default then + declare + Value : constant String := + To_Lower + (Get_Name_String (Lib_Symbol_Policy.Value)); - else - Data.Naming.Casing := Casing_Value; - end if; - end; + begin + if Value = "autonomous" or else Value = "default" then + Data.Symbol_Data.Symbol_Policy := Autonomous; - exception - when Constraint_Error => - if Casing_Image'Length = 0 then - Error_Msg - (Project, - "Casing cannot be an empty string", - Casing_String.Location); + elsif Value = "compliant" then + Data.Symbol_Data.Symbol_Policy := Compliant; - else - Name_Len := Casing_Image'Length; - Name_Buffer (1 .. Name_Len) := Casing_Image; - Err_Vars.Error_Msg_Name_1 := Name_Find; - Error_Msg - (Project, - "{ is not a correct Casing", - Casing_String.Location); - end if; - end; - end if; - end; + elsif Value = "controlled" then + Data.Symbol_Data.Symbol_Policy := Controlled; - if Current_Verbosity = High then - Write_Str (" Casing = "); - Write_Str (Image (Data.Naming.Casing)); - Write_Char ('.'); - Write_Eol; + elsif Value = "restricted" then + Data.Symbol_Data.Symbol_Policy := Restricted; + + else + Error_Msg + (Project, + "illegal value for Library_Symbol_Policy", + Lib_Symbol_Policy.Location); + end if; + end; end if; - -- Check Spec_Suffix + if Lib_Symbol_File.Default then + if Data.Symbol_Data.Symbol_Policy = Restricted then + Error_Msg + (Project, + "Library_Symbol_File needs to be defined when " & + "symbol policy is Restricted", + Lib_Symbol_Policy.Location); + end if; - declare - Ada_Spec_Suffix : constant Variable_Value := - Prj.Util.Value_Of - (Index => Name_Ada, - Src_Index => 0, - In_Array => Data.Naming.Spec_Suffix); + else + Data.Symbol_Data.Symbol_File := Lib_Symbol_File.Value; - begin - if Ada_Spec_Suffix.Kind = Single - and then Get_Name_String (Ada_Spec_Suffix.Value) /= "" - then - Get_Name_String (Ada_Spec_Suffix.Value); - Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len)); - Data.Naming.Current_Spec_Suffix := Name_Find; - Data.Naming.Spec_Suffix_Loc := Ada_Spec_Suffix.Location; + Get_Name_String (Lib_Symbol_File.Value); - else - Data.Naming.Current_Spec_Suffix := Default_Ada_Spec_Suffix; - end if; - end; + if Name_Len = 0 then + Error_Msg + (Project, + "symbol file name cannot be an empty string", + Lib_Symbol_File.Location); - if Current_Verbosity = High then - Write_Str (" Spec_Suffix = """); - Write_Str (Get_Name_String (Data.Naming.Current_Spec_Suffix)); - Write_Char ('"'); - Write_Eol; - end if; + else + OK := not Is_Absolute_Path (Name_Buffer (1 .. Name_Len)); - -- Check Body_Suffix + if OK then + for J in 1 .. Name_Len loop + if Name_Buffer (J) = '/' + or else Name_Buffer (J) = Directory_Separator + then + OK := False; + exit; + end if; + end loop; + end if; - declare - Ada_Body_Suffix : constant Variable_Value := - Prj.Util.Value_Of - (Index => Name_Ada, - Src_Index => 0, - In_Array => Data.Naming.Body_Suffix); + if not OK then + Error_Msg_Name_1 := Lib_Symbol_File.Value; + Error_Msg + (Project, + "symbol file name { is illegal. " & + "Name canot include directory info.", + Lib_Symbol_File.Location); + end if; + end if; + end if; - begin - if Ada_Body_Suffix.Kind = Single - and then Get_Name_String (Ada_Body_Suffix.Value) /= "" + if Lib_Ref_Symbol_File.Default then + if Data.Symbol_Data.Symbol_Policy = Compliant + or else Data.Symbol_Data.Symbol_Policy = Controlled then - Get_Name_String (Ada_Body_Suffix.Value); - Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len)); - Data.Naming.Current_Body_Suffix := Name_Find; - Data.Naming.Body_Suffix_Loc := Ada_Body_Suffix.Location; - - else - Data.Naming.Current_Body_Suffix := Default_Ada_Body_Suffix; + Error_Msg + (Project, + "a reference symbol file need to be defined", + Lib_Symbol_Policy.Location); end if; - end; - - if Current_Verbosity = High then - Write_Str (" Body_Suffix = """); - Write_Str (Get_Name_String (Data.Naming.Current_Body_Suffix)); - Write_Char ('"'); - Write_Eol; - end if; - -- Check Separate_Suffix + else + Data.Symbol_Data.Reference := Lib_Ref_Symbol_File.Value; - declare - Ada_Sep_Suffix : constant Variable_Value := - Prj.Util.Value_Of - (Variable_Name => Name_Separate_Suffix, - In_Variables => Naming.Decl.Attributes); + Get_Name_String (Lib_Ref_Symbol_File.Value); - begin - if Ada_Sep_Suffix.Default then - Data.Naming.Separate_Suffix := - Data.Naming.Current_Body_Suffix; + if Name_Len = 0 then + Error_Msg + (Project, + "reference symbol file name cannot be an empty string", + Lib_Symbol_File.Location); else - Get_Name_String (Ada_Sep_Suffix.Value); + OK := not Is_Absolute_Path (Name_Buffer (1 .. Name_Len)); - if Name_Len = 0 then + if OK then + for J in 1 .. Name_Len loop + if Name_Buffer (J) = '/' + or else Name_Buffer (J) = Directory_Separator + then + OK := False; + exit; + end if; + end loop; + end if; + + if not OK then + Error_Msg_Name_1 := Lib_Ref_Symbol_File.Value; Error_Msg (Project, - "Separate_Suffix cannot be empty", - Ada_Sep_Suffix.Location); - - else - Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len)); - Data.Naming.Separate_Suffix := Name_Find; - Data.Naming.Sep_Suffix_Loc := Ada_Sep_Suffix.Location; + "reference symbol file { name is illegal. " & + "Name canot include directory info.", + Lib_Ref_Symbol_File.Location); end if; - end if; - end; - - if Current_Verbosity = High then - Write_Str (" Separate_Suffix = """); - Write_Str (Get_Name_String (Data.Naming.Separate_Suffix)); - Write_Char ('"'); - Write_Eol; - end if; - - -- Check if Data.Naming is valid - Check_Ada_Naming_Scheme_Validity (Project, Data.Naming); - - else - Data.Naming.Current_Spec_Suffix := Default_Ada_Spec_Suffix; - Data.Naming.Current_Body_Suffix := Default_Ada_Body_Suffix; - Data.Naming.Separate_Suffix := Default_Ada_Body_Suffix; - end if; - end Check_Ada_Naming_Scheme; + if not Is_Regular_File + (Get_Name_String (Data.Object_Directory) & + Directory_Separator & + Get_Name_String (Lib_Ref_Symbol_File.Value)) + then + Error_Msg_Name_1 := Lib_Ref_Symbol_File.Value; + Error_Msg + (Project, + "library reference symbol file { does not exist", + Lib_Ref_Symbol_File.Location); + end if; - ------------------- - -- Check_Project -- - ------------------- + if Data.Symbol_Data.Symbol_File /= No_Name then + declare + Symbol : String := + Get_Name_String + (Data.Symbol_Data.Symbol_File); - function Check_Project - (P : Project_Id; - Root_Project : Project_Id; - Extending : Boolean) return Boolean - is - begin - if P = Root_Project then - return True; + Reference : String := + Get_Name_String + (Data.Symbol_Data.Reference); - elsif Extending then - declare - Data : Project_Data := Projects.Table (Root_Project); + begin + Canonical_Case_File_Name (Symbol); + Canonical_Case_File_Name (Reference); - begin - while Data.Extends /= No_Project loop - if P = Data.Extends then - return True; + if Symbol = Reference then + Error_Msg + (Project, + "reference symbol file and symbol file " & + "cannot be the same file", + Lib_Ref_Symbol_File.Location); + end if; + end; end if; - - Data := Projects.Table (Data.Extends); - end loop; - end; + end if; + end if; end if; - - return False; - end Check_Project; + end Check_Stand_Alone_Library; ---------------------------- -- Compute_Directory_Last -- @@ -2296,6 +2406,23 @@ package body Prj.Nmsc is end if; end Compute_Directory_Last; + -------------------- + -- Body_Suffix_Of -- + -------------------- + + function Body_Suffix_Of + (Language : Language_Index; + In_Project : Project_Data) return String + is + Suffix_Id : constant Name_Id := Suffix_Of (Language, In_Project); + begin + if Suffix_Id /= No_Name then + return Get_Name_String (Suffix_Id); + else + return "." & Get_Name_String (Language_Names.Table (Language)); + end if; + end Body_Suffix_Of; + --------------- -- Error_Msg -- --------------- @@ -2349,16 +2476,14 @@ package body Prj.Nmsc is return; end if; - if Msg (First) = '\' then - - -- Continuation character, ignore. + -- Ignore continuation character + if Msg (First) = '\' then First := First + 1; - elsif Msg (First) = '?' then - - -- Warning character. It is always the first one in this package + -- Warniung character is always the first one in this package + elsif Msg (First) = '?' then First := First + 1; Add ("Warning: "); end if; @@ -2366,7 +2491,7 @@ package body Prj.Nmsc is for Index in First .. Msg'Last loop if Msg (Index) = '{' or else Msg (Index) = '%' then - -- Include a name between double quotes. + -- Include a name between double quotes Msg_Name := Msg_Name + 1; Add ('"'); @@ -2397,7 +2522,7 @@ package body Prj.Nmsc is procedure Find_Sources (Project : Project_Id; Data : in out Project_Data; - For_Language : Programming_Language; + For_Language : Language_Index; Follow_Links : Boolean := False) is Source_Dir : String_List_Id := Data.Source_Dirs; @@ -2463,12 +2588,12 @@ package body Prj.Nmsc is Name_Buffer (1 .. Name_Len) := Path; Path_Name := Name_Find; - if For_Language = Lang_Ada then - -- 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. + if For_Language = Ada_Language_Index then + + -- 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. Record_Ada_Source (File_Name => File_Name, @@ -2489,8 +2614,7 @@ package body Prj.Nmsc is Location => No_Location, Language => For_Language, Suffix => - Get_Name_String - (Data.Impl_Suffixes (For_Language)), + Body_Suffix_Of (For_Language, Data), Naming_Exception => False); end if; end; @@ -2516,7 +2640,8 @@ package body Prj.Nmsc is Write_Line ("end Looking for sources."); end if; - if For_Language = Lang_Ada then + if For_Language = Ada_Language_Index then + -- 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 @@ -2545,1569 +2670,1455 @@ package body Prj.Nmsc is Reverse_Ada_Naming_Exceptions.Reset; end Free_Ada_Naming_Exceptions; - --------------- - -- Get_Mains -- - --------------- - - procedure Get_Mains (Project : Project_Id; Data : in out Project_Data) is - Mains : constant Variable_Value := - Prj.Util.Value_Of (Name_Main, Data.Decl.Attributes); + --------------------- + -- Get_Directories -- + --------------------- - begin - Data.Mains := Mains.Values; + procedure Get_Directories + (Project : Project_Id; + Data : in out Project_Data) + is + Object_Dir : constant Variable_Value := + Util.Value_Of (Name_Object_Dir, Data.Decl.Attributes); - -- If no Mains were specified, and if we are an extending - -- project, inherit the Mains from the project we are extending. + Exec_Dir : constant Variable_Value := + Util.Value_Of (Name_Exec_Dir, Data.Decl.Attributes); - if Mains.Default then - if Data.Extends /= No_Project then - Data.Mains := Projects.Table (Data.Extends).Mains; - end if; + Source_Dirs : constant Variable_Value := + Util.Value_Of + (Name_Source_Dirs, Data.Decl.Attributes); - -- In a library project file, Main cannot be specified + Last_Source_Dir : String_List_Id := Nil_String; - elsif Data.Library then - Error_Msg - (Project, - "a library project file cannot have Main specified", - Mains.Location); - end if; - end Get_Mains; + procedure Find_Source_Dirs (From : Name_Id; Location : Source_Ptr); + -- Find one or several source directories, and add them + -- to the list of source directories of the project. - --------------------------- - -- Get_Sources_From_File -- - --------------------------- + ---------------------- + -- Find_Source_Dirs -- + ---------------------- - procedure Get_Sources_From_File - (Path : String; - Location : Source_Ptr; - Project : Project_Id) - is - File : Prj.Util.Text_File; - Line : String (1 .. 250); - Last : Natural; - Source_Name : Name_Id; + procedure Find_Source_Dirs (From : Name_Id; Location : Source_Ptr) is + Directory : constant String := Get_Name_String (From); + Element : String_Element; - begin - Source_Names.Reset; + procedure Recursive_Find_Dirs (Path : Name_Id); + -- Find all the subdirectories (recursively) of Path and add them + -- to the list of source directories of the project. - if Current_Verbosity = High then - Write_Str ("Opening """); - Write_Str (Path); - Write_Line ("""."); - end if; + ------------------------- + -- Recursive_Find_Dirs -- + ------------------------- - -- Open the file + procedure Recursive_Find_Dirs (Path : Name_Id) is + Dir : Dir_Type; + Name : String (1 .. 250); + Last : Natural; + List : String_List_Id := Data.Source_Dirs; + Element : String_Element; + Found : Boolean := False; - Prj.Util.Open (File, Path); + Non_Canonical_Path : Name_Id := No_Name; + Canonical_Path : Name_Id := No_Name; - if not Prj.Util.Is_Valid (File) then - Error_Msg (Project, "file does not exist", Location); - else - -- Read the lines one by one + The_Path : constant String := + Normalize_Pathname (Get_Name_String (Path)) & + Directory_Separator; - while not Prj.Util.End_Of_File (File) loop - Prj.Util.Get_Line (File, Line, Last); + The_Path_Last : constant Natural := + Compute_Directory_Last (The_Path); - -- A non empty, non comment line should contain a file name + begin + Name_Len := The_Path_Last - The_Path'First + 1; + Name_Buffer (1 .. Name_Len) := + The_Path (The_Path'First .. The_Path_Last); + Non_Canonical_Path := Name_Find; + Get_Name_String (Non_Canonical_Path); + Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len)); + Canonical_Path := Name_Find; - if Last /= 0 - and then (Last = 1 or else Line (1 .. 2) /= "--") - then - -- ??? we should check that there is no directory information + -- To avoid processing the same directory several times, check + -- if the directory is already in Recursive_Dirs. If it is, + -- then there is nothing to do, just return. If it is not, put + -- it there and continue recursive processing. - Name_Len := Last; - Name_Buffer (1 .. Name_Len) := Line (1 .. Last); - Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len)); - Source_Name := Name_Find; - Source_Names.Set - (K => Source_Name, - E => - (Name => Source_Name, - Location => Location, - Found => False)); + if Recursive_Dirs.Get (Canonical_Path) then + return; + + else + Recursive_Dirs.Set (Canonical_Path, True); end if; - end loop; - Prj.Util.Close (File); + -- Check if directory is already in list - end if; - end Get_Sources_From_File; + while List /= Nil_String loop + Element := String_Elements.Table (List); - -------------- - -- Get_Unit -- - -------------- + if Element.Value /= No_Name then + Found := Element.Value = Canonical_Path; + exit when Found; + end if; - procedure Get_Unit - (Canonical_File_Name : Name_Id; - Naming : Naming_Data; - Exception_Id : out Ada_Naming_Exception_Id; - Unit_Name : out Name_Id; - Unit_Kind : out Spec_Or_Body; - Needs_Pragma : out Boolean) - is - Info_Id : Ada_Naming_Exception_Id - := Ada_Naming_Exceptions.Get (Canonical_File_Name); - VMS_Name : Name_Id; + List := Element.Next; + end loop; - begin - if Info_Id = No_Ada_Naming_Exception then - if Hostparm.OpenVMS then - VMS_Name := Canonical_File_Name; - Get_Name_String (VMS_Name); + -- If directory is not already in list, put it there - if Name_Buffer (Name_Len) = '.' then - Name_Len := Name_Len - 1; - VMS_Name := Name_Find; - end if; + if not Found then + if Current_Verbosity = High then + Write_Str (" "); + Write_Line (The_Path (The_Path'First .. The_Path_Last)); + end if; - Info_Id := Ada_Naming_Exceptions.Get (VMS_Name); - end if; + String_Elements.Increment_Last; + Element := + (Value => Canonical_Path, + Display_Value => Non_Canonical_Path, + Location => No_Location, + Flag => False, + Next => Nil_String, + Index => 0); - end if; + -- Case of first source directory - if Info_Id /= No_Ada_Naming_Exception then - Exception_Id := Info_Id; - Unit_Name := No_Name; - Unit_Kind := Specification; - Needs_Pragma := True; - return; - end if; + if Last_Source_Dir = Nil_String then + Data.Source_Dirs := String_Elements.Last; - Needs_Pragma := False; - Exception_Id := No_Ada_Naming_Exception; + -- Here we already have source directories - Get_Name_String (Canonical_File_Name); + else + -- Link the previous last to the new one - declare - File : String := Name_Buffer (1 .. Name_Len); - First : constant Positive := File'First; - Last : Natural := File'Last; - Standard_GNAT : Boolean; + String_Elements.Table (Last_Source_Dir).Next := + String_Elements.Last; + end if; - begin - Standard_GNAT := - Naming.Current_Spec_Suffix = Default_Ada_Spec_Suffix - and then Naming.Current_Body_Suffix = Default_Ada_Body_Suffix; + -- And register this source directory as the new last - -- Check if the end of the file name is Specification_Append + Last_Source_Dir := String_Elements.Last; + String_Elements.Table (Last_Source_Dir) := Element; + end if; - Get_Name_String (Naming.Current_Spec_Suffix); + -- Now look for subdirectories. We do that even when this + -- directory is already in the list, because some of its + -- subdirectories may not be in the list yet. - if File'Length > Name_Len - and then File (Last - Name_Len + 1 .. Last) = - Name_Buffer (1 .. Name_Len) - then - -- We have a spec + Open (Dir, The_Path (The_Path'First .. The_Path_Last)); - Unit_Kind := Specification; - Last := Last - Name_Len; + loop + Read (Dir, Name, Last); + exit when Last = 0; - if Current_Verbosity = High then - Write_Str (" Specification: "); - Write_Line (File (First .. Last)); - end if; + if Name (1 .. Last) /= "." + and then Name (1 .. Last) /= ".." + then + -- Avoid . and .. directories - else - Get_Name_String (Naming.Current_Body_Suffix); + if Current_Verbosity = High then + Write_Str (" Checking "); + Write_Line (Name (1 .. Last)); + end if; - -- Check if the end of the file name is Body_Append + 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); - if File'Length > Name_Len - and then File (Last - Name_Len + 1 .. Last) = - Name_Buffer (1 .. Name_Len) - then - -- We have a body + begin + if Is_Directory (Path_Name) then - Unit_Kind := Body_Part; - Last := Last - Name_Len; + -- We have found a new subdirectory, call self - if Current_Verbosity = High then - Write_Str (" Body: "); - Write_Line (File (First .. Last)); + Name_Len := Path_Name'Length; + Name_Buffer (1 .. Name_Len) := Path_Name; + Recursive_Find_Dirs (Name_Find); + end if; + end; end if; + end loop; - elsif Naming.Separate_Suffix /= Naming.Current_Spec_Suffix then - Get_Name_String (Naming.Separate_Suffix); - - -- Check if the end of the file name is Separate_Append - - if File'Length > Name_Len - and then File (Last - Name_Len + 1 .. Last) = - Name_Buffer (1 .. Name_Len) - then - -- We have a separate (a body) - - Unit_Kind := Body_Part; - Last := Last - Name_Len; + Close (Dir); - if Current_Verbosity = High then - Write_Str (" Separate: "); - Write_Line (File (First .. Last)); - end if; + exception + when Directory_Error => + null; + end Recursive_Find_Dirs; - else - Last := 0; - end if; + -- Start of processing for Find_Source_Dirs - else - Last := 0; - end if; + begin + if Current_Verbosity = High then + Write_Str ("Find_Source_Dirs ("""); + Write_Str (Directory); + Write_Line (""")"); end if; - if Last = 0 then + -- First, check if we are looking for a directory tree, + -- indicated by "/**" at the end. - -- This is not a source file + if Directory'Length >= 3 + and then Directory (Directory'Last - 1 .. Directory'Last) = "**" + and then (Directory (Directory'Last - 2) = '/' + or else + Directory (Directory'Last - 2) = Directory_Separator) + then + Data.Known_Order_Of_Source_Dirs := False; - Unit_Name := No_Name; - Unit_Kind := Specification; + Name_Len := Directory'Length - 3; + + if Name_Len = 0 then + + -- This is the case of "/**": all directories + -- in the file system. + + Name_Len := 1; + Name_Buffer (1) := Directory (Directory'First); + + else + Name_Buffer (1 .. Name_Len) := + Directory (Directory'First .. Directory'Last - 3); + end if; if Current_Verbosity = High then - Write_Line (" Not a valid file name."); + Write_Str ("Looking for all subdirectories of """); + Write_Str (Name_Buffer (1 .. Name_Len)); + Write_Line (""""); end if; - return; - end if; + declare + Base_Dir : constant Name_Id := Name_Find; + Root_Dir : constant String := + Normalize_Pathname + (Name => Get_Name_String (Base_Dir), + Directory => + Get_Name_String (Data.Display_Directory), + Resolve_Links => False, + Case_Sensitive => True); - Get_Name_String (Naming.Dot_Replacement); - Standard_GNAT := - Standard_GNAT and then Name_Buffer (1 .. Name_Len) = "-"; + begin + if Root_Dir'Length = 0 then + Err_Vars.Error_Msg_Name_1 := Base_Dir; - if Name_Buffer (1 .. Name_Len) /= "." then + if Location = No_Location then + Error_Msg + (Project, + "{ is not a valid directory.", + Data.Location); + else + Error_Msg + (Project, + "{ is not a valid directory.", + Location); + end if; - -- If Dot_Replacement is not a single dot, - -- then there should not be any dot in the name. + else + -- We have an existing directory, we register it and all + -- of its subdirectories. - for Index in First .. Last loop - if File (Index) = '.' then if Current_Verbosity = High then - Write_Line - (" Not a valid file name (some dot not replaced)."); + Write_Line ("Looking for source directories:"); end if; - Unit_Name := No_Name; - return; + Name_Len := Root_Dir'Length; + Name_Buffer (1 .. Name_Len) := Root_Dir; + Recursive_Find_Dirs (Name_Find); + if Current_Verbosity = High then + Write_Line ("End of looking for source directories."); + end if; end if; - end loop; + end; - -- Replace the substring Dot_Replacement with dots + -- We have a single directory + else declare - Index : Positive := First; + Path_Name : Name_Id; + Display_Path_Name : Name_Id; begin - while Index <= Last - Name_Len + 1 loop - - if File (Index .. Index + Name_Len - 1) = - Name_Buffer (1 .. Name_Len) - then - File (Index) := '.'; + Locate_Directory + (From, Data.Display_Directory, Path_Name, Display_Path_Name); - if Name_Len > 1 and then Index < Last then - File (Index + 1 .. Last - Name_Len + 1) := - File (Index + Name_Len .. Last); - end if; + if Path_Name = No_Name then + Err_Vars.Error_Msg_Name_1 := From; - Last := Last - Name_Len + 1; + if Location = No_Location then + Error_Msg + (Project, + "{ is not a valid directory", + Data.Location); + else + Error_Msg + (Project, + "{ is not a valid directory", + Location); end if; - Index := Index + 1; - end loop; - end; - end if; + else + -- As it is an existing directory, we add it to + -- the list of directories. - -- Check if the casing is right + String_Elements.Increment_Last; + Element.Value := Path_Name; + Element.Display_Value := Display_Path_Name; - declare - Src : String := File (First .. Last); + if Last_Source_Dir = Nil_String then - begin - case Naming.Casing is - when All_Lower_Case => - Fixed.Translate - (Source => Src, - Mapping => Lower_Case_Map); + -- This is the first source directory - when All_Upper_Case => - Fixed.Translate - (Source => Src, - Mapping => Upper_Case_Map); + Data.Source_Dirs := String_Elements.Last; - when Mixed_Case | Unknown => - null; - end case; + else + -- We already have source directories, + -- link the previous last to the new one. - if Src /= File (First .. Last) then - if Current_Verbosity = High then - Write_Line (" Not a valid file name (casing)."); - end if; + String_Elements.Table (Last_Source_Dir).Next := + String_Elements.Last; + end if; - Unit_Name := No_Name; - return; - end if; + -- And register this source directory as the new last - -- We put the name in lower case + Last_Source_Dir := String_Elements.Last; + String_Elements.Table (Last_Source_Dir) := Element; + end if; + end; + end if; + end Find_Source_Dirs; - Fixed.Translate - (Source => Src, - Mapping => Lower_Case_Map); + -- Start of processing for Get_Directories - -- In the standard GNAT naming scheme, check for special cases: - -- children or separates of A, G, I or S, and run time sources. + begin + if Current_Verbosity = High then + Write_Line ("Starting to look for directories"); + end if; - if Standard_GNAT and then Src'Length >= 3 then - declare - S1 : constant Character := Src (Src'First); - S2 : constant Character := Src (Src'First + 1); + -- Check the object directory - begin - if S1 = 'a' or else S1 = 'g' - or else S1 = 'i' or else S1 = 's' - then - -- Children or separates of packages A, G, I or S + pragma Assert (Object_Dir.Kind = Single, + "Object_Dir is not a single string"); - if (Hostparm.OpenVMS and then S2 = '$') - or else (not Hostparm.OpenVMS and then S2 = '~') - then - Src (Src'First + 1) := '.'; + -- We set the object directory to its default - -- If it is potentially a run time source, disable - -- filling of the mapping file to avoid warnings. + Data.Object_Directory := Data.Directory; + Data.Display_Object_Dir := Data.Display_Directory; - elsif S2 = '.' then - Set_Mapping_File_Initial_State_To_Empty; - end if; + if Object_Dir.Value /= Empty_String then + Get_Name_String (Object_Dir.Value); - end if; - end; - end if; + if Name_Len = 0 then + Error_Msg + (Project, + "Object_Dir cannot be empty", + Object_Dir.Location); - if Current_Verbosity = High then - Write_Str (" "); - Write_Line (Src); - end if; + else + -- We check that the specified object directory does exist - -- Now, we check if this name is a valid unit name + Locate_Directory + (Object_Dir.Value, Data.Display_Directory, + Data.Object_Directory, Data.Display_Object_Dir); - Check_Ada_Name (Name => Src, Unit => Unit_Name); - end; + if Data.Object_Directory = No_Name then - end; - end Get_Unit; + -- The object directory does not exist, report an error - ---------- - -- Hash -- - ---------- + Err_Vars.Error_Msg_Name_1 := Object_Dir.Value; + Error_Msg + (Project, + "the object directory { cannot be found", + Data.Location); - function Hash (Unit : Unit_Info) return Header_Num is - begin - return Header_Num (Unit.Unit mod 2048); - end Hash; + -- Do not keep a nil Object_Directory. Set it to the specified + -- (relative or absolute) path. This is for the benefit of + -- tools that recover from errors; for example, these tools + -- could create the non existent directory. - ----------------------- - -- Is_Illegal_Suffix -- - ----------------------- + Data.Display_Object_Dir := Object_Dir.Value; + 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; - function Is_Illegal_Suffix - (Suffix : String; - Dot_Replacement_Is_A_Single_Dot : Boolean) return Boolean - is - begin - if Suffix'Length = 0 or else Index (Suffix, ".") = 0 then - return True; + if Current_Verbosity = High then + if Data.Object_Directory = No_Name then + Write_Line ("No object directory"); + else + Write_Str ("Object directory: """); + Write_Str (Get_Name_String (Data.Display_Object_Dir)); + Write_Line (""""); + end if; end if; - -- If dot replacement is a single dot, and first character of - -- suffix is also a dot + -- Check the exec directory - if Dot_Replacement_Is_A_Single_Dot - and then Suffix (Suffix'First) = '.' - then - for Index in Suffix'First + 1 .. Suffix'Last loop + pragma Assert (Exec_Dir.Kind = Single, + "Exec_Dir is not a single string"); - -- If there is another dot + -- We set the object directory to its default - if Suffix (Index) = '.' then + Data.Exec_Directory := Data.Object_Directory; + Data.Display_Exec_Dir := Data.Display_Object_Dir; - -- It is illegal to have a letter following the initial dot + if Exec_Dir.Value /= Empty_String then + Get_Name_String (Exec_Dir.Value); - return Is_Letter (Suffix (Suffix'First + 1)); - end if; - end loop; - end if; + if Name_Len = 0 then + Error_Msg + (Project, + "Exec_Dir cannot be empty", + Exec_Dir.Location); - -- Everything is OK + else + -- We check that the specified object directory + -- does exist. - return False; - end Is_Illegal_Suffix; + Locate_Directory + (Exec_Dir.Value, Data.Directory, + Data.Exec_Directory, Data.Display_Exec_Dir); - -------------------------------- - -- Language_Independent_Check -- - -------------------------------- + if Data.Exec_Directory = No_Name then + Err_Vars.Error_Msg_Name_1 := Exec_Dir.Value; + Error_Msg + (Project, + "the exec directory { cannot be found", + Data.Location); + end if; + end if; + end if; - procedure Language_Independent_Check - (Project : Project_Id; - Report_Error : Put_Line_Access) - is - Last_Source_Dir : String_List_Id := Nil_String; - Data : Project_Data := Projects.Table (Project); + if Current_Verbosity = High then + if Data.Exec_Directory = No_Name then + Write_Line ("No exec directory"); + else + Write_Str ("Exec directory: """); + Write_Str (Get_Name_String (Data.Display_Exec_Dir)); + Write_Line (""""); + end if; + end if; - procedure Find_Source_Dirs (From : Name_Id; Location : Source_Ptr); - -- Find one or several source directories, and add them - -- to the list of source directories of the project. + -- Look for the source directories - ---------------------- - -- Find_Source_Dirs -- - ---------------------- + if Current_Verbosity = High then + Write_Line ("Starting to look for source directories"); + end if; - procedure Find_Source_Dirs (From : Name_Id; Location : Source_Ptr) is - Directory : constant String := Get_Name_String (From); - Element : String_Element; + pragma Assert (Source_Dirs.Kind = List, "Source_Dirs is not a list"); - procedure Recursive_Find_Dirs (Path : Name_Id); - -- Find all the subdirectories (recursively) of Path and add them - -- to the list of source directories of the project. + if Source_Dirs.Default then - ------------------------- - -- Recursive_Find_Dirs -- - ------------------------- + -- No Source_Dirs specified: the single source directory + -- is the one containing the project file - procedure Recursive_Find_Dirs (Path : Name_Id) is - Dir : Dir_Type; - Name : String (1 .. 250); - Last : Natural; - List : String_List_Id := Data.Source_Dirs; - Element : String_Element; - Found : Boolean := False; + String_Elements.Increment_Last; + Data.Source_Dirs := String_Elements.Last; + String_Elements.Table (Data.Source_Dirs) := + (Value => Data.Directory, + Display_Value => Data.Display_Directory, + Location => No_Location, + Flag => False, + Next => Nil_String, + Index => 0); - Non_Canonical_Path : Name_Id := No_Name; - Canonical_Path : Name_Id := No_Name; + if Current_Verbosity = High then + Write_Line ("Single source directory:"); + Write_Str (" """); + Write_Str (Get_Name_String (Data.Display_Directory)); + Write_Line (""""); + end if; - The_Path : constant String := - Normalize_Pathname (Get_Name_String (Path)) & - Directory_Separator; + elsif Source_Dirs.Values = Nil_String then - The_Path_Last : constant Natural := - Compute_Directory_Last (The_Path); + -- If Source_Dirs is an empty string list, this means + -- that 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. - begin - Name_Len := The_Path_Last - The_Path'First + 1; - Name_Buffer (1 .. Name_Len) := - The_Path (The_Path'First .. The_Path_Last); - Non_Canonical_Path := Name_Find; - Get_Name_String (Non_Canonical_Path); - Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len)); - Canonical_Path := Name_Find; + if Data.Extends = No_Project + and then Data.Object_Directory = Data.Directory + then + Data.Object_Directory := No_Name; + end if; - -- To avoid processing the same directory several times, check - -- if the directory is already in Recursive_Dirs. If it is, - -- then there is nothing to do, just return. If it is not, put - -- it there and continue recursive processing. + Data.Source_Dirs := Nil_String; + Data.Ada_Sources_Present := False; + Data.Other_Sources_Present := False; - if Recursive_Dirs.Get (Canonical_Path) then - return; + else + declare + Source_Dir : String_List_Id := Source_Dirs.Values; + Element : String_Element; - else - Recursive_Dirs.Set (Canonical_Path, True); - end if; + begin + -- We will find the source directories for each + -- element of the list - -- Check if directory is already in list + while Source_Dir /= Nil_String loop + Element := String_Elements.Table (Source_Dir); + Find_Source_Dirs (Element.Value, Element.Location); + Source_Dir := Element.Next; + end loop; + end; + end if; - while List /= Nil_String loop - Element := String_Elements.Table (List); + if Current_Verbosity = High then + Write_Line ("Putting source directories in canonical cases"); + end if; - if Element.Value /= No_Name then - Found := Element.Value = Canonical_Path; - exit when Found; - end if; + declare + Current : String_List_Id := Data.Source_Dirs; + Element : String_Element; - List := Element.Next; - end loop; + begin + while Current /= Nil_String loop + Element := 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; + String_Elements.Table (Current) := Element; + end if; - -- If directory is not already in list, put it there + Current := Element.Next; + end loop; + end; - if not Found then - if Current_Verbosity = High then - Write_Str (" "); - Write_Line (The_Path (The_Path'First .. The_Path_Last)); - end if; + end Get_Directories; - String_Elements.Increment_Last; - Element := - (Value => Canonical_Path, - Display_Value => Non_Canonical_Path, - Location => No_Location, - Flag => False, - Next => Nil_String, - Index => 0); - - -- Case of first source directory + --------------- + -- Get_Mains -- + --------------- - if Last_Source_Dir = Nil_String then - Data.Source_Dirs := String_Elements.Last; + procedure Get_Mains (Project : Project_Id; Data : in out Project_Data) is + Mains : constant Variable_Value := + Prj.Util.Value_Of (Name_Main, Data.Decl.Attributes); - -- Here we already have source directories. + begin + Data.Mains := Mains.Values; - else - -- Link the previous last to the new one + -- If no Mains were specified, and if we are an extending + -- project, inherit the Mains from the project we are extending. - String_Elements.Table (Last_Source_Dir).Next := - String_Elements.Last; - end if; + if Mains.Default then + if Data.Extends /= No_Project then + Data.Mains := Projects.Table (Data.Extends).Mains; + end if; - -- And register this source directory as the new last + -- In a library project file, Main cannot be specified - Last_Source_Dir := String_Elements.Last; - String_Elements.Table (Last_Source_Dir) := Element; - end if; + elsif Data.Library then + Error_Msg + (Project, + "a library project file cannot have Main specified", + Mains.Location); + end if; + end Get_Mains; - -- Now look for subdirectories. We do that even when this - -- directory is already in the list, because some of its - -- subdirectories may not be in the list yet. + --------------------------- + -- Get_Sources_From_File -- + --------------------------- - Open (Dir, The_Path (The_Path'First .. The_Path_Last)); + procedure Get_Sources_From_File + (Path : String; + Location : Source_Ptr; + Project : Project_Id) + is + File : Prj.Util.Text_File; + Line : String (1 .. 250); + Last : Natural; + Source_Name : Name_Id; - loop - Read (Dir, Name, Last); - exit when Last = 0; + begin + Source_Names.Reset; - if Name (1 .. Last) /= "." - and then Name (1 .. Last) /= ".." - then - -- Avoid . and .. + if Current_Verbosity = High then + Write_Str ("Opening """); + Write_Str (Path); + Write_Line ("""."); + end if; - if Current_Verbosity = High then - Write_Str (" Checking "); - Write_Line (Name (1 .. Last)); - end if; + -- Open the file - 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); + Prj.Util.Open (File, Path); - begin - if Is_Directory (Path_Name) then + if not Prj.Util.Is_Valid (File) then + Error_Msg (Project, "file does not exist", Location); + else + -- Read the lines one by one - -- We have found a new subdirectory, call self + while not Prj.Util.End_Of_File (File) loop + Prj.Util.Get_Line (File, Line, Last); - Name_Len := Path_Name'Length; - Name_Buffer (1 .. Name_Len) := Path_Name; - Recursive_Find_Dirs (Name_Find); - end if; - end; - end if; - end loop; + -- A non empty, non comment line should contain a file name - Close (Dir); + if Last /= 0 + and then (Last = 1 or else Line (1 .. 2) /= "--") + then + -- ??? we should check that there is no directory information - exception - when Directory_Error => - null; - end Recursive_Find_Dirs; + Name_Len := Last; + Name_Buffer (1 .. Name_Len) := Line (1 .. Last); + Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len)); + Source_Name := Name_Find; + Source_Names.Set + (K => Source_Name, + E => + (Name => Source_Name, + Location => Location, + Found => False)); + end if; + end loop; - -- Start of processing for Find_Source_Dirs + Prj.Util.Close (File); - begin - if Current_Verbosity = High then - Write_Str ("Find_Source_Dirs ("""); - Write_Str (Directory); - Write_Line (""")"); - end if; + end if; + end Get_Sources_From_File; - -- First, check if we are looking for a directory tree, - -- indicated by "/**" at the end. + -------------- + -- Get_Unit -- + -------------- - if Directory'Length >= 3 - and then Directory (Directory'Last - 1 .. Directory'Last) = "**" - and then (Directory (Directory'Last - 2) = '/' - or else - Directory (Directory'Last - 2) = Directory_Separator) - then - Data.Known_Order_Of_Source_Dirs := False; + procedure Get_Unit + (Canonical_File_Name : Name_Id; + Naming : Naming_Data; + Exception_Id : out Ada_Naming_Exception_Id; + Unit_Name : out Name_Id; + Unit_Kind : out Spec_Or_Body; + Needs_Pragma : out Boolean) + is + Info_Id : Ada_Naming_Exception_Id + := Ada_Naming_Exceptions.Get (Canonical_File_Name); + VMS_Name : Name_Id; - Name_Len := Directory'Length - 3; + begin + if Info_Id = No_Ada_Naming_Exception then + if Hostparm.OpenVMS then + VMS_Name := Canonical_File_Name; + Get_Name_String (VMS_Name); - if Name_Len = 0 then + if Name_Buffer (Name_Len) = '.' then + Name_Len := Name_Len - 1; + VMS_Name := Name_Find; + end if; - -- This is the case of "/**": all directories - -- in the file system. + Info_Id := Ada_Naming_Exceptions.Get (VMS_Name); + end if; - Name_Len := 1; - Name_Buffer (1) := Directory (Directory'First); + end if; - else - Name_Buffer (1 .. Name_Len) := - Directory (Directory'First .. Directory'Last - 3); - end if; + if Info_Id /= No_Ada_Naming_Exception then + Exception_Id := Info_Id; + Unit_Name := No_Name; + Unit_Kind := Specification; + Needs_Pragma := True; + return; + end if; - if Current_Verbosity = High then - Write_Str ("Looking for all subdirectories of """); - Write_Str (Name_Buffer (1 .. Name_Len)); - Write_Line (""""); - end if; + Needs_Pragma := False; + Exception_Id := No_Ada_Naming_Exception; - declare - Base_Dir : constant Name_Id := Name_Find; - Root_Dir : constant String := - Normalize_Pathname - (Name => Get_Name_String (Base_Dir), - Directory => - Get_Name_String (Data.Display_Directory), - Resolve_Links => False, - Case_Sensitive => True); + Get_Name_String (Canonical_File_Name); - begin - if Root_Dir'Length = 0 then - Err_Vars.Error_Msg_Name_1 := Base_Dir; + declare + File : String := Name_Buffer (1 .. Name_Len); + First : constant Positive := File'First; + Last : Natural := File'Last; + Standard_GNAT : Boolean; - if Location = No_Location then - Error_Msg - (Project, - "{ is not a valid directory.", - Data.Location); - else - Error_Msg - (Project, - "{ is not a valid directory.", - Location); - end if; + begin + Standard_GNAT := + Naming.Ada_Spec_Suffix = Default_Ada_Spec_Suffix + and then Naming.Ada_Body_Suffix = Default_Ada_Body_Suffix; - else - -- We have an existing directory, - -- we register it and all of its subdirectories. + -- Check if the end of the file name is Specification_Append - if Current_Verbosity = High then - Write_Line ("Looking for source directories:"); - end if; + Get_Name_String (Naming.Ada_Spec_Suffix); - Name_Len := Root_Dir'Length; - Name_Buffer (1 .. Name_Len) := Root_Dir; - Recursive_Find_Dirs (Name_Find); + if File'Length > Name_Len + and then File (Last - Name_Len + 1 .. Last) = + Name_Buffer (1 .. Name_Len) + then + -- We have a spec - if Current_Verbosity = High then - Write_Line ("End of looking for source directories."); - end if; - end if; - end; + Unit_Kind := Specification; + Last := Last - Name_Len; - -- We have a single directory + if Current_Verbosity = High then + Write_Str (" Specification: "); + Write_Line (File (First .. Last)); + end if; else - declare - Path_Name : Name_Id; - Display_Path_Name : Name_Id; - begin - Locate_Directory - (From, Data.Display_Directory, Path_Name, Display_Path_Name); - if Path_Name = No_Name then - Err_Vars.Error_Msg_Name_1 := From; + Get_Name_String (Naming.Ada_Body_Suffix); - if Location = No_Location then - Error_Msg - (Project, - "{ is not a valid directory", - Data.Location); - else - Error_Msg - (Project, - "{ is not a valid directory", - Location); - end if; - else + -- Check if the end of the file name is Body_Append - -- As it is an existing directory, we add it to - -- the list of directories. + if File'Length > Name_Len + and then File (Last - Name_Len + 1 .. Last) = + Name_Buffer (1 .. Name_Len) + then + -- We have a body - String_Elements.Increment_Last; - Element.Value := Path_Name; - Element.Display_Value := Display_Path_Name; + Unit_Kind := Body_Part; + Last := Last - Name_Len; - if Last_Source_Dir = Nil_String then + if Current_Verbosity = High then + Write_Str (" Body: "); + Write_Line (File (First .. Last)); + end if; - -- This is the first source directory + elsif Naming.Separate_Suffix /= Naming.Ada_Spec_Suffix then + Get_Name_String (Naming.Separate_Suffix); - Data.Source_Dirs := String_Elements.Last; + -- Check if the end of the file name is Separate_Append - else - -- We already have source directories, - -- link the previous last to the new one. + if File'Length > Name_Len + and then File (Last - Name_Len + 1 .. Last) = + Name_Buffer (1 .. Name_Len) + then + -- We have a separate (a body) - String_Elements.Table (Last_Source_Dir).Next := - String_Elements.Last; - end if; + Unit_Kind := Body_Part; + Last := Last - Name_Len; - -- And register this source directory as the new last + if Current_Verbosity = High then + Write_Str (" Separate: "); + Write_Line (File (First .. Last)); + end if; - Last_Source_Dir := String_Elements.Last; - String_Elements.Table (Last_Source_Dir) := Element; + else + Last := 0; end if; - end; - end if; - end Find_Source_Dirs; - -- Start of processing for Language_Independent_Check + else + Last := 0; + end if; + end if; - begin - if Data.Language_Independent_Checked then - return; - end if; + if Last = 0 then - Data.Language_Independent_Checked := True; + -- This is not a source file - Error_Report := Report_Error; + Unit_Name := No_Name; + Unit_Kind := Specification; - Recursive_Dirs.Reset; + if Current_Verbosity = High then + Write_Line (" Not a valid file name."); + end if; - if Current_Verbosity = High then - Write_Line ("Starting to look for directories"); - end if; + return; + end if; - -- Check the object directory + Get_Name_String (Naming.Dot_Replacement); + Standard_GNAT := + Standard_GNAT and then Name_Buffer (1 .. Name_Len) = "-"; - declare - Object_Dir : constant Variable_Value := - Util.Value_Of (Name_Object_Dir, Data.Decl.Attributes); + if Name_Buffer (1 .. Name_Len) /= "." then - begin - pragma Assert (Object_Dir.Kind = Single, - "Object_Dir is not a single string"); + -- If Dot_Replacement is not a single dot, then there should + -- not be any dot in the name. - -- We set the object directory to its default + for Index in First .. Last loop + if File (Index) = '.' then + if Current_Verbosity = High then + Write_Line + (" Not a valid file name (some dot not replaced)."); + end if; - Data.Object_Directory := Data.Directory; - Data.Display_Object_Dir := Data.Display_Directory; + Unit_Name := No_Name; + return; - if Object_Dir.Value /= Empty_String then + end if; + end loop; - Get_Name_String (Object_Dir.Value); + -- Replace the substring Dot_Replacement with dots - if Name_Len = 0 then - Error_Msg - (Project, - "Object_Dir cannot be empty", - Object_Dir.Location); + declare + Index : Positive := First; - else - -- We check that the specified object directory - -- does exist. + begin + while Index <= Last - Name_Len + 1 loop - Locate_Directory - (Object_Dir.Value, Data.Display_Directory, - Data.Object_Directory, Data.Display_Object_Dir); + if File (Index .. Index + Name_Len - 1) = + Name_Buffer (1 .. Name_Len) + then + File (Index) := '.'; - if Data.Object_Directory = No_Name then - -- The object directory does not exist, report an error - Err_Vars.Error_Msg_Name_1 := Object_Dir.Value; - Error_Msg - (Project, - "the object directory { cannot be found", - Data.Location); + if Name_Len > 1 and then Index < Last then + File (Index + 1 .. Last - Name_Len + 1) := + File (Index + Name_Len .. Last); + end if; - -- Do not keep a nil Object_Directory. Set it to the - -- specified (relative or absolute) path. - -- This is for the benefit of tools that recover from - -- errors; for example, these tools could create the - -- non existent directory. + Last := Last - Name_Len + 1; + end if; - Data.Display_Object_Dir := Object_Dir.Value; - Get_Name_String (Object_Dir.Value); - Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len)); - Data.Object_Directory := Name_Find; - end if; - end if; + Index := Index + 1; + end loop; + end; end if; - end; - if Current_Verbosity = High then - if Data.Object_Directory = No_Name then - Write_Line ("No object directory"); - else - Write_Str ("Object directory: """); - Write_Str (Get_Name_String (Data.Display_Object_Dir)); - Write_Line (""""); - end if; - end if; + -- Check if the casing is right - -- Check the exec directory + declare + Src : String := File (First .. Last); - declare - Exec_Dir : constant Variable_Value := - Util.Value_Of (Name_Exec_Dir, Data.Decl.Attributes); + begin + case Naming.Casing is + when All_Lower_Case => + Fixed.Translate + (Source => Src, + Mapping => Lower_Case_Map); - begin - pragma Assert (Exec_Dir.Kind = Single, - "Exec_Dir is not a single string"); + when All_Upper_Case => + Fixed.Translate + (Source => Src, + Mapping => Upper_Case_Map); - -- We set the object directory to its default + when Mixed_Case | Unknown => + null; + end case; - Data.Exec_Directory := Data.Object_Directory; - Data.Display_Exec_Dir := Data.Display_Object_Dir; + if Src /= File (First .. Last) then + if Current_Verbosity = High then + Write_Line (" Not a valid file name (casing)."); + end if; - if Exec_Dir.Value /= Empty_String then + Unit_Name := No_Name; + return; + end if; - Get_Name_String (Exec_Dir.Value); + -- We put the name in lower case - if Name_Len = 0 then - Error_Msg - (Project, - "Exec_Dir cannot be empty", - Exec_Dir.Location); + Fixed.Translate + (Source => Src, + Mapping => Lower_Case_Map); - else - -- We check that the specified object directory - -- does exist. + -- In the standard GNAT naming scheme, check for special cases: + -- children or separates of A, G, I or S, and run time sources. - Locate_Directory - (Exec_Dir.Value, Data.Directory, - Data.Exec_Directory, Data.Display_Exec_Dir); + if Standard_GNAT and then Src'Length >= 3 then + declare + S1 : constant Character := Src (Src'First); + S2 : constant Character := Src (Src'First + 1); - if Data.Exec_Directory = No_Name then - Err_Vars.Error_Msg_Name_1 := Exec_Dir.Value; - Error_Msg - (Project, - "the exec directory { cannot be found", - Data.Location); - end if; - end if; - end if; - end; + begin + if S1 = 'a' or else S1 = 'g' + or else S1 = 'i' or else S1 = 's' + then + -- Children or separates of packages A, G, I or S - if Current_Verbosity = High then - if Data.Exec_Directory = No_Name then - Write_Line ("No exec directory"); - else - Write_Str ("Exec directory: """); - Write_Str (Get_Name_String (Data.Display_Exec_Dir)); - Write_Line (""""); - end if; - end if; + if (Hostparm.OpenVMS and then S2 = '$') + or else (not Hostparm.OpenVMS and then S2 = '~') + then + Src (Src'First + 1) := '.'; - -- Look for the source directories + -- If it is potentially a run time source, disable + -- filling of the mapping file to avoid warnings. - declare - Source_Dirs : constant Variable_Value := - Util.Value_Of - (Name_Source_Dirs, Data.Decl.Attributes); + elsif S2 = '.' then + Set_Mapping_File_Initial_State_To_Empty; + end if; - begin - if Current_Verbosity = High then - Write_Line ("Starting to look for source directories"); - end if; + end if; + end; + end if; - pragma Assert (Source_Dirs.Kind = List, - "Source_Dirs is not a list"); + if Current_Verbosity = High then + Write_Str (" "); + Write_Line (Src); + end if; - if Source_Dirs.Default then + -- Now, we check if this name is a valid unit name - -- No Source_Dirs specified: the single source directory - -- is the one containing the project file + Check_Ada_Name (Name => Src, Unit => Unit_Name); + end; - String_Elements.Increment_Last; - Data.Source_Dirs := String_Elements.Last; - String_Elements.Table (Data.Source_Dirs) := - (Value => Data.Directory, - Display_Value => Data.Display_Directory, - Location => No_Location, - Flag => False, - Next => Nil_String, - Index => 0); + end; + end Get_Unit; - if Current_Verbosity = High then - Write_Line ("Single source directory:"); - Write_Str (" """); - Write_Str (Get_Name_String (Data.Display_Directory)); - Write_Line (""""); - end if; + ---------- + -- Hash -- + ---------- - elsif Source_Dirs.Values = Nil_String then + function Hash (Unit : Unit_Info) return Header_Num is + begin + return Header_Num (Unit.Unit mod 2048); + end Hash; - -- If Source_Dirs is an empty string list, this means - -- that 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. + ----------------------- + -- Is_Illegal_Suffix -- + ----------------------- - if Data.Extends = No_Project - and then Data.Object_Directory = Data.Directory - then - Data.Object_Directory := No_Name; - end if; + function Is_Illegal_Suffix + (Suffix : String; + Dot_Replacement_Is_A_Single_Dot : Boolean) return Boolean + is + begin + if Suffix'Length = 0 or else Index (Suffix, ".") = 0 then + return True; + end if; - Data.Source_Dirs := Nil_String; - Data.Ada_Sources_Present := False; - Data.Other_Sources_Present := False; + -- If dot replacement is a single dot, and first character of + -- suffix is also a dot - else - declare - Source_Dir : String_List_Id := Source_Dirs.Values; - Element : String_Element; + if Dot_Replacement_Is_A_Single_Dot + and then Suffix (Suffix'First) = '.' + then + for Index in Suffix'First + 1 .. Suffix'Last loop - begin - -- We will find the source directories for each - -- element of the list + -- If there is another dot - while Source_Dir /= Nil_String loop - Element := String_Elements.Table (Source_Dir); - Find_Source_Dirs (Element.Value, Element.Location); - Source_Dir := Element.Next; - end loop; - end; - end if; + if Suffix (Index) = '.' then - if Current_Verbosity = High then - Write_Line ("Putting source directories in canonical cases"); - end if; + -- It is illegal to have a letter following the initial dot - declare - Current : String_List_Id := Data.Source_Dirs; - Element : String_Element; + return Is_Letter (Suffix (Suffix'First + 1)); + end if; + end loop; + end if; - begin - while Current /= Nil_String loop - Element := 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; - String_Elements.Table (Current) := Element; - end if; + -- Everything is OK - Current := Element.Next; - end loop; - end; - end; + return False; + end Is_Illegal_Suffix; - -- Library attributes + ---------------------- + -- Locate_Directory -- + ---------------------- - declare - Attributes : constant Prj.Variable_Id := Data.Decl.Attributes; + procedure Locate_Directory + (Name : Name_Id; + Parent : Name_Id; + Dir : out Name_Id; + Display : out Name_Id) + is + The_Name : constant String := Get_Name_String (Name); - Lib_Dir : constant Prj.Variable_Value := - Prj.Util.Value_Of (Snames.Name_Library_Dir, Attributes); + The_Parent : constant String := + Get_Name_String (Parent) & Directory_Separator; - Lib_Name : constant Prj.Variable_Value := - Prj.Util.Value_Of (Snames.Name_Library_Name, Attributes); + The_Parent_Last : constant Natural := + Compute_Directory_Last (The_Parent); - Lib_Version : constant Prj.Variable_Value := - Prj.Util.Value_Of - (Snames.Name_Library_Version, Attributes); + begin + if Current_Verbosity = High then + Write_Str ("Locate_Directory ("""); + Write_Str (The_Name); + Write_Str (""", """); + Write_Str (The_Parent); + Write_Line (""")"); + end if; - The_Lib_Kind : constant Prj.Variable_Value := - Prj.Util.Value_Of - (Snames.Name_Library_Kind, Attributes); + Dir := No_Name; + Display := No_Name; - begin - -- Special case of extending project + if Is_Absolute_Path (The_Name) then + if Is_Directory (The_Name) then + declare + Normed : constant String := + Normalize_Pathname + (The_Name, + Resolve_Links => False, + Case_Sensitive => True); - if Data.Extends /= No_Project then - declare - Extended_Data : constant Project_Data := - Projects.Table (Data.Extends); + Canonical_Path : constant String := + Normalize_Pathname + (Normed, + Resolve_Links => True, + Case_Sensitive => False); begin - -- If the project extended is a library project, we inherit - -- the library name, if it is not redefined; we check that - -- the library directory is specified; and we reset the - -- library flag for the extended project. - - if Extended_Data.Library then - if Lib_Name.Default then - Data.Library_Name := Extended_Data.Library_Name; - end if; - - if Lib_Dir.Default then - if not Data.Virtual then - Error_Msg - (Project, - "a project extending a library project must " & - "specify an attribute Library_Dir", - Data.Location); - end if; - end if; + Name_Len := Normed'Length; + Name_Buffer (1 .. Name_Len) := Normed; + Display := Name_Find; - Projects.Table (Data.Extends).Library := False; - end if; + Name_Len := Canonical_Path'Length; + Name_Buffer (1 .. Name_Len) := Canonical_Path; + Dir := Name_Find; end; end if; - pragma Assert (Lib_Dir.Kind = Single); - - if Lib_Dir.Value = Empty_String then - - if Current_Verbosity = High then - Write_Line ("No library directory"); - end if; - - else - -- Find path name, check that it is a directory - - Locate_Directory - (Lib_Dir.Value, Data.Display_Directory, - Data.Library_Dir, Data.Display_Library_Dir); - - if Data.Library_Dir = No_Name then - - -- Get the absolute name of the library directory that - -- does not exist, to report an error. + else + declare + Full_Path : constant String := + The_Parent (The_Parent'First .. The_Parent_Last) & + The_Name; + begin + if Is_Directory (Full_Path) then declare - Dir_Name : constant String := - Get_Name_String (Lib_Dir.Value); - begin - if Is_Absolute_Path (Dir_Name) then - Err_Vars.Error_Msg_Name_1 := Lib_Dir.Value; - - else - Get_Name_String (Data.Display_Directory); - - if Name_Buffer (Name_Len) /= Directory_Separator then - Name_Len := Name_Len + 1; - Name_Buffer (Name_Len) := Directory_Separator; - end if; + Normed : constant String := + Normalize_Pathname + (Full_Path, + Resolve_Links => False, + Case_Sensitive => True); - Name_Buffer - (Name_Len + 1 .. Name_Len + Dir_Name'Length) := - Dir_Name; - Name_Len := Name_Len + Dir_Name'Length; - Err_Vars.Error_Msg_Name_1 := Name_Find; - end if; + Canonical_Path : constant String := + Normalize_Pathname + (Normed, + Resolve_Links => True, + Case_Sensitive => False); - -- Report the error + begin + Name_Len := Normed'Length; + Name_Buffer (1 .. Name_Len) := Normed; + Display := Name_Find; - Error_Msg - (Project, - "library directory { does not exist", - Lib_Dir.Location); + Name_Len := Canonical_Path'Length; + Name_Buffer (1 .. Name_Len) := Canonical_Path; + Dir := Name_Find; end; - - elsif Data.Library_Dir = Data.Object_Directory then - Error_Msg - (Project, - "library directory cannot be the same " & - "as object directory", - Lib_Dir.Location); - Data.Library_Dir := No_Name; - Data.Display_Library_Dir := No_Name; - - else - if Current_Verbosity = High then - Write_Str ("Library directory ="""); - Write_Str (Get_Name_String (Data.Display_Library_Dir)); - Write_Line (""""); - end if; end if; - end if; - - pragma Assert (Lib_Name.Kind = Single); - - 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 - -- There is no restriction on the syntax of library names + end; + end if; + end Locate_Directory; - Data.Library_Name := Lib_Name.Value; - end if; + ---------------------- + -- Look_For_Sources -- + ---------------------- - 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; + procedure Look_For_Sources + (Project : Project_Id; + Data : in out Project_Data; + Follow_Links : Boolean) + 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. - Data.Library := - Data.Library_Dir /= No_Name - and then - Data.Library_Name /= No_Name; + procedure Get_Sources_From_File + (Path : String; + Location : Source_Ptr); + -- Get the sources of a project from a text file - if Data.Library then - if MLib.Tgt.Support_For_Libraries = MLib.Tgt.None then - Error_Msg - (Project, - "?libraries are not supported on this platform", - Lib_Name.Location); - Data.Library := False; + --------------------------------------- + -- Get_Path_Names_And_Record_Sources -- + --------------------------------------- - else - pragma Assert (Lib_Version.Kind = Single); + procedure Get_Path_Names_And_Record_Sources (Follow_Links : Boolean) is + Source_Dir : String_List_Id := Data.Source_Dirs; + Element : String_Element; + Path : Name_Id; - if Lib_Version.Value = Empty_String then - if Current_Verbosity = High then - Write_Line ("No library version specified"); - end if; + Dir : Dir_Type; + Name : Name_Id; + Canonical_Name : Name_Id; + Name_Str : String (1 .. 1_024); + Last : Natural := 0; + NL : Name_Location; - else - Data.Lib_Internal_Name := Lib_Version.Value; - end if; + Current_Source : String_List_Id := Nil_String; - pragma Assert (The_Lib_Kind.Kind = Single); + First_Error : Boolean := True; - if The_Lib_Kind.Value = Empty_String then - if Current_Verbosity = High then - Write_Line ("No library kind specified"); - end if; + Source_Recorded : Boolean := False; - else - Get_Name_String (The_Lib_Kind.Value); + begin + -- We look in all source directories for the file names in the + -- hash table Source_Names - declare - Kind_Name : constant String := - To_Lower (Name_Buffer (1 .. Name_Len)); + while Source_Dir /= Nil_String loop + Source_Recorded := False; + Element := String_Elements.Table (Source_Dir); - OK : Boolean := True; + declare + Dir_Path : constant String := Get_Name_String (Element.Value); + begin + if Current_Verbosity = High then + Write_Str ("checking directory """); + Write_Str (Dir_Path); + Write_Line (""""); + end if; - begin - if Kind_Name = "static" then - Data.Library_Kind := Static; + Open (Dir, Dir_Path); - elsif Kind_Name = "dynamic" then - Data.Library_Kind := Dynamic; + loop + Read (Dir, Name_Str, Last); + exit when Last = 0; + Name_Len := Last; + Name_Buffer (1 .. Name_Len) := Name_Str (1 .. Last); + Name := Name_Find; + Canonical_Case_File_Name (Name_Str (1 .. Last)); + Name_Len := Last; + Name_Buffer (1 .. Name_Len) := Name_Str (1 .. Last); + Canonical_Name := Name_Find; + NL := Source_Names.Get (Canonical_Name); - elsif Kind_Name = "relocatable" then - Data.Library_Kind := Relocatable; + 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; - else - Error_Msg - (Project, - "illegal value for Library_Kind", - The_Lib_Kind.Location); - OK := False; + if Name_Buffer (Name_Len) /= Directory_Separator then + Add_Char_To_Name_Buffer (Directory_Separator); end if; - if Current_Verbosity = High and then OK then - Write_Str ("Library kind = "); - Write_Line (Kind_Name); - end if; + Add_Str_To_Name_Buffer (Name_Str (1 .. Last)); + Path := Name_Find; - if Data.Library_Kind /= Static and then - MLib.Tgt.Support_For_Libraries = MLib.Tgt.Static_Only - then - Error_Msg - (Project, - "only static libraries are supported " & - "on this platform", - The_Lib_Kind.Location); - Data.Library := False; + if Current_Verbosity = High then + Write_Str (" found "); + Write_Line (Get_Name_String (Name)); end if; - end; - end if; - - if Data.Library and then Current_Verbosity = High then - Write_Line ("This is a library project file"); - end if; - - end if; - end if; - end; - - if Current_Verbosity = High then - Show_Source_Dirs (Project); - end if; - - declare - Naming_Id : constant Package_Id := - Util.Value_Of (Name_Naming, Data.Decl.Packages); - Naming : Package_Element; + -- Register the source if it is an Ada compilation unit - begin - -- If there is a package Naming, we will put in Data.Naming - -- what is in this package Naming. + Record_Ada_Source + (File_Name => Name, + Path_Name => Path, + Project => Project, + Data => Data, + Location => NL.Location, + Current_Source => Current_Source, + Source_Recorded => Source_Recorded, + Follow_Links => Follow_Links); + end if; + end loop; - if Naming_Id /= No_Package then - Naming := Packages.Table (Naming_Id); + Close (Dir); + end; - if Current_Verbosity = High then - Write_Line ("Checking ""Naming""."); + if Source_Recorded then + String_Elements.Table (Source_Dir).Flag := True; end if; - -- Check Spec_Suffix - - declare - Spec_Suffixs : Array_Element_Id := - Util.Value_Of - (Name_Spec_Suffix, - Naming.Decl.Arrays); - Suffix : Array_Element_Id; - Element : Array_Element; - Suffix2 : Array_Element_Id; + Source_Dir := Element.Next; + end loop; - begin - -- If some suffixs have been specified, we make sure that - -- for each language for which a default suffix has been - -- specified, there is a suffix specified, either the one - -- in the project file or if there were none, the default. - - if Spec_Suffixs /= No_Array_Element then - Suffix := Data.Naming.Spec_Suffix; - - while Suffix /= No_Array_Element loop - Element := Array_Elements.Table (Suffix); - Suffix2 := Spec_Suffixs; - - while Suffix2 /= No_Array_Element loop - exit when Array_Elements.Table (Suffix2).Index = - Element.Index; - Suffix2 := Array_Elements.Table (Suffix2).Next; - end loop; + -- It is an error if a source file name in a source list or + -- in a source list file is not found. - -- There is a registered default suffix, but no - -- suffix specified in the project file. - -- Add the default to the array. - - if Suffix2 = No_Array_Element then - Array_Elements.Increment_Last; - Array_Elements.Table (Array_Elements.Last) := - (Index => Element.Index, - Src_Index => Element.Src_Index, - Index_Case_Sensitive => False, - Value => Element.Value, - Next => Spec_Suffixs); - Spec_Suffixs := Array_Elements.Last; - end if; + NL := Source_Names.Get_First; - Suffix := Element.Next; - end loop; + while NL /= No_Name_Location loop + if not NL.Found then + Err_Vars.Error_Msg_Name_1 := NL.Name; - -- Put the resulting array as the specification suffixs + if First_Error then + Error_Msg + (Project, + "source file { cannot be found", + NL.Location); + First_Error := False; - Data.Naming.Spec_Suffix := Spec_Suffixs; + else + Error_Msg + (Project, + "\source file { cannot be found", + NL.Location); end if; - end; - - declare - Current : Array_Element_Id := Data.Naming.Spec_Suffix; - Element : Array_Element; - - begin - while Current /= No_Array_Element loop - Element := Array_Elements.Table (Current); - Get_Name_String (Element.Value.Value); + end if; - if Name_Len = 0 then - Error_Msg - (Project, - "Spec_Suffix cannot be empty", - Element.Value.Location); - end if; + NL := Source_Names.Get_Next; + end loop; + end Get_Path_Names_And_Record_Sources; - Array_Elements.Table (Current) := Element; - Current := Element.Next; - end loop; - end; + --------------------------- + -- Get_Sources_From_File -- + --------------------------- - -- Check Body_Suffix + 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. - declare - Impl_Suffixs : Array_Element_Id := - Util.Value_Of - (Name_Body_Suffix, - Naming.Decl.Arrays); + Get_Sources_From_File (Path, Location, Project); - Suffix : Array_Element_Id; - Element : Array_Element; - Suffix2 : Array_Element_Id; + -- Look in the source directories to find those sources - begin - -- If some suffixs have been specified, we make sure that - -- for each language for which a default suffix has been - -- specified, there is a suffix specified, either the one - -- in the project file or if there were noe, the default. - - if Impl_Suffixs /= No_Array_Element then - Suffix := Data.Naming.Body_Suffix; - - while Suffix /= No_Array_Element loop - Element := Array_Elements.Table (Suffix); - Suffix2 := Impl_Suffixs; - - while Suffix2 /= No_Array_Element loop - exit when Array_Elements.Table (Suffix2).Index = - Element.Index; - Suffix2 := Array_Elements.Table (Suffix2).Next; - end loop; + Get_Path_Names_And_Record_Sources (Follow_Links); - -- There is a registered default suffix, but no - -- suffix specified in the project file. - -- Add the default to the array. - - if Suffix2 = No_Array_Element then - Array_Elements.Increment_Last; - Array_Elements.Table (Array_Elements.Last) := - (Index => Element.Index, - Src_Index => Element.Src_Index, - Index_Case_Sensitive => False, - Value => Element.Value, - Next => Impl_Suffixs); - Impl_Suffixs := Array_Elements.Last; - end if; + -- We should have found at least one source. + -- If not, report an error. - Suffix := Element.Next; - end loop; + if Data.Sources = Nil_String then + Error_Msg (Project, + "there are no Ada sources in this project", + Location); + end if; + end Get_Sources_From_File; - -- Put the resulting array as the implementation suffixs + begin + if Data.Ada_Sources_Present then + declare + Sources : constant Variable_Value := + Util.Value_Of + (Name_Source_Files, + Data.Decl.Attributes); - Data.Naming.Body_Suffix := Impl_Suffixs; - end if; - end; + Source_List_File : constant Variable_Value := + Util.Value_Of + (Name_Source_List_File, + Data.Decl.Attributes); - declare - Current : Array_Element_Id := Data.Naming.Body_Suffix; - Element : Array_Element; + Locally_Removed : constant Variable_Value := + Util.Value_Of + (Name_Locally_Removed_Files, + Data.Decl.Attributes); - begin - while Current /= No_Array_Element loop - Element := Array_Elements.Table (Current); - Get_Name_String (Element.Value.Value); + begin + pragma Assert + (Sources.Kind = List, + "Source_Files is not a list"); - if Name_Len = 0 then - Error_Msg - (Project, - "Body_Suffix cannot be empty", - Element.Value.Location); - end if; + pragma Assert + (Source_List_File.Kind = Single, + "Source_List_File is not a single string"); - Array_Elements.Table (Current) := Element; - Current := Element.Next; - end loop; - end; + if not Sources.Default then + if not Source_List_File.Default then + Error_Msg + (Project, + "?both variables source_files and " & + "source_list_file are present", + Source_List_File.Location); + end if; - -- Get the exceptions, if any + -- Sources is a list of file names - Data.Naming.Specification_Exceptions := - Util.Value_Of - (Name_Specification_Exceptions, - In_Arrays => Naming.Decl.Arrays); + declare + Current : String_List_Id := Sources.Values; + Element : String_Element; + Location : Source_Ptr; + Name : Name_Id; - Data.Naming.Implementation_Exceptions := - Util.Value_Of - (Name_Implementation_Exceptions, - In_Arrays => Naming.Decl.Arrays); - end if; - end; + begin + Source_Names.Reset; - Projects.Table (Project) := Data; - end Language_Independent_Check; + Data.Ada_Sources_Present := Current /= Nil_String; - ---------------------- - -- Locate_Directory -- - ---------------------- + while Current /= Nil_String loop + Element := String_Elements.Table (Current); + Get_Name_String (Element.Value); + Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len)); + Name := Name_Find; - procedure Locate_Directory - (Name : Name_Id; - Parent : Name_Id; - Dir : out Name_Id; - Display : out Name_Id) - is - The_Name : constant String := Get_Name_String (Name); - The_Parent : constant String := - Get_Name_String (Parent) & Directory_Separator; - The_Parent_Last : constant Natural := - Compute_Directory_Last (The_Parent); + -- If the element has no location, then use the + -- location of Sources to report possible errors. - begin - if Current_Verbosity = High then - Write_Str ("Locate_Directory ("""); - Write_Str (The_Name); - Write_Str (""", """); - Write_Str (The_Parent); - Write_Line (""")"); - end if; + if Element.Location = No_Location then + Location := Sources.Location; + else + Location := Element.Location; + end if; - Dir := No_Name; - Display := No_Name; + Source_Names.Set + (K => Name, + E => + (Name => Name, + Location => Location, + Found => False)); - if Is_Absolute_Path (The_Name) then - if Is_Directory (The_Name) then - declare - Normed : constant String := - Normalize_Pathname - (The_Name, - Resolve_Links => False, - Case_Sensitive => True); + Current := Element.Next; + end loop; - Canonical_Path : constant String := - Normalize_Pathname - (Normed, - Resolve_Links => True, - Case_Sensitive => False); + Get_Path_Names_And_Record_Sources (Follow_Links); + end; - begin - Name_Len := Normed'Length; - Name_Buffer (1 .. Name_Len) := Normed; - Display := Name_Find; + -- No source_files specified - Name_Len := Canonical_Path'Length; - Name_Buffer (1 .. Name_Len) := Canonical_Path; - Dir := Name_Find; - end; - end if; + -- We check Source_List_File has been specified - else - declare - Full_Path : constant String := - The_Parent (The_Parent'First .. The_Parent_Last) & - The_Name; + elsif not Source_List_File.Default then - begin - if Is_Directory (Full_Path) then - declare - Normed : constant String := - Normalize_Pathname - (Full_Path, - Resolve_Links => False, - Case_Sensitive => True); + -- Source_List_File is the name of the file + -- that contains the source file names - Canonical_Path : constant String := - Normalize_Pathname - (Normed, - Resolve_Links => True, - Case_Sensitive => False); + declare + Source_File_Path_Name : constant String := + Path_Name_Of + (Source_List_File.Value, + Data.Directory); begin - Name_Len := Normed'Length; - Name_Buffer (1 .. Name_Len) := Normed; - Display := Name_Find; + if Source_File_Path_Name'Length = 0 then + Err_Vars.Error_Msg_Name_1 := Source_List_File.Value; + Error_Msg + (Project, + "file with sources { does not exist", + Source_List_File.Location); - Name_Len := Canonical_Path'Length; - Name_Buffer (1 .. Name_Len) := Canonical_Path; - Dir := Name_Find; + else + Get_Sources_From_File + (Source_File_Path_Name, + Source_List_File.Location); + end if; end; - end if; - end; - end if; - end Locate_Directory; - - --------------------------- - -- Other_Languages_Check -- - --------------------------- - procedure Other_Languages_Check - (Project : Project_Id; - Report_Error : Put_Line_Access) is + 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. - Data : Project_Data; + Find_Sources + (Project, Data, Ada_Language_Index, Follow_Links); + end if; - Languages : Variable_Value := Nil_Variable_Value; + -- If there are sources that are locally removed, mark them as + -- such in the Units table. - begin - Language_Independent_Check (Project, Report_Error); + if not Locally_Removed.Default then - Error_Report := Report_Error; + -- Sources can be locally removed only in extending + -- project files. - Data := Projects.Table (Project); - Languages := Prj.Util.Value_Of (Name_Languages, Data.Decl.Attributes); + if Data.Extends = No_Project then + Error_Msg + (Project, + "Locally_Removed_Files can only be used " & + "in an extending project file", + Locally_Removed.Location); - Data.Other_Sources_Present := Data.Source_Dirs /= Nil_String; + else + declare + Current : String_List_Id := Locally_Removed.Values; + Element : String_Element; + Location : Source_Ptr; + OK : Boolean; + Unit : Unit_Data; + Name : Name_Id; + Extended : Project_Id; - if Data.Other_Sources_Present then - -- Check if languages other than Ada are specified in this project + begin + while Current /= Nil_String loop + Element := String_Elements.Table (Current); + Get_Name_String (Element.Value); + Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len)); + Name := Name_Find; - if Languages.Default then - -- Attribute Languages is not specified. So, it defaults to - -- a project of language Ada only. + -- If the element has no location, then use the + -- location of Locally_Removed to report + -- possible errors. - Data.Languages (Lang_Ada) := True; + if Element.Location = No_Location then + Location := Locally_Removed.Location; + else + Location := Element.Location; + end if; - -- No sources of languages other than Ada + OK := False; - Data.Other_Sources_Present := False; + for Index in 1 .. Units.Last loop + Unit := Units.Table (Index); - else - declare - Current : String_List_Id := Languages.Values; - Element : String_Element; - OK : Boolean := False; - begin - -- Assumethat there is no language other than Ada specified. - -- If in fact there is at least one, we will set back - -- Other_Sources_Present to True. + if Unit.File_Names (Specification).Name = Name then + OK := True; - Data.Other_Sources_Present := False; + -- Check that this is from a project that + -- the current project extends, but not the + -- current project. - -- Look through all the languages specified in attribute - -- Languages, if any + Extended := Unit.File_Names + (Specification).Project; - while Current /= Nil_String loop - Element := String_Elements.Table (Current); - Get_Name_String (Element.Value); - To_Lower (Name_Buffer (1 .. Name_Len)); - OK := False; + if Extended = Project then + Error_Msg + (Project, + "cannot remove a source " & + "of the same project", + Location); - -- Check if it is a known language + elsif + Project_Extends (Project, Extended) + then + Unit.File_Names + (Specification).Path := Slash; + Unit.File_Names + (Specification).Needs_Pragma := False; + Units.Table (Index) := Unit; + Add_Forbidden_File_Name + (Unit.File_Names (Specification).Name); + exit; - Lang_Loop : for Lang in Programming_Language loop - if - Name_Buffer (1 .. Name_Len) = Lang_Names (Lang).all - then - -- Yes, this is a known language + else + Error_Msg + (Project, + "cannot remove a source from " & + "another project", + Location); + end if; - OK := True; + elsif + Unit.File_Names (Body_Part).Name = Name + then + OK := True; - -- Indicate the presence of this language - Data.Languages (Lang) := True; + -- Check that this is from a project that + -- the current project extends, but not the + -- current project. - -- If it is a language other than Ada, indicate that - -- there should be some sources of a language other - -- than Ada. + Extended := Unit.File_Names + (Body_Part).Project; - if Lang /= Lang_Ada then - Data.Other_Sources_Present := True; - end if; + if Extended = Project then + Error_Msg + (Project, + "cannot remove a source " & + "of the same project", + Location); - exit Lang_Loop; - end if; - end loop Lang_Loop; + elsif + Project_Extends (Project, Extended) + then + Unit.File_Names (Body_Part).Path := Slash; + Unit.File_Names (Body_Part).Needs_Pragma + := False; + Units.Table (Index) := Unit; + Add_Forbidden_File_Name + (Unit.File_Names (Body_Part).Name); + exit; + end if; - -- We don't support this language: report an error + end if; + end loop; - if not OK then - Error_Msg_Name_1 := Element.Value; - Error_Msg - (Project, - "unknown programming language {", - Element.Location); - end if; + if not OK then + Err_Vars.Error_Msg_Name_1 := Name; + Error_Msg (Project, "unknown file {", Location); + end if; - Current := Element.Next; - end loop; - end; - end if; + Current := Element.Next; + end loop; + end; + end if; + end if; + end; end if; - -- If there may be some sources, look for them - if Data.Other_Sources_Present then - -- Set Source_Present to False. It will be set back to True whenever - -- a source is found. + + -- Set Source_Present to False. It will be set back to True + -- whenever a source is found. Data.Other_Sources_Present := False; + for Lang in Ada_Language_Index + 1 .. Last_Language_Index loop - for Lang in Other_Programming_Language loop -- For each language (other than Ada) in the project file - if Data.Languages (Lang) then + if Is_Present (Lang, Data) then + -- Reset the indication that there are sources of this -- language. It will be set back to True whenever we find a -- source of the language. - Data.Languages (Lang) := False; + Set (Lang, False, Data); -- First, get the source suffix for the language - Data.Impl_Suffixes (Lang) := Suffix_For (Lang, Data.Naming); + Set (Suffix => Suffix_For (Lang, Data.Naming), + For_Language => Lang, + In_Project => Data); -- Then, deal with the naming exceptions, if any @@ -4116,13 +4127,14 @@ package body Prj.Nmsc is declare Naming_Exceptions : constant Variable_Value := Value_Of - (Index => Lang_Name_Ids (Lang), + (Index => Language_Names.Table (Lang), Src_Index => 0, In_Array => Data.Naming.Implementation_Exceptions); - Element_Id : String_List_Id; - Element : String_Element; - File_Id : Name_Id; - Source_Found : Boolean := False; + Element_Id : String_List_Id; + Element : String_Element; + File_Id : Name_Id; + Source_Found : Boolean := False; + begin -- If there are naming exceptions, look through them one -- by one. @@ -4133,14 +4145,17 @@ package body Prj.Nmsc is while Element_Id /= Nil_String loop Element := String_Elements.Table (Element_Id); Get_Name_String (Element.Value); - Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len)); + Canonical_Case_File_Name + (Name_Buffer (1 .. Name_Len)); File_Id := Name_Find; -- 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, @@ -4168,20 +4183,20 @@ package body Prj.Nmsc is -- Now, check if a list of sources is declared either through -- a string list (attribute Source_Files) or a text file - -- (attribute Source_List_File). - -- If a source list is declared, we will consider only those - -- naming exceptions that are on the list. + -- (attribute Source_List_File). If a source list is declared, + -- 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); + Sources : constant Variable_Value := + Util.Value_Of + (Name_Source_Files, + Data.Decl.Attributes); Source_List_File : constant Variable_Value := - Util.Value_Of - (Name_Source_List_File, - Data.Decl.Attributes); + Util.Value_Of + (Name_Source_List_File, + Data.Decl.Attributes); begin pragma Assert @@ -4204,16 +4219,15 @@ package body Prj.Nmsc is -- Sources is a list of file names declare - Current : String_List_Id := Sources.Values; - Element : String_Element; - Location : Source_Ptr; - Name : Name_Id; + Current : String_List_Id := Sources.Values; + Element : String_Element; + Location : Source_Ptr; + Name : Name_Id; begin Source_Names.Reset; - -- Put all the sources in the Source_Names hash - -- table. + -- Put all the sources in the Source_Names hash table while Current /= Nil_String loop Element := String_Elements.Table (Current); @@ -4227,7 +4241,6 @@ package body Prj.Nmsc is if Element.Location = No_Location then Location := Sources.Location; - else Location := Element.Location; end if; @@ -4251,8 +4264,9 @@ package body Prj.Nmsc is Naming_Exceptions => False); end; - -- No source_files specified. - -- We check if Source_List_File has been specified. + -- No source_files specified + + -- We check if Source_List_File has been specified elsif not Source_List_File.Default then @@ -4267,7 +4281,8 @@ package body Prj.Nmsc is begin if Source_File_Path_Name'Length = 0 then - Err_Vars.Error_Msg_Name_1 := Source_List_File.Value; + Err_Vars.Error_Msg_Name_1 := + Source_List_File.Value; Error_Msg (Project, "file with sources { does not exist", @@ -4282,7 +4297,7 @@ package body Prj.Nmsc is Source_List_File.Location, Project); - -- And look for their directories. + -- And look for their directories Record_Other_Sources (Project => Project, @@ -4292,28 +4307,21 @@ package body Prj.Nmsc is end if; end; + -- Neither Source_Files nor Source_List_File was specified + 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. - -- All the naming exceptions that effectively exist are - -- also part of the source of this language. + -- 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, Data, Lang); end if; - end; end if; end loop; end if; - - -- Finally, get the mains, if any - - Get_Mains (Project, Data); - - Projects.Table (Project) := Data; - - end Other_Languages_Check; + end Look_For_Sources; ------------------ -- Path_Name_Of -- @@ -4324,6 +4332,7 @@ package body Prj.Nmsc is Directory : Name_Id) return String is Result : String_Access; + The_Directory : constant String := Get_Name_String (Directory); begin @@ -4416,6 +4425,7 @@ package body Prj.Nmsc is is Canonical_File_Name : Name_Id; Canonical_Path_Name : Name_Id; + Exception_Id : Ada_Naming_Exception_Id; Unit_Name : Name_Id; Unit_Kind : Spec_Or_Body; @@ -4424,9 +4434,9 @@ package body Prj.Nmsc is Name_Index : Name_And_Index; Needs_Pragma : Boolean; - The_Location : Source_Ptr := Location; + The_Location : Source_Ptr := Location; Previous_Source : constant String_List_Id := Current_Source; - Except_Name : Name_And_Index := No_Name_And_Index; + Except_Name : Name_And_Index := No_Name_And_Index; Unit_Prj : Unit_Project; @@ -4470,7 +4480,6 @@ package body Prj.Nmsc is end if; else - -- Check to see if the source has been hidden by an exception, -- but only if it is not an exception. @@ -4507,6 +4516,7 @@ package body Prj.Nmsc is Unit_Index := Name_Index.Index; Unit_Kind := Info.Kind; end if; + -- Put the file name in the list of sources of the project if not File_Name_Recorded then @@ -4522,7 +4532,6 @@ package body Prj.Nmsc is if Current_Source = Nil_String then Data.Sources := String_Elements.Last; - else String_Elements.Table (Current_Source).Next := String_Elements.Last; @@ -4615,10 +4624,9 @@ package body Prj.Nmsc is Err_Vars.Error_Msg_Name_2 := Canonical_Path_Name; Error_Msg (Project, "\ project file {, {", The_Location); - end if; - -- It is a new unit, create a new record + -- It is a new unit, create a new record else -- First, check if there is no other unit with this file @@ -4673,23 +4681,23 @@ package body Prj.Nmsc is procedure Record_Other_Sources (Project : Project_Id; Data : in out Project_Data; - Language : Programming_Language; + Language : Language_Index; Naming_Exceptions : Boolean) is Source_Dir : String_List_Id := Data.Source_Dirs; Element : String_Element; Path : Name_Id; - Dir : Dir_Type; + Dir : Dir_Type; Canonical_Name : Name_Id; + Name_Str : String (1 .. 1_024); Last : Natural := 0; NL : Name_Location; First_Error : Boolean := True; - Suffix : constant String := - Get_Name_String (Data.Impl_Suffixes (Language)); + Suffix : constant String := Body_Suffix_Of (Language, Data); begin while Source_Dir /= Nil_String loop @@ -4697,6 +4705,7 @@ package body Prj.Nmsc is declare Dir_Path : constant String := Get_Name_String (Element.Value); + begin if Current_Verbosity = High then Write_Str ("checking directory """); @@ -4711,7 +4720,7 @@ package body Prj.Nmsc is end if; Write_Str (" of Language "); - Write_Line (Lang_Display_Names (Language).all); + Display_Language_Name (Language); end if; Open (Dir, Dir_Path); @@ -4769,7 +4778,6 @@ package body Prj.Nmsc is end loop; if not Naming_Exceptions then - NL := Source_Names.Get_First; -- It is an error if a source file name in a source list or @@ -4804,6 +4812,7 @@ package body Prj.Nmsc is Source_Id : Other_Source_Id := Data.First_Other_Source; Prev_Id : Other_Source_Id := No_Other_Source; Source : Other_Source; + begin while Source_Id /= No_Other_Source loop Source := Other_Sources.Table (Source_Id); @@ -4866,21 +4875,33 @@ package body Prj.Nmsc is ---------------- function Suffix_For - (Language : Programming_Language; + (Language : Language_Index; Naming : Naming_Data) return Name_Id is Suffix : constant Variable_Value := Value_Of - (Index => Lang_Name_Ids (Language), + (Index => Language_Names.Table (Language), Src_Index => 0, In_Array => Naming.Body_Suffix); begin - -- If no suffix for this language is found in package Naming, use the - -- default. + -- If no suffix for this language in package Naming, use the default if Suffix = Nil_Variable_Value then Name_Len := 0; - Add_Str_To_Name_Buffer (Lang_Suffixes (Language).all); + + case Language is + when Ada_Language_Index => + Add_Str_To_Name_Buffer (".adb"); + + when C_Language_Index => + Add_Str_To_Name_Buffer (".c"); + + when C_Plus_Plus_Language_Index => + Add_Str_To_Name_Buffer (".cc"); + + when others => + return No_Name; + end case; -- Otherwise use the one specified @@ -4892,4 +4913,69 @@ package body Prj.Nmsc is return Name_Find; end Suffix_For; + ------------------------- + -- Warn_If_Not_Sources -- + ------------------------- + + -- comments needed in this body ??? + + procedure Warn_If_Not_Sources + (Project : Project_Id; + Conventions : Array_Element_Id; + Specs : Boolean; + Extending : Boolean) + is + Conv : Array_Element_Id := Conventions; + Unit : Name_Id; + The_Unit_Id : Unit_Id; + The_Unit_Data : Unit_Data; + Location : Source_Ptr; + + begin + while Conv /= No_Array_Element loop + Unit := Array_Elements.Table (Conv).Index; + Error_Msg_Name_1 := Unit; + Get_Name_String (Unit); + To_Lower (Name_Buffer (1 .. Name_Len)); + Unit := Name_Find; + The_Unit_Id := Units_Htable.Get (Unit); + Location := Array_Elements.Table (Conv).Value.Location; + + if The_Unit_Id = Prj.Com.No_Unit then + Error_Msg + (Project, + "?unknown unit {", + Location); + + else + The_Unit_Data := Units.Table (The_Unit_Id); + + if Specs then + if not Check_Project + (The_Unit_Data.File_Names (Specification).Project, + Project, Extending) + then + Error_Msg + (Project, + "?unit{ has no spec in this project", + Location); + end if; + + else + if not Check_Project + (The_Unit_Data.File_Names (Com.Body_Part).Project, + Project, Extending) + then + Error_Msg + (Project, + "?unit{ has no body in this project", + Location); + end if; + end if; + end if; + + Conv := Array_Elements.Table (Conv).Next; + end loop; + end Warn_If_Not_Sources; + end Prj.Nmsc; diff --git a/gcc/ada/prj-nmsc.ads b/gcc/ada/prj-nmsc.ads index 9202ad33c40..a8d4c9f3d5b 100644 --- a/gcc/ada/prj-nmsc.ads +++ b/gcc/ada/prj-nmsc.ads @@ -32,27 +32,23 @@ private package Prj.Nmsc is -- procedures do (related to their names), rather than just an english -- language summary of the implementation ??? - procedure Other_Languages_Check - (Project : Project_Id; - Report_Error : Put_Line_Access); - -- Call Language_Independent_Check - -- - -- Check the naming scheme for the supported languages (c, c++, ...) other - -- than Ada. Find the source files if any. - -- - -- If Report_Error is null, use the standard error reporting mechanism - -- (Errout). Otherwise, report errors using Report_Error. - - procedure Ada_Check + procedure Check (Project : Project_Id; Report_Error : Put_Line_Access; Follow_Links : Boolean); - -- Call Language_Independent_Check + -- Check the object directory and the source directories + -- + -- Check the library attributes, including the library directory if any + -- + -- Get the set of specification and implementation suffixes, if any -- -- Check the naming scheme for Ada -- -- Find the Ada source files if any -- + -- Check the naming scheme for the supported languages (c, c++, ...) other + -- than Ada. Find the source files if any. + -- -- If Report_Error is null , use the standard error reporting mechanism -- (Errout). Otherwise, report errors using Report_Error. -- @@ -61,16 +57,4 @@ private package Prj.Nmsc is -- 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. - procedure Language_Independent_Check - (Project : Project_Id; - Report_Error : Put_Line_Access); - -- Check the object directory and the source directories - -- - -- Check the library attributes, including the library directory if any - -- - -- Get the set of specification and implementation suffixes, if any - -- - -- If Report_Error is null , use the standard error reporting mechanism - -- (Errout). Otherwise, report errors using Report_Error. - end Prj.Nmsc; diff --git a/gcc/ada/prj-pars.adb b/gcc/ada/prj-pars.adb index bf266880507..8ea1eac340a 100644 --- a/gcc/ada/prj-pars.adb +++ b/gcc/ada/prj-pars.adb @@ -43,8 +43,7 @@ package body Prj.Pars is procedure Parse (Project : out Project_Id; Project_File_Name : String; - Packages_To_Check : String_List_Access := All_Packages; - Process_Languages : Languages_Processed := Ada_Language) + Packages_To_Check : String_List_Access := All_Packages) is Project_Tree : Project_Node_Id := Empty_Node; The_Project : Project_Id := No_Project; @@ -67,7 +66,6 @@ package body Prj.Pars is Success => Success, From_Project_Node => Project_Tree, Report_Error => null, - Process_Languages => Process_Languages, Follow_Links => Opt.Follow_Links); Prj.Err.Finalize; diff --git a/gcc/ada/prj-pars.ads b/gcc/ada/prj-pars.ads index be23e4bdc83..99800e39c24 100644 --- a/gcc/ada/prj-pars.ads +++ b/gcc/ada/prj-pars.ads @@ -24,24 +24,25 @@ -- -- ------------------------------------------------------------------------------ --- Implements the parsing of project files. +-- Implements the parsing of project files with GNAT.OS_Lib; use GNAT.OS_Lib; package Prj.Pars is procedure Set_Verbosity (To : Verbosity); - -- Set the verbosity when parsing the project files. + -- Set the verbosity when parsing the project files procedure Parse (Project : out Project_Id; Project_File_Name : String; - Packages_To_Check : String_List_Access := All_Packages; - Process_Languages : Languages_Processed := Ada_Language); + Packages_To_Check : String_List_Access := All_Packages); -- Parse a project files and all its imported project files. + -- -- If parsing is successful, Project_Id is the project ID -- of the main project file; otherwise, Project_Id is set -- to No_Project. + -- -- Packages_To_Check indicates the packages where any unknown attribute -- produces an error. For other packages, an unknown attribute produces -- a warning. diff --git a/gcc/ada/prj-part.adb b/gcc/ada/prj-part.adb index c09f8fa803a..291fc23eb2a 100644 --- a/gcc/ada/prj-part.adb +++ b/gcc/ada/prj-part.adb @@ -32,8 +32,8 @@ with Output; use Output; with Prj.Com; use Prj.Com; with Prj.Dect; with Prj.Err; use Prj.Err; +with Prj.Ext; use Prj.Ext; with Scans; use Scans; -with Sdefault; with Sinput; use Sinput; with Sinput.P; use Sinput.P; with Snames; @@ -54,18 +54,6 @@ package body Prj.Part is Dir_Sep : Character renames GNAT.OS_Lib.Directory_Separator; - Project_Path : String_Access; - -- The project path; initialized during package elaboration. - -- Contains at least the current working directory. - - Ada_Project_Path : constant String := "ADA_PROJECT_PATH"; - -- Name of the env. variable that contains path name(s) of directories - -- where project files may reside. - - Prj_Path : constant String_Access := Getenv (Ada_Project_Path); - -- The path name(s) of directories where project files may reside. - -- May be empty. - type Extension_Origin is (None, Extending_Simple, Extending_All); -- Type of parameter From_Extended for procedures Parse_Single_Project and -- Post_Parse_Context_Clause. Extending_All means that we are parsing the @@ -449,7 +437,7 @@ package body Prj.Part is if Current_Verbosity >= Medium then Write_Str ("ADA_PROJECT_PATH="""); - Write_Str (Project_Path.all); + Write_Str (Project_Path); Write_Line (""""); end if; @@ -707,7 +695,7 @@ package body Prj.Part is Normalize_Pathname (Imported_Path_Name, Resolve_Links => True, - Case_Sensitive => False); + Case_Sensitive => True); Withed_Project : Project_Node_Id := Empty_Node; @@ -763,6 +751,7 @@ package body Prj.Part is begin Name_Len := Resolved_Path'Length; Name_Buffer (1 .. Name_Len) := Resolved_Path; + Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len)); Canonical_Path_Name := Name_Find; for Index in 1 .. Project_Stack.Last loop @@ -922,73 +911,60 @@ package body Prj.Part is Project_Stack.Table (Project_Stack.Last).Canonical_Path_Name := Canonical_Path_Name; - -- Check if the project file has already been parsed. + -- Check if the project file has already been parsed while A_Project_Name_And_Node /= Tree_Private_Part.No_Project_Name_And_Node loop - declare - Path_Id : Name_Id := Path_Name_Of (A_Project_Name_And_Node.Node); - - begin - if Path_Id /= No_Name then - Get_Name_String (Path_Id); - Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len)); - Path_Id := Name_Find; - end if; - - if Path_Id = Canonical_Path_Name then - if Extended then + if A_Project_Name_And_Node.Canonical_Path = Canonical_Path_Name then + if Extended then - if A_Project_Name_And_Node.Extended then - Error_Msg - ("cannot extend the same project file several times", - Token_Ptr); - - else - Error_Msg - ("cannot extend an already imported project file", - Token_Ptr); - end if; + if A_Project_Name_And_Node.Extended then + Error_Msg + ("cannot extend the same project file several times", + Token_Ptr); + else + Error_Msg + ("cannot extend an already imported project file", + Token_Ptr); + end if; - elsif A_Project_Name_And_Node.Extended then - Extends_All := - Is_Extending_All (A_Project_Name_And_Node.Node); + elsif A_Project_Name_And_Node.Extended then + Extends_All := + Is_Extending_All (A_Project_Name_And_Node.Node); - -- If the imported project is an extended project A, - -- and we are in an extended project, replace A with the - -- ultimate project extending A. + -- If the imported project is an extended project A, + -- and we are in an extended project, replace A with the + -- ultimate project extending A. - if From_Extended /= None then - declare - Decl : Project_Node_Id := - Project_Declaration_Of - (A_Project_Name_And_Node.Node); + if From_Extended /= None then + declare + Decl : Project_Node_Id := + Project_Declaration_Of + (A_Project_Name_And_Node.Node); - Prj : Project_Node_Id := - Extending_Project_Of (Decl); + Prj : Project_Node_Id := Extending_Project_Of (Decl); - begin - loop - Decl := Project_Declaration_Of (Prj); - exit when Extending_Project_Of (Decl) = Empty_Node; - Prj := Extending_Project_Of (Decl); - end loop; + begin + loop + Decl := Project_Declaration_Of (Prj); + exit when Extending_Project_Of (Decl) = Empty_Node; + Prj := Extending_Project_Of (Decl); + end loop; - A_Project_Name_And_Node.Node := Prj; - end; - else - Error_Msg - ("cannot import an already extended project file", - Token_Ptr); - end if; + A_Project_Name_And_Node.Node := Prj; + end; + else + Error_Msg + ("cannot import an already extended project file", + Token_Ptr); end if; - - Project := A_Project_Name_And_Node.Node; - Project_Stack.Decrement_Last; - return; end if; - end; + + Project := A_Project_Name_And_Node.Node; + Project_Stack.Decrement_Last; + return; + end if; A_Project_Name_And_Node := Tree_Private_Part.Projects_Htable.Get_Next; end loop; @@ -1037,7 +1013,7 @@ package body Prj.Part is Project := Default_Project_Node (Of_Kind => N_Project); Project_Stack.Table (Project_Stack.Last).Id := Project; Set_Directory_Of (Project, Project_Directory); - Set_Path_Name_Of (Project, Canonical_Path_Name); + Set_Path_Name_Of (Project, Normed_Path_Name); Set_Location_Of (Project, Token_Ptr); Expect (Tok_Project, "PROJECT"); @@ -1052,7 +1028,6 @@ package body Prj.Part is -- Clear the Buffer Buffer_Last := 0; - loop Expect (Tok_Identifier, "identifier"); @@ -1201,9 +1176,10 @@ package body Prj.Part is Tree_Private_Part.Projects_Htable.Set (K => Name_Of_Project, - E => (Name => Name_Of_Project, - Node => Project, - Extended => Extended)); + E => (Name => Name_Of_Project, + Node => Project, + Canonical_Path => Canonical_Path_Name, + Extended => Extended)); end if; end; @@ -1370,7 +1346,7 @@ package body Prj.Part is Project_Declaration : Project_Node_Id := Empty_Node; begin - -- No need to Scan past "is", Prj.Dect.Parse will do it. + -- No need to Scan past "is", Prj.Dect.Parse will do it Prj.Dect.Parse (Declarations => Project_Declaration, @@ -1630,7 +1606,7 @@ package body Prj.Part is Locate_Regular_File (File_Name => Directory & Directory_Separator & Project_File_Name & Project_File_Extension, - Path => Project_Path.all); + Path => Project_Path); -- Then we try / @@ -1646,7 +1622,7 @@ package body Prj.Part is Locate_Regular_File (File_Name => Directory & Directory_Separator & Project_File_Name, - Path => Project_Path.all); + Path => Project_Path); end if; end if; @@ -1663,7 +1639,7 @@ package body Prj.Part is Result := Locate_Regular_File (File_Name => Project_File_Name & Project_File_Extension, - Path => Project_Path.all); + Path => Project_Path); end if; if Result = null then @@ -1678,7 +1654,7 @@ package body Prj.Part is Result := Locate_Regular_File (File_Name => Project_File_Name, - Path => Project_Path.all); + Path => Project_Path); end if; -- If we cannot find the project file, we return an empty string @@ -1700,15 +1676,4 @@ package body Prj.Part is end if; end Project_Path_Name_Of; -begin - -- Initialize Project_Path during package elaboration - - if Prj_Path.all = "" then - Project_Path := - new String'("." & Path_Separator & Sdefault.Search_Dir_Prefix.all & - ".." & Directory_Separator & ".." & Directory_Separator & - ".." & Directory_Separator & "gnat"); - else - Project_Path := new String'("." & Path_Separator & Prj_Path.all); - end if; end Prj.Part; diff --git a/gcc/ada/prj-proc.adb b/gcc/ada/prj-proc.adb index 561c5d43809..7adcd08dac7 100644 --- a/gcc/ada/prj-proc.adb +++ b/gcc/ada/prj-proc.adb @@ -30,7 +30,6 @@ with Opt; with Osint; use Osint; with Output; use Output; with Prj.Attr; use Prj.Attr; -with Prj.Com; use Prj.Com; with Prj.Err; use Prj.Err; with Prj.Ext; use Prj.Ext; with Prj.Nmsc; use Prj.Nmsc; @@ -64,12 +63,10 @@ package body Prj.Proc is -- values to the package or project with declarations Decl. procedure Check - (Project : in out Project_Id; - Process_Languages : Languages_Processed; - Follow_Links : Boolean); + (Project : in out Project_Id; + Follow_Links : Boolean); -- Set all projects to not checked, then call Recursive_Check for the -- main project Project. Project is set to No_Project if errors occurred. - -- See Prj.Nmsc.Ada_Check for information on Follow_Links. function Expression (Project : Project_Id; @@ -111,13 +108,11 @@ package body Prj.Proc is -- Then process the declarative items of the project. procedure Recursive_Check - (Project : Project_Id; - Process_Languages : Languages_Processed; - Follow_Links : Boolean); + (Project : Project_Id; + Follow_Links : Boolean); -- 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. - -- See Prj.Nmsc.Ada_Check for information on Follow_Links --------- -- Add -- @@ -127,7 +122,7 @@ package body Prj.Proc is begin if To_Exp = Types.No_Name or else To_Exp = Empty_String then - -- To_Exp is nil or empty. The result is Str. + -- To_Exp is nil or empty. The result is Str To_Exp := Str; @@ -213,9 +208,9 @@ package body Prj.Proc is ----------- procedure Check - (Project : in out Project_Id; - Process_Languages : Languages_Processed; - Follow_Links : Boolean) is + (Project : in out Project_Id; + Follow_Links : Boolean) + is begin -- Make sure that all projects are marked as not checked @@ -223,8 +218,7 @@ package body Prj.Proc is Projects.Table (Index).Checked := False; end loop; - Recursive_Check (Project, Process_Languages, Follow_Links); - + Recursive_Check (Project, Follow_Links); end Check; ---------------- @@ -248,7 +242,7 @@ package body Prj.Proc is -- The returned result Last : String_List_Id := Nil_String; - -- Reference to the last string elements in Result, when Kind is List. + -- Reference to the last string elements in Result, when Kind is List begin Result.Project := Project; @@ -282,8 +276,7 @@ package body Prj.Proc is if Last = Nil_String then - -- This can happen in an expression such as - -- () & "toto" + -- This can happen in an expression like () & "toto" Result.Values := String_Elements.Last; @@ -300,7 +293,6 @@ package body Prj.Proc is Location => Location_Of (The_Current_Term), Flag => False, Next => Nil_String); - end case; when N_Literal_String_List => @@ -856,7 +848,6 @@ package body Prj.Proc is Success : out Boolean; From_Project_Node : Project_Node_Id; Report_Error : Put_Line_Access; - Process_Languages : Languages_Processed := Ada_Language; Follow_Links : Boolean := True) is Obj_Dir : Name_Id; @@ -881,7 +872,7 @@ package body Prj.Proc is Extended_By => No_Project); if Project /= No_Project then - Check (Project, Process_Languages, Follow_Links); + Check (Project, Follow_Links); end if; -- If main project is an extending all project, set the object @@ -922,15 +913,20 @@ package body Prj.Proc is Extending2 := Extending; while Extending2 /= No_Project loop - if ((Process_Languages = Ada_Language - and then - Projects.Table (Extending2).Ada_Sources_Present) - or else - (Process_Languages = Other_Languages - and then - Projects.Table (Extending2).Other_Sources_Present)) + +-- why is this code commented out ??? + +-- if ((Process_Languages = Ada_Language +-- and then +-- Projects.Table (Extending2).Ada_Sources_Present) +-- or else +-- (Process_Languages = Other_Languages +-- and then +-- Projects.Table (Extending2).Other_Sources_Present)) + + if Projects.Table (Extending2).Ada_Sources_Present and then - Projects.Table (Extending2).Object_Directory = Obj_Dir + Projects.Table (Extending2).Object_Directory = Obj_Dir then if Projects.Table (Extending2).Virtual then Error_Msg_Name_1 := Projects.Table (Proj).Name; @@ -1267,9 +1263,11 @@ package body Prj.Proc is -- Copy each array element while Orig_Element /= No_Array_Element loop - -- If it is the first element ... + + -- Case of first element if Prev_Element = No_Array_Element then + -- And there is no array element declared yet, -- create a new first array element. @@ -1324,6 +1322,7 @@ package body Prj.Proc is Prev_Element := New_Element; -- Go to the next element in the original array + Orig_Element := Array_Elements.Table (Orig_Element).Next; end loop; @@ -1804,7 +1803,6 @@ package body Prj.Proc is procedure Recursive_Check (Project : Project_Id; - Process_Languages : Languages_Processed; Follow_Links : Boolean) is Data : Project_Data; @@ -1827,7 +1825,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, Process_Languages, Follow_Links); + Recursive_Check (Data.Extends, Follow_Links); -- Call itself for all imported projects @@ -1835,7 +1833,7 @@ package body Prj.Proc is while Imported_Project_List /= Empty_Project_List loop Recursive_Check (Project_Lists.Table (Imported_Project_List).Project, - Process_Languages, Follow_Links); + Follow_Links); Imported_Project_List := Project_Lists.Table (Imported_Project_List).Next; end loop; @@ -1846,18 +1844,7 @@ package body Prj.Proc is Write_Line (""""); end if; - case Process_Languages is - when Ada_Language => - Prj.Nmsc.Ada_Check (Project, Error_Report, Follow_Links); - - when Other_Languages => - Prj.Nmsc.Other_Languages_Check (Project, Error_Report); - - when All_Languages => - Prj.Nmsc.Ada_Check (Project, Error_Report, Follow_Links); - Prj.Nmsc.Other_Languages_Check (Project, Error_Report); - - end case; + Prj.Nmsc.Check (Project, Error_Report, Follow_Links); end if; end Recursive_Check; diff --git a/gcc/ada/prj-proc.ads b/gcc/ada/prj-proc.ads index ca55a512a92..dae791b27d6 100644 --- a/gcc/ada/prj-proc.ads +++ b/gcc/ada/prj-proc.ads @@ -37,7 +37,6 @@ package Prj.Proc is Success : out Boolean; From_Project_Node : Project_Node_Id; Report_Error : Put_Line_Access; - Process_Languages : Languages_Processed := Ada_Language; Follow_Links : Boolean := True); -- Process a project file tree into project file data structures. -- If Report_Error is null, use the error reporting mechanism. diff --git a/gcc/ada/prj-tree.ads b/gcc/ada/prj-tree.ads index c376d3beee2..e50be5d7878 100644 --- a/gcc/ada/prj-tree.ads +++ b/gcc/ada/prj-tree.ads @@ -24,12 +24,11 @@ -- -- ------------------------------------------------------------------------------ --- This package defines the structure of the Project File tree. +-- This package defines the structure of the Project File tree with GNAT.HTable; with Prj.Attr; use Prj.Attr; -with Prj.Com; use Prj.Com; with Table; use Table; with Types; use Types; @@ -150,7 +149,7 @@ package Prj.Tree is -- this node. procedure Remove_Next_End_Node; - -- Remove the top of the end node stack. + -- Remove the top of the end node stack ------------------------ -- Comment Processing -- @@ -172,13 +171,13 @@ package Prj.Tree is -- A table to store the comments that may be stored is the tree procedure Scan; - -- Scan the tokens and accumulate comments. + -- Scan the tokens and accumulate comments type Comment_Location is (Before, After, Before_End, After_End, End_Of_Line); procedure Add_Comments (To : Project_Node_Id; Where : Comment_Location); - -- Add comments to this node. + -- Add comments to this node ---------------------- -- Access Functions -- @@ -235,7 +234,7 @@ package Prj.Tree is function Directory_Of (Node : Project_Node_Id) return Name_Id; pragma Inline (Directory_Of); - -- Only valid for N_Project nodes. + -- Only valid for N_Project nodes function Expression_Kind_Of (Node : Project_Node_Id) return Variable_Kind; pragma Inline (Expression_Kind_Of); @@ -263,7 +262,7 @@ package Prj.Tree is function Path_Name_Of (Node : Project_Node_Id) return Name_Id; pragma Inline (Path_Name_Of); - -- Only valid for N_Project and N_With_Clause nodes. + -- Only valid for N_Project and N_With_Clause nodes function String_Value_Of (Node : Project_Node_Id) return Name_Id; pragma Inline (String_Value_Of); @@ -1046,12 +1045,18 @@ package Prj.Tree is Node : Project_Node_Id; -- Node of the project in table Project_Nodes + Canonical_Path : Name_Id; + -- Resolved and canonical path of the project file + Extended : Boolean; -- True when the project is being extended by another project end record; No_Project_Name_And_Node : constant Project_Name_And_Node := - (Name => No_Name, Node => Empty_Node, Extended => True); + (Name => No_Name, + Node => Empty_Node, + Canonical_Path => No_Name, + Extended => True); package Projects_Htable is new GNAT.HTable.Simple_HTable (Header_Num => Header_Num, diff --git a/gcc/ada/prj-util.adb b/gcc/ada/prj-util.adb index 9de974760dd..a0709cbb8b1 100644 --- a/gcc/ada/prj-util.adb +++ b/gcc/ada/prj-util.adb @@ -107,12 +107,12 @@ package body Prj.Util is Body_Append : constant String := Get_Name_String (Projects.Table (Project). - Naming.Current_Body_Suffix); + Naming.Ada_Body_Suffix); Spec_Append : constant String := Get_Name_String (Projects.Table (Project). - Naming.Current_Spec_Suffix); + Naming.Ada_Spec_Suffix); begin if Builder_Package /= No_Package then @@ -131,9 +131,9 @@ package body Prj.Util is Projects.Table (Project).Naming; Spec_Suffix : constant String := - Get_Name_String (Naming.Current_Spec_Suffix); + Get_Name_String (Naming.Ada_Spec_Suffix); Body_Suffix : constant String := - Get_Name_String (Naming.Current_Body_Suffix); + Get_Name_String (Naming.Ada_Body_Suffix); Truncated : Boolean := False; diff --git a/gcc/ada/prj.adb b/gcc/ada/prj.adb index af6482dac76..602d3a5c550 100644 --- a/gcc/ada/prj.adb +++ b/gcc/ada/prj.adb @@ -27,6 +27,7 @@ with Ada.Characters.Handling; use Ada.Characters.Handling; with Namet; use Namet; +with Output; use Output; with Osint; use Osint; with Prj.Attr; with Prj.Com; @@ -36,12 +37,15 @@ with Scans; use Scans; with Snames; use Snames; with Uintp; use Uintp; -with GNAT.OS_Lib; use GNAT.OS_Lib; +with GNAT.Case_Util; use GNAT.Case_Util; +with GNAT.OS_Lib; use GNAT.OS_Lib; package body Prj is The_Empty_String : Name_Id; + Name_C_Plus_Plus : Name_Id; + subtype Known_Casing is Casing_Type range All_Upper_Case .. Mixed_Case; The_Casing_Images : constant array (Known_Casing) of String_Access := @@ -55,15 +59,16 @@ package body Prj is First_Name_Id + Character'Pos ('-'); Std_Naming_Data : Naming_Data := - (Current_Language => No_Name, - Dot_Replacement => Standard_Dot_Replacement, + (Dot_Replacement => Standard_Dot_Replacement, Dot_Repl_Loc => No_Location, Casing => All_Lower_Case, Spec_Suffix => No_Array_Element, - Current_Spec_Suffix => No_Name, + Ada_Spec_Suffix => No_Name, Spec_Suffix_Loc => No_Location, + Impl_Suffixes => No_Impl_Suffixes, + Supp_Suffixes => No_Supp_Language_Index, Body_Suffix => No_Array_Element, - Current_Body_Suffix => No_Name, + Ada_Body_Suffix => No_Name, Body_Suffix_Loc => No_Location, Separate_Suffix => No_Name, Sep_Suffix_Loc => No_Location, @@ -73,8 +78,9 @@ package body Prj is Implementation_Exceptions => No_Array_Element); Project_Empty : constant Project_Data := - (Languages => No_Languages, - Impl_Suffixes => No_Impl_Suffixes, + (Externally_Built => False, + Languages => No_Languages, + Supp_Languages => No_Supp_Language_Index, First_Referred_By => No_Project, Name => No_Name, Path_Name => No_Name, @@ -114,6 +120,10 @@ package body Prj is Extends => No_Project, Extended_By => No_Project, Naming => Std_Naming_Data, + First_Language_Processing => Default_First_Language_Processing_Data, + Supp_Language_Processing => No_Supp_Language_Index, + Default_Linker => No_Name, + Default_Linker_Path => No_Name, Decl => No_Declarations, Imported_Projects => Empty_Project_List, Ada_Include_Path => null, @@ -131,6 +141,18 @@ package body Prj is Depth => 0, Unkept_Comments => False); + ----------------------- + -- Add_Language_Name -- + ----------------------- + + procedure Add_Language_Name (Name : Name_Id) is + begin + Last_Language_Index := Last_Language_Index + 1; + Language_Indexes.Set (Name, Last_Language_Index); + Language_Names.Increment_Last; + Language_Names.Table (Last_Language_Index) := Name; + end Add_Language_Name; + ------------------- -- Add_To_Buffer -- ------------------- @@ -155,6 +177,17 @@ package body Prj is Buffer_Last := Buffer_Last + S'Length; end Add_To_Buffer; + --------------------------- + -- Display_Language_Name -- + --------------------------- + + procedure Display_Language_Name (Language : Language_Index) is + begin + Get_Name_String (Language_Names.Table (Language)); + To_Upper (Name_Buffer (1 .. 1)); + Write_Str (Name_Buffer (1 .. Name_Len)); + end Display_Language_Name; + ------------------- -- Empty_Project -- ------------------- @@ -195,9 +228,12 @@ package body Prj is is procedure Check (Project : Project_Id); - -- Check if a project has already been seen. - -- If not seen, mark it as seen, call Action, - -- and check all its imported projects. + -- Check if a project has already been seen. If not seen, mark it as + -- Seen, Call Action, and check all its imported projects. + + ----------- + -- Check -- + ----------- procedure Check (Project : Project_Id) is List : Project_List; @@ -215,6 +251,8 @@ package body Prj is end if; end Check; + -- Start of procecessing for For_Every_Project_Imported + begin for Project in Projects.First .. Projects.Last loop Projects.Table (Project).Seen := False; @@ -223,6 +261,15 @@ package body Prj is Check (Project => By); end For_Every_Project_Imported; + ---------- + -- Hash -- + ---------- + + function Hash (Name : Name_Id) return Header_Num is + begin + return Hash (Get_Name_String (Name)); + end Hash; + ----------- -- Image -- ----------- @@ -253,18 +300,12 @@ package body Prj is Name_Len := 1; Name_Buffer (1) := '/'; Slash := Name_Find; + Name_Len := 3; + Name_Buffer (1 .. 3) := "c++"; + Name_C_Plus_Plus := Name_Find; - for Lang in Programming_Language loop - Name_Len := Lang_Names (Lang)'Length; - Name_Buffer (1 .. Name_Len) := Lang_Names (Lang).all; - Lang_Name_Ids (Lang) := Name_Find; - Name_Len := Lang_Suffixes (Lang)'Length; - Name_Buffer (1 .. Name_Len) := Lang_Suffixes (Lang).all; - Lang_Suffix_Ids (Lang) := Name_Find; - end loop; - - Std_Naming_Data.Current_Spec_Suffix := Default_Ada_Spec_Suffix; - Std_Naming_Data.Current_Body_Suffix := Default_Ada_Body_Suffix; + Std_Naming_Data.Ada_Spec_Suffix := Default_Ada_Spec_Suffix; + Std_Naming_Data.Ada_Body_Suffix := Default_Ada_Body_Suffix; Std_Naming_Data.Separate_Suffix := Default_Ada_Body_Suffix; Register_Default_Naming_Scheme (Language => Name_Ada, @@ -275,9 +316,91 @@ package body Prj is Set_Name_Table_Byte (Name_Project, Token_Type'Pos (Tok_Project)); Set_Name_Table_Byte (Name_Extends, Token_Type'Pos (Tok_Extends)); Set_Name_Table_Byte (Name_External, Token_Type'Pos (Tok_External)); + + Language_Indexes.Reset; + Last_Language_Index := No_Language_Index; + Language_Names.Init; + Add_Language_Name (Name_Ada); + Add_Language_Name (Name_C); + Add_Language_Name (Name_C_Plus_Plus); end if; end Initialize; + ---------------- + -- Is_Present -- + ---------------- + + function Is_Present + (Language : Language_Index; + In_Project : Project_Data) return Boolean + is + begin + case Language is + when No_Language_Index => + return False; + + when First_Language_Indexes => + return In_Project.Languages (Language); + + when others => + declare + Supp : Supp_Language; + Supp_Index : Supp_Language_Index := In_Project.Supp_Languages; + + begin + while Supp_Index /= No_Supp_Language_Index loop + Supp := Present_Languages.Table (Supp_Index); + + if Supp.Index = Language then + return Supp.Present; + end if; + + Supp_Index := Supp.Next; + end loop; + + return False; + end; + end case; + end Is_Present; + + --------------------------------- + -- Language_Processing_Data_Of -- + --------------------------------- + + function Language_Processing_Data_Of + (Language : Language_Index; + In_Project : Project_Data) return Language_Processing_Data + is + begin + case Language is + when No_Language_Index => + return Default_Language_Processing_Data; + + when First_Language_Indexes => + return In_Project.First_Language_Processing (Language); + + when others => + declare + Supp : Supp_Language_Data; + Supp_Index : Supp_Language_Index := + In_Project.Supp_Language_Processing; + + begin + while Supp_Index /= No_Supp_Language_Index loop + Supp := Supp_Languages.Table (Supp_Index); + + if Supp.Index = Language then + return Supp.Data; + end if; + + Supp_Index := Supp.Next; + end loop; + + return Default_Language_Processing_Data; + end; + end case; + end Language_Processing_Data_Of; + ------------------------------------ -- Register_Default_Naming_Scheme -- ------------------------------------ @@ -398,17 +521,145 @@ package body Prj is ------------------------ function Same_Naming_Scheme - (Left, Right : Naming_Data) - return Boolean + (Left, Right : Naming_Data) return Boolean is begin return Left.Dot_Replacement = Right.Dot_Replacement and then Left.Casing = Right.Casing - and then Left.Current_Spec_Suffix = Right.Current_Spec_Suffix - and then Left.Current_Body_Suffix = Right.Current_Body_Suffix + and then Left.Ada_Spec_Suffix = Right.Ada_Spec_Suffix + and then Left.Ada_Body_Suffix = Right.Ada_Body_Suffix and then Left.Separate_Suffix = Right.Separate_Suffix; end Same_Naming_Scheme; + --------- + -- Set -- + --------- + + procedure Set + (Language : Language_Index; + Present : Boolean; + In_Project : in out Project_Data) + is + begin + case Language is + when No_Language_Index => + null; + + when First_Language_Indexes => + In_Project.Languages (Language) := Present; + + when others => + declare + Supp : Supp_Language; + Supp_Index : Supp_Language_Index := In_Project.Supp_Languages; + + begin + while Supp_Index /= No_Supp_Language_Index loop + Supp := Present_Languages.Table (Supp_Index); + + if Supp.Index = Language then + Present_Languages.Table (Supp_Index).Present := Present; + return; + end if; + + Supp_Index := Supp.Next; + end loop; + + Supp := (Index => Language, Present => Present, + Next => In_Project.Supp_Languages); + Present_Languages.Increment_Last; + Supp_Index := Present_Languages.Last; + Present_Languages.Table (Supp_Index) := Supp; + In_Project.Supp_Languages := Supp_Index; + end; + end case; + end Set; + + procedure Set + (Language_Processing : in Language_Processing_Data; + For_Language : Language_Index; + In_Project : in out Project_Data) + is + begin + case For_Language is + when No_Language_Index => + null; + + when First_Language_Indexes => + In_Project.First_Language_Processing (For_Language) := + Language_Processing; + + when others => + declare + Supp : Supp_Language_Data; + Supp_Index : Supp_Language_Index := + In_Project.Supp_Language_Processing; + + begin + while Supp_Index /= No_Supp_Language_Index loop + Supp := Supp_Languages.Table (Supp_Index); + + if Supp.Index = For_Language then + Supp_Languages.Table (Supp_Index).Data := + Language_Processing; + return; + end if; + + Supp_Index := Supp.Next; + end loop; + + Supp := (Index => For_Language, Data => Language_Processing, + Next => In_Project.Supp_Language_Processing); + Supp_Languages.Increment_Last; + Supp_Index := Supp_Languages.Last; + Supp_Languages.Table (Supp_Index) := Supp; + In_Project.Supp_Language_Processing := Supp_Index; + end; + end case; + end Set; + + procedure Set + (Suffix : Name_Id; + For_Language : Language_Index; + In_Project : in out Project_Data) + is + begin + case For_Language is + when No_Language_Index => + null; + + when First_Language_Indexes => + In_Project.Naming.Impl_Suffixes (For_Language) := Suffix; + + when others => + declare + Supp : Supp_Suffix; + Supp_Index : Supp_Language_Index := + In_Project.Naming.Supp_Suffixes; + + begin + while Supp_Index /= No_Supp_Language_Index loop + Supp := Supp_Suffix_Table.Table (Supp_Index); + + if Supp.Index = For_Language then + Supp_Suffix_Table.Table (Supp_Index).Suffix := Suffix; + return; + end if; + + Supp_Index := Supp.Next; + end loop; + + Supp := (Index => For_Language, Suffix => Suffix, + Next => In_Project.Naming.Supp_Suffixes); + Supp_Suffix_Table.Increment_Last; + Supp_Index := Supp_Suffix_Table.Last; + Supp_Suffix_Table.Table (Supp_Index) := Supp; + In_Project.Naming.Supp_Suffixes := Supp_Index; + end; + end case; + end Set; + + -------------------------- -- Standard_Naming_Data -- -------------------------- @@ -419,6 +670,44 @@ package body Prj is return Std_Naming_Data; end Standard_Naming_Data; + --------------- + -- Suffix_Of -- + --------------- + + function Suffix_Of + (Language : Language_Index; + In_Project : Project_Data) return Name_Id + is + begin + case Language is + when No_Language_Index => + return No_Name; + + when First_Language_Indexes => + return In_Project.Naming.Impl_Suffixes (Language); + + when others => + declare + Supp : Supp_Suffix; + Supp_Index : Supp_Language_Index := + In_Project.Naming.Supp_Suffixes; + + begin + while Supp_Index /= No_Supp_Language_Index loop + Supp := Supp_Suffix_Table.Table (Supp_Index); + + if Supp.Index = Language then + return Supp.Suffix; + end if; + + Supp_Index := Supp.Next; + end loop; + + return No_Name; + end; + end case; + end Suffix_Of; + ----------- -- Value -- ----------- diff --git a/gcc/ada/prj.ads b/gcc/ada/prj.ads index 41ca8d9fbc1..21c796c4977 100644 --- a/gcc/ada/prj.ads +++ b/gcc/ada/prj.ads @@ -37,6 +37,8 @@ with Types; use Types; with GNAT.OS_Lib; use GNAT.OS_Lib; +with System.HTable; use System.HTable; + package Prj is Empty_Name : Name_Id; @@ -66,96 +68,167 @@ package Prj is Slash : Name_Id; -- "/", used as the path of locally removed files - type Languages_Processed is (Ada_Language, Other_Languages, All_Languages); - -- To specify how to process project files + type Language_Index is new Nat; + + No_Language_Index : constant Language_Index := 0; + First_Language_Index : constant Language_Index := 1; + First_Language_Indexes_Last : constant Language_Index := 5; + + Ada_Language_Index : constant Language_Index := + First_Language_Index; + C_Language_Index : constant Language_Index := + Ada_Language_Index + 1; + C_Plus_Plus_Language_Index : constant Language_Index := + C_Language_Index + 1; + + Last_Language_Index : Language_Index := No_Language_Index; + + subtype First_Language_Indexes is Language_Index + range First_Language_Index .. First_Language_Indexes_Last; + + type Header_Num is range 0 .. 2047; - type Programming_Language is - (Lang_Ada, Lang_C, Lang_C_Plus_Plus); - -- The set of languages supported + function Hash is new System.HTable.Hash (Header_Num => Header_Num); + + function Hash (Name : Name_Id) return Header_Num; + + package Language_Indexes is new System.HTable.Simple_HTable + (Header_Num => Header_Num, + Element => Language_Index, + No_Element => No_Language_Index, + Key => Name_Id, + Hash => Hash, + Equal => "="); + -- Mapping of language names to language indexes + + package Language_Names is new Table.Table + (Table_Component_Type => Name_Id, + Table_Index_Type => Language_Index, + Table_Low_Bound => 1, + Table_Initial => 4, + Table_Increment => 100, + Table_Name => "Prj.Language_Names"); + -- The table for the name of programming languages - subtype Other_Programming_Language is - Programming_Language range Lang_C .. Programming_Language'Last; - -- The set of non-Ada languages supported + procedure Add_Language_Name (Name : Name_Id); - type Languages_In_Project is array (Programming_Language) of Boolean; + procedure Display_Language_Name (Language : Language_Index); + + type Languages_In_Project is array (First_Language_Indexes) of Boolean; -- Set of supported languages used in a project No_Languages : constant Languages_In_Project := (others => False); -- No supported languages are used - type Impl_Suffix_Array is array (Programming_Language) of Name_Id; + type Supp_Language_Index is new Nat; + No_Supp_Language_Index : constant Supp_Language_Index := 0; + + type Supp_Language is record + Index : Language_Index := No_Language_Index; + Present : Boolean := False; + Next : Supp_Language_Index := No_Supp_Language_Index; + end record; + + package Present_Languages is new Table.Table + (Table_Component_Type => Supp_Language, + Table_Index_Type => Supp_Language_Index, + Table_Low_Bound => 1, + Table_Initial => 4, + Table_Increment => 100, + Table_Name => "Prj.Present_Languages"); + -- The table for the presence of languages with an index that is outside + -- of First_Language_Indexes. + + type Impl_Suffix_Array is array (First_Language_Indexes) of Name_Id; -- Suffixes for the non spec sources of the different supported languages -- in a project. No_Impl_Suffixes : constant Impl_Suffix_Array := (others => No_Name); -- A default value for the non spec source suffixes - Lang_Ada_Name : aliased String := "ada"; - Lang_C_Name : aliased String := "c"; - Lang_C_Plus_Plus_Name : aliased String := "c++"; - Lang_Names : constant array (Programming_Language) of String_Access := - (Lang_Ada => Lang_Ada_Name 'Access, - Lang_C => Lang_C_Name 'Access, - Lang_C_Plus_Plus => Lang_C_Plus_Plus_Name'Access); - -- Names of the supported programming languages, to be used after switch - -- -x when using a GCC compiler. - - Lang_Name_Ids : array (Programming_Language) of Name_Id; - -- Same as Lang_Names, but using Name_Id, instead of String_Access. - -- Initialized by Prj.Initialize. - - Lang_Ada_Display_Name : aliased String := "Ada"; - Lang_C_Display_Name : aliased String := "C"; - Lang_C_Plus_Plus_Display_Name : aliased String := "C++"; - Lang_Display_Names : - constant array (Programming_Language) of String_Access := - (Lang_Ada => Lang_Ada_Display_Name 'Access, - Lang_C => Lang_C_Display_Name 'Access, - Lang_C_Plus_Plus => Lang_C_Plus_Plus_Display_Name'Access); - -- Names of the supported programming languages, to be used for display - -- purposes. - - Ada_Impl_Suffix : aliased String := ".adb"; - C_Impl_Suffix : aliased String := ".c"; - C_Plus_Plus_Impl_Suffix : aliased String := ".cc"; - Lang_Suffixes : constant array (Programming_Language) of String_Access := - (Lang_Ada => Ada_Impl_Suffix 'Access, - Lang_C => C_Impl_Suffix 'Access, - Lang_C_Plus_Plus => C_Plus_Plus_Impl_Suffix'Access); - -- Default extension of the sources of the different languages. - - Lang_Suffix_Ids : array (Programming_Language) of Name_Id; - -- Same as Lang_Suffixes, but using Name_Id, instead of String_Access. - -- Initialized by Prj.Initialize. - - Gnatmake_String : aliased String := "gnatmake"; - Gcc_String : aliased String := "gcc"; - G_Plus_Plus_String : aliased String := "g++"; - Default_Compiler_Names : - constant array (Programming_Language) of String_Access := - (Lang_Ada => Gnatmake_String 'Access, - Lang_C => Gcc_String 'Access, - Lang_C_Plus_Plus => G_Plus_Plus_String'Access); - -- Default names of the compilers for the supported languages. - -- Used when no IDE'Compiler_Command is specified for a language. - -- For Ada, specify the gnatmake executable. - - Ada_Args_Strings : aliased String := ""; - C_Args_String : aliased String := "c"; - C_Plus_Plus_Args_String : aliased String := "xx"; - Lang_Args : constant array (Programming_Language) of String_Access := - (Lang_Ada => Ada_Args_Strings 'Access, - Lang_C => C_Args_String 'Access, - Lang_C_Plus_Plus => C_Plus_Plus_Args_String'Access); - -- For each supported language, the string between "-c" and "args" to - -- be used in the gprmake switch for the start of the compiling switch - -- section for each supported language. For example, "-ccargs" indicates - -- the start of the C compiler switch section. + type Supp_Suffix is record + Index : Language_Index := No_Language_Index; + Suffix : Name_Id := No_Name; + Next : Supp_Language_Index := No_Supp_Language_Index; + end record; + + package Supp_Suffix_Table is new Table.Table + (Table_Component_Type => Supp_Suffix, + Table_Index_Type => Supp_Language_Index, + Table_Low_Bound => 1, + Table_Initial => 4, + Table_Increment => 100, + Table_Name => "Prj.Supp_Suffix_Table"); + -- The table for the presence of languages with an index that is outside + -- of First_Language_Indexes. + + type Language_Kind is (GNU, other); + + type Name_List_Index is new Nat; + No_Name_List : constant Name_List_Index := 0; + + type Name_Node is record + Name : Name_Id := No_Name; + Next : Name_List_Index := No_Name_List; + end record; + + package Name_Lists is new Table.Table + (Table_Component_Type => Name_Node, + Table_Index_Type => Name_List_Index, + Table_Low_Bound => 1, + Table_Initial => 10, + Table_Increment => 100, + Table_Name => "Prj.Name_Lists"); + -- The table for lists of names used in package Language_Processing + + type Language_Processing_Data is record + Compiler_Drivers : Name_List_Index := No_Name_List; + Compiler_Paths : Name_Id := No_Name; + Compiler_Kinds : Language_Kind := GNU; + Dependency_Options : Name_List_Index := No_Name_List; + Compute_Dependencies : Name_List_Index := No_Name_List; + Include_Options : Name_List_Index := No_Name_List; + Binder_Drivers : Name_Id := No_Name; + Binder_Driver_Paths : Name_Id := No_Name; + end record; + + Default_Language_Processing_Data : + constant Language_Processing_Data := + (Compiler_Drivers => No_Name_List, + Compiler_Paths => No_Name, + Compiler_Kinds => GNU, + Dependency_Options => No_Name_List, + Compute_Dependencies => No_Name_List, + Include_Options => No_Name_List, + Binder_Drivers => No_Name, + Binder_Driver_Paths => No_Name); + + type First_Language_Processing_Data is + array (First_Language_Indexes) of Language_Processing_Data; + + Default_First_Language_Processing_Data : First_Language_Processing_Data := + (others => Default_Language_Processing_Data); + + type Supp_Language_Data is record + Index : Language_Index := No_Language_Index; + Data : Language_Processing_Data := Default_Language_Processing_Data; + Next : Supp_Language_Index := No_Supp_Language_Index; + end record; + + package Supp_Languages is new Table.Table + (Table_Component_Type => Supp_Language_Data, + Table_Index_Type => Supp_Language_Index, + Table_Low_Bound => 1, + Table_Initial => 4, + Table_Increment => 100, + Table_Name => "Prj.Supp_Languages"); + -- The table for language data when there are more languages than + -- in First_Language_Indexes. type Other_Source_Id is new Nat; No_Other_Source : constant Other_Source_Id := 0; type Other_Source is record - Language : Programming_Language; -- language of the source + Language : Language_Index; -- language of the source File_Name : Name_Id; -- source file simple name Path_Name : Name_Id; -- source full path name Source_TS : Time_Stamp_Type; -- source file time stamp @@ -375,8 +448,6 @@ package Prj is -- The following record contains data for a naming scheme type Naming_Data is record - Current_Language : Name_Id := No_Name; - -- The programming language being currently considered Dot_Replacement : Name_Id := No_Name; -- The string to replace '.' in the source file name (for Ada). @@ -393,24 +464,28 @@ package Prj is -- source file name of a spec. -- Indexed by the programming language. - Current_Spec_Suffix : Name_Id := No_Name; - -- The "spec" suffix of the current programming language + Ada_Spec_Suffix : Name_Id := No_Name; + -- The suffix of the Ada spec sources Spec_Suffix_Loc : Source_Ptr := No_Location; -- The position in the project file source where - -- Current_Spec_Suffix is defined. + -- Ada_Spec_Suffix is defined. + + Impl_Suffixes : Impl_Suffix_Array := No_Impl_Suffixes; + Supp_Suffixes : Supp_Language_Index := No_Supp_Language_Index; + -- The source suffixes of the different languages Body_Suffix : Array_Element_Id := No_Array_Element; -- The string to append to the unit name for the -- source file name of a body. -- Indexed by the programming language. - Current_Body_Suffix : Name_Id := No_Name; - -- The "body" suffix of the current programming language + Ada_Body_Suffix : Name_Id := No_Name; + -- The suffix of the Ada body sources Body_Suffix_Loc : Source_Ptr := No_Location; -- The position in the project file source where - -- Current_Body_Suffix is defined. + -- Ada_Body_Suffix is defined. Separate_Suffix : Name_Id := No_Name; -- String to append to unit name for source file name of an Ada subunit. @@ -441,8 +516,7 @@ package Prj is -- The standard GNAT naming scheme function Same_Naming_Scheme - (Left, Right : Naming_Data) - return Boolean; + (Left, Right : Naming_Data) return Boolean; -- Returns True if Left and Right are the same naming scheme -- not considering Specs and Bodies. @@ -469,11 +543,11 @@ package Prj is -- The following record describes a project file representation type Project_Data is record - Languages : Languages_In_Project := No_Languages; - -- Indicate the different languages of the source of this project + Externally_Built : Boolean := False; - Impl_Suffixes : Impl_Suffix_Array := No_Impl_Suffixes; - -- The source suffixes of the different languages other than Ada + Languages : Languages_In_Project := No_Languages; + Supp_Languages : Supp_Language_Index := No_Supp_Language_Index; + -- Indicate the different languages of the source of this project First_Referred_By : Project_Id := No_Project; -- The project, if any, that was the first to be known @@ -498,7 +572,7 @@ package Prj is -- project. Set by Prj.Proc.Process. Mains : String_List_Id := Nil_String; - -- List of mains specified by attribute Main. Set by Prj.Nmsc.Ada_Check. + -- List of mains specified by attribute Main. Set by Prj.Nmsc.Check. Directory : Name_Id := No_Name; -- Directory where the project file resides. Set by Prj.Proc.Process. @@ -548,11 +622,11 @@ package Prj is Standalone_Library : Boolean := False; -- Indicate that this is a Standalone Library Project File. - -- Set by Prj.Nmsc.Ada_Check. + -- Set by Prj.Nmsc.Check. Lib_Interface_ALIs : String_List_Id := Nil_String; -- For Standalone Library Project Files, indicate the list - -- of Interface ALI files. Set by Prj.Nmsc.Ada_Check. + -- of Interface ALI files. Set by Prj.Nmsc.Check. Lib_Auto_Init : Boolean := False; -- For non static Standalone Library Project Files, indicate if @@ -629,6 +703,15 @@ package Prj is -- The naming scheme of this project file. -- Set by Prj.Nmsc.Check_Naming_Scheme. + First_Language_Processing : First_Language_Processing_Data := + Default_First_Language_Processing_Data; + + Supp_Language_Processing : Supp_Language_Index := + No_Supp_Language_Index; + + Default_Linker : Name_Id := No_Name; + Default_Linker_Path : Name_Id := No_Name; + Decl : Declarations := No_Declarations; -- The declarations (variables, attributes and packages) of this -- project file. Set by Prj.Proc.Process. @@ -699,6 +782,44 @@ package Prj is end record; + function Is_Present + (Language : Language_Index; + In_Project : Project_Data) return Boolean; + -- Return True when Language is one of the languages used in + -- project Project. + + procedure Set + (Language : Language_Index; + Present : Boolean; + In_Project : in out Project_Data); + -- Indicate if Language is or not a language used in project Project + + function Language_Processing_Data_Of + (Language : Language_Index; + In_Project : Project_Data) return Language_Processing_Data; + -- Return the Language_Processing_Data for language Language in project + -- In_Project. Return the default when no Language_Processing_Data are + -- defined for the language. + + procedure Set + (Language_Processing : Language_Processing_Data; + For_Language : Language_Index; + In_Project : in out Project_Data); + -- Set the Language_Processing_Data for language Language in project + -- In_Project. + + function Suffix_Of + (Language : Language_Index; + In_Project : Project_Data) return Name_Id; + -- Return the suffix for language Language in project In_Project. Return + -- No_Name when no suffix is defined for the language. + + procedure Set + (Suffix : Name_Id; + For_Language : Language_Index; + In_Project : in out Project_Data); + -- Set the suffix for language Language in project In_Project + Project_Error : exception; -- Raised by some subprograms in Prj.Attr. diff --git a/gcc/ada/snames.adb b/gcc/ada/snames.adb index 30a80707c8e..125455ca6bf 100644 --- a/gcc/ada/snames.adb +++ b/gcc/ada/snames.adb @@ -626,16 +626,24 @@ package body Snames is "requeue#" & "tagged#" & "raise_exception#" & + "ada_roots#" & "binder#" & + "binder_driver#" & "body_suffix#" & "builder#" & "compiler#" & + "compiler_driver#" & + "compiler_kind#" & + "compute_dependency#" & "cross_reference#" & + "default_linker#" & "default_switches#" & + "dependency_option#" & "exec_dir#" & "executable#" & "executable_suffix#" & "extends#" & + "externally_built#" & "finder#" & "global_configuration_pragmas#" & "gnatls#" & @@ -643,6 +651,8 @@ package body Snames is "implementation#" & "implementation_exceptions#" & "implementation_suffix#" & + "include_option#" & + "language_processing#" & "languages#" & "library_dir#" & "library_auto_init#" & diff --git a/gcc/ada/snames.ads b/gcc/ada/snames.ads index 10eb49b229c..4fb6c255ba8 100644 --- a/gcc/ada/snames.ads +++ b/gcc/ada/snames.ads @@ -921,64 +921,75 @@ package Snames is Name_Raise_Exception : constant Name_Id := N + 568; - -- Additional reserved words in GNAT Project Files + -- Additional reserved words and identifiers used in GNAT Project Files -- Note that Name_External is already previously declared - Name_Binder : constant Name_Id := N + 569; - Name_Body_Suffix : constant Name_Id := N + 570; - Name_Builder : constant Name_Id := N + 571; - Name_Compiler : constant Name_Id := N + 572; - Name_Cross_Reference : constant Name_Id := N + 573; - Name_Default_Switches : constant Name_Id := N + 574; - Name_Exec_Dir : constant Name_Id := N + 575; - Name_Executable : constant Name_Id := N + 576; - Name_Executable_Suffix : constant Name_Id := N + 577; - Name_Extends : constant Name_Id := N + 578; - Name_Finder : constant Name_Id := N + 579; - Name_Global_Configuration_Pragmas : constant Name_Id := N + 580; - Name_Gnatls : constant Name_Id := N + 581; - Name_Gnatstub : constant Name_Id := N + 582; - Name_Implementation : constant Name_Id := N + 583; - Name_Implementation_Exceptions : constant Name_Id := N + 584; - Name_Implementation_Suffix : constant Name_Id := N + 585; - Name_Languages : constant Name_Id := N + 586; - Name_Library_Dir : constant Name_Id := N + 587; - Name_Library_Auto_Init : constant Name_Id := N + 588; - Name_Library_GCC : constant Name_Id := N + 589; - Name_Library_Interface : constant Name_Id := N + 590; - Name_Library_Kind : constant Name_Id := N + 591; - Name_Library_Name : constant Name_Id := N + 592; - Name_Library_Options : constant Name_Id := N + 593; - Name_Library_Reference_Symbol_File : constant Name_Id := N + 594; - Name_Library_Src_Dir : constant Name_Id := N + 595; - Name_Library_Symbol_File : constant Name_Id := N + 596; - Name_Library_Symbol_Policy : constant Name_Id := N + 597; - Name_Library_Version : constant Name_Id := N + 598; - Name_Linker : constant Name_Id := N + 599; - Name_Local_Configuration_Pragmas : constant Name_Id := N + 600; - Name_Locally_Removed_Files : constant Name_Id := N + 601; - Name_Metrics : constant Name_Id := N + 602; - Name_Naming : constant Name_Id := N + 603; - Name_Object_Dir : constant Name_Id := N + 604; - Name_Pretty_Printer : constant Name_Id := N + 605; - Name_Project : constant Name_Id := N + 606; - Name_Separate_Suffix : constant Name_Id := N + 607; - Name_Source_Dirs : constant Name_Id := N + 608; - Name_Source_Files : constant Name_Id := N + 609; - Name_Source_List_File : constant Name_Id := N + 610; - Name_Spec : constant Name_Id := N + 611; - Name_Spec_Suffix : constant Name_Id := N + 612; - Name_Specification : constant Name_Id := N + 613; - Name_Specification_Exceptions : constant Name_Id := N + 614; - Name_Specification_Suffix : constant Name_Id := N + 615; - Name_Switches : constant Name_Id := N + 616; + Name_Ada_Roots : constant Name_Id := N + 569; + Name_Binder : constant Name_Id := N + 570; + Name_Binder_Driver : constant Name_Id := N + 571; + Name_Body_Suffix : constant Name_Id := N + 572; + Name_Builder : constant Name_Id := N + 573; + Name_Compiler : constant Name_Id := N + 574; + Name_Compiler_Driver : constant Name_Id := N + 575; + Name_Compiler_Kind : constant Name_Id := N + 576; + Name_Compute_Dependency : constant Name_Id := N + 577; + Name_Cross_Reference : constant Name_Id := N + 578; + Name_Default_Linker : constant Name_Id := N + 579; + Name_Default_Switches : constant Name_Id := N + 580; + Name_Dependency_Option : constant Name_Id := N + 581; + Name_Exec_Dir : constant Name_Id := N + 582; + Name_Executable : constant Name_Id := N + 583; + Name_Executable_Suffix : constant Name_Id := N + 584; + Name_Extends : constant Name_Id := N + 585; + Name_Externally_Built : constant Name_Id := N + 586; + Name_Finder : constant Name_Id := N + 587; + Name_Global_Configuration_Pragmas : constant Name_Id := N + 588; + Name_Gnatls : constant Name_Id := N + 589; + Name_Gnatstub : constant Name_Id := N + 590; + Name_Implementation : constant Name_Id := N + 591; + Name_Implementation_Exceptions : constant Name_Id := N + 592; + Name_Implementation_Suffix : constant Name_Id := N + 593; + Name_Include_Option : constant Name_Id := N + 594; + Name_Language_Processing : constant Name_Id := N + 595; + Name_Languages : constant Name_Id := N + 596; + Name_Library_Dir : constant Name_Id := N + 597; + Name_Library_Auto_Init : constant Name_Id := N + 598; + Name_Library_GCC : constant Name_Id := N + 599; + Name_Library_Interface : constant Name_Id := N + 600; + Name_Library_Kind : constant Name_Id := N + 601; + Name_Library_Name : constant Name_Id := N + 602; + Name_Library_Options : constant Name_Id := N + 603; + Name_Library_Reference_Symbol_File : constant Name_Id := N + 604; + Name_Library_Src_Dir : constant Name_Id := N + 605; + Name_Library_Symbol_File : constant Name_Id := N + 606; + Name_Library_Symbol_Policy : constant Name_Id := N + 607; + Name_Library_Version : constant Name_Id := N + 608; + Name_Linker : constant Name_Id := N + 609; + Name_Local_Configuration_Pragmas : constant Name_Id := N + 610; + Name_Locally_Removed_Files : constant Name_Id := N + 611; + Name_Metrics : constant Name_Id := N + 612; + Name_Naming : constant Name_Id := N + 613; + Name_Object_Dir : constant Name_Id := N + 614; + Name_Pretty_Printer : constant Name_Id := N + 615; + Name_Project : constant Name_Id := N + 616; + Name_Separate_Suffix : constant Name_Id := N + 617; + Name_Source_Dirs : constant Name_Id := N + 618; + Name_Source_Files : constant Name_Id := N + 619; + Name_Source_List_File : constant Name_Id := N + 620; + Name_Spec : constant Name_Id := N + 621; + Name_Spec_Suffix : constant Name_Id := N + 622; + Name_Specification : constant Name_Id := N + 623; + Name_Specification_Exceptions : constant Name_Id := N + 624; + Name_Specification_Suffix : constant Name_Id := N + 625; + Name_Switches : constant Name_Id := N + 626; + -- Other miscellaneous names used in front end - Name_Unaligned_Valid : constant Name_Id := N + 617; + Name_Unaligned_Valid : constant Name_Id := N + 627; -- Mark last defined name for consistency check in Snames body - Last_Predefined_Name : constant Name_Id := N + 617; + Last_Predefined_Name : constant Name_Id := N + 627; subtype Any_Operator_Name is Name_Id range First_Operator_Name .. Last_Operator_Name;