diff options
| author | charlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4> | 2004-12-08 11:25:51 +0000 |
|---|---|---|
| committer | charlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4> | 2004-12-08 11:25:51 +0000 |
| commit | 9080eb6bba3613f90aa8b0444a4eb07a4eda3a9d (patch) | |
| tree | 5f264e895f21f42a7c2b643a609e2b267faf6e7e | |
| parent | abc1c7367f2daa619b80129dd927520829f81364 (diff) | |
| download | ppe42-gcc-9080eb6bba3613f90aa8b0444a4eb07a4eda3a9d.tar.gz ppe42-gcc-9080eb6bba3613f90aa8b0444a4eb07a4eda3a9d.zip | |
* 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 (<prefix>/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 .<lang> when no
suffix is defined for language <lang>.
(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 (<prefix>/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:"
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@91877 138bc75d-0d04-0410-961f-82ee72b054a4
| -rw-r--r-- | gcc/ada/clean.adb | 21 | ||||
| -rw-r--r-- | gcc/ada/gnatcmd.adb | 84 | ||||
| -rw-r--r-- | gcc/ada/gnatls.adb | 112 | ||||
| -rw-r--r-- | gcc/ada/make.adb | 215 | ||||
| -rw-r--r-- | gcc/ada/makegpr.adb | 201 | ||||
| -rw-r--r-- | gcc/ada/mlib-prj.adb | 20 | ||||
| -rw-r--r-- | gcc/ada/prj-attr.adb | 13 | ||||
| -rw-r--r-- | gcc/ada/prj-com.adb | 7 | ||||
| -rw-r--r-- | gcc/ada/prj-com.ads | 6 | ||||
| -rw-r--r-- | gcc/ada/prj-env.adb | 18 | ||||
| -rw-r--r-- | gcc/ada/prj-ext.adb | 110 | ||||
| -rw-r--r-- | gcc/ada/prj-ext.ads | 12 | ||||
| -rw-r--r-- | gcc/ada/prj-nmsc.adb | 4612 | ||||
| -rw-r--r-- | gcc/ada/prj-nmsc.ads | 34 | ||||
| -rw-r--r-- | gcc/ada/prj-pars.adb | 4 | ||||
| -rw-r--r-- | gcc/ada/prj-pars.ads | 9 | ||||
| -rw-r--r-- | gcc/ada/prj-part.adb | 145 | ||||
| -rw-r--r-- | gcc/ada/prj-proc.adb | 77 | ||||
| -rw-r--r-- | gcc/ada/prj-proc.ads | 1 | ||||
| -rw-r--r-- | gcc/ada/prj-tree.ads | 21 | ||||
| -rw-r--r-- | gcc/ada/prj-util.adb | 8 | ||||
| -rw-r--r-- | gcc/ada/prj.adb | 339 | ||||
| -rw-r--r-- | gcc/ada/prj.ads | 299 | ||||
| -rw-r--r-- | gcc/ada/snames.adb | 10 | ||||
| -rw-r--r-- | gcc/ada/snames.ads | 113 |
25 files changed, 3633 insertions, 2858 deletions
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 := "<no_obj>"; @@ -1523,6 +1536,105 @@ begin end loop; Write_Eol; + Write_Eol; + Write_Str (Project_Search_Path); + Write_Eol; + Write_Str (" <Current_Directory>"); + 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 <prefix>/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; -- Output usage information when requested 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 <<Next_Main>> @@ -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<project file> [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:<lang> 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,1130 +317,133 @@ 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 Ada_Check - (Project : Project_Id; - Report_Error : Put_Line_Access; - Follow_Links : Boolean) - is - Data : Project_Data; - Languages : Variable_Value := Nil_Variable_Value; + 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. - 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 -- - --------------------------------------- - - procedure Get_Path_Names_And_Record_Sources is - Source_Dir : String_List_Id := Data.Source_Dirs; - Element : String_Element; - Path : Name_Id; - - Dir : Dir_Type; - Name : Name_Id; - Canonical_Name : Name_Id; - Name_Str : String (1 .. 1_024); - Last : Natural := 0; - NL : Name_Location; - - Current_Source : String_List_Id := Nil_String; - - First_Error : Boolean := True; - - Source_Recorded : Boolean := False; - - begin - -- We look in all source directories for the file names in the - -- hash table Source_Names - - while Source_Dir /= Nil_String loop - Source_Recorded := False; - Element := String_Elements.Table (Source_Dir); - - 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; - - Open (Dir, Dir_Path); - - 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); - - if NL /= No_Name_Location and then not NL.Found then - NL.Found := True; - Source_Names.Set (Canonical_Name, NL); - Name_Len := Dir_Path'Length; - Name_Buffer (1 .. Name_Len) := Dir_Path; - - if Name_Buffer (Name_Len) /= Directory_Separator then - Add_Char_To_Name_Buffer (Directory_Separator); - end if; - - Add_Str_To_Name_Buffer (Name_Str (1 .. Last)); - Path := Name_Find; - - if Current_Verbosity = High then - Write_Str (" found "); - Write_Line (Get_Name_String (Name)); - end if; - - -- Register the source if it is an Ada compilation unit. - - Record_Ada_Source - (File_Name => Name, - Path_Name => Path, - Project => Project, - Data => Data, - Location => NL.Location, - Current_Source => Current_Source, - Source_Recorded => Source_Recorded, - Follow_Links => Follow_Links); - end if; - end loop; - - Close (Dir); - end; - - if Source_Recorded then - String_Elements.Table (Source_Dir).Flag := True; - end if; - - Source_Dir := Element.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. - - NL := Source_Names.Get_First; - - while NL /= No_Name_Location loop - if not NL.Found then - Err_Vars.Error_Msg_Name_1 := NL.Name; - - if First_Error then - Error_Msg - (Project, - "source file { cannot be found", - NL.Location); - First_Error := False; - - else - Error_Msg - (Project, - "\source file { cannot be found", - NL.Location); - end if; - end if; - - NL := Source_Names.Get_Next; - end loop; - end Get_Path_Names_And_Record_Sources; - - --------------------------- - -- Get_Sources_From_File -- - --------------------------- - - 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. - - Get_Sources_From_File (Path, Location, Project); - - -- Look in the source directories to find those sources - - Get_Path_Names_And_Record_Sources; + ------------------- + -- ALI_File_Name -- + ------------------- - -- We should have found at least one source. - -- If not, report an error. + function ALI_File_Name (Source : String) return String is + begin + -- If the source name has an extension, then replace it with + -- the ALI suffix. - if Data.Sources = Nil_String then - Error_Msg (Project, - "there are no Ada sources in this project", - Location); + 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 Get_Sources_From_File; - - ------------------------- - -- Warn_If_Not_Sources -- - ------------------------- - - 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; - - 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); + end loop; - else - The_Unit_Data := Units.Table (The_Unit_Id); + -- If there is no dot, or if it is the first character, just add the + -- ALI suffix. - 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; + return Source & ALI_Suffix; + end ALI_File_Name; - 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; + ----------- + -- Check -- + ----------- - Conv := Array_Elements.Table (Conv).Next; - end loop; - end Warn_If_Not_Sources; + procedure Check + (Project : Project_Id; + Report_Error : Put_Line_Access; + Follow_Links : Boolean) + is + Data : Project_Data := Projects.Table (Project); - -- Start of processing for Ada_Check + Extending : Boolean := False; begin - Language_Independent_Check (Project, Report_Error); - - Error_Report := Report_Error; + Error_Report := Report_Error; - Data := Projects.Table (Project); - Extending := Data.Extends /= No_Project; - Languages := Prj.Util.Value_Of (Name_Languages, Data.Decl.Attributes); + Recursive_Dirs.Reset; - Data.Naming.Current_Language := Name_Ada; - Data.Ada_Sources_Present := Data.Source_Dirs /= Nil_String; + -- Object, exec and source directories - if not Languages.Default then - declare - Current : String_List_Id := Languages.Values; - Element : String_Element; - Ada_Found : Boolean := False; + Get_Directories (Project, Data); - 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)); + -- Get the programming languages - if Name_Buffer (1 .. Name_Len) = "ada" then - Ada_Found := True; - exit Look_For_Ada; - end if; + Check_Programming_Languages (Data); - Current := Element.Next; - end loop Look_For_Ada; + -- Library attributes - if not Ada_Found then + Check_Library_Attributes (Project, Data); - -- Mark the project file as having no sources for Ada + Check_If_Externally_Built (Project, Data); - Data.Ada_Sources_Present := False; - end if; - end; + if Current_Verbosity = High then + Show_Source_Dirs (Project); end if; - Check_Ada_Naming_Scheme (Data, Project); - - Prepare_Ada_Naming_Exceptions (Data.Naming.Bodies, Body_Part); - Prepare_Ada_Naming_Exceptions (Data.Naming.Specs, Specification); - - -- If we have source directories, then find the sources - - if Data.Ada_Sources_Present then - if Data.Source_Dirs = Nil_String then - Data.Ada_Sources_Present := False; - - else - declare - 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); - - Locally_Removed : constant Variable_Value := - Util.Value_Of - (Name_Locally_Removed_Files, - Data.Decl.Attributes); - - begin - pragma Assert - (Sources.Kind = List, - "Source_Files is not a list"); - - pragma Assert - (Source_List_File.Kind = Single, - "Source_List_File is not a single string"); - - if not Sources.Default then - if not Source_List_File.Default then - Error_Msg - (Project, - "?both variables source_files and " & - "source_list_file are present", - Source_List_File.Location); - end if; - - -- Sources is a list of file names - - declare - Current : String_List_Id := Sources.Values; - Element : String_Element; - Location : Source_Ptr; - Name : Name_Id; - - begin - Source_Names.Reset; - - Data.Ada_Sources_Present := Current /= Nil_String; - - 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 the element has no location, then use the - -- location of Sources to report possible errors. - - if Element.Location = No_Location then - Location := Sources.Location; - - else - Location := Element.Location; - end if; - - Source_Names.Set - (K => Name, - E => - (Name => Name, - Location => Location, - Found => False)); - - Current := Element.Next; - end loop; - - Get_Path_Names_And_Record_Sources; - end; - - -- No source_files specified - - -- We check Source_List_File has been specified. - - elsif not Source_List_File.Default then - - -- Source_List_File is the name of the file - -- that contains the source file names - - declare - Source_File_Path_Name : constant String := - Path_Name_Of - (Source_List_File.Value, - Data.Directory); - - 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); - - else - Get_Sources_From_File - (Source_File_Path_Name, - Source_List_File.Location); - end if; - end; - - 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. - - Find_Sources (Project, Data, Lang_Ada, Follow_Links); - end if; - - -- If there are sources that are locally removed, mark them as - -- such in the Units table. - - if not Locally_Removed.Default then - - -- Sources can be locally removed only in extending - -- project files. - - if Data.Extends = No_Project then - Error_Msg - (Project, - "Locally_Removed_Files can only be used " & - "in an extending project file", - Locally_Removed.Location); - - 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 - 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; + Check_Package_Naming (Project, Data); - -- If the element has no location, then use the - -- location of Locally_Removed to report - -- possible errors. - - if Element.Location = No_Location then - Location := Locally_Removed.Location; - - else - Location := Element.Location; - end if; - - 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); - - 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; - - elsif - Unit.File_Names (Body_Part).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 - (Body_Part).Project; - - if Extended = Project then - Error_Msg - (Project, - "cannot remove a source " & - "of the same project", - Location); + Extending := Data.Extends /= No_Project; - 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; + Check_Naming_Scheme (Data, Project); - end if; - end loop; + Prepare_Ada_Naming_Exceptions (Data.Naming.Bodies, Body_Part); + Prepare_Ada_Naming_Exceptions (Data.Naming.Specs, Specification); - if not OK then - Err_Vars.Error_Msg_Name_1 := Name; - Error_Msg (Project, "unknown file {", Location); - end if; + -- Find the sources - Current := Element.Next; - end loop; - end; - end if; - end if; - end; - end if; + if Data.Source_Dirs /= Nil_String then + Look_For_Sources (Project, Data, Follow_Links); end if; if Data.Ada_Sources_Present then - -- Check that all individual naming conventions apply to - -- sources of this project file. - - Warn_If_Not_Sources (Data.Naming.Bodies, Specs => False); - Warn_If_Not_Sources (Data.Naming.Specs, Specs => True); + -- 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 it is a library project file, check if it is a standalone library 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); - - 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 - 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; - - begin - Data.Standalone_Library := True; - - -- Library_Interface cannot be an empty list - - if Interfaces = Nil_String then - Error_Msg - (Project, - "Library_Interface cannot be an empty list", - Lib_Interfaces.Location); - 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); - - if The_Unit_Id = Prj.Com.No_Unit then - Error_Msg - (Project, - "unknown unit {", - String_Elements.Table (Interfaces).Location); - - else - -- Check that the unit is part of the project - - The_Unit_Data := Units.Table (The_Unit_Id); - - 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. - - 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; - - -- The unit is not a subunit, so we add - -- to the Interface ALIs the ALI file - -- corresponding to the body. - - Add_ALI_For - (The_Unit_Data.File_Names (Body_Part).Name); - - else - Error_Msg - (Project, - "{ is not an unit of this project", - String_Elements.Table - (Interfaces).Location); - end if; - - 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) - - 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. - - Add_ALI_For - (The_Unit_Data.File_Names (Specification).Name); - - else - Error_Msg - (Project, - "{ is not an unit of this project", - String_Elements.Table (Interfaces).Location); - end if; - end if; - - end if; - - Interfaces := String_Elements.Table (Interfaces).Next; - end loop; - - -- Put the list of Interface ALIs in the project data - - Data.Lib_Interface_ALIs := Interface_ALIs; - - -- Check value of attribute Library_Auto_Init and set - -- Lib_Auto_Init accordingly. - - if Lib_Auto_Init.Default then - - -- If no attribute Library_Auto_Init is declared, then - -- set auto init only if it is supported. - - Data.Lib_Auto_Init := Auto_Init_Supported; - - else - Get_Name_String (Lib_Auto_Init.Value); - To_Lower (Name_Buffer (1 .. Name_Len)); - - if Name_Buffer (1 .. Name_Len) = "false" then - Data.Lib_Auto_Init := False; - - elsif Name_Buffer (1 .. Name_Len) = "true" then - if Auto_Init_Supported then - Data.Lib_Auto_Init := True; - - else - -- Library_Auto_Init cannot be "true" if auto init - -- is not supported - - Error_Msg - (Project, - "library auto init not supported " & - "on this platform", - Lib_Auto_Init.Location); - end if; - - else - Error_Msg - (Project, - "invalid value for attribute Library_Auto_Init", - Lib_Auto_Init.Location); - end if; - end if; - end; - - -- If attribute Library_Src_Dir is defined and not the - -- empty string, check if the directory exist and is not - -- the object directory or 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. - - if Lib_Src_Dir.Value /= Empty_String then - declare - Dir_Id : constant Name_Id := Lib_Src_Dir.Value; - - begin - Locate_Directory - (Dir_Id, Data.Display_Directory, - Data.Library_Src_Dir, - Data.Display_Library_Src_Dir); - - -- If directory does not exist, report an error - - if Data.Library_Src_Dir = No_Name then - - -- Get the absolute name of the library directory - -- that does not exist, to report an error. - - declare - Dir_Name : constant String := - Get_Name_String (Dir_Id); - - begin - if Is_Absolute_Path (Dir_Name) then - Err_Vars.Error_Msg_Name_1 := Dir_Id; - - else - Get_Name_String (Data.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; - - -- 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, - "directory to copy interfaces cannot be " & - "the object directory", - Lib_Src_Dir.Location); - Data.Library_Src_Dir := No_Name; - - -- Check if it is the same as one of the source - -- directories. - - else - declare - Src_Dirs : String_List_Id := Data.Source_Dirs; - Src_Dir : String_Element; - - begin - while Src_Dirs /= Nil_String loop - Src_Dir := String_Elements.Table (Src_Dirs); - Src_Dirs := Src_Dir.Next; - - -- Report an error if it is one of the - -- source directories. - - 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; - - 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 Lib_Symbol_Policy.Default then - declare - Value : constant String := - To_Lower - (Get_Name_String (Lib_Symbol_Policy.Value)); - - begin - if Value = "autonomous" or else Value = "default" then - Data.Symbol_Data.Symbol_Policy := Autonomous; - - elsif Value = "compliant" then - Data.Symbol_Data.Symbol_Policy := Compliant; - - elsif Value = "controlled" then - Data.Symbol_Data.Symbol_Policy := Controlled; - - 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; - - 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; - - else - Data.Symbol_Data.Symbol_File := Lib_Symbol_File.Value; - - Get_Name_String (Lib_Symbol_File.Value); - - if Name_Len = 0 then - Error_Msg - (Project, - "symbol file name cannot be an empty string", - Lib_Symbol_File.Location); - - else - OK := not Is_Absolute_Path (Name_Buffer (1 .. Name_Len)); - - 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_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; - - 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; - - else - Data.Symbol_Data.Reference := Lib_Ref_Symbol_File.Value; - - Get_Name_String (Lib_Ref_Symbol_File.Value); - - if Name_Len = 0 then - Error_Msg - (Project, - "reference symbol file name cannot be an empty string", - Lib_Symbol_File.Location); - - else - OK := not Is_Absolute_Path (Name_Buffer (1 .. Name_Len)); - - 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, - "reference symbol file { name is illegal. " & - "Name canot include directory info.", - Lib_Ref_Symbol_File.Location); - end if; - - 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; - - 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; - end if; - end if; - end if; - end if; - end Standalone_Library; + Check_Stand_Alone_Library (Project, Data, Extending); end if; -- Put the list of Mains, if any, in the project data Get_Mains (Project, Data); + -- Update the project data in the Projects table + Projects.Table (Project) := Data; Free_Ada_Naming_Exceptions; - end Ada_Check; - - ------------------- - -- 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; + end Check; -------------------- -- Check_Ada_Name -- @@ -1524,6 +565,141 @@ package body Prj.Nmsc is end if; end Check_Ada_Name; + -------------------------------------- + -- Check_Ada_Naming_Scheme_Validity -- + -------------------------------------- + + 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 + + if Naming /= Standard_Naming_Data then + declare + Dot_Replacement : constant String := + Get_Name_String + (Naming.Dot_Replacement); + + Spec_Suffix : constant String := + Get_Name_String + (Naming.Ada_Spec_Suffix); + + Body_Suffix : constant String := + Get_Name_String + (Naming.Ada_Body_Suffix); + + Separate_Suffix : constant String := + Get_Name_String + (Naming.Separate_Suffix); + + 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 "." + + 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 + + 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 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 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; + + -- Spec_Suffix cannot have the same termination as + -- Body_Suffix or Separate_Suffix + + if Spec_Suffix'Length <= Body_Suffix'Length + and then + Body_Suffix (Body_Suffix'Last - + Spec_Suffix'Length + 1 .. + Body_Suffix'Last) = Spec_Suffix + then + Error_Msg + (Project, + "Body_Suffix (""" & + Body_Suffix & + """) cannot end with" & + " Spec_Suffix (""" & + Spec_Suffix & """).", + Naming.Body_Suffix_Loc); + end if; + + if Body_Suffix /= Separate_Suffix + and then Spec_Suffix'Length <= Separate_Suffix'Length + and then + Separate_Suffix + (Separate_Suffix'Last - Spec_Suffix'Length + 1 + .. + Separate_Suffix'Last) = Spec_Suffix + 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; + ---------------------- -- Check_For_Source -- ---------------------- @@ -1534,7 +710,7 @@ 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) is @@ -1558,29 +734,29 @@ package body Prj.Nmsc is declare Path : String := Get_Name_String (Path_Name); - Path_Id : Name_Id; + Path_Id : Name_Id; -- The path name id (in canonical case) - File_Id : Name_Id; + File_Id : Name_Id; -- The file name id (in canonical case) - Obj_Id : Name_Id; + Obj_Id : Name_Id; -- The object file name Obj_Path_Id : Name_Id; -- The object path name - Dep_Id : Name_Id; + Dep_Id : Name_Id; -- The dependency file name Dep_Path_Id : Name_Id; -- The dependency path name - Dot_Pos : Natural := 0; + Dot_Pos : Natural := 0; -- Position of the last dot in Name - Source : Other_Source; - Source_Id : Other_Source_Id := Data.First_Other_Source; + Source : Other_Source; + Source_Id : Other_Source_Id := Data.First_Other_Source; begin Canonical_Case_File_Name (Path); @@ -1661,8 +837,8 @@ package body Prj.Nmsc is -- 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 + -- exception for the same language or an other language, or + -- they may be two identical file names in different source -- directories. while Source_Id /= No_Other_Source loop @@ -1670,6 +846,7 @@ package body Prj.Nmsc is Source_Id := Source.Next; if Source.File_Name = File_Id then + -- Two sources of different languages cannot have the same -- file name. @@ -1685,6 +862,7 @@ package body Prj.Nmsc is -- a naming exception of this language. elsif Source.Path_Name = Path_Id then + -- Reset the naming exception flag, if this is not a -- naming exception. @@ -1732,7 +910,7 @@ package body Prj.Nmsc is if Current_Verbosity = High then Write_Str (" found "); - Write_Str (Lang_Display_Names (Language).all); + Display_Language_Name (Language); Write_Str (" source """); Write_Str (Get_Name_String (File_Name)); Write_Line (""""); @@ -1741,6 +919,7 @@ package body Prj.Nmsc is end if; -- Create the Other_Source record + Source := (Language => Language, File_Name => File_Id, @@ -1766,7 +945,7 @@ package body Prj.Nmsc is -- And there are sources of this language in this project - Data.Languages (Language) := True; + Set (Language, True, Data); -- Add this source to the list of sources of languages other than -- Ada of the project. @@ -1784,146 +963,48 @@ package body Prj.Nmsc is end if; end Check_For_Source; - -------------------------------------- - -- Check_Ada_Naming_Scheme_Validity -- - -------------------------------------- + ------------------------------- + -- Check_If_Externally_Built -- + ------------------------------- - procedure Check_Ada_Naming_Scheme_Validity - (Project : Project_Id; - Naming : Naming_Data) + procedure Check_If_Externally_Built + (Project : Project_Id; Data : in out Project_Data) is - begin - -- Only check if we are not using the standard naming scheme - - if Naming /= Standard_Naming_Data then - declare - Dot_Replacement : constant String := - Get_Name_String - (Naming.Dot_Replacement); - - Spec_Suffix : constant String := - Get_Name_String - (Naming.Current_Spec_Suffix); - - Body_Suffix : constant String := - Get_Name_String - (Naming.Current_Body_Suffix); - - Separate_Suffix : constant String := - Get_Name_String - (Naming.Separate_Suffix); - - 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 "." - - 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; + Externally_Built : constant Variable_Value := + Util.Value_Of + (Name_Externally_Built, Data.Decl.Attributes); - -- Suffixes cannot - -- - be empty + begin + if not Externally_Built.Default then + Get_Name_String (Externally_Built.Value); + To_Lower (Name_Buffer (1 .. Name_Len)); - if Is_Illegal_Suffix - (Spec_Suffix, Dot_Replacement = ".") - then - Err_Vars.Error_Msg_Name_1 := Naming.Current_Spec_Suffix; - Error_Msg - (Project, - "{ is illegal for Spec_Suffix", - Naming.Spec_Suffix_Loc); - end if; + if Name_Buffer (1 .. Name_Len) = "true" then + Data.Externally_Built := True; - 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; - - 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; + 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; - -- Spec_Suffix cannot have the same termination as - -- Body_Suffix or Separate_Suffix + if Current_Verbosity = High then + Write_Str ("Project is "); - 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; + if not Data.Externally_Built then + Write_Str ("not "); + end if; - if Body_Suffix /= Separate_Suffix - and then Spec_Suffix'Length <= Separate_Suffix'Length - and then - Separate_Suffix - (Separate_Suffix'Last - Spec_Suffix'Length + 1 - .. - Separate_Suffix'Last) = Spec_Suffix - then - Error_Msg - (Project, - "Separate_Suffix (""" & - Separate_Suffix & - """) cannot end with" & - " Spec_Suffix (""" & - Spec_Suffix & """).", - Naming.Sep_Suffix_Loc); - end if; - end; + Write_Line ("externally built."); end if; - end Check_Ada_Naming_Scheme_Validity; + end Check_If_Externally_Built; ----------------------------- - -- Check_Ada_Naming_Scheme -- + -- Check_Naming_Scheme -- ----------------------------- - procedure Check_Ada_Naming_Scheme + procedure Check_Naming_Scheme (Data : in out Project_Data; Project : Project_Id) is @@ -1933,7 +1014,7 @@ package body Prj.Nmsc is Naming : Package_Element; procedure Check_Unit_Names (List : Array_Element_Id); - -- Check that a list of unit names contains only valid names. + -- Check that a list of unit names contains only valid names ---------------------- -- Check_Unit_Names -- @@ -1983,7 +1064,7 @@ package body Prj.Nmsc is end loop; end Check_Unit_Names; - -- Start of processing for Check_Ada_Naming_Scheme + -- Start of processing for Check_Naming_Scheme begin -- If there is a package Naming, we will put in Data.Naming what is in @@ -2156,17 +1237,17 @@ package body Prj.Nmsc is 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.Ada_Spec_Suffix := Name_Find; Data.Naming.Spec_Suffix_Loc := Ada_Spec_Suffix.Location; else - Data.Naming.Current_Spec_Suffix := Default_Ada_Spec_Suffix; + Data.Naming.Ada_Spec_Suffix := Default_Ada_Spec_Suffix; end if; end; if Current_Verbosity = High then Write_Str (" Spec_Suffix = """); - Write_Str (Get_Name_String (Data.Naming.Current_Spec_Suffix)); + Write_Str (Get_Name_String (Data.Naming.Ada_Spec_Suffix)); Write_Char ('"'); Write_Eol; end if; @@ -2186,17 +1267,17 @@ package body Prj.Nmsc is 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.Ada_Body_Suffix := Name_Find; Data.Naming.Body_Suffix_Loc := Ada_Body_Suffix.Location; else - Data.Naming.Current_Body_Suffix := Default_Ada_Body_Suffix; + Data.Naming.Ada_Body_Suffix := Default_Ada_Body_Suffix; end if; end; if Current_Verbosity = High then Write_Str (" Body_Suffix = """); - Write_Str (Get_Name_String (Data.Naming.Current_Body_Suffix)); + Write_Str (Get_Name_String (Data.Naming.Ada_Body_Suffix)); Write_Char ('"'); Write_Eol; end if; @@ -2212,7 +1293,7 @@ package body Prj.Nmsc is begin if Ada_Sep_Suffix.Default then Data.Naming.Separate_Suffix := - Data.Naming.Current_Body_Suffix; + Data.Naming.Ada_Body_Suffix; else Get_Name_String (Ada_Sep_Suffix.Value); @@ -2243,11 +1324,510 @@ package body Prj.Nmsc is 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; + 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; + + ------------------------------ + -- Check_Library_Attributes -- + ------------------------------ + + procedure Check_Library_Attributes + (Project : Project_Id; Data : in out Project_Data) + is + Attributes : constant Prj.Variable_Id := Data.Decl.Attributes; + + Lib_Dir : constant Prj.Variable_Value := + Prj.Util.Value_Of (Snames.Name_Library_Dir, Attributes); + + Lib_Name : constant Prj.Variable_Value := + Prj.Util.Value_Of (Snames.Name_Library_Name, Attributes); + + Lib_Version : constant Prj.Variable_Value := + Prj.Util.Value_Of + (Snames.Name_Library_Version, Attributes); + + The_Lib_Kind : constant Prj.Variable_Value := + Prj.Util.Value_Of + (Snames.Name_Library_Kind, Attributes); + + begin + -- Special case of extending project + + if Data.Extends /= No_Project then + declare + Extended_Data : constant Project_Data := + Projects.Table (Data.Extends); + + 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; + + 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. + + 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; + + 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; + + -- Report the error + + Error_Msg + (Project, + "library directory { does not exist", + Lib_Dir.Location); + end; + + -- comment ??? + + 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; + + -- comment ??? + + 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 + + Data.Library_Name := Lib_Name.Value; + end if; + + if Data.Library_Name /= No_Name + and then Current_Verbosity = High + then + Write_Str ("Library name = """); + Write_Str (Get_Name_String (Data.Library_Name)); + Write_Line (""""); end if; - end Check_Ada_Naming_Scheme; + + Data.Library := + Data.Library_Dir /= No_Name + and then + Data.Library_Name /= No_Name; + + 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; + + else + pragma Assert (Lib_Version.Kind = Single); + + if Lib_Version.Value = Empty_String then + if Current_Verbosity = High then + Write_Line ("No library version specified"); + end if; + + else + Data.Lib_Internal_Name := Lib_Version.Value; + end if; + + pragma Assert (The_Lib_Kind.Kind = Single); + + if The_Lib_Kind.Value = Empty_String then + if Current_Verbosity = High then + Write_Line ("No library kind specified"); + end if; + + else + Get_Name_String (The_Lib_Kind.Value); + + declare + Kind_Name : constant String := + To_Lower (Name_Buffer (1 .. Name_Len)); + + OK : Boolean := True; + + begin + if Kind_Name = "static" then + Data.Library_Kind := Static; + + elsif Kind_Name = "dynamic" then + Data.Library_Kind := Dynamic; + + elsif Kind_Name = "relocatable" then + Data.Library_Kind := Relocatable; + + else + Error_Msg + (Project, + "illegal value for Library_Kind", + The_Lib_Kind.Location); + OK := False; + end if; + + if Current_Verbosity = High and then OK then + Write_Str ("Library kind = "); + Write_Line (Kind_Name); + end if; + + 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 Data.Library and then Current_Verbosity = High then + Write_Line ("This is a library project file"); + end if; + + end if; + end if; + end Check_Library_Attributes; + + -------------------------- + -- Check_Package_Naming -- + -------------------------- + + 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); + + Naming : Package_Element; + + begin + -- If there is a package Naming, we will put in Data.Naming + -- what is in this package Naming. + + if Naming_Id /= No_Package then + Naming := Packages.Table (Naming_Id); + + if Current_Verbosity = High then + Write_Line ("Checking ""Naming""."); + 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; + + 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; + + -- 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; + + Suffix := Element.Next; + end loop; + + -- Put the resulting array as the specification suffixs + + Data.Naming.Spec_Suffix := Spec_Suffixs; + 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); + + if Name_Len = 0 then + Error_Msg + (Project, + "Spec_Suffix cannot be empty", + Element.Value.Location); + end if; + + Array_Elements.Table (Current) := Element; + Current := Element.Next; + end loop; + end; + + -- Check Body_Suffix + + declare + Impl_Suffixs : Array_Element_Id := + Util.Value_Of + (Name_Body_Suffix, + Naming.Decl.Arrays); + + Suffix : Array_Element_Id; + Element : Array_Element; + Suffix2 : Array_Element_Id; + + 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; + + -- 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; + + Suffix := Element.Next; + end loop; + + -- Put the resulting array as the implementation suffixs + + Data.Naming.Body_Suffix := Impl_Suffixs; + end if; + end; + + declare + Current : Array_Element_Id := Data.Naming.Body_Suffix; + Element : Array_Element; + + begin + while Current /= No_Array_Element loop + Element := Array_Elements.Table (Current); + Get_Name_String (Element.Value.Value); + + if Name_Len = 0 then + Error_Msg + (Project, + "Body_Suffix cannot be empty", + Element.Value.Location); + end if; + + Array_Elements.Table (Current) := Element; + Current := Element.Next; + end loop; + end; + + -- Get the exceptions, if any + + Data.Naming.Specification_Exceptions := + Util.Value_Of + (Name_Specification_Exceptions, + In_Arrays => Naming.Decl.Arrays); + + Data.Naming.Implementation_Exceptions := + Util.Value_Of + (Name_Implementation_Exceptions, + In_Arrays => Naming.Decl.Arrays); + end if; + end Check_Package_Naming; + + --------------------------------- + -- Check_Programming_Languages -- + --------------------------------- + + procedure Check_Programming_Languages (Data : in out Project_Data) is + Languages : Variable_Value := Nil_Variable_Value; + + 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; + + if Data.Source_Dirs /= Nil_String then + + -- Check if languages are specified in this project + + if Languages.Default then + + -- Attribute Languages is not specified. So, it defaults to + -- a project of language Ada only. + + Data.Languages (Ada_Language_Index) := True; + + -- 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_Programming_Languages; ------------------- -- Check_Project -- @@ -2280,6 +1860,536 @@ package body Prj.Nmsc is 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 + Data.Standalone_Library := True; + + -- Library_Interface cannot be an empty list + + if Interfaces = Nil_String then + Error_Msg + (Project, + "Library_Interface cannot be an empty list", + Lib_Interfaces.Location); + 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); + + if The_Unit_Id = Prj.Com.No_Unit then + Error_Msg + (Project, + "unknown unit {", + String_Elements.Table (Interfaces).Location); + + else + -- Check that the unit is part of the project + + The_Unit_Data := Units.Table (The_Unit_Id); + + 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. + + 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; + + -- The unit is not a subunit, so we add + -- to the Interface ALIs the ALI file + -- corresponding to the body. + + Add_ALI_For + (The_Unit_Data.File_Names (Body_Part).Name); + + else + Error_Msg + (Project, + "{ is not an unit of this project", + String_Elements.Table + (Interfaces).Location); + end if; + + 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) + + 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. + + Add_ALI_For + (The_Unit_Data.File_Names (Specification).Name); + + else + Error_Msg + (Project, + "{ is not an unit of this project", + String_Elements.Table (Interfaces).Location); + end if; + end if; + + end if; + + Interfaces := String_Elements.Table (Interfaces).Next; + end loop; + + -- Put the list of Interface ALIs in the project data + + Data.Lib_Interface_ALIs := Interface_ALIs; + + -- Check value of attribute Library_Auto_Init and set + -- Lib_Auto_Init accordingly. + + if Lib_Auto_Init.Default then + + -- If no attribute Library_Auto_Init is declared, then + -- set auto init only if it is supported. + + Data.Lib_Auto_Init := Auto_Init_Supported; + + else + Get_Name_String (Lib_Auto_Init.Value); + To_Lower (Name_Buffer (1 .. Name_Len)); + + if Name_Buffer (1 .. Name_Len) = "false" then + Data.Lib_Auto_Init := False; + + elsif Name_Buffer (1 .. Name_Len) = "true" then + if Auto_Init_Supported then + Data.Lib_Auto_Init := True; + + else + -- Library_Auto_Init cannot be "true" if auto init + -- is not supported + + Error_Msg + (Project, + "library auto init not supported " & + "on this platform", + Lib_Auto_Init.Location); + end if; + + else + Error_Msg + (Project, + "invalid value for attribute Library_Auto_Init", + Lib_Auto_Init.Location); + end if; + end if; + end SAL_Library; + + -- 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. + + if Lib_Src_Dir.Value /= Empty_String then + declare + Dir_Id : constant Name_Id := Lib_Src_Dir.Value; + + begin + Locate_Directory + (Dir_Id, Data.Display_Directory, + Data.Library_Src_Dir, + Data.Display_Library_Src_Dir); + + -- If directory does not exist, report an error + + if Data.Library_Src_Dir = No_Name then + + -- Get the absolute name of the library directory + -- that does not exist, to report an error. + + declare + Dir_Name : constant String := + Get_Name_String (Dir_Id); + + begin + if Is_Absolute_Path (Dir_Name) then + Err_Vars.Error_Msg_Name_1 := Dir_Id; + + else + Get_Name_String (Data.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; + + -- 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, + "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 + declare + Src_Dirs : String_List_Id := Data.Source_Dirs; + Src_Dir : String_Element; + + begin + while Src_Dirs /= Nil_String loop + Src_Dir := String_Elements.Table (Src_Dirs); + Src_Dirs := Src_Dir.Next; + + -- Report error if it is one of the source directories + + 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; + + -- pages of code follow here with no comments at all ??? + + 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 Lib_Symbol_Policy.Default then + declare + Value : constant String := + To_Lower + (Get_Name_String (Lib_Symbol_Policy.Value)); + + begin + if Value = "autonomous" or else Value = "default" then + Data.Symbol_Data.Symbol_Policy := Autonomous; + + elsif Value = "compliant" then + Data.Symbol_Data.Symbol_Policy := Compliant; + + elsif Value = "controlled" then + Data.Symbol_Data.Symbol_Policy := Controlled; + + 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; + + 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; + + else + Data.Symbol_Data.Symbol_File := Lib_Symbol_File.Value; + + Get_Name_String (Lib_Symbol_File.Value); + + if Name_Len = 0 then + Error_Msg + (Project, + "symbol file name cannot be an empty string", + Lib_Symbol_File.Location); + + else + OK := not Is_Absolute_Path (Name_Buffer (1 .. Name_Len)); + + 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_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; + + 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; + + else + Data.Symbol_Data.Reference := Lib_Ref_Symbol_File.Value; + + Get_Name_String (Lib_Ref_Symbol_File.Value); + + if Name_Len = 0 then + Error_Msg + (Project, + "reference symbol file name cannot be an empty string", + Lib_Symbol_File.Location); + + else + OK := not Is_Absolute_Path (Name_Buffer (1 .. Name_Len)); + + 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, + "reference symbol file { name is illegal. " & + "Name canot include directory info.", + Lib_Ref_Symbol_File.Location); + end if; + + 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; + + 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; + end if; + end if; + end if; + end if; + 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,413 +2670,25 @@ 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); - - begin - Data.Mains := Mains.Values; - - -- If no Mains were specified, and if we are an extending - -- project, inherit the Mains from the project we are extending. - - if Mains.Default then - if Data.Extends /= No_Project then - Data.Mains := Projects.Table (Data.Extends).Mains; - end if; - - -- In a library project file, Main cannot be specified - - elsif Data.Library then - Error_Msg - (Project, - "a library project file cannot have Main specified", - Mains.Location); - end if; - end Get_Mains; - - --------------------------- - -- Get_Sources_From_File -- - --------------------------- - - 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; - - begin - Source_Names.Reset; - - if Current_Verbosity = High then - Write_Str ("Opening """); - Write_Str (Path); - Write_Line ("""."); - end if; - - -- Open the file - - Prj.Util.Open (File, Path); - - if not Prj.Util.Is_Valid (File) then - Error_Msg (Project, "file does not exist", Location); - else - -- Read the lines one by one - - while not Prj.Util.End_Of_File (File) loop - Prj.Util.Get_Line (File, Line, Last); - - -- A non empty, non comment line should contain a file name - - if Last /= 0 - and then (Last = 1 or else Line (1 .. 2) /= "--") - then - -- ??? we should check that there is no directory information - - Name_Len := Last; - Name_Buffer (1 .. Name_Len) := Line (1 .. Last); - Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len)); - Source_Name := Name_Find; - Source_Names.Set - (K => Source_Name, - E => - (Name => Source_Name, - Location => Location, - Found => False)); - end if; - end loop; - - Prj.Util.Close (File); - - end if; - end Get_Sources_From_File; - - -------------- - -- Get_Unit -- - -------------- - - 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; - - 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_Buffer (Name_Len) = '.' then - Name_Len := Name_Len - 1; - VMS_Name := Name_Find; - end if; - - Info_Id := Ada_Naming_Exceptions.Get (VMS_Name); - end if; - - 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; - - Needs_Pragma := False; - Exception_Id := No_Ada_Naming_Exception; - - Get_Name_String (Canonical_File_Name); - - declare - File : String := Name_Buffer (1 .. Name_Len); - First : constant Positive := File'First; - Last : Natural := File'Last; - Standard_GNAT : Boolean; - - begin - Standard_GNAT := - Naming.Current_Spec_Suffix = Default_Ada_Spec_Suffix - and then Naming.Current_Body_Suffix = Default_Ada_Body_Suffix; - - -- Check if the end of the file name is Specification_Append - - Get_Name_String (Naming.Current_Spec_Suffix); - - if File'Length > Name_Len - and then File (Last - Name_Len + 1 .. Last) = - Name_Buffer (1 .. Name_Len) - then - -- We have a spec - - Unit_Kind := Specification; - Last := Last - Name_Len; - - if Current_Verbosity = High then - Write_Str (" Specification: "); - Write_Line (File (First .. Last)); - end if; - - else - Get_Name_String (Naming.Current_Body_Suffix); - - -- Check if the end of the file name is Body_Append - - if File'Length > Name_Len - and then File (Last - Name_Len + 1 .. Last) = - Name_Buffer (1 .. Name_Len) - then - -- We have a body - - Unit_Kind := Body_Part; - Last := Last - Name_Len; - - if Current_Verbosity = High then - Write_Str (" Body: "); - Write_Line (File (First .. Last)); - end if; - - 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; - - if Current_Verbosity = High then - Write_Str (" Separate: "); - Write_Line (File (First .. Last)); - end if; - - else - Last := 0; - end if; - - else - Last := 0; - end if; - end if; - - if Last = 0 then - - -- This is not a source file - - Unit_Name := No_Name; - Unit_Kind := Specification; - - if Current_Verbosity = High then - Write_Line (" Not a valid file name."); - end if; - - return; - end if; - - Get_Name_String (Naming.Dot_Replacement); - Standard_GNAT := - Standard_GNAT and then Name_Buffer (1 .. Name_Len) = "-"; - - if Name_Buffer (1 .. Name_Len) /= "." then - - -- If Dot_Replacement is not a single dot, - -- then there should not be any dot in the name. - - 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; - - Unit_Name := No_Name; - return; - - end if; - end loop; - - -- Replace the substring Dot_Replacement with dots - - declare - Index : Positive := First; - - begin - while Index <= Last - Name_Len + 1 loop - - if File (Index .. Index + Name_Len - 1) = - Name_Buffer (1 .. Name_Len) - then - File (Index) := '.'; - - if Name_Len > 1 and then Index < Last then - File (Index + 1 .. Last - Name_Len + 1) := - File (Index + Name_Len .. Last); - end if; - - Last := Last - Name_Len + 1; - end if; - - Index := Index + 1; - end loop; - end; - end if; - - -- Check if the casing is right - - declare - Src : String := File (First .. Last); - - begin - case Naming.Casing is - when All_Lower_Case => - Fixed.Translate - (Source => Src, - Mapping => Lower_Case_Map); - - when All_Upper_Case => - Fixed.Translate - (Source => Src, - Mapping => Upper_Case_Map); - - when Mixed_Case | Unknown => - null; - end case; - - if Src /= File (First .. Last) then - if Current_Verbosity = High then - Write_Line (" Not a valid file name (casing)."); - end if; - - Unit_Name := No_Name; - return; - end if; - - -- We put the name in lower case - - Fixed.Translate - (Source => Src, - Mapping => Lower_Case_Map); - - -- In the standard GNAT naming scheme, check for special cases: - -- children or separates of A, G, I or S, and run time sources. - - if Standard_GNAT and then Src'Length >= 3 then - declare - S1 : constant Character := Src (Src'First); - S2 : constant Character := Src (Src'First + 1); - - 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 (Hostparm.OpenVMS and then S2 = '$') - or else (not Hostparm.OpenVMS and then S2 = '~') - then - Src (Src'First + 1) := '.'; - - -- If it is potentially a run time source, disable - -- filling of the mapping file to avoid warnings. - - elsif S2 = '.' then - Set_Mapping_File_Initial_State_To_Empty; - end if; - - end if; - end; - end if; - - if Current_Verbosity = High then - Write_Str (" "); - Write_Line (Src); - end if; - - -- Now, we check if this name is a valid unit name - - Check_Ada_Name (Name => Src, Unit => Unit_Name); - end; - - end; - end Get_Unit; - - ---------- - -- Hash -- - ---------- - - function Hash (Unit : Unit_Info) return Header_Num is - begin - return Header_Num (Unit.Unit mod 2048); - end Hash; - - ----------------------- - -- Is_Illegal_Suffix -- - ----------------------- + --------------------- + -- Get_Directories -- + --------------------- - function Is_Illegal_Suffix - (Suffix : String; - Dot_Replacement_Is_A_Single_Dot : Boolean) return Boolean + procedure Get_Directories + (Project : Project_Id; + Data : in out Project_Data) is - begin - if Suffix'Length = 0 or else Index (Suffix, ".") = 0 then - return True; - end if; - - -- If dot replacement is a single dot, and first character of - -- suffix is also a dot - - if Dot_Replacement_Is_A_Single_Dot - and then Suffix (Suffix'First) = '.' - then - for Index in Suffix'First + 1 .. Suffix'Last loop - - -- If there is another dot + Object_Dir : constant Variable_Value := + Util.Value_Of (Name_Object_Dir, Data.Decl.Attributes); - if Suffix (Index) = '.' then - - -- It is illegal to have a letter following the initial dot - - return Is_Letter (Suffix (Suffix'First + 1)); - end if; - end loop; - end if; - - -- Everything is OK + Exec_Dir : constant Variable_Value := + Util.Value_Of (Name_Exec_Dir, Data.Decl.Attributes); - return False; - end Is_Illegal_Suffix; - - -------------------------------- - -- Language_Independent_Check -- - -------------------------------- + Source_Dirs : constant Variable_Value := + Util.Value_Of + (Name_Source_Dirs, Data.Decl.Attributes); - 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); procedure Find_Source_Dirs (From : Name_Id; Location : Source_Ptr); -- Find one or several source directories, and add them @@ -3047,7 +2784,7 @@ package body Prj.Nmsc is if Last_Source_Dir = Nil_String then Data.Source_Dirs := String_Elements.Last; - -- Here we already have source directories. + -- Here we already have source directories else -- Link the previous last to the new one @@ -3075,7 +2812,7 @@ package body Prj.Nmsc is if Name (1 .. Last) /= "." and then Name (1 .. Last) /= ".." then - -- Avoid . and .. + -- Avoid . and .. directories if Current_Verbosity = High then Write_Str (" Checking "); @@ -3180,8 +2917,8 @@ package body Prj.Nmsc is end if; else - -- We have an existing directory, - -- we register it and all of its subdirectories. + -- We have an existing directory, we register it and all + -- of its subdirectories. if Current_Verbosity = High then Write_Line ("Looking for source directories:"); @@ -3201,11 +2938,13 @@ package body Prj.Nmsc is else declare - Path_Name : Name_Id; + 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; @@ -3220,8 +2959,8 @@ package body Prj.Nmsc is "{ is not a valid directory", Location); end if; - else + else -- As it is an existing directory, we add it to -- the list of directories. @@ -3252,78 +2991,61 @@ package body Prj.Nmsc is end if; end Find_Source_Dirs; - -- Start of processing for Language_Independent_Check + -- Start of processing for Get_Directories begin - if Data.Language_Independent_Checked then - return; - end if; - - Data.Language_Independent_Checked := True; - - Error_Report := Report_Error; - - Recursive_Dirs.Reset; - if Current_Verbosity = High then Write_Line ("Starting to look for directories"); end if; -- Check the object directory - declare - Object_Dir : constant Variable_Value := - Util.Value_Of (Name_Object_Dir, Data.Decl.Attributes); + pragma Assert (Object_Dir.Kind = Single, + "Object_Dir is not a single string"); - begin - pragma Assert (Object_Dir.Kind = Single, - "Object_Dir is not a single string"); + -- We set the object directory to its default - -- We set the object directory to its default + Data.Object_Directory := Data.Directory; + Data.Display_Object_Dir := Data.Display_Directory; - Data.Object_Directory := Data.Directory; - Data.Display_Object_Dir := Data.Display_Directory; + if Object_Dir.Value /= Empty_String then + Get_Name_String (Object_Dir.Value); - if Object_Dir.Value /= Empty_String then + if Name_Len = 0 then + Error_Msg + (Project, + "Object_Dir cannot be empty", + Object_Dir.Location); - Get_Name_String (Object_Dir.Value); + else + -- We check that the specified object directory does exist - if Name_Len = 0 then - Error_Msg - (Project, - "Object_Dir cannot be empty", - Object_Dir.Location); + Locate_Directory + (Object_Dir.Value, Data.Display_Directory, + Data.Object_Directory, Data.Display_Object_Dir); - else - -- We check that the specified object directory - -- does exist. + if Data.Object_Directory = No_Name then - Locate_Directory - (Object_Dir.Value, Data.Display_Directory, - Data.Object_Directory, Data.Display_Object_Dir); + -- The object directory does not exist, report an error - 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); + Err_Vars.Error_Msg_Name_1 := Object_Dir.Value; + Error_Msg + (Project, + "the object directory { cannot be found", + Data.Location); - -- 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. + -- 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. - 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; + 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; + end if; if Current_Verbosity = High then if Data.Object_Directory = No_Name then @@ -3337,47 +3059,40 @@ package body Prj.Nmsc is -- Check the exec directory - declare - Exec_Dir : constant Variable_Value := - Util.Value_Of (Name_Exec_Dir, Data.Decl.Attributes); + pragma Assert (Exec_Dir.Kind = Single, + "Exec_Dir is not a single string"); - begin - pragma Assert (Exec_Dir.Kind = Single, - "Exec_Dir is not a single string"); + -- We set the object directory to its default - -- We set the object directory to its default + Data.Exec_Directory := Data.Object_Directory; + Data.Display_Exec_Dir := Data.Display_Object_Dir; - Data.Exec_Directory := Data.Object_Directory; - Data.Display_Exec_Dir := Data.Display_Object_Dir; + if Exec_Dir.Value /= Empty_String then + Get_Name_String (Exec_Dir.Value); - if Exec_Dir.Value /= Empty_String then + if Name_Len = 0 then + Error_Msg + (Project, + "Exec_Dir cannot be empty", + Exec_Dir.Location); - Get_Name_String (Exec_Dir.Value); + else + -- We check that the specified object directory + -- does exist. - if Name_Len = 0 then + Locate_Directory + (Exec_Dir.Value, Data.Directory, + Data.Exec_Directory, Data.Display_Exec_Dir); + + if Data.Exec_Directory = No_Name then + Err_Vars.Error_Msg_Name_1 := Exec_Dir.Value; Error_Msg (Project, - "Exec_Dir cannot be empty", - Exec_Dir.Location); - - else - -- We check that the specified object directory - -- does exist. - - Locate_Directory - (Exec_Dir.Value, Data.Directory, - Data.Exec_Directory, Data.Display_Exec_Dir); - - 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; + "the exec directory { cannot be found", + Data.Location); end if; end if; - end; + end if; if Current_Verbosity = High then if Data.Exec_Directory = No_Name then @@ -3391,515 +3106,488 @@ package body Prj.Nmsc is -- Look for the source directories - declare - Source_Dirs : constant Variable_Value := - Util.Value_Of - (Name_Source_Dirs, Data.Decl.Attributes); - - begin - if Current_Verbosity = High then - Write_Line ("Starting to look for source directories"); - end if; - - pragma Assert (Source_Dirs.Kind = List, - "Source_Dirs is not a list"); - - if Source_Dirs.Default then - - -- No Source_Dirs specified: the single source directory - -- is the one containing the project file - - 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); + if Current_Verbosity = High then + Write_Line ("Starting to look for source directories"); + end if; - if Current_Verbosity = High then - Write_Line ("Single source directory:"); - Write_Str (" """); - Write_Str (Get_Name_String (Data.Display_Directory)); - Write_Line (""""); - end if; + pragma Assert (Source_Dirs.Kind = List, "Source_Dirs is not a list"); - elsif Source_Dirs.Values = Nil_String then + if Source_Dirs.Default then - -- 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. + -- No Source_Dirs specified: the single source directory + -- is the one containing the project file - if Data.Extends = No_Project - and then Data.Object_Directory = Data.Directory - then - Data.Object_Directory := No_Name; - end if; + 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); - Data.Source_Dirs := Nil_String; - Data.Ada_Sources_Present := False; - Data.Other_Sources_Present := False; + if Current_Verbosity = High then + Write_Line ("Single source directory:"); + Write_Str (" """); + Write_Str (Get_Name_String (Data.Display_Directory)); + Write_Line (""""); + end if; - else - declare - Source_Dir : String_List_Id := Source_Dirs.Values; - Element : String_Element; + elsif Source_Dirs.Values = Nil_String then - begin - -- We will find the source directories for each - -- element of the list + -- 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. - 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; + if Data.Extends = No_Project + and then Data.Object_Directory = Data.Directory + then + Data.Object_Directory := No_Name; end if; - if Current_Verbosity = High then - Write_Line ("Putting source directories in canonical cases"); - end if; + Data.Source_Dirs := Nil_String; + Data.Ada_Sources_Present := False; + Data.Other_Sources_Present := False; + else declare - Current : String_List_Id := Data.Source_Dirs; - Element : String_Element; + Source_Dir : String_List_Id := Source_Dirs.Values; + Element : String_Element; 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; + -- We will find the source directories for each + -- element of the list - Current := Element.Next; + 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; + end if; - -- Library attributes + if Current_Verbosity = High then + Write_Line ("Putting source directories in canonical cases"); + end if; declare - Attributes : constant Prj.Variable_Id := Data.Decl.Attributes; + Current : String_List_Id := Data.Source_Dirs; + Element : String_Element; - Lib_Dir : constant Prj.Variable_Value := - Prj.Util.Value_Of (Snames.Name_Library_Dir, Attributes); + 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; - Lib_Name : constant Prj.Variable_Value := - Prj.Util.Value_Of (Snames.Name_Library_Name, Attributes); + Current := Element.Next; + end loop; + end; - Lib_Version : constant Prj.Variable_Value := - Prj.Util.Value_Of - (Snames.Name_Library_Version, Attributes); + end Get_Directories; - The_Lib_Kind : constant Prj.Variable_Value := - Prj.Util.Value_Of - (Snames.Name_Library_Kind, Attributes); + --------------- + -- Get_Mains -- + --------------- - begin - -- Special case of extending project + 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); + + begin + Data.Mains := Mains.Values; + + -- If no Mains were specified, and if we are an extending + -- project, inherit the Mains from the project we are extending. + if Mains.Default then if Data.Extends /= No_Project then - declare - Extended_Data : constant Project_Data := - Projects.Table (Data.Extends); + Data.Mains := Projects.Table (Data.Extends).Mains; + end if; - 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; + -- In a library project file, Main cannot be specified - 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; + elsif Data.Library then + Error_Msg + (Project, + "a library project file cannot have Main specified", + Mains.Location); + end if; + end Get_Mains; - Projects.Table (Data.Extends).Library := False; - end if; - end; - end if; + --------------------------- + -- Get_Sources_From_File -- + --------------------------- - pragma Assert (Lib_Dir.Kind = Single); + 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; - if Lib_Dir.Value = Empty_String then + begin + Source_Names.Reset; - if Current_Verbosity = High then - Write_Line ("No library directory"); - end if; + if Current_Verbosity = High then + Write_Str ("Opening """); + Write_Str (Path); + Write_Line ("""."); + end if; - else - -- Find path name, check that it is a directory + -- Open the file - Locate_Directory - (Lib_Dir.Value, Data.Display_Directory, - Data.Library_Dir, Data.Display_Library_Dir); + Prj.Util.Open (File, Path); - if Data.Library_Dir = No_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 - -- Get the absolute name of the library directory that - -- does not exist, to report an error. + while not Prj.Util.End_Of_File (File) loop + Prj.Util.Get_Line (File, Line, Last); - 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; + -- A non empty, non comment line should contain a file name - else - Get_Name_String (Data.Display_Directory); + if Last /= 0 + and then (Last = 1 or else Line (1 .. 2) /= "--") + then + -- ??? we should check that there is no directory information - if Name_Buffer (Name_Len) /= Directory_Separator then - Name_Len := Name_Len + 1; - Name_Buffer (Name_Len) := Directory_Separator; - end if; + 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; - 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; + Prj.Util.Close (File); - -- Report the error + end if; + end Get_Sources_From_File; - Error_Msg - (Project, - "library directory { does not exist", - Lib_Dir.Location); - end; + -------------- + -- Get_Unit -- + -------------- - 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; + 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; - else - if Current_Verbosity = High then - Write_Str ("Library directory ="""); - Write_Str (Get_Name_String (Data.Display_Library_Dir)); - Write_Line (""""); - end if; + 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_Buffer (Name_Len) = '.' then + Name_Len := Name_Len - 1; + VMS_Name := Name_Find; end if; + + Info_Id := Ada_Naming_Exceptions.Get (VMS_Name); end if; - pragma Assert (Lib_Name.Kind = Single); + end if; - 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; + 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; - else - -- There is no restriction on the syntax of library names + Needs_Pragma := False; + Exception_Id := No_Ada_Naming_Exception; - Data.Library_Name := Lib_Name.Value; - end if; + Get_Name_String (Canonical_File_Name); - 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; + declare + File : String := Name_Buffer (1 .. Name_Len); + First : constant Positive := File'First; + Last : Natural := File'Last; + Standard_GNAT : Boolean; - Data.Library := - Data.Library_Dir /= No_Name - and then - Data.Library_Name /= No_Name; + begin + Standard_GNAT := + Naming.Ada_Spec_Suffix = Default_Ada_Spec_Suffix + and then Naming.Ada_Body_Suffix = Default_Ada_Body_Suffix; - 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; + -- Check if the end of the file name is Specification_Append - else - pragma Assert (Lib_Version.Kind = Single); + Get_Name_String (Naming.Ada_Spec_Suffix); - if Lib_Version.Value = Empty_String then - if Current_Verbosity = High then - Write_Line ("No library version specified"); - end if; + if File'Length > Name_Len + and then File (Last - Name_Len + 1 .. Last) = + Name_Buffer (1 .. Name_Len) + then + -- We have a spec - else - Data.Lib_Internal_Name := Lib_Version.Value; - end if; + Unit_Kind := Specification; + Last := Last - Name_Len; - pragma Assert (The_Lib_Kind.Kind = Single); + if Current_Verbosity = High then + Write_Str (" Specification: "); + Write_Line (File (First .. Last)); + end if; - if The_Lib_Kind.Value = Empty_String then - if Current_Verbosity = High then - Write_Line ("No library kind specified"); - end if; + else + Get_Name_String (Naming.Ada_Body_Suffix); - else - Get_Name_String (The_Lib_Kind.Value); + -- Check if the end of the file name is Body_Append - declare - Kind_Name : constant String := - To_Lower (Name_Buffer (1 .. Name_Len)); + if File'Length > Name_Len + and then File (Last - Name_Len + 1 .. Last) = + Name_Buffer (1 .. Name_Len) + then + -- We have a body - OK : Boolean := True; + Unit_Kind := Body_Part; + Last := Last - Name_Len; - begin - if Kind_Name = "static" then - Data.Library_Kind := Static; + if Current_Verbosity = High then + Write_Str (" Body: "); + Write_Line (File (First .. Last)); + end if; - elsif Kind_Name = "dynamic" then - Data.Library_Kind := Dynamic; + elsif Naming.Separate_Suffix /= Naming.Ada_Spec_Suffix then + Get_Name_String (Naming.Separate_Suffix); - elsif Kind_Name = "relocatable" then - Data.Library_Kind := Relocatable; + -- Check if the end of the file name is Separate_Append - else - Error_Msg - (Project, - "illegal value for Library_Kind", - The_Lib_Kind.Location); - OK := False; - end if; + 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) - if Current_Verbosity = High and then OK then - Write_Str ("Library kind = "); - Write_Line (Kind_Name); - end if; + Unit_Kind := Body_Part; + Last := Last - Name_Len; - 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 Current_Verbosity = High then + Write_Str (" Separate: "); + Write_Line (File (First .. Last)); + end if; - if Data.Library and then Current_Verbosity = High then - Write_Line ("This is a library project file"); + else + Last := 0; end if; + else + Last := 0; 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; + if Last = 0 then - begin - -- If there is a package Naming, we will put in Data.Naming - -- what is in this package Naming. + -- This is not a source file - if Naming_Id /= No_Package then - Naming := Packages.Table (Naming_Id); + Unit_Name := No_Name; + Unit_Kind := Specification; if Current_Verbosity = High then - Write_Line ("Checking ""Naming""."); + Write_Line (" Not a valid file name."); end if; - -- Check Spec_Suffix + return; + end if; - 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; + Get_Name_String (Naming.Dot_Replacement); + Standard_GNAT := + Standard_GNAT and then Name_Buffer (1 .. Name_Len) = "-"; - 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; + if Name_Buffer (1 .. Name_Len) /= "." then - -- 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 Dot_Replacement is not a single dot, then there should + -- not be any dot in the name. - Suffix := Element.Next; - end loop; + 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; - -- Put the resulting array as the specification suffixs + Unit_Name := No_Name; + return; - Data.Naming.Spec_Suffix := Spec_Suffixs; end if; - end; + end loop; + + -- Replace the substring Dot_Replacement with dots declare - Current : Array_Element_Id := Data.Naming.Spec_Suffix; - Element : Array_Element; + Index : Positive := First; begin - while Current /= No_Array_Element loop - Element := Array_Elements.Table (Current); - Get_Name_String (Element.Value.Value); + while Index <= Last - Name_Len + 1 loop - if Name_Len = 0 then - Error_Msg - (Project, - "Spec_Suffix cannot be empty", - Element.Value.Location); + if File (Index .. Index + Name_Len - 1) = + Name_Buffer (1 .. Name_Len) + then + File (Index) := '.'; + + if Name_Len > 1 and then Index < Last then + File (Index + 1 .. Last - Name_Len + 1) := + File (Index + Name_Len .. Last); + end if; + + Last := Last - Name_Len + 1; end if; - Array_Elements.Table (Current) := Element; - Current := Element.Next; + Index := Index + 1; end loop; end; + end if; - -- Check Body_Suffix + -- Check if the casing is right - declare - Impl_Suffixs : Array_Element_Id := - Util.Value_Of - (Name_Body_Suffix, - Naming.Decl.Arrays); + declare + Src : String := File (First .. Last); - Suffix : Array_Element_Id; - Element : Array_Element; - Suffix2 : Array_Element_Id; + begin + case Naming.Casing is + when All_Lower_Case => + Fixed.Translate + (Source => Src, + Mapping => Lower_Case_Map); - 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; + when All_Upper_Case => + Fixed.Translate + (Source => Src, + Mapping => Upper_Case_Map); - -- 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; + when Mixed_Case | Unknown => + null; + end case; - Suffix := Element.Next; - end loop; + if Src /= File (First .. Last) then + if Current_Verbosity = High then + Write_Line (" Not a valid file name (casing)."); + end if; - -- Put the resulting array as the implementation suffixs + Unit_Name := No_Name; + return; + end if; - Data.Naming.Body_Suffix := Impl_Suffixs; - end if; - end; + -- We put the name in lower case - declare - Current : Array_Element_Id := Data.Naming.Body_Suffix; - Element : Array_Element; + Fixed.Translate + (Source => Src, + Mapping => Lower_Case_Map); - begin - while Current /= No_Array_Element loop - Element := Array_Elements.Table (Current); - Get_Name_String (Element.Value.Value); + -- In the standard GNAT naming scheme, check for special cases: + -- children or separates of A, G, I or S, and run time sources. + + if Standard_GNAT and then Src'Length >= 3 then + declare + S1 : constant Character := Src (Src'First); + S2 : constant Character := Src (Src'First + 1); + + 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 (Hostparm.OpenVMS and then S2 = '$') + or else (not Hostparm.OpenVMS and then S2 = '~') + then + Src (Src'First + 1) := '.'; + + -- If it is potentially a run time source, disable + -- filling of the mapping file to avoid warnings. + + elsif S2 = '.' then + Set_Mapping_File_Initial_State_To_Empty; + end if; - if Name_Len = 0 then - Error_Msg - (Project, - "Body_Suffix cannot be empty", - Element.Value.Location); end if; + end; + end if; - Array_Elements.Table (Current) := Element; - Current := Element.Next; - end loop; - end; + if Current_Verbosity = High then + Write_Str (" "); + Write_Line (Src); + end if; - -- Get the exceptions, if any + -- Now, we check if this name is a valid unit name - Data.Naming.Specification_Exceptions := - Util.Value_Of - (Name_Specification_Exceptions, - In_Arrays => Naming.Decl.Arrays); + Check_Ada_Name (Name => Src, Unit => Unit_Name); + end; - Data.Naming.Implementation_Exceptions := - Util.Value_Of - (Name_Implementation_Exceptions, - In_Arrays => Naming.Decl.Arrays); - end if; end; + end Get_Unit; - Projects.Table (Project) := Data; - end Language_Independent_Check; + ---------- + -- Hash -- + ---------- + + function Hash (Unit : Unit_Info) return Header_Num is + begin + return Header_Num (Unit.Unit mod 2048); + end Hash; + + ----------------------- + -- Is_Illegal_Suffix -- + ----------------------- + + function Is_Illegal_Suffix + (Suffix : 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; + + -- If dot replacement is a single dot, and first character of + -- suffix is also a dot + + if Dot_Replacement_Is_A_Single_Dot + and then Suffix (Suffix'First) = '.' + then + for Index in Suffix'First + 1 .. Suffix'Last loop + + -- If there is another dot + + if Suffix (Index) = '.' then + + -- It is illegal to have a letter following the initial dot + + return Is_Letter (Suffix (Suffix'First + 1)); + end if; + end loop; + end if; + + -- Everything is OK + + return False; + end Is_Illegal_Suffix; ---------------------- -- Locate_Directory -- @@ -3912,8 +3600,10 @@ package body Prj.Nmsc is 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); @@ -3990,124 +3680,445 @@ package body Prj.Nmsc is end if; end Locate_Directory; - --------------------------- - -- Other_Languages_Check -- - --------------------------- + ---------------------- + -- Look_For_Sources -- + ---------------------- - procedure Other_Languages_Check + procedure Look_For_Sources (Project : Project_Id; - Report_Error : Put_Line_Access) is - - Data : Project_Data; - - Languages : Variable_Value := Nil_Variable_Value; + 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. - begin - Language_Independent_Check (Project, Report_Error); + procedure Get_Sources_From_File + (Path : String; + Location : Source_Ptr); + -- Get the sources of a project from a text file - Error_Report := Report_Error; + --------------------------------------- + -- Get_Path_Names_And_Record_Sources -- + --------------------------------------- - Data := Projects.Table (Project); - Languages := Prj.Util.Value_Of (Name_Languages, Data.Decl.Attributes); + 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; - Data.Other_Sources_Present := Data.Source_Dirs /= Nil_String; + Dir : Dir_Type; + Name : Name_Id; + Canonical_Name : Name_Id; + Name_Str : String (1 .. 1_024); + Last : Natural := 0; + NL : Name_Location; - if Data.Other_Sources_Present then - -- Check if languages other than Ada are specified in this project + Current_Source : String_List_Id := Nil_String; - if Languages.Default then - -- Attribute Languages is not specified. So, it defaults to - -- a project of language Ada only. + First_Error : Boolean := True; - Data.Languages (Lang_Ada) := True; + Source_Recorded : Boolean := False; - -- No sources of languages other than Ada + begin + -- We look in all source directories for the file names in the + -- hash table Source_Names - Data.Other_Sources_Present := False; + while Source_Dir /= Nil_String loop + Source_Recorded := False; + Element := String_Elements.Table (Source_Dir); - else declare - Current : String_List_Id := Languages.Values; - Element : String_Element; - OK : Boolean := False; + Dir_Path : constant String := Get_Name_String (Element.Value); 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 Current_Verbosity = High then + Write_Str ("checking directory """); + Write_Str (Dir_Path); + Write_Line (""""); + end if; - Data.Other_Sources_Present := False; + Open (Dir, Dir_Path); - -- Look through all the languages specified in attribute - -- Languages, if any + 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); - 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 NL /= No_Name_Location and then not NL.Found then + NL.Found := True; + Source_Names.Set (Canonical_Name, NL); + Name_Len := Dir_Path'Length; + Name_Buffer (1 .. Name_Len) := Dir_Path; + + if Name_Buffer (Name_Len) /= Directory_Separator then + Add_Char_To_Name_Buffer (Directory_Separator); + end if; - -- Check if it is a known language + Add_Str_To_Name_Buffer (Name_Str (1 .. Last)); + Path := Name_Find; - 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 + if Current_Verbosity = High then + Write_Str (" found "); + Write_Line (Get_Name_String (Name)); + end if; + + -- Register the source if it is an Ada compilation unit + + Record_Ada_Source + (File_Name => Name, + Path_Name => Path, + Project => Project, + Data => Data, + Location => NL.Location, + Current_Source => Current_Source, + Source_Recorded => Source_Recorded, + Follow_Links => Follow_Links); + end if; + end loop; - OK := True; + Close (Dir); + end; - -- Indicate the presence of this language - Data.Languages (Lang) := True; + if Source_Recorded then + String_Elements.Table (Source_Dir).Flag := True; + end if; - -- If it is a language other than Ada, indicate that - -- there should be some sources of a language other - -- than Ada. + Source_Dir := Element.Next; + end loop; - if Lang /= Lang_Ada then - Data.Other_Sources_Present := True; - end if; + -- It is an error if a source file name in a source list or + -- in a source list file is not found. + + NL := Source_Names.Get_First; + + while NL /= No_Name_Location loop + if not NL.Found then + Err_Vars.Error_Msg_Name_1 := NL.Name; + + if First_Error then + Error_Msg + (Project, + "source file { cannot be found", + NL.Location); + First_Error := False; + + else + Error_Msg + (Project, + "\source file { cannot be found", + NL.Location); + end if; + end if; + + NL := Source_Names.Get_Next; + end loop; + end Get_Path_Names_And_Record_Sources; + + --------------------------- + -- Get_Sources_From_File -- + --------------------------- + + 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. + + Get_Sources_From_File (Path, Location, Project); + + -- Look in the source directories to find those sources + + Get_Path_Names_And_Record_Sources (Follow_Links); + + -- We should have found at least one source. + -- If not, report an error. + + 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; + + begin + if Data.Ada_Sources_Present then + declare + 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); + + Locally_Removed : constant Variable_Value := + Util.Value_Of + (Name_Locally_Removed_Files, + Data.Decl.Attributes); + + begin + pragma Assert + (Sources.Kind = List, + "Source_Files is not a list"); + + pragma Assert + (Source_List_File.Kind = Single, + "Source_List_File is not a single string"); + + if not Sources.Default then + if not Source_List_File.Default then + Error_Msg + (Project, + "?both variables source_files and " & + "source_list_file are present", + Source_List_File.Location); + end if; + + -- Sources is a list of file names + + declare + Current : String_List_Id := Sources.Values; + Element : String_Element; + Location : Source_Ptr; + Name : Name_Id; + + begin + Source_Names.Reset; + + Data.Ada_Sources_Present := Current /= Nil_String; + + 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; - exit Lang_Loop; + -- If the element has no location, then use the + -- location of Sources to report possible errors. + + if Element.Location = No_Location then + Location := Sources.Location; + else + Location := Element.Location; end if; - end loop Lang_Loop; - -- We don't support this language: report an error + Source_Names.Set + (K => Name, + E => + (Name => Name, + Location => Location, + Found => False)); + + Current := Element.Next; + end loop; + + Get_Path_Names_And_Record_Sources (Follow_Links); + end; + + -- No source_files specified - if not OK then - Error_Msg_Name_1 := Element.Value; + -- We check Source_List_File has been specified + + elsif not Source_List_File.Default then + + -- Source_List_File is the name of the file + -- that contains the source file names + + declare + Source_File_Path_Name : constant String := + Path_Name_Of + (Source_List_File.Value, + Data.Directory); + + begin + if Source_File_Path_Name'Length = 0 then + Err_Vars.Error_Msg_Name_1 := Source_List_File.Value; Error_Msg (Project, - "unknown programming language {", - Element.Location); + "file with sources { does not exist", + Source_List_File.Location); + + else + Get_Sources_From_File + (Source_File_Path_Name, + Source_List_File.Location); end if; + end; - Current := Element.Next; - end loop; - end; - end if; - end if; + else + -- Neither Source_Files nor Source_List_File has been + -- specified. Find all the files that satisfy the naming + -- scheme in all the source directories. + + Find_Sources + (Project, Data, Ada_Language_Index, Follow_Links); + end if; + + -- If there are sources that are locally removed, mark them as + -- such in the Units table. + + if not Locally_Removed.Default then + + -- Sources can be locally removed only in extending + -- project files. + + if Data.Extends = No_Project then + Error_Msg + (Project, + "Locally_Removed_Files can only be used " & + "in an extending project file", + Locally_Removed.Location); + + 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 + 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 the element has no location, then use the + -- location of Locally_Removed to report + -- possible errors. + + if Element.Location = No_Location then + Location := Locally_Removed.Location; + else + Location := Element.Location; + end if; + + 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); + + 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; - -- If there may be some sources, look for them + elsif + Unit.File_Names (Body_Part).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 + (Body_Part).Project; + + if Extended = Project then + Error_Msg + (Project, + "cannot remove a source " & + "of the same project", + Location); + + 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; + + end if; + end loop; + + 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; + end if; + end; + end if; 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 <directory>/<file_name> @@ -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; |
