From 0b795892d2bb3638b44b03fbfd0087714ced817c Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Wed, 28 May 2008 13:30:37 +0000 Subject: [PATCH] Make-lang.in: Remove gprmake. * Make-lang.in: Remove gprmake. * gprmake.adb, makegpr.ads, makegpr.adb: Removed. From-SVN: r136084 --- gcc/ada/ChangeLog | 6 + gcc/ada/Make-lang.in | 18 +- gcc/ada/gprmake.adb | 35 - gcc/ada/makegpr.adb | 4471 ------------------------------------------ gcc/ada/makegpr.ads | 34 - 5 files changed, 7 insertions(+), 4557 deletions(-) delete mode 100644 gcc/ada/gprmake.adb delete mode 100644 gcc/ada/makegpr.adb delete mode 100644 gcc/ada/makegpr.ads diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index a12cb11ded45..ca221233dd46 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,9 @@ +2008-05-28 Arnaud Charlet + + * Make-lang.in: Remove gprmake. + + * gprmake.adb, makegpr.ads, makegpr.adb: Removed. + 2008-05-28 Ed Schonberg * sem_ch3.adb (Diagnose_Interface): Cleanup error messages involving diff --git a/gcc/ada/Make-lang.in b/gcc/ada/Make-lang.in index df7682c20b2c..a7617ae39685 100644 --- a/gcc/ada/Make-lang.in +++ b/gcc/ada/Make-lang.in @@ -378,10 +378,6 @@ ada.all.cross: then \ $(MV) gnatsym$(exeext) gnatsym-cross$(exeext); \ fi - -if [ -f gprmake$(exeext) ] ; \ - then \ - $(MV) gprmake$(exeext) gprmake-cross$(exeext); \ - fi ada.start.encap: ada.rest.encap: @@ -497,7 +493,7 @@ doc/gnat-style.pdf: ada/gnat-style.texi $(gcc_docdir)/include/fdl.texi # and also as either gnatbind (if native) or $(tooldir)/bin/gnatbind # likewise for gnatf, gnatchop, and gnatlink, gnatkr, gnatmake, gnat, # gnatprep, gnatls, gnatxref, gnatfind, gnatname, gnatclean, -# gnatsym, gprmake +# gnatsym ada.install-common: $(MKDIR) $(DESTDIR)$(bindir) -if [ -f gnat1$(exeext) ] ; \ @@ -664,17 +660,6 @@ ada.install-common: $(INSTALL_PROGRAM) gnatclean$(exeext) $(DESTDIR)$(bindir)/gnatclean$(exeext); \ fi ; \ fi - -if [ -f gnat1$(exeext) ] ; \ - then \ - if [ -f gprmake-cross$(exeext) ] ; \ - then \ - $(RM) $(DESTDIR)$(bindir)/$(target_noncanonical)-gprmake$(exeext); \ - $(INSTALL_PROGRAM) gprmake-cross$(exeext) $(DESTDIR)$(bindir)/$(target_noncanonical)-gprmake$(exeext); \ - else \ - $(RM) $(bindir)/gprmake$(exeext); \ - $(INSTALL_PROGRAM) gprmake$(exeext) $(DESTDIR)$(bindir)/gprmake$(exeext); \ - fi ; \ - fi # # Gnatsym is only built on some platforms, including VMS # @@ -808,7 +793,6 @@ ada.distclean: -$(RM) gnatxref$(exeext) -$(RM) gnatclean$(exeext) -$(RM) gnatsym$(exeext) - -$(RM) gprmake$(exeext) # Gnatlbr is only used on VMS -$(RM) gnatlbr$(exeext) -$(RM) ada/rts/* diff --git a/gcc/ada/gprmake.adb b/gcc/ada/gprmake.adb deleted file mode 100644 index 61bef3c9098b..000000000000 --- a/gcc/ada/gprmake.adb +++ /dev/null @@ -1,35 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT COMPILER COMPONENTS -- --- -- --- G P R M A K E -- --- -- --- B o d y -- --- -- --- Copyright (C) 2004-2007, 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- -- --- ware Foundation; either version 3, or (at your option) any later ver- -- --- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- --- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- --- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- --- for more details. You should have received a copy of the GNU General -- --- Public License distributed with GNAT; see file COPYING3. If not, go to -- --- http://www.gnu.org/licenses for a complete copy of the license. -- --- -- --- GNAT was originally developed by the GNAT team at New York University. -- --- Extensive contributions were provided by Ada Core Technologies Inc. -- --- -- ------------------------------------------------------------------------------- - --- The driver for the gprmake tool - -with Makegpr; - -procedure Gprmake is -begin - -- The code is in Makegpr - - Makegpr.Gprmake; -end Gprmake; diff --git a/gcc/ada/makegpr.adb b/gcc/ada/makegpr.adb deleted file mode 100644 index 04996bb4e13e..000000000000 --- a/gcc/ada/makegpr.adb +++ /dev/null @@ -1,4471 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT COMPILER COMPONENTS -- --- -- --- M A K E G P R -- --- -- --- B o d y -- --- -- --- Copyright (C) 2004-2008, 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- -- --- ware Foundation; either version 3, or (at your option) any later ver- -- --- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- --- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- --- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- --- for more details. You should have received a copy of the GNU General -- --- Public License distributed with GNAT; see file COPYING3. If not, go to -- --- http://www.gnu.org/licenses for a complete copy of the license. -- --- -- --- GNAT was originally developed by the GNAT team at New York University. -- --- Extensive contributions were provided by Ada Core Technologies Inc. -- --- -- ------------------------------------------------------------------------------- - -with Csets; -with Gnatvsn; -with Hostparm; use Hostparm; -with Makeutl; use Makeutl; -with MLib.Tgt; use MLib.Tgt; -with Namet; use Namet; -with Output; use Output; -with Opt; use Opt; -with Osint; use Osint; -with Prj; use Prj; -with Prj.Ext; use Prj.Ext; -with Prj.Pars; -with Prj.Util; use Prj.Util; -with Snames; use Snames; -with Table; -with Types; use Types; - -with Ada.Command_Line; use Ada.Command_Line; -with Ada.Strings.Fixed; use Ada.Strings.Fixed; -with Ada.Text_IO; use Ada.Text_IO; -with Ada.Unchecked_Deallocation; - -with GNAT.Directory_Operations; use GNAT.Directory_Operations; -with GNAT.Dynamic_Tables; -with GNAT.Expect; use GNAT.Expect; -with GNAT.HTable; -with GNAT.OS_Lib; use GNAT.OS_Lib; -with GNAT.Regpat; use GNAT.Regpat; - -with System; -with System.Case_Util; use System.Case_Util; - -package body Makegpr is - - On_Windows : constant Boolean := Directory_Separator = '\'; - -- True when on Windows. Used in Check_Compilation_Needed when processing - -- C/C++ dependency files for backslash handling. - - Max_In_Archives : constant := 50; - -- The maximum number of arguments for a single invocation of the - -- Archive Indexer (ar). - - No_Argument : aliased Argument_List := (1 .. 0 => null); - -- Null argument list representing case of no arguments - - FD : Process_Descriptor; - -- The process descriptor used when invoking a non GNU compiler with -M - -- and getting the output with GNAT.Expect. - - Line_Matcher : constant Pattern_Matcher := Compile ("^.*?\n", Single_Line); - -- Pattern for GNAT.Expect for the invocation of a non GNU compiler with -M - - Name_Ide : Name_Id; - Name_Compiler_Command : Name_Id; - -- Names of package IDE and its attribute Compiler_Command. - -- Set up by Initialize. - - Unique_Compile : Boolean := False; - -- True when switch -u is used on the command line - - type Source_Index_Rec is record - Project : Project_Id; - Id : Other_Source_Id; - Found : Boolean := False; - end record; - -- Used as Source_Indexes component to check if archive needs to be rebuilt - - type Source_Index_Array is array (Positive range <>) of Source_Index_Rec; - type Source_Indexes_Ref is access Source_Index_Array; - - procedure Free is new Ada.Unchecked_Deallocation - (Source_Index_Array, Source_Indexes_Ref); - - Initial_Source_Index_Count : constant Positive := 20; - Source_Indexes : Source_Indexes_Ref := - new Source_Index_Array (1 .. Initial_Source_Index_Count); - -- A list of the Other_Source_Ids of a project file, with an indication - -- that they have been found in the archive dependency file. - - Last_Source : Natural := 0; - -- The index of the last valid component of Source_Indexes - - 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. - - 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 (First_Language_Indexes) of Boolean; - -- An indication that a compiler is a GCC compiler, to be able to use - -- specific GCC switches. - - Archive_Builder_Path : String_Access := null; - -- The path name of the archive builder (ar). To be used when spawning - -- ar commands. - - Archive_Indexer_Path : String_Access := null; - -- The path name of the archive indexer (ranlib), if it exists - - Copyright_Output : Boolean := False; - Usage_Output : Boolean := False; - -- Flags to avoid multiple displays of Copyright notice and of Usage - - Output_File_Name : String_Access := null; - -- The name given after a switch -o - - Output_File_Name_Expected : Boolean := False; - -- True when last switch was -o - - Project_File_Name : String_Access := null; - -- The name of the project file specified with switch -P - - Project_File_Name_Expected : Boolean := False; - -- True when last switch was -P - - Naming_String : aliased String := "naming"; - Builder_String : aliased String := "builder"; - Compiler_String : aliased String := "compiler"; - Binder_String : aliased String := "binder"; - Linker_String : aliased String := "linker"; - -- Name of packages to be checked when parsing/processing project files - - List_Of_Packages : aliased String_List := - (Naming_String 'Access, - Builder_String 'Access, - Compiler_String 'Access, - Binder_String 'Access, - Linker_String 'Access); - Packages_To_Check : constant String_List_Access := List_Of_Packages'Access; - -- List of the packages to be checked when parsing/processing project files - - Project_Tree : constant Project_Tree_Ref := new Project_Tree_Data; - - Main_Project : Project_Id; - -- The project id of the main project - - type Processor is (None, Linker, Compiler); - Current_Processor : Processor := None; - -- This variable changes when switches -*args are used - - Current_Language : Language_Index := Ada_Language_Index; - -- The compiler language to consider when Processor is Compiler - - package Comp_Opts is new GNAT.Dynamic_Tables - (Table_Component_Type => String_Access, - Table_Index_Type => Integer, - Table_Low_Bound => 1, - Table_Initial => 20, - Table_Increment => 100); - 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 - (Table_Component_Type => String_Access, - Table_Index_Type => Integer, - Table_Low_Bound => 1, - Table_Initial => 20, - Table_Increment => 100, - Table_Name => "Makegpr.Linker_Options"); - -- Table to store the linking options - - package Library_Opts 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 => "Makegpr.Library_Opts"); - -- Table to store the linking options - - package Ada_Mains 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 => "Makegpr.Ada_Mains"); - -- Table to store the Ada mains, either specified on the command line - -- or found in attribute Main of the main project file. - - package Other_Mains is new Table.Table - (Table_Component_Type => Other_Source, - Table_Index_Type => Integer, - Table_Low_Bound => 1, - Table_Initial => 20, - Table_Increment => 100, - Table_Name => "Makegpr.Other_Mains"); - -- Table to store the mains of languages other than Ada, either specified - -- on the command line or found in attribute Main of the main project file. - - package Sources_Compiled is new GNAT.HTable.Simple_HTable - (Header_Num => Header_Num, - Element => Boolean, - No_Element => False, - Key => File_Name_Type, - Hash => Hash, - Equal => "="); - - package Saved_Switches is new Table.Table - (Table_Component_Type => String_Access, - Table_Index_Type => Integer, - Table_Low_Bound => 1, - Table_Initial => 10, - Table_Increment => 100, - Table_Name => "Makegpr.Saved_Switches"); - -- Table to store the switches to be passed to gnatmake - - Initial_Argument_Count : constant Positive := 20; - type Boolean_Array is array (Positive range <>) of Boolean; - type Booleans is access Boolean_Array; - - procedure Free is new Ada.Unchecked_Deallocation (Boolean_Array, Booleans); - - Arguments : Argument_List_Access := - new Argument_List (1 .. Initial_Argument_Count); - -- Used to store lists of arguments to be used when spawning a process - - Arguments_Displayed : Booleans := - new Boolean_Array (1 .. Initial_Argument_Count); - -- For each argument in Arguments, indicate if the argument should be - -- displayed when procedure Display_Command is called. - - Last_Argument : Natural := 0; - -- Index of the last valid argument in Arguments - - package Cache_Args is new Table.Table - (Table_Component_Type => String_Access, - Table_Index_Type => Integer, - Table_Low_Bound => 1, - Table_Initial => 200, - Table_Increment => 100, - Table_Name => "Makegpr.Cache_Args"); - -- A table to cache arguments, to avoid multiple allocation of the same - -- strings. It is not possible to use a hash table, because String is - -- an unconstrained type. - - -- Various switches used when spawning processes: - - Dash_B_String : aliased String := "-B"; - Dash_B : constant String_Access := Dash_B_String'Access; - Dash_c_String : aliased String := "-c"; - Dash_c : constant String_Access := Dash_c_String'Access; - Dash_cargs_String : aliased String := "-cargs"; - Dash_cargs : constant String_Access := Dash_cargs_String'Access; - Dash_d_String : aliased String := "-d"; - Dash_d : constant String_Access := Dash_d_String'Access; - Dash_eL_String : aliased String := "-eL"; - Dash_eL : constant String_Access := Dash_eL_String'Access; - Dash_f_String : aliased String := "-f"; - Dash_f : constant String_Access := Dash_f_String'Access; - Dash_k_String : aliased String := "-k"; - Dash_k : constant String_Access := Dash_k_String'Access; - Dash_largs_String : aliased String := "-largs"; - Dash_largs : constant String_Access := Dash_largs_String'Access; - Dash_M_String : aliased String := "-M"; - Dash_M : constant String_Access := Dash_M_String'Access; - Dash_margs_String : aliased String := "-margs"; - Dash_margs : constant String_Access := Dash_margs_String'Access; - Dash_o_String : aliased String := "-o"; - Dash_o : constant String_Access := Dash_o_String'Access; - Dash_P_String : aliased String := "-P"; - Dash_P : constant String_Access := Dash_P_String'Access; - Dash_q_String : aliased String := "-q"; - Dash_q : constant String_Access := Dash_q_String'Access; - Dash_u_String : aliased String := "-u"; - Dash_u : constant String_Access := Dash_u_String'Access; - Dash_v_String : aliased String := "-v"; - Dash_v : constant String_Access := Dash_v_String'Access; - Dash_vP1_String : aliased String := "-vP1"; - Dash_vP1 : constant String_Access := Dash_vP1_String'Access; - Dash_vP2_String : aliased String := "-vP2"; - Dash_vP2 : constant String_Access := Dash_vP2_String'Access; - Dash_x_String : aliased String := "-x"; - Dash_x : constant String_Access := Dash_x_String'Access; - r_String : aliased String := "r"; - r : constant String_Access := r_String'Access; - - CPATH : constant String := "CPATH"; - -- The environment variable to set when compiler is a GCC compiler - -- to indicate the include directory path. - - 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. - - C_Plus_Plus_Is_Used : Boolean := False; - -- True when there are sources in C++ - - Link_Options_Switches : Argument_List_Access := null; - -- The link options coming from the attributes Linker'Linker_Options in - -- project files imported, directly or indirectly, by the main project. - - Total_Number_Of_Errors : Natural := 0; - -- Used when Keep_Going is True (switch -k) to keep the total number - -- of compilation/linking errors, to report at the end of execution. - - Need_To_Rebuild_Global_Archive : Boolean := False; - - Error_Header : constant String := "*** ERROR: "; - -- The beginning of error message, when Keep_Going is True - - Need_To_Relink : Boolean := False; - -- True when an executable of a language other than Ada need to be linked - - Global_Archive_Exists : Boolean := False; - -- True if there is a non empty global archive, to prevent creation - -- of such archives. - - Path_Option : String_Access; - -- The path option switch, when supported - - Project_Of_Current_Object_Directory : Project_Id := No_Project; - -- The object directory of the project for the last compilation. Avoid - -- calling Change_Dir if the current working directory is already this - -- directory. - - package Lib_Path is new Table.Table - (Table_Component_Type => Character, - Table_Index_Type => Integer, - Table_Low_Bound => 1, - Table_Initial => 200, - Table_Increment => 100, - Table_Name => "Makegpr.Lib_Path"); - -- A table to compute the path to put in the path option switch, when it - -- is supported. - - procedure Add_Archives (For_Gnatmake : Boolean); - -- Add to Arguments the list of archives for linking an executable - - procedure Add_Argument (Arg : String_Access; Display : Boolean); - procedure Add_Argument (Arg : String; Display : Boolean); - -- Add an argument to Arguments. Reallocate if necessary - - procedure Add_Arguments (Args : Argument_List; Display : Boolean); - -- Add a list of arguments to Arguments. Reallocate if necessary - - procedure Add_Option (Arg : String); - -- Add a switch for the Ada, C or C++ compiler, or for the linker. - -- The table where this option is stored depends on the values of - -- Current_Processor and Current_Language. - - procedure Add_Search_Directories - (Data : Project_Data; - 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. - - procedure Add_Source_Id (Project : Project_Id; Id : Other_Source_Id); - -- Add a source id to Source_Indexes, with Found set to False - - procedure Add_Switches - (Data : Project_Data; - Proc : Processor; - Language : Language_Index; - File_Name : File_Name_Type); - -- Add to Arguments the switches, if any, for a source (attribute Switches) - -- or language (attribute Default_Switches), coming from package Compiler - -- or Linker (depending on Proc) of a specified project file. - - procedure Build_Global_Archive; - -- Build the archive for the main project - - procedure Build_Library (Project : Project_Id; Unconditionally : Boolean); - -- Build the library for a library project. If Unconditionally is - -- False, first check if the library is up to date, and build it only - -- if it is not. - - procedure Check (Option : String); - -- Check that a switch coming from a project file is not the concatenation - -- of several valid switch, for example "-g -v". If it is, issue a warning. - - procedure Check_Archive_Builder; - -- Check if the archive builder (ar) is there - - procedure Check_Compilation_Needed - (Source : Other_Source; - Need_To_Compile : out Boolean); - -- Check if a source of a language other than Ada needs to be compiled or - -- recompiled. - - procedure Check_For_C_Plus_Plus; - -- Check if C++ is used in at least one project - - procedure Compile - (Source_Id : Other_Source_Id; - Data : Project_Data; - Local_Errors : in out Boolean); - -- Compile one non-Ada source - - procedure Compile_Individual_Sources; - -- Compile the sources specified on the command line, when in - -- Unique_Compile mode. - - procedure Compile_Link_With_Gnatmake (Mains_Specified : Boolean); - -- Compile/Link with gnatmake when there are Ada sources in the main - -- project. Arguments may already contain options to be used by - -- gnatmake. Used for both Ada mains and mains of other languages. - -- When Compile_Only is True, do not use the linking options - - procedure Compile_Sources; - -- Compile the sources of languages other than Ada, if necessary - - procedure Copyright; - -- Output the Copyright notice - - procedure Create_Archive_Dependency_File - (Name : String; - First_Source : Other_Source_Id); - -- Create the archive dependency file for a library project - - procedure Create_Global_Archive_Dependency_File (Name : String); - -- Create the archive dependency file for the main project - - procedure Display_Command - (Name : String; - Path : String_Access; - CPATH : String_Access := null; - Ellipse : Boolean := False); - -- Display the command for a spawned process, if in Verbose_Mode or not in - -- Quiet_Output. In non verbose mode, when Ellipse is True, display "..." - -- in place of the first argument that has Display set to False. - - 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 is found - -- in package IDE of the main project, or defaulted. Fail if compiler - -- cannot be found on the path. For the Ada language, gnatmake, rather than - -- the Ada compiler is returned. - - procedure Get_Imported_Directories - (Project : Project_Id; - Data : in out Project_Data); - -- Find the necessary switches -I to be used when compiling sources of - -- languages other than Ada, in a specified project file. Cache the result - -- in component Imported_Directories_Switches of the project data. For - -- gcc/g++ compilers, get the value of the C*_INCLUDE_PATH, instead. - - procedure Initialize; - -- Do the necessary package initialization and process the command line - -- arguments. - - function Is_Included_In_Global_Archive - (Object_Name : File_Name_Type; - Project : Project_Id) return Boolean; - -- Return True if the object Object_Name is not overridden by a source - -- in a project extending project Project. - - procedure Link_Executables; - -- Link executables - - procedure Report_Error (S1 : String; S2 : String := ""; S3 : String := ""); - -- Report an error. If Keep_Going is False, just call Osint.Fail. If - -- Keep_Going is True, display the error and increase the total number of - -- errors. - - procedure Report_Total_Errors (Kind : String); - -- If Total_Number_Of_Errors is not zero, report it, and fail - - procedure Scan_Arg (Arg : String); - -- Process one command line argument - - function Strip_CR_LF (Text : String) return String; - -- Remove characters ASCII.CR and ASCII.LF from a String - - procedure Usage; - -- Display the usage - - ------------------ - -- Add_Archives -- - ------------------ - - procedure Add_Archives (For_Gnatmake : Boolean) is - Last_Arg : constant Natural := Last_Argument; - -- The position of the last argument before adding the archives. Used to - -- reverse the order of the arguments added when processing the - -- archives. - - procedure Recursive_Add_Archives (Project : Project_Id); - -- Recursive procedure to add the archive of a project file, if any, - -- then call itself for the project imported. - - ---------------------------- - -- Recursive_Add_Archives -- - ---------------------------- - - procedure Recursive_Add_Archives (Project : Project_Id) is - Data : Project_Data; - Imported : Project_List; - Prj : Project_Id; - - procedure Add_Archive_Path; - -- For a library project or the main project, add the archive - -- path to the arguments. - - ---------------------- - -- Add_Archive_Path -- - ---------------------- - - procedure Add_Archive_Path is - Increment : Positive; - Prev_Last : Positive; - - begin - if Data.Library then - - -- If it is a library project file, nothing to do if gnatmake - -- will be invoked, because gnatmake will take care of it, even - -- if the library is not an Ada library. - - if not For_Gnatmake then - if Data.Library_Kind = Static then - Add_Argument - (Get_Name_String (Data.Library_Dir.Display_Name) & - Directory_Separator & - "lib" & Get_Name_String (Data.Library_Name) & - '.' & Archive_Ext, - Verbose_Mode); - - else - -- As we first insert in the reverse order, - -- -L is put after -l - - Add_Argument - ("-l" & Get_Name_String (Data.Library_Name), - Verbose_Mode); - - Get_Name_String (Data.Library_Dir.Display_Name); - - Add_Argument - ("-L" & Name_Buffer (1 .. Name_Len), - Verbose_Mode); - - -- If there is a run path option, prepend this directory - -- to the library path. It is probable that the order of - -- the directories in the path option is not important, - -- but just in case put the directories in the same order - -- as the libraries. - - if Path_Option /= null then - - -- If it is not the first directory, make room at the - -- beginning of the table, including for a path - -- separator. - - if Lib_Path.Last > 0 then - Increment := Name_Len + 1; - Prev_Last := Lib_Path.Last; - Lib_Path.Set_Last (Prev_Last + Increment); - - for Index in reverse 1 .. Prev_Last loop - Lib_Path.Table (Index + Increment) := - Lib_Path.Table (Index); - end loop; - - Lib_Path.Table (Increment) := Path_Separator; - - else - -- If it is the first directory, just set - -- Last to the length of the directory. - - Lib_Path.Set_Last (Name_Len); - end if; - - -- Put the directory at the beginning of the - -- table. - - for Index in 1 .. Name_Len loop - Lib_Path.Table (Index) := Name_Buffer (Index); - end loop; - end if; - end if; - end if; - - -- For a non-library project, the only archive needed is the one - -- for the main project, if there is one. - - elsif Project = Main_Project and then Global_Archive_Exists then - Add_Argument - (Get_Name_String (Data.Object_Directory.Display_Name) & - Directory_Separator & - "lib" & Get_Name_String (Data.Display_Name) - & '.' & Archive_Ext, - Verbose_Mode); - end if; - end Add_Archive_Path; - - begin - -- Nothing to do when there is no project specified - - if Project /= No_Project then - Data := Project_Tree.Projects.Table (Project); - - -- Nothing to do if the project has already been processed - - if not Data.Seen then - - -- Mark the project as processed, to avoid processing it again - - Project_Tree.Projects.Table (Project).Seen := True; - - Recursive_Add_Archives (Data.Extends); - - Imported := Data.Imported_Projects; - - -- Call itself recursively for all imported projects - - while Imported /= Empty_Project_List loop - Prj := Project_Tree.Project_Lists.Table - (Imported).Project; - - if Prj /= No_Project then - while Project_Tree.Projects.Table - (Prj).Extended_By /= No_Project - loop - Prj := Project_Tree.Projects.Table - (Prj).Extended_By; - end loop; - - Recursive_Add_Archives (Prj); - end if; - - Imported := Project_Tree.Project_Lists.Table - (Imported).Next; - end loop; - - -- If there is sources of language other than Ada in this - -- project, add the path of the archive to Arguments. - - if Project = Main_Project - or else Data.Other_Sources_Present - then - Add_Archive_Path; - end if; - end if; - end if; - end Recursive_Add_Archives; - - -- Start of processing for Add_Archives - - begin - -- First, mark all projects as not processed - - for Project in Project_Table.First .. - Project_Table.Last (Project_Tree.Projects) - loop - Project_Tree.Projects.Table (Project).Seen := False; - end loop; - - -- Take care of the run path option - - if Path_Option = null then - Path_Option := MLib.Linker_Library_Path_Option; - end if; - - Lib_Path.Set_Last (0); - - -- Add archives in the reverse order - - Recursive_Add_Archives (Main_Project); - - -- And reverse the order - - declare - First : Positive; - Last : Natural; - Temp : String_Access; - - begin - First := Last_Arg + 1; - Last := Last_Argument; - while First < Last loop - Temp := Arguments (First); - Arguments (First) := Arguments (Last); - Arguments (Last) := Temp; - First := First + 1; - Last := Last - 1; - end loop; - end; - end Add_Archives; - - ------------------ - -- Add_Argument -- - ------------------ - - procedure Add_Argument (Arg : String_Access; Display : Boolean) is - begin - -- Nothing to do if no argument is specified or if argument is empty - - if Arg /= null or else Arg'Length = 0 then - - -- Reallocate arrays if necessary - - if Last_Argument = Arguments'Last then - declare - New_Arguments : constant Argument_List_Access := - new Argument_List - (1 .. Last_Argument + - Initial_Argument_Count); - - New_Arguments_Displayed : constant Booleans := - new Boolean_Array - (1 .. Last_Argument + - Initial_Argument_Count); - - begin - New_Arguments (Arguments'Range) := Arguments.all; - - -- To avoid deallocating the strings, nullify all components - -- of Arguments before calling Free. - - Arguments.all := (others => null); - - Free (Arguments); - Arguments := New_Arguments; - - New_Arguments_Displayed (Arguments_Displayed'Range) := - Arguments_Displayed.all; - Free (Arguments_Displayed); - Arguments_Displayed := New_Arguments_Displayed; - end; - end if; - - -- Add the argument and its display indication - - Last_Argument := Last_Argument + 1; - Arguments (Last_Argument) := Arg; - Arguments_Displayed (Last_Argument) := Display; - end if; - end Add_Argument; - - procedure Add_Argument (Arg : String; Display : Boolean) is - Argument : String_Access := null; - - begin - -- Nothing to do if argument is empty - - if Arg'Length > 0 then - - -- Check if the argument is already in the Cache_Args table. - -- If it is already there, reuse the allocated value. - - for Index in 1 .. Cache_Args.Last loop - if Cache_Args.Table (Index).all = Arg then - Argument := Cache_Args.Table (Index); - exit; - end if; - end loop; - - -- If the argument is not in the cache, create a new entry in the - -- cache. - - if Argument = null then - Argument := new String'(Arg); - Cache_Args.Increment_Last; - Cache_Args.Table (Cache_Args.Last) := Argument; - end if; - - -- And add the argument - - Add_Argument (Argument, Display); - end if; - end Add_Argument; - - ------------------- - -- Add_Arguments -- - ------------------- - - procedure Add_Arguments (Args : Argument_List; Display : Boolean) is - begin - -- Reallocate the arrays, if necessary - - if Last_Argument + Args'Length > Arguments'Last then - declare - New_Arguments : constant Argument_List_Access := - new Argument_List - (1 .. Last_Argument + Args'Length + - Initial_Argument_Count); - - New_Arguments_Displayed : constant Booleans := - new Boolean_Array - (1 .. Last_Argument + - Args'Length + - Initial_Argument_Count); - - begin - New_Arguments (1 .. Last_Argument) := - Arguments (1 .. Last_Argument); - - -- To avoid deallocating the strings, nullify all components - -- of Arguments before calling Free. - - Arguments.all := (others => null); - Free (Arguments); - - Arguments := New_Arguments; - New_Arguments_Displayed (1 .. Last_Argument) := - Arguments_Displayed (1 .. Last_Argument); - Free (Arguments_Displayed); - Arguments_Displayed := New_Arguments_Displayed; - end; - end if; - - -- Add the new arguments and the display indications - - Arguments (Last_Argument + 1 .. Last_Argument + Args'Length) := Args; - Arguments_Displayed (Last_Argument + 1 .. Last_Argument + Args'Length) := - (others => Display); - Last_Argument := Last_Argument + Args'Length; - end Add_Arguments; - - ---------------- - -- Add_Option -- - ---------------- - - procedure Add_Option (Arg : String) is - Option : constant String_Access := new String'(Arg); - - begin - case Current_Processor is - when None => - null; - - when Linker => - - -- Add option to the linker table - - Linker_Options.Increment_Last; - Linker_Options.Table (Linker_Options.Last) := Option; - - when Compiler => - - -- Add option to the compiler option table, depending on the - -- value of Current_Language. - - Comp_Opts.Increment_Last (Options (Current_Language)); - Options (Current_Language).Table - (Comp_Opts.Last (Options (Current_Language))) := Option; - - end case; - end Add_Option; - - ------------------- - -- Add_Source_Id -- - ------------------- - - procedure Add_Source_Id (Project : Project_Id; Id : Other_Source_Id) is - begin - -- Reallocate the array, if necessary - - if Last_Source = Source_Indexes'Last then - declare - New_Indexes : constant Source_Indexes_Ref := - new Source_Index_Array - (1 .. Source_Indexes'Last + - Initial_Source_Index_Count); - begin - New_Indexes (Source_Indexes'Range) := Source_Indexes.all; - Free (Source_Indexes); - Source_Indexes := New_Indexes; - end; - end if; - - Last_Source := Last_Source + 1; - Source_Indexes (Last_Source) := (Project, Id, False); - end Add_Source_Id; - - ---------------------------- - -- Add_Search_Directories -- - ---------------------------- - - procedure Add_Search_Directories - (Data : Project_Data; - Language : First_Language_Indexes) - is - begin - -- If a GNU compiler is used, set the CPATH environment variable, - -- if it does not already has the correct value. - - if Compiler_Is_Gcc (Language) then - if Current_Include_Paths (Language) /= Data.Include_Path then - Current_Include_Paths (Language) := Data.Include_Path; - Setenv (CPATH, Data.Include_Path.all); - end if; - - else - Add_Arguments (Data.Imported_Directories_Switches.all, Verbose_Mode); - end if; - end Add_Search_Directories; - - ------------------ - -- Add_Switches -- - ------------------ - - procedure Add_Switches - (Data : Project_Data; - Proc : Processor; - Language : Language_Index; - File_Name : File_Name_Type) - is - Switches : Variable_Value; - -- The switches, if any, for the file/language - - Pkg : Package_Id; - -- The id of the package where to look for the switches - - Defaults : Array_Element_Id; - -- The Default_Switches associative array - - Switches_Array : Array_Element_Id; - -- The Switches associative array - - Element_Id : String_List_Id; - Element : String_Element; - - begin - -- First, choose the proper package - - case Proc is - when None => - raise Program_Error; - - when Linker => - Pkg := Value_Of (Name_Linker, Data.Decl.Packages, Project_Tree); - - when Compiler => - Pkg := Value_Of (Name_Compiler, Data.Decl.Packages, Project_Tree); - end case; - - if Pkg /= No_Package then - - -- Get the Switches ("file name"), if they exist - - Switches_Array := Prj.Util.Value_Of - (Name => Name_Switches, - In_Arrays => Project_Tree.Packages.Table - (Pkg).Decl.Arrays, - In_Tree => Project_Tree); - - Switches := - Prj.Util.Value_Of - (Index => Name_Id (File_Name), - Src_Index => 0, - In_Array => Switches_Array, - In_Tree => Project_Tree); - - -- Otherwise, get the Default_Switches ("language"), if they exist - - if Switches = Nil_Variable_Value then - Defaults := Prj.Util.Value_Of - (Name => Name_Default_Switches, - In_Arrays => Project_Tree.Packages.Table - (Pkg).Decl.Arrays, - In_Tree => Project_Tree); - Switches := Prj.Util.Value_Of - (Index => Language_Names.Table (Language), - Src_Index => 0, - In_Array => Defaults, - In_Tree => Project_Tree); - end if; - - -- If there are switches, add them to Arguments - - if Switches /= Nil_Variable_Value then - Element_Id := Switches.Values; - while Element_Id /= Nil_String loop - Element := Project_Tree.String_Elements.Table - (Element_Id); - - if Element.Value /= No_Name then - Get_Name_String (Element.Value); - - if not Quiet_Output then - - -- When not in quiet output (no -q), check that the - -- switch is not the concatenation of several valid - -- switches, such as "-g -v". If it is, issue a warning. - - Check (Option => Name_Buffer (1 .. Name_Len)); - end if; - - Add_Argument (Name_Buffer (1 .. Name_Len), True); - end if; - - Element_Id := Element.Next; - end loop; - end if; - end if; - end Add_Switches; - - -------------------------- - -- Build_Global_Archive -- - -------------------------- - - procedure Build_Global_Archive is - Data : Project_Data := Project_Tree.Projects.Table (Main_Project); - Source_Id : Other_Source_Id; - S_Id : Other_Source_Id; - Source : Other_Source; - Success : Boolean; - - Archive_Name : constant String := - "lib" - & Get_Name_String (Data.Display_Name) - & '.' - & Archive_Ext; - -- The name of the archive file for this project - - Archive_Dep_Name : constant String := - "lib" - & Get_Name_String (Data.Display_Name) - & ".deps"; - -- The name of the archive dependency file for this project - - Need_To_Rebuild : Boolean := Need_To_Rebuild_Global_Archive; - -- When True, archive will be rebuilt - - File : Prj.Util.Text_File; - Object_Path : Path_Name_Type; - Time_Stamp : Time_Stamp_Type; - Saved_Last_Argument : Natural; - First_Object : Natural; - - Discard : Boolean; - pragma Warnings (Off, Discard); - - begin - Check_Archive_Builder; - - if Project_Of_Current_Object_Directory /= Main_Project then - Project_Of_Current_Object_Directory := Main_Project; - Change_Dir (Get_Name_String (Data.Object_Directory.Name)); - - if Verbose_Mode then - Write_Str ("Changing to object directory of """); - Write_Name (Data.Display_Name); - Write_Str (""": """); - Write_Name (Data.Object_Directory.Display_Name); - Write_Line (""""); - end if; - end if; - - if not Need_To_Rebuild then - if Verbose_Mode then - Write_Str (" Checking "); - Write_Line (Archive_Name); - end if; - - -- If the archive does not exist, of course it needs to be built - - if not Is_Regular_File (Archive_Name) then - Need_To_Rebuild := True; - - if Verbose_Mode then - Write_Line (" -> archive does not exist"); - end if; - - -- Archive does exist - - else - -- Check the archive dependency file - - Open (File, Archive_Dep_Name); - - -- If the archive dependency file does not exist, we need to - -- rebuild the archive and to create its dependency file. - - if not Is_Valid (File) then - Need_To_Rebuild := True; - - if Verbose_Mode then - Write_Str (" -> archive dependency file "); - Write_Str (Archive_Dep_Name); - Write_Line (" does not exist"); - end if; - - else - -- Put all sources of language other than Ada in Source_Indexes - - declare - Local_Data : Project_Data; - - begin - Last_Source := 0; - - for Proj in Project_Table.First .. - Project_Table.Last (Project_Tree.Projects) - loop - Local_Data := Project_Tree.Projects.Table (Proj); - - if not Local_Data.Library then - Source_Id := Local_Data.First_Other_Source; - while Source_Id /= No_Other_Source loop - Add_Source_Id (Proj, Source_Id); - Source_Id := Project_Tree.Other_Sources.Table - (Source_Id).Next; - end loop; - end if; - end loop; - end; - - -- Read the dependency file, line by line - - while not End_Of_File (File) loop - Get_Line (File, Name_Buffer, Name_Len); - - -- First line is the path of the object file - - Object_Path := Name_Find; - Source_Id := No_Other_Source; - - -- Check if this object file is for a source of this project - - for S in 1 .. Last_Source loop - S_Id := Source_Indexes (S).Id; - Source := Project_Tree.Other_Sources.Table (S_Id); - - if (not Source_Indexes (S).Found) - and then Source.Object_Path = Object_Path - then - -- We have found the object file: get the source data, - -- and mark it as found. - - Source_Id := S_Id; - Source_Indexes (S).Found := True; - exit; - end if; - end loop; - - -- If it is not for a source of this project, then the - -- archive needs to be rebuilt. - - if Source_Id = No_Other_Source then - Need_To_Rebuild := True; - if Verbose_Mode then - Write_Str (" -> "); - Write_Str (Get_Name_String (Object_Path)); - Write_Line (" is not an object of any project"); - end if; - - exit; - end if; - - -- The second line is the time stamp of the object file. If - -- there is no next line, then the dependency file is - -- truncated, and the archive need to be rebuilt. - - if End_Of_File (File) then - Need_To_Rebuild := True; - - if Verbose_Mode then - Write_Str (" -> archive dependency file "); - Write_Line (" is truncated"); - end if; - - exit; - end if; - - Get_Line (File, Name_Buffer, Name_Len); - - -- If the line has the wrong number of characters, then - -- the dependency file is incorrectly formatted, and the - -- archive needs to be rebuilt. - - if Name_Len /= Time_Stamp_Length then - Need_To_Rebuild := True; - - if Verbose_Mode then - Write_Str (" -> archive dependency file "); - Write_Line (" is incorrectly formatted (time stamp)"); - end if; - - exit; - end if; - - Time_Stamp := Time_Stamp_Type (Name_Buffer (1 .. Name_Len)); - - -- If the time stamp in the dependency file is different - -- from the time stamp of the object file, then the archive - -- needs to be rebuilt. - - if Time_Stamp /= Source.Object_TS then - Need_To_Rebuild := True; - - if Verbose_Mode then - Write_Str (" -> time stamp of "); - Write_Str (Get_Name_String (Object_Path)); - Write_Str (" is incorrect in the archive"); - Write_Line (" dependency file"); - end if; - - exit; - end if; - end loop; - - Close (File); - end if; - end if; - end if; - - if not Need_To_Rebuild then - if Verbose_Mode then - Write_Line (" -> up to date"); - end if; - - -- No need to create a global archive, if there is no object - -- file to put into. - - Global_Archive_Exists := Last_Source /= 0; - - -- Archive needs to be rebuilt - - else - -- If archive already exists, first delete it - - -- Comment needed on why we discard result??? - - if Is_Regular_File (Archive_Name) then - Delete_File (Archive_Name, Discard); - end if; - - Last_Argument := 0; - - -- Start with the options found in MLib.Tgt (usually just "rc") - - Add_Arguments (Archive_Builder_Options.all, True); - - -- Followed by the archive name - - Add_Argument (Archive_Name, True); - - First_Object := Last_Argument; - - -- Followed by all the object files of the non library projects - - for Proj in Project_Table.First .. - Project_Table.Last (Project_Tree.Projects) - loop - Data := Project_Tree.Projects.Table (Proj); - - if not Data.Library then - Source_Id := Data.First_Other_Source; - while Source_Id /= No_Other_Source loop - Source := - Project_Tree.Other_Sources.Table (Source_Id); - - -- Only include object file name that have not been - -- overridden in extending projects. - - if Is_Included_In_Global_Archive - (Source.Object_Name, Proj) - then - Add_Argument - (Get_Name_String (Source.Object_Path), - Verbose_Mode or (First_Object = Last_Argument)); - end if; - - Source_Id := Source.Next; - end loop; - end if; - end loop; - - -- No need to create a global archive, if there is no object - -- file to put into. - - Global_Archive_Exists := Last_Argument > First_Object; - - if Global_Archive_Exists then - - -- If the archive is built, then linking will need to occur - -- unconditionally. - - Need_To_Relink := True; - - -- Spawn the archive builder (ar) - - Saved_Last_Argument := Last_Argument; - Last_Argument := First_Object + Max_In_Archives; - loop - if Last_Argument > Saved_Last_Argument then - Last_Argument := Saved_Last_Argument; - end if; - - Display_Command - (Archive_Builder, - Archive_Builder_Path, - Ellipse => True); - - Spawn - (Archive_Builder_Path.all, - Arguments (1 .. Last_Argument), - Success); - - exit when not Success - or else Last_Argument = Saved_Last_Argument; - - Arguments (1) := r; - Arguments (3 .. Saved_Last_Argument - Last_Argument + 2) := - Arguments (Last_Argument + 1 .. Saved_Last_Argument); - Saved_Last_Argument := Saved_Last_Argument - Last_Argument + 2; - end loop; - - -- If the archive was built, run the archive indexer (ranlib) - -- if there is one. - - if Success then - - if Archive_Indexer_Path /= null then - Last_Argument := 0; - Add_Argument (Archive_Name, True); - - Display_Command (Archive_Indexer, Archive_Indexer_Path); - - Spawn - (Archive_Indexer_Path.all, Arguments (1 .. 1), Success); - - if not Success then - - -- Running ranlib failed, delete the dependency file, - -- if it exists. - - if Is_Regular_File (Archive_Dep_Name) then - Delete_File (Archive_Dep_Name, Success); - end if; - - -- And report the error - - Report_Error - ("running" & Archive_Indexer & " for project """, - Get_Name_String (Data.Display_Name), - """ failed"); - return; - end if; - end if; - - -- The archive was correctly built, create its dependency file - - Create_Global_Archive_Dependency_File (Archive_Dep_Name); - - -- Building the archive failed, delete dependency file if one - -- exists. - - else - if Is_Regular_File (Archive_Dep_Name) then - Delete_File (Archive_Dep_Name, Success); - end if; - - -- And report the error - - Report_Error - ("building archive for project """, - Get_Name_String (Data.Display_Name), - """ failed"); - end if; - end if; - end if; - end Build_Global_Archive; - - ------------------- - -- Build_Library -- - ------------------- - - procedure Build_Library (Project : Project_Id; Unconditionally : Boolean) is - Data : constant Project_Data := - Project_Tree.Projects.Table (Project); - Source_Id : Other_Source_Id; - Source : Other_Source; - - Archive_Name : constant String := - "lib" & Get_Name_String (Data.Library_Name) - & '.' & Archive_Ext; - -- The name of the archive file for this project - - Archive_Dep_Name : constant String := - "lib" & Get_Name_String (Data.Library_Name) - & ".deps"; - -- The name of the archive dependency file for this project - - Need_To_Rebuild : Boolean := Unconditionally; - -- When True, archive will be rebuilt - - File : Prj.Util.Text_File; - - Object_Name : File_Name_Type; - Time_Stamp : Time_Stamp_Type; - Driver_Name : Name_Id := No_Name; - - Lib_Opts : Argument_List_Access := No_Argument'Access; - - begin - -- Nothing to do if the project is externally built - - if Data.Externally_Built then - return; - end if; - - Check_Archive_Builder; - - -- If Unconditionally is False, check if the archive need to be built - - if not Need_To_Rebuild then - if Verbose_Mode then - Write_Str (" Checking "); - Write_Line (Archive_Name); - end if; - - -- If the archive does not exist, of course it needs to be built - - if not Is_Regular_File (Archive_Name) then - Need_To_Rebuild := True; - - if Verbose_Mode then - Write_Line (" -> archive does not exist"); - end if; - - -- Archive does exist - - else - -- Check the archive dependency file - - Open (File, Archive_Dep_Name); - - -- If the archive dependency file does not exist, we need to - -- rebuild the archive and to create its dependency file. - - if not Is_Valid (File) then - Need_To_Rebuild := True; - - if Verbose_Mode then - Write_Str (" -> archive dependency file "); - Write_Str (Archive_Dep_Name); - Write_Line (" does not exist"); - end if; - - else - -- Put all sources of language other than Ada in Source_Indexes - - Last_Source := 0; - - Source_Id := Data.First_Other_Source; - while Source_Id /= No_Other_Source loop - Add_Source_Id (Project, Source_Id); - Source_Id := - Project_Tree.Other_Sources.Table (Source_Id).Next; - end loop; - - -- Read the dependency file, line by line - - while not End_Of_File (File) loop - Get_Line (File, Name_Buffer, Name_Len); - - -- First line is the name of an object file - - Object_Name := Name_Find; - Source_Id := No_Other_Source; - - -- Check if this object file is for a source of this project - - for S in 1 .. Last_Source loop - if (not Source_Indexes (S).Found) - and then - Project_Tree.Other_Sources.Table - (Source_Indexes (S).Id).Object_Name = Object_Name - then - -- We have found the object file: get the source - -- data, and mark it as found. - - Source_Id := Source_Indexes (S).Id; - Source := Project_Tree.Other_Sources.Table - (Source_Id); - Source_Indexes (S).Found := True; - exit; - end if; - end loop; - - -- If it is not for a source of this project, then the - -- archive needs to be rebuilt. - - if Source_Id = No_Other_Source then - Need_To_Rebuild := True; - - if Verbose_Mode then - Write_Str (" -> "); - Write_Str (Get_Name_String (Object_Name)); - Write_Line (" is not an object of the project"); - end if; - - exit; - end if; - - -- The second line is the time stamp of the object file. - -- If there is no next line, then the dependency file is - -- truncated, and the archive need to be rebuilt. - - if End_Of_File (File) then - Need_To_Rebuild := True; - - if Verbose_Mode then - Write_Str (" -> archive dependency file "); - Write_Line (" is truncated"); - end if; - - exit; - end if; - - Get_Line (File, Name_Buffer, Name_Len); - - -- If the line has the wrong number of character, then - -- the dependency file is incorrectly formatted, and the - -- archive needs to be rebuilt. - - if Name_Len /= Time_Stamp_Length then - Need_To_Rebuild := True; - - if Verbose_Mode then - Write_Str (" -> archive dependency file "); - Write_Line (" is incorrectly formatted (time stamp)"); - end if; - - exit; - end if; - - Time_Stamp := Time_Stamp_Type (Name_Buffer (1 .. Name_Len)); - - -- If the time stamp in the dependency file is different - -- from the time stamp of the object file, then the archive - -- needs to be rebuilt. - - if Time_Stamp /= Source.Object_TS then - Need_To_Rebuild := True; - - if Verbose_Mode then - Write_Str (" -> time stamp of "); - Write_Str (Get_Name_String (Object_Name)); - Write_Str (" is incorrect in the archive"); - Write_Line (" dependency file"); - end if; - - exit; - end if; - end loop; - - Close (File); - - if not Need_To_Rebuild then - - -- Now, check if all object files of the project have been - -- accounted for. If any of them is not in the dependency - -- file, the archive needs to be rebuilt. - - for Index in 1 .. Last_Source loop - if not Source_Indexes (Index).Found then - Need_To_Rebuild := True; - - if Verbose_Mode then - Source_Id := Source_Indexes (Index).Id; - Source := Project_Tree.Other_Sources.Table - (Source_Id); - Write_Str (" -> "); - Write_Str (Get_Name_String (Source.Object_Name)); - Write_Str (" is not in the archive "); - Write_Line ("dependency file"); - end if; - - exit; - end if; - end loop; - end if; - - if (not Need_To_Rebuild) and Verbose_Mode then - Write_Line (" -> up to date"); - end if; - end if; - end if; - end if; - - -- Build the library if necessary - - if Need_To_Rebuild then - - -- If a library is built, then linking will need to occur - -- unconditionally. - - Need_To_Relink := True; - - Last_Argument := 0; - - -- If there are sources in Ada, then gnatmake will build the library, - -- so nothing to do. - - if not Data.Langs (Ada_Language_Index) then - - -- Get all the object files of the project - - Source_Id := Data.First_Other_Source; - while Source_Id /= No_Other_Source loop - Source := Project_Tree.Other_Sources.Table (Source_Id); - Add_Argument - (Get_Name_String (Source.Object_Name), Verbose_Mode); - Source_Id := Source.Next; - end loop; - - -- If it is a library, it need to be built it the same way Ada - -- libraries are built. - - if Data.Library_Kind = Static then - MLib.Build_Library - (Ofiles => Arguments (1 .. Last_Argument), - Output_File => Get_Name_String (Data.Library_Name), - Output_Dir => Get_Name_String - (Data.Library_Dir.Display_Name)); - - else - -- Link with g++ if C++ is one of the languages, otherwise - -- building the library may fail with unresolved symbols. - - if C_Plus_Plus_Is_Used then - if Compiler_Names (C_Plus_Plus_Language_Index) = null then - Get_Compiler (C_Plus_Plus_Language_Index); - end if; - - if Compiler_Is_Gcc (C_Plus_Plus_Language_Index) then - Name_Len := 0; - Add_Str_To_Name_Buffer - (Compiler_Names (C_Plus_Plus_Language_Index).all); - Driver_Name := Name_Find; - end if; - end if; - - -- If Library_Options is specified, add these options - - declare - Library_Options : constant Variable_Value := - Value_Of - (Name_Library_Options, - Data.Decl.Attributes, - Project_Tree); - - begin - if not Library_Options.Default then - declare - Current : String_List_Id; - Element : String_Element; - - begin - Current := Library_Options.Values; - while Current /= Nil_String loop - Element := - Project_Tree.String_Elements.Table (Current); - Get_Name_String (Element.Value); - - if Name_Len /= 0 then - Library_Opts.Increment_Last; - Library_Opts.Table (Library_Opts.Last) := - new String'(Name_Buffer (1 .. Name_Len)); - end if; - - Current := Element.Next; - end loop; - end; - end if; - - Lib_Opts := - new Argument_List'(Argument_List - (Library_Opts.Table (1 .. Library_Opts.Last))); - end; - - MLib.Tgt.Build_Dynamic_Library - (Ofiles => Arguments (1 .. Last_Argument), - Options => Lib_Opts.all, - Interfaces => No_Argument, - Lib_Filename => Get_Name_String (Data.Library_Name), - Lib_Dir => Get_Name_String (Data.Library_Dir.Name), - Symbol_Data => No_Symbols, - Driver_Name => Driver_Name, - Lib_Version => "", - Auto_Init => False); - end if; - end if; - - -- Create fake empty archive, so we can check its time stamp later - - declare - Archive : Ada.Text_IO.File_Type; - begin - Create (Archive, Out_File, Archive_Name); - Close (Archive); - end; - - Create_Archive_Dependency_File - (Archive_Dep_Name, Data.First_Other_Source); - end if; - end Build_Library; - - ----------- - -- Check -- - ----------- - - procedure Check (Option : String) is - First : Positive := Option'First; - Last : Natural; - - begin - for Index in Option'First + 1 .. Option'Last - 1 loop - if Option (Index) = ' ' and then Option (Index + 1) = '-' then - Write_Str ("warning: switch """); - Write_Str (Option); - Write_Str (""" is suspicious; consider using "); - - Last := First; - while Last <= Option'Last loop - if Option (Last) = ' ' then - if First /= Option'First then - Write_Str (", "); - end if; - - Write_Char ('"'); - Write_Str (Option (First .. Last - 1)); - Write_Char ('"'); - - while Last <= Option'Last and then Option (Last) = ' ' loop - Last := Last + 1; - end loop; - - First := Last; - - else - if Last = Option'Last then - if First /= Option'First then - Write_Str (", "); - end if; - - Write_Char ('"'); - Write_Str (Option (First .. Last)); - Write_Char ('"'); - end if; - - Last := Last + 1; - end if; - end loop; - - Write_Line (" instead"); - exit; - end if; - end loop; - end Check; - - --------------------------- - -- Check_Archive_Builder -- - --------------------------- - - procedure Check_Archive_Builder is - begin - -- First, make sure that the archive builder (ar) is on the path - - if Archive_Builder_Path = null then - Archive_Builder_Path := Locate_Exec_On_Path (Archive_Builder); - - if Archive_Builder_Path = null then - Osint.Fail - ("unable to locate archive builder """, - Archive_Builder, - """"); - end if; - - -- If there is an archive indexer (ranlib), try to locate it on the - -- path. Don't fail if it is not found. - - if Archive_Indexer /= "" then - Archive_Indexer_Path := Locate_Exec_On_Path (Archive_Indexer); - end if; - end if; - end Check_Archive_Builder; - - ------------------------------ - -- Check_Compilation_Needed -- - ------------------------------ - - procedure Check_Compilation_Needed - (Source : Other_Source; - Need_To_Compile : out Boolean) - is - Source_Name : constant String := Get_Name_String (Source.File_Name); - Source_Path : constant String := Get_Name_String (Source.Path_Name); - Object_Name : constant String := Get_Name_String (Source.Object_Name); - C_Object_Name : String := Object_Name; - Dep_Name : constant String := Get_Name_String (Source.Dep_Name); - C_Source_Path : constant String := - Normalize_Pathname - (Name => Source_Path, - Resolve_Links => False, - Case_Sensitive => False); - - Source_In_Dependencies : Boolean := False; - -- Set True if source was found in dependency file of its object file - - Dep_File : Prj.Util.Text_File; - Start : Natural; - Finish : Natural; - - Looping : Boolean := False; - -- Set to True at the end of the first Big_Loop - - begin - Canonical_Case_File_Name (C_Object_Name); - - -- Assume the worst, so that statement "return;" may be used if there - -- is any problem. - - Need_To_Compile := True; - - if Verbose_Mode then - Write_Str (" Checking "); - Write_Str (Source_Name); - Write_Line (" ... "); - end if; - - -- If object file does not exist, of course source need to be compiled - - if Source.Object_TS = Empty_Time_Stamp then - if Verbose_Mode then - Write_Str (" -> object file "); - Write_Str (Object_Name); - Write_Line (" does not exist"); - end if; - - return; - end if; - - -- If the object file has been created before the last modification - -- of the source, the source need to be recompiled. - - if Source.Object_TS < Source.Source_TS then - if Verbose_Mode then - Write_Str (" -> object file "); - Write_Str (Object_Name); - Write_Line (" has time stamp earlier than source"); - end if; - - return; - end if; - - -- If there is no dependency file, then the source needs to be - -- recompiled and the dependency file need to be created. - - if Source.Dep_TS = Empty_Time_Stamp then - if Verbose_Mode then - Write_Str (" -> dependency file "); - Write_Str (Dep_Name); - Write_Line (" does not exist"); - end if; - - return; - end if; - - -- The source needs to be recompiled if the source has been modified - -- after the dependency file has been created. - - if Source.Dep_TS < Source.Source_TS then - if Verbose_Mode then - Write_Str (" -> dependency file "); - Write_Str (Dep_Name); - Write_Line (" has time stamp earlier than source"); - end if; - - return; - end if; - - -- Look for all dependencies - - Open (Dep_File, Dep_Name); - - -- If dependency file cannot be open, we need to recompile the source - - if not Is_Valid (Dep_File) then - if Verbose_Mode then - Write_Str (" -> could not open dependency file "); - Write_Line (Dep_Name); - end if; - - return; - end if; - - -- Loop Big_Loop is executed several times only when the dependency file - -- contains several times - -- : ... - -- When there is only one of such occurrence, Big_Loop is exited - -- successfully at the beginning of the second loop. - - Big_Loop : - loop - declare - End_Of_File_Reached : Boolean := False; - - begin - loop - if End_Of_File (Dep_File) then - End_Of_File_Reached := True; - exit; - end if; - - Get_Line (Dep_File, Name_Buffer, Name_Len); - - exit when Name_Len > 0 and then Name_Buffer (1) /= '#'; - end loop; - - -- If dependency file contains only empty lines or comments, then - -- dependencies are unknown, and the source needs to be - -- recompiled. - - if End_Of_File_Reached then - -- If we have reached the end of file after the first loop, - -- there is nothing else to do. - - exit Big_Loop when Looping; - - if Verbose_Mode then - Write_Str (" -> dependency file "); - Write_Str (Dep_Name); - Write_Line (" is empty"); - end if; - - Close (Dep_File); - return; - end if; - end; - - Start := 1; - Finish := Index (Name_Buffer (1 .. Name_Len), ": "); - - if Finish /= 0 then - Canonical_Case_File_Name (Name_Buffer (1 .. Finish - 1)); - end if; - - -- First line must start with name of object file, followed by colon - - if Finish = 0 or else - Name_Buffer (1 .. Finish - 1) /= C_Object_Name - then - if Verbose_Mode then - Write_Str (" -> dependency file "); - Write_Str (Dep_Name); - Write_Line (" has wrong format"); - end if; - - Close (Dep_File); - return; - - else - Start := Finish + 2; - - -- Process each line - - Line_Loop : loop - declare - Line : String := Name_Buffer (1 .. Name_Len); - Last : Natural := Name_Len; - - begin - Name_Loop : loop - - -- Find the beginning of the next source path name - - while Start < Last and then Line (Start) = ' ' loop - Start := Start + 1; - end loop; - - -- Go to next line when there is a continuation character - -- \ at the end of the line. - - exit Name_Loop when Start = Last - and then Line (Start) = '\'; - - -- We should not be at the end of the line, without - -- a continuation character \. - - if Start = Last then - if Verbose_Mode then - Write_Str (" -> dependency file "); - Write_Str (Dep_Name); - Write_Line (" has wrong format"); - end if; - - Close (Dep_File); - return; - end if; - - -- Look for the end of the source path name - - Finish := Start; - while Finish < Last loop - if Line (Finish) = '\' then - - -- On Windows, a '\' is part of the path name, - -- except when it is followed by another '\' or by - -- a space. On other platforms, when we are getting - -- a '\' that is not the last character of the - -- line, the next character is part of the path - -- name, even if it is a space. - - if On_Windows - and then Line (Finish + 1) /= '\' - and then Line (Finish + 1) /= ' ' - then - Finish := Finish + 1; - - else - Line (Finish .. Last - 1) := - Line (Finish + 1 .. Last); - Last := Last - 1; - end if; - - else - -- A space that is not preceded by '\' indicates - -- the end of the path name. - - exit when Line (Finish + 1) = ' '; - - Finish := Finish + 1; - end if; - end loop; - - -- Check this source - - declare - Src_Name : constant String := - Normalize_Pathname - (Name => - Line (Start .. Finish), - Resolve_Links => False, - Case_Sensitive => False); - Src_TS : Time_Stamp_Type; - - begin - -- If it is original source, set - -- Source_In_Dependencies. - - if Src_Name = C_Source_Path then - Source_In_Dependencies := True; - end if; - - Name_Len := 0; - Add_Str_To_Name_Buffer (Src_Name); - Src_TS := File_Stamp (File_Name_Type'(Name_Find)); - - -- If the source does not exist, we need to recompile - - if Src_TS = Empty_Time_Stamp then - if Verbose_Mode then - Write_Str (" -> source "); - Write_Str (Src_Name); - Write_Line (" does not exist"); - end if; - - Close (Dep_File); - return; - - -- If the source has been modified after the object - -- file, we need to recompile. - - elsif Src_TS > Source.Object_TS then - if Verbose_Mode then - Write_Str (" -> source "); - Write_Str (Src_Name); - Write_Line - (" has time stamp later than object file"); - end if; - - Close (Dep_File); - return; - end if; - end; - - -- If the source path name ends the line, we are done - - exit Line_Loop when Finish = Last; - - -- Go get the next source on the line - - Start := Finish + 1; - end loop Name_Loop; - end; - - -- If we are here, we had a continuation character \ at the end - -- of the line, so we continue with the next line. - - Get_Line (Dep_File, Name_Buffer, Name_Len); - Start := 1; - end loop Line_Loop; - end if; - - -- Set Looping at the end of the first loop - Looping := True; - end loop Big_Loop; - - Close (Dep_File); - - -- If the original sources were not in the dependency file, then we - -- need to recompile. It may mean that we are using a different source - -- (different variant) for this object file. - - if not Source_In_Dependencies then - if Verbose_Mode then - Write_Str (" -> source "); - Write_Str (Source_Path); - Write_Line (" is not in the dependencies"); - end if; - - return; - end if; - - -- If we are here, then everything is OK, no need to recompile - - if Verbose_Mode then - Write_Line (" -> up to date"); - end if; - - Need_To_Compile := False; - end Check_Compilation_Needed; - - --------------------------- - -- Check_For_C_Plus_Plus -- - --------------------------- - - procedure Check_For_C_Plus_Plus is - begin - C_Plus_Plus_Is_Used := False; - - for Project in Project_Table.First .. - Project_Table.Last (Project_Tree.Projects) - loop - if - Project_Tree.Projects.Table (Project).Langs - (C_Plus_Plus_Language_Index) - then - C_Plus_Plus_Is_Used := True; - exit; - end if; - end loop; - end Check_For_C_Plus_Plus; - - ------------- - -- Compile -- - ------------- - - procedure Compile - (Source_Id : Other_Source_Id; - Data : Project_Data; - Local_Errors : in out Boolean) - is - Source : Other_Source := - Project_Tree.Other_Sources.Table (Source_Id); - Success : Boolean; - CPATH : String_Access := null; - - begin - -- If the compiler is not known yet, get its path name - - if Compiler_Names (Source.Language) = null then - Get_Compiler (Source.Language); - end if; - - -- For non GCC compilers, get the dependency file, first calling the - -- compiler with the switch -M. - - if not Compiler_Is_Gcc (Source.Language) then - Last_Argument := 0; - - -- Add the source name, preceded by -M - - Add_Argument (Dash_M, True); - Add_Argument (Get_Name_String (Source.Path_Name), True); - - -- Add the compiling switches for this source found in - -- package Compiler of the project file, if they exist. - - Add_Switches - (Data, Compiler, Source.Language, Source.File_Name); - - -- Add the compiling switches for the language specified - -- on the command line, if any. - - for - J in 1 .. Comp_Opts.Last (Options (Source.Language)) - loop - Add_Argument (Options (Source.Language).Table (J), True); - end loop; - - -- Finally, add imported directory switches for this project file - - Add_Search_Directories (Data, Source.Language); - - -- And invoke the compiler using GNAT.Expect - - Display_Command - (Compiler_Names (Source.Language).all, - Compiler_Paths (Source.Language)); - - begin - Non_Blocking_Spawn - (FD, - Compiler_Paths (Source.Language).all, - Arguments (1 .. Last_Argument), - Buffer_Size => 0, - Err_To_Out => True); - - declare - Dep_File : Ada.Text_IO.File_Type; - Result : Expect_Match; - - Status : Integer; - pragma Warnings (Off, Status); - - begin - -- Create the dependency file - - Create (Dep_File, Out_File, Get_Name_String (Source.Dep_Name)); - - loop - Expect (FD, Result, Line_Matcher); - - exit when Result = Expect_Timeout; - - declare - S : constant String := Strip_CR_LF (Expect_Out (FD)); - - begin - -- Each line of the output is put in the dependency - -- file, including errors. If there are errors, the - -- syntax of the dependency file will be incorrect and - -- recompilation will occur automatically the next time - -- the dependencies are checked. - - Put_Line (Dep_File, S); - end; - end loop; - - -- If we are here, it means we had a timeout, so the - -- dependency file may be incomplete. It is safer to - -- delete it, otherwise the dependencies may be wrong. - - Close (FD, Status); - Close (Dep_File); - Delete_File (Get_Name_String (Source.Dep_Name), Success); - - exception - when Process_Died => - - -- This is the normal outcome. Just close the file - - Close (FD, Status); - Close (Dep_File); - - when others => - - -- Something wrong happened. It is safer to delete the - -- dependency file, otherwise the dependencies may be wrong. - - Close (FD, Status); - - if Is_Open (Dep_File) then - Close (Dep_File); - end if; - - Delete_File (Get_Name_String (Source.Dep_Name), Success); - end; - - exception - -- If we cannot spawn the compiler, then the dependencies are - -- not updated. It is safer then to delete the dependency file, - -- otherwise the dependencies may be wrong. - - when Invalid_Process => - Delete_File (Get_Name_String (Source.Dep_Name), Success); - end; - end if; - - Last_Argument := 0; - - -- For GCC compilers, make sure the language is always specified to - -- to the GCC driver, in case the extension is not recognized by the - -- GCC driver as a source of the language. - - if Compiler_Is_Gcc (Source.Language) then - Add_Argument (Dash_x, Verbose_Mode); - Add_Argument - (Get_Name_String (Language_Names.Table (Source.Language)), - Verbose_Mode); - end if; - - Add_Argument (Dash_c, True); - - -- Add the compiling switches for this source found in package Compiler - -- of the project file, if they exist. - - Add_Switches - (Data, Compiler, Source.Language, Source.File_Name); - - -- Specify the source to be compiled - - Add_Argument (Get_Name_String (Source.Path_Name), True); - - -- If non static library project, compile with the PIC option if there - -- is one (when there is no PIC option, MLib.Tgt.PIC_Option returns an - -- empty string, and Add_Argument with an empty string has no effect). - - if Data.Library and then Data.Library_Kind /= Static then - Add_Argument (PIC_Option, True); - end if; - - -- Indicate the name of the object - - Add_Argument (Dash_o, True); - Add_Argument (Get_Name_String (Source.Object_Name), True); - - -- When compiler is GCC, use the magic switch that creates the - -- dependency file in the correct format. - - if Compiler_Is_Gcc (Source.Language) then - Add_Argument - ("-Wp,-MD," & Get_Name_String (Source.Dep_Name), - Verbose_Mode); - end if; - - -- Add the compiling switches for the language specified on the command - -- line, if any. - - for J in 1 .. Comp_Opts.Last (Options (Source.Language)) loop - Add_Argument (Options (Source.Language).Table (J), True); - end loop; - - -- Finally, add the imported directory switches for this project file - -- (or, for gcc compilers, set up the CPATH env var if needed). - - Add_Search_Directories (Data, Source.Language); - - -- Set CPATH, if compiler is GCC - - if Compiler_Is_Gcc (Source.Language) then - CPATH := Current_Include_Paths (Source.Language); - end if; - - -- And invoke the compiler - - Display_Command - (Name => Compiler_Names (Source.Language).all, - Path => Compiler_Paths (Source.Language), - CPATH => CPATH); - - Spawn - (Compiler_Paths (Source.Language).all, - Arguments (1 .. Last_Argument), - Success); - - -- Case of successful compilation - - if Success then - - -- Update the time stamp of the object file - - Source.Object_TS := File_Stamp (Source.Object_Name); - - -- Do some sanity checks - - if Source.Object_TS = Empty_Time_Stamp then - Local_Errors := True; - Report_Error - ("object file ", - Get_Name_String (Source.Object_Name), - " has not been created"); - - elsif Source.Object_TS < Source.Source_TS then - Local_Errors := True; - Report_Error - ("object file ", - Get_Name_String (Source.Object_Name), - " has not been modified"); - - else - -- Everything looks fine, update the Other_Sources table - - Project_Tree.Other_Sources.Table (Source_Id) := Source; - end if; - - -- Compilation failed - - else - Local_Errors := True; - Report_Error - ("compilation of ", - Get_Name_String (Source.Path_Name), - " failed"); - end if; - end Compile; - - -------------------------------- - -- Compile_Individual_Sources -- - -------------------------------- - - procedure Compile_Individual_Sources is - Data : Project_Data := - Project_Tree.Projects.Table (Main_Project); - Source_Id : Other_Source_Id; - Source : Other_Source; - Source_Name : File_Name_Type; - Project_Name : String := Get_Name_String (Data.Name); - Dummy : Boolean := False; - - Ada_Is_A_Language : constant Boolean := - Data.Langs (Ada_Language_Index); - - begin - Ada_Mains.Init; - To_Mixed (Project_Name); - Compile_Only := True; - - Get_Imported_Directories (Main_Project, Data); - Project_Tree.Projects.Table (Main_Project) := Data; - - -- Compilation will occur in the object directory - - if Project_Of_Current_Object_Directory /= Main_Project then - Project_Of_Current_Object_Directory := Main_Project; - Change_Dir (Get_Name_String (Data.Object_Directory.Name)); - - if Verbose_Mode then - Write_Str ("Changing to object directory of """); - Write_Name (Data.Name); - Write_Str (""": """); - Write_Name (Data.Object_Directory.Display_Name); - Write_Line (""""); - end if; - end if; - - if not Data.Other_Sources_Present then - if Ada_Is_A_Language then - Mains.Reset; - - loop - declare - Main : constant String := Mains.Next_Main; - begin - exit when Main'Length = 0; - Ada_Mains.Increment_Last; - Ada_Mains.Table (Ada_Mains.Last) := new String'(Main); - end; - end loop; - - else - Osint.Fail ("project ", Project_Name, " contains no source"); - end if; - - else - Mains.Reset; - - loop - declare - Main : constant String := Mains.Next_Main; - begin - Name_Len := Main'Length; - exit when Name_Len = 0; - Name_Buffer (1 .. Name_Len) := Main; - Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len)); - Source_Name := Name_Find; - - if not Sources_Compiled.Get (Source_Name) then - Sources_Compiled.Set (Source_Name, True); - - Source_Id := Data.First_Other_Source; - while Source_Id /= No_Other_Source loop - Source := Project_Tree.Other_Sources.Table (Source_Id); - exit when Source.File_Name = Source_Name; - Source_Id := Source.Next; - end loop; - - if Source_Id = No_Other_Source then - if Ada_Is_A_Language then - Ada_Mains.Increment_Last; - Ada_Mains.Table (Ada_Mains.Last) := new String'(Main); - - else - Report_Error - (Main, - " is not a valid source of project ", - Project_Name); - end if; - - else - Compile (Source_Id, Data, Dummy); - end if; - end if; - end; - end loop; - end if; - - if Ada_Mains.Last > 0 then - - -- Invoke gnatmake for all Ada sources - - Last_Argument := 0; - Add_Argument (Dash_u, True); - - for Index in 1 .. Ada_Mains.Last loop - Add_Argument (Ada_Mains.Table (Index), True); - end loop; - - Compile_Link_With_Gnatmake (Mains_Specified => False); - end if; - end Compile_Individual_Sources; - - -------------------------------- - -- Compile_Link_With_Gnatmake -- - -------------------------------- - - procedure Compile_Link_With_Gnatmake (Mains_Specified : Boolean) is - Data : constant Project_Data := - Project_Tree.Projects.Table (Main_Project); - Success : Boolean; - - begin - -- Array Arguments may already contain some arguments, so we don't - -- set Last_Argument to 0. - - -- Get the gnatmake to invoke - - Get_Compiler (Ada_Language_Index); - - -- Specify the project file - - Add_Argument (Dash_P, True); - Add_Argument (Get_Name_String (Data.Path.Display_Name), True); - - -- Add the saved switches, if any - - for Index in 1 .. Saved_Switches.Last loop - Add_Argument (Saved_Switches.Table (Index), True); - end loop; - - -- If Mains_Specified is True, find the mains in package Mains - - if Mains_Specified then - Mains.Reset; - - loop - declare - Main : constant String := Mains.Next_Main; - begin - exit when Main'Length = 0; - Add_Argument (Main, True); - end; - end loop; - end if; - - -- Specify output file name, if any was specified on the command line - - if Output_File_Name /= null then - Add_Argument (Dash_o, True); - Add_Argument (Output_File_Name, True); - end if; - - -- Transmit some switches to gnatmake - - -- -c - - if Compile_Only then - Add_Argument (Dash_c, True); - end if; - - -- -d - - if Display_Compilation_Progress then - Add_Argument (Dash_d, True); - end if; - - -- -eL - - if Follow_Links_For_Files then - Add_Argument (Dash_eL, True); - end if; - - -- -k - - if Keep_Going then - Add_Argument (Dash_k, True); - end if; - - -- -f - - if Force_Compilations then - Add_Argument (Dash_f, True); - end if; - - -- -v - - if Verbose_Mode then - Add_Argument (Dash_v, True); - end if; - - -- -q - - if Quiet_Output then - Add_Argument (Dash_q, True); - end if; - - -- -vP1 and -vP2 - - case Current_Verbosity is - when Default => - null; - - when Medium => - Add_Argument (Dash_vP1, True); - - when High => - Add_Argument (Dash_vP2, True); - end case; - - -- If there are compiling options for Ada, transmit them to gnatmake - - if Comp_Opts.Last (Options (Ada_Language_Index)) /= 0 then - Add_Argument (Dash_cargs, 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; - - if not Compile_Only then - - -- Linking options - - if Linker_Options.Last /= 0 then - Add_Argument (Dash_largs, True); - else - Add_Argument (Dash_largs, Verbose_Mode); - end if; - - -- Add the archives - - Add_Archives (For_Gnatmake => True); - - -- If there are linking options from the command line, - -- transmit them to gnatmake. - - for Arg in 1 .. Linker_Options.Last loop - Add_Argument (Linker_Options.Table (Arg), True); - end loop; - end if; - - -- And invoke gnatmake - - Display_Command - (Compiler_Names (Ada_Language_Index).all, - Compiler_Paths (Ada_Language_Index)); - - Spawn - (Compiler_Paths (Ada_Language_Index).all, - Arguments (1 .. Last_Argument), - Success); - - -- Report an error if call to gnatmake failed - - if not Success then - Report_Error - ("invocation of ", - Compiler_Names (Ada_Language_Index).all, - " failed"); - end if; - end Compile_Link_With_Gnatmake; - - --------------------- - -- Compile_Sources -- - --------------------- - - procedure Compile_Sources is - Data : Project_Data; - Source_Id : Other_Source_Id; - Source : Other_Source; - - Local_Errors : Boolean := False; - -- Set to True when there is a compilation error. Used only when - -- Keep_Going is True, to inhibit the building of the archive. - - Need_To_Compile : Boolean; - -- Set to True when a source needs to be compiled/recompiled - - Need_To_Rebuild_Archive : Boolean := Force_Compilations; - -- True when the archive needs to be built/rebuilt unconditionally - - Total_Number_Of_Sources : Int := 0; - - Current_Source_Number : Int := 0; - - begin - -- First, get the number of sources - - for Project in Project_Table.First .. - Project_Table.Last (Project_Tree.Projects) - loop - Data := Project_Tree.Projects.Table (Project); - - if not Data.Virtual and then Data.Other_Sources_Present then - Source_Id := Data.First_Other_Source; - while Source_Id /= No_Other_Source loop - Source := Project_Tree.Other_Sources.Table (Source_Id); - Total_Number_Of_Sources := Total_Number_Of_Sources + 1; - Source_Id := Source.Next; - end loop; - end if; - end loop; - - -- Loop through project files - - for Project in Project_Table.First .. - Project_Table.Last (Project_Tree.Projects) - loop - Local_Errors := False; - Data := Project_Tree.Projects.Table (Project); - - -- Nothing to do when no sources of language other than Ada - - if (not Data.Virtual) and then Data.Other_Sources_Present then - - -- If the imported directory switches are unknown, compute them - - if not Data.Include_Data_Set then - Get_Imported_Directories (Project, Data); - Data.Include_Data_Set := True; - Project_Tree.Projects.Table (Project) := Data; - end if; - - Need_To_Rebuild_Archive := Force_Compilations; - - -- Compilation will occur in the object directory - - if Project_Of_Current_Object_Directory /= Project then - Project_Of_Current_Object_Directory := Project; - Change_Dir (Get_Name_String (Data.Object_Directory.Name)); - - if Verbose_Mode then - Write_Str ("Changing to object directory of """); - Write_Name (Data.Display_Name); - Write_Str (""": """); - Write_Name (Data.Object_Directory.Display_Name); - Write_Line (""""); - end if; - end if; - - -- Process each source one by one - - Source_Id := Data.First_Other_Source; - while Source_Id /= No_Other_Source loop - Source := Project_Tree.Other_Sources.Table (Source_Id); - Current_Source_Number := Current_Source_Number + 1; - Need_To_Compile := Force_Compilations; - - -- Check if compilation is needed - - if not Need_To_Compile then - Check_Compilation_Needed (Source, Need_To_Compile); - end if; - - -- Proceed, if compilation is needed - - if Need_To_Compile then - - -- If a source is compiled/recompiled, of course the - -- archive will need to be built/rebuilt. - - Need_To_Rebuild_Archive := True; - Compile (Source_Id, Data, Local_Errors); - end if; - - if Display_Compilation_Progress then - Write_Str ("completed "); - Write_Int (Current_Source_Number); - Write_Str (" out of "); - Write_Int (Total_Number_Of_Sources); - Write_Str (" ("); - Write_Int - ((Current_Source_Number * 100) / Total_Number_Of_Sources); - Write_Str ("%)..."); - Write_Eol; - end if; - - -- Next source, if any - - Source_Id := Source.Next; - end loop; - - if Need_To_Rebuild_Archive and then (not Data.Library) then - Need_To_Rebuild_Global_Archive := True; - end if; - - -- If there was no compilation error and -c was not used, - -- build / rebuild the archive if necessary. - - if not Local_Errors - and then Data.Library - and then not Data.Langs (Ada_Language_Index) - and then not Compile_Only - then - Build_Library (Project, Need_To_Rebuild_Archive); - end if; - end if; - end loop; - end Compile_Sources; - - --------------- - -- Copyright -- - --------------- - - procedure Copyright is - begin - -- Only output the Copyright notice once - - if not Copyright_Output then - Copyright_Output := True; - Write_Eol; - Write_Str ("GPRMAKE "); - Write_Str (Gnatvsn.Gnat_Version_String); - Write_Str (" Copyright 2004-"); - Write_Str (Gnatvsn.Current_Year); - Write_Str (" Free Software Foundation, Inc."); - Write_Eol; - end if; - end Copyright; - - ------------------------------------ - -- Create_Archive_Dependency_File -- - ------------------------------------ - - procedure Create_Archive_Dependency_File - (Name : String; - First_Source : Other_Source_Id) - is - Source_Id : Other_Source_Id; - Source : Other_Source; - Dep_File : Ada.Text_IO.File_Type; - - begin - -- Create the file in Append mode, to avoid automatic insertion of - -- an end of line if file is empty. - - Create (Dep_File, Append_File, Name); - - Source_Id := First_Source; - while Source_Id /= No_Other_Source loop - Source := Project_Tree.Other_Sources.Table (Source_Id); - Put_Line (Dep_File, Get_Name_String (Source.Object_Name)); - Put_Line (Dep_File, String (Source.Object_TS)); - Source_Id := Source.Next; - end loop; - - Close (Dep_File); - - exception - when others => - if Is_Open (Dep_File) then - Close (Dep_File); - end if; - end Create_Archive_Dependency_File; - - ------------------------------------------- - -- Create_Global_Archive_Dependency_File -- - ------------------------------------------- - - procedure Create_Global_Archive_Dependency_File (Name : String) is - Source_Id : Other_Source_Id; - Source : Other_Source; - Dep_File : Ada.Text_IO.File_Type; - - begin - -- Create the file in Append mode, to avoid automatic insertion of - -- an end of line if file is empty. - - Create (Dep_File, Append_File, Name); - - -- Get all the object files of non-Ada sources in non-library projects - - for Project in Project_Table.First .. - Project_Table.Last (Project_Tree.Projects) - loop - if not Project_Tree.Projects.Table (Project).Library then - Source_Id := - Project_Tree.Projects.Table (Project).First_Other_Source; - while Source_Id /= No_Other_Source loop - Source := Project_Tree.Other_Sources.Table (Source_Id); - - -- Put only those object files that are in the global archive - - if Is_Included_In_Global_Archive - (Source.Object_Name, Project) - then - Put_Line (Dep_File, Get_Name_String (Source.Object_Path)); - Put_Line (Dep_File, String (Source.Object_TS)); - end if; - - Source_Id := Source.Next; - end loop; - end if; - end loop; - - Close (Dep_File); - - exception - when others => - if Is_Open (Dep_File) then - Close (Dep_File); - end if; - end Create_Global_Archive_Dependency_File; - - --------------------- - -- Display_Command -- - --------------------- - - procedure Display_Command - (Name : String; - Path : String_Access; - CPATH : String_Access := null; - Ellipse : Boolean := False) - is - Display_Ellipse : Boolean := Ellipse; - - begin - -- Only display the command in Verbose Mode (-v) or when - -- not in Quiet Output (no -q). - - if Verbose_Mode or (not Quiet_Output) then - - -- In Verbose Mode output the full path of the spawned process - - if Verbose_Mode then - if CPATH /= null then - Write_Str ("CPATH = "); - Write_Line (CPATH.all); - end if; - - Write_Str (Path.all); - - else - Write_Str (Name); - end if; - - -- Display only the arguments for which the display flag is set - -- (in Verbose Mode, the display flag is set for all arguments) - - for Arg in 1 .. Last_Argument loop - if Arguments_Displayed (Arg) then - Write_Char (' '); - Write_Str (Arguments (Arg).all); - - elsif Display_Ellipse then - Write_Str (" ..."); - Display_Ellipse := False; - end if; - end loop; - - Write_Eol; - end if; - end Display_Command; - - ------------------ - -- Get_Compiler -- - ------------------ - - procedure Get_Compiler (For_Language : First_Language_Indexes) is - Data : constant Project_Data := - Project_Tree.Projects.Table (Main_Project); - - Ide : constant Package_Id := - Value_Of - (Name_Ide, - In_Packages => Data.Decl.Packages, - In_Tree => Project_Tree); - -- The id of the package IDE in the project file - - Compiler : constant Variable_Value := - Value_Of - (Name => Language_Names.Table (For_Language), - Index => 0, - Attribute_Or_Array_Name => Name_Compiler_Command, - In_Package => Ide, - In_Tree => Project_Tree); - -- The value of Compiler_Command ("language") in package IDE, if defined - - begin - -- No need to do it again if the compiler is known for this language - - if Compiler_Names (For_Language) = null then - - -- If compiler command is not defined for this language in package - -- IDE, use the default compiler for this language. - - if Compiler = Nil_Variable_Value then - if For_Language in Default_Compiler_Names'Range then - Compiler_Names (For_Language) := - Default_Compiler_Names (For_Language); - - else - Osint.Fail - ("unknown compiler name for language """, - Get_Name_String (Language_Names.Table (For_Language)), - """"); - end if; - - else - Compiler_Names (For_Language) := - new String'(Get_Name_String (Compiler.Value)); - end if; - - -- Check we have a GCC compiler (name ends with "gcc" or "g++") - - declare - Comp_Name : constant String := Compiler_Names (For_Language).all; - Last3 : String (1 .. 3); - begin - if Comp_Name'Length >= 3 then - Last3 := Comp_Name (Comp_Name'Last - 2 .. Comp_Name'Last); - Compiler_Is_Gcc (For_Language) := - (Last3 = "gcc") or (Last3 = "g++"); - else - Compiler_Is_Gcc (For_Language) := False; - end if; - end; - - -- Locate the compiler on the path - - Compiler_Paths (For_Language) := - Locate_Exec_On_Path (Compiler_Names (For_Language).all); - - -- Fail if compiler cannot be found - - if Compiler_Paths (For_Language) = null then - if For_Language = Ada_Language_Index then - Osint.Fail - ("unable to locate """, - Compiler_Names (For_Language).all, - """"); - - else - Osint.Fail - ("unable to locate " & - Get_Name_String (Language_Names.Table (For_Language)), - " compiler """, Compiler_Names (For_Language).all & '"'); - end if; - end if; - end if; - end Get_Compiler; - - ------------------------------ - -- Get_Imported_Directories -- - ------------------------------ - - procedure Get_Imported_Directories - (Project : Project_Id; - Data : in out Project_Data) - is - Imported_Projects : Project_List := Data.Imported_Projects; - - Path_Length : Natural := 0; - Position : Natural := 0; - - procedure Add (Source_Dirs : String_List_Id); - -- Add a list of source directories - - procedure Recursive_Get_Dirs (Prj : Project_Id); - -- Recursive procedure to get the source directories of this project - -- file and of the project files it imports, in the correct order. - - --------- - -- Add -- - --------- - - procedure Add (Source_Dirs : String_List_Id) is - Element_Id : String_List_Id; - Element : String_Element; - Add_Arg : Boolean := True; - - begin - -- Add each source directory path name, preceded by "-I" to Arguments - - Element_Id := Source_Dirs; - while Element_Id /= Nil_String loop - Element := Project_Tree.String_Elements.Table (Element_Id); - - if Element.Value /= No_Name then - Get_Name_String (Element.Display_Value); - - if Name_Len > 0 then - - -- Remove a trailing directory separator: this may cause - -- problems on Windows. - - if Name_Len > 1 - and then Name_Buffer (Name_Len) = Directory_Separator - then - Name_Len := Name_Len - 1; - end if; - - declare - Arg : constant String := - "-I" & Name_Buffer (1 .. Name_Len); - begin - -- Check if directory is already in the list. If it is, - -- no need to put it there again. - - Add_Arg := True; - - for Index in 1 .. Last_Argument loop - if Arguments (Index).all = Arg then - Add_Arg := False; - exit; - end if; - end loop; - - if Add_Arg then - if Path_Length /= 0 then - Path_Length := Path_Length + 1; - end if; - - Path_Length := Path_Length + Name_Len; - - Add_Argument (Arg, True); - end if; - end; - end if; - end if; - - Element_Id := Element.Next; - end loop; - end Add; - - ------------------------ - -- Recursive_Get_Dirs -- - ------------------------ - - procedure Recursive_Get_Dirs (Prj : Project_Id) is - Data : Project_Data; - Imported : Project_List; - - begin - -- Nothing to do if project is undefined - - if Prj /= No_Project then - Data := Project_Tree.Projects.Table (Prj); - - -- Nothing to do if project has already been processed - - if not Data.Seen then - - -- Mark the project as processed, to avoid multiple processing - -- of the same project. - - Project_Tree.Projects.Table (Prj).Seen := True; - - -- Add the source directories of this project - - if not Data.Virtual then - Add (Data.Source_Dirs); - end if; - - Recursive_Get_Dirs (Data.Extends); - - -- Call itself for all imported projects, if any - - Imported := Data.Imported_Projects; - while Imported /= Empty_Project_List loop - Recursive_Get_Dirs - (Project_Tree.Project_Lists.Table (Imported).Project); - Imported := - Project_Tree.Project_Lists.Table (Imported).Next; - end loop; - end if; - end if; - end Recursive_Get_Dirs; - - -- Start of processing for Get_Imported_Directories - - begin - -- First, mark all project as not processed - - for J in Project_Table.First .. - Project_Table.Last (Project_Tree.Projects) - loop - Project_Tree.Projects.Table (J).Seen := False; - end loop; - - -- Empty Arguments - - Last_Argument := 0; - - -- Process this project individually, project data are already known - - Project_Tree.Projects.Table (Project).Seen := True; - - Add (Data.Source_Dirs); - - Recursive_Get_Dirs (Data.Extends); - - while Imported_Projects /= Empty_Project_List loop - Recursive_Get_Dirs - (Project_Tree.Project_Lists.Table - (Imported_Projects).Project); - Imported_Projects := Project_Tree.Project_Lists.Table - (Imported_Projects).Next; - end loop; - - Data.Imported_Directories_Switches := - new Argument_List'(Arguments (1 .. Last_Argument)); - - -- Create the Include_Path, from the Arguments - - Data.Include_Path := new String (1 .. Path_Length); - Data.Include_Path (1 .. Arguments (1)'Length - 2) := - Arguments (1)(Arguments (1)'First + 2 .. Arguments (1)'Last); - Position := Arguments (1)'Length - 2; - - for Arg in 2 .. Last_Argument loop - Position := Position + 1; - Data.Include_Path (Position) := Path_Separator; - Data.Include_Path - (Position + 1 .. Position + Arguments (Arg)'Length - 2) := - Arguments (Arg)(Arguments (Arg)'First + 2 .. Arguments (Arg)'Last); - Position := Position + Arguments (Arg)'Length - 2; - end loop; - - Last_Argument := 0; - end Get_Imported_Directories; - - ------------- - -- Gprmake -- - ------------- - - procedure Gprmake is - begin - Makegpr.Initialize; - - if Verbose_Mode then - Write_Eol; - Write_Str ("Parsing project file """); - Write_Str (Project_File_Name.all); - Write_Str ("""."); - Write_Eol; - end if; - - -- Parse and process project files for other languages (not for Ada) - - Prj.Pars.Parse - (Project => Main_Project, - In_Tree => Project_Tree, - Project_File_Name => Project_File_Name.all, - Packages_To_Check => Packages_To_Check); - - -- Fail if parsing/processing was unsuccessful - - if Main_Project = No_Project then - Osint.Fail ("""", Project_File_Name.all, """ processing failed"); - end if; - - if Verbose_Mode then - Write_Eol; - Write_Str ("Parsing of project file """); - Write_Str (Project_File_Name.all); - Write_Str (""" is finished."); - Write_Eol; - end if; - - -- If -f was specified, we will certainly need to link (except when - -- -u or -c were specified, of course). - - Need_To_Relink := Force_Compilations; - - if Unique_Compile then - if Mains.Number_Of_Mains = 0 then - Osint.Fail - ("No source specified to compile in 'unique compile' mode"); - else - Compile_Individual_Sources; - Report_Total_Errors ("compilation"); - end if; - - else - declare - Data : constant Prj.Project_Data := - Project_Tree.Projects.Table (Main_Project); - begin - if Data.Library and then Mains.Number_Of_Mains /= 0 then - Osint.Fail - ("Cannot specify mains on the command line " & - "for a Library Project"); - end if; - - -- First check for C++, to link libraries with g++, - -- rather than gcc. - - Check_For_C_Plus_Plus; - - -- Compile sources and build archives for library project, - -- if necessary. - - Compile_Sources; - - -- When Keep_Going is True, if we had some errors, fail now, - -- reporting the number of compilation errors. - -- Do not attempt to link. - - Report_Total_Errors ("compilation"); - - -- If -c was not specified, link the executables, - -- if there are any. - - if not Compile_Only - and then not Data.Library - and then Data.Object_Directory /= No_Path_Information - then - Build_Global_Archive; - Link_Executables; - end if; - - -- When Keep_Going is True, if we had some errors, fail, reporting - -- the number of linking errors. - - Report_Total_Errors ("linking"); - end; - end if; - end Gprmake; - - ---------------- - -- Initialize -- - ---------------- - - procedure Initialize is - begin - Set_Mode (Ada_Only); - - -- Do some necessary package initializations - - Csets.Initialize; - Namet.Initialize; - Snames.Initialize; - Prj.Initialize (Project_Tree); - Mains.Delete; - - -- Add the directory where gprmake is invoked in front of the path, - -- if gprmake is invoked from a bin directory or with directory - -- information. Only do this if the platform is not VMS, where the - -- notion of path does not really exist. - - -- Below code shares nasty code duplication with make.adb code??? - - if not OpenVMS then - declare - Prefix : constant String := Executable_Prefix_Path; - Command : constant String := Command_Name; - - begin - if Prefix'Length > 0 then - declare - PATH : constant String := - Prefix & Directory_Separator & "bin" & - Path_Separator & - Getenv ("PATH").all; - begin - Setenv ("PATH", PATH); - end; - - else - for Index in reverse Command'Range loop - if Command (Index) = Directory_Separator then - declare - Absolute_Dir : constant String := - Normalize_Pathname - (Command (Command'First .. Index)); - PATH : constant String := - Absolute_Dir & - Path_Separator & - Getenv ("PATH").all; - begin - Setenv ("PATH", PATH); - end; - - exit; - end if; - end loop; - end if; - end; - end if; - - -- Set Name_Ide and Name_Compiler_Command - - Name_Len := 0; - Add_Str_To_Name_Buffer ("ide"); - Name_Ide := Name_Find; - - Name_Len := 0; - Add_Str_To_Name_Buffer ("compiler_command"); - Name_Compiler_Command := Name_Find; - - -- Make sure the Saved_Switches table is empty - - Saved_Switches.Set_Last (0); - - -- Get the command line arguments - - Scan_Args : for Next_Arg in 1 .. Argument_Count loop - Scan_Arg (Argument (Next_Arg)); - end loop Scan_Args; - - -- Fail if command line ended with "-P" - - if Project_File_Name_Expected then - Osint.Fail ("project file name missing after -P"); - - -- Or if it ended with "-o" - - elsif Output_File_Name_Expected then - Osint.Fail ("output file name missing after -o"); - end if; - - -- If no project file was specified, display the usage and fail - - if Project_File_Name = null then - Usage; - Exit_Program (E_Success); - end if; - - -- To be able of finding libgnat.a in MLib.Tgt, we need to have the - -- default search dirs established in Osint. - - Osint.Add_Default_Search_Dirs; - end Initialize; - - ----------------------------------- - -- Is_Included_In_Global_Archive -- - ----------------------------------- - - function Is_Included_In_Global_Archive - (Object_Name : File_Name_Type; - Project : Project_Id) return Boolean - is - Data : Project_Data := Project_Tree.Projects.Table (Project); - Source : Other_Source_Id; - - begin - while Data.Extended_By /= No_Project loop - Data := Project_Tree.Projects.Table (Data.Extended_By); - - Source := Data.First_Other_Source; - while Source /= No_Other_Source loop - if Project_Tree.Other_Sources.Table (Source).Object_Name = - Object_Name - then - return False; - else - Source := - Project_Tree.Other_Sources.Table (Source).Next; - end if; - end loop; - end loop; - - return True; - end Is_Included_In_Global_Archive; - - ---------------------- - -- Link_Executables -- - ---------------------- - - procedure Link_Executables is - Data : constant Project_Data := - Project_Tree.Projects.Table (Main_Project); - - Mains_Specified : constant Boolean := Mains.Number_Of_Mains /= 0; - -- True if main sources were specified on the command line - - Object_Dir : constant String := - Get_Name_String (Data.Object_Directory.Display_Name); - -- Path of the object directory of the main project - - Source_Id : Other_Source_Id; - Source : Other_Source; - Success : Boolean; - - Linker_Name : String_Access; - Linker_Path : String_Access; - -- The linker name and path, when linking is not done by gnatlink - - Link_Done : Boolean := False; - -- Set to True when the linker is invoked directly (not through - -- gnatmake) to be able to report if mains were up to date at the end - -- of execution. - - procedure Add_C_Plus_Plus_Link_For_Gnatmake; - -- Add the --LINK= switch for gnatlink, depending on the C++ compiler - - procedure Check_Time_Stamps (Exec_Time_Stamp : Time_Stamp_Type); - -- Check if there is an archive that is more recent than the executable - -- to decide if we need to relink. - - procedure Choose_C_Plus_Plus_Link_Process; - -- If the C++ compiler is not g++, create the correct script to link - - procedure Link_Foreign - (Main : String; - Main_Id : File_Name_Type; - Source : Other_Source); - -- Link a non-Ada main, when there is no Ada code - - --------------------------------------- - -- Add_C_Plus_Plus_Link_For_Gnatmake -- - --------------------------------------- - - procedure Add_C_Plus_Plus_Link_For_Gnatmake is - begin - Add_Argument - ("--LINK=" & Compiler_Names (C_Plus_Plus_Language_Index).all, - Verbose_Mode); - end Add_C_Plus_Plus_Link_For_Gnatmake; - - ----------------------- - -- Check_Time_Stamps -- - ----------------------- - - procedure Check_Time_Stamps (Exec_Time_Stamp : Time_Stamp_Type) is - Prj_Data : Project_Data; - - begin - for Prj in Project_Table.First .. - Project_Table.Last (Project_Tree.Projects) - loop - Prj_Data := Project_Tree.Projects.Table (Prj); - - -- There is an archive only in project - -- files with sources other than Ada - -- sources. - - if Data.Other_Sources_Present then - declare - Archive_Path : constant String := Get_Name_String - (Prj_Data.Object_Directory.Display_Name) - & Directory_Separator - & "lib" & Get_Name_String (Prj_Data.Display_Name) - & '.' & Archive_Ext; - Archive_TS : Time_Stamp_Type; - begin - Name_Len := 0; - Add_Str_To_Name_Buffer (Archive_Path); - Archive_TS := File_Stamp (File_Name_Type'(Name_Find)); - - -- If the archive is later than the - -- executable, we need to relink. - - if Archive_TS /= Empty_Time_Stamp - and then - Exec_Time_Stamp < Archive_TS - then - Need_To_Relink := True; - - if Verbose_Mode then - Write_Str (" -> "); - Write_Str (Archive_Path); - Write_Str (" has time stamp "); - Write_Str ("later than "); - Write_Line ("executable"); - end if; - - exit; - end if; - end; - end if; - end loop; - end Check_Time_Stamps; - - ------------------------------------- - -- Choose_C_Plus_Plus_Link_Process -- - ------------------------------------- - - procedure Choose_C_Plus_Plus_Link_Process is - begin - if Compiler_Names (C_Plus_Plus_Language_Index) = null then - Get_Compiler (C_Plus_Plus_Language_Index); - end if; - end Choose_C_Plus_Plus_Link_Process; - - ------------------ - -- Link_Foreign -- - ------------------ - - procedure Link_Foreign - (Main : String; - Main_Id : File_Name_Type; - Source : Other_Source) - is - Executable_Name : constant String := - Get_Name_String - (Executable_Of - (Project => Main_Project, - In_Tree => Project_Tree, - Main => Main_Id, - Index => 0, - Ada_Main => False)); - -- File name of the executable - - Executable_Path : constant String := - Get_Name_String - (Data.Exec_Directory.Display_Name) & - Directory_Separator & Executable_Name; - -- Path name of the executable - - Exec_Time_Stamp : Time_Stamp_Type; - - begin - -- Now, check if the executable is up to date. It is considered - -- up to date if its time stamp is not earlier that the time stamp - -- of any archive. Only do that if we don't know if we need to link. - - if not Need_To_Relink then - - -- Get the time stamp of the executable - - Name_Len := 0; - Add_Str_To_Name_Buffer (Executable_Path); - Exec_Time_Stamp := File_Stamp (File_Name_Type'(Name_Find)); - - if Verbose_Mode then - Write_Str (" Checking executable "); - Write_Line (Executable_Name); - end if; - - -- If executable does not exist, we need to link - - if Exec_Time_Stamp = Empty_Time_Stamp then - Need_To_Relink := True; - - if Verbose_Mode then - Write_Line (" -> not found"); - end if; - - -- Otherwise, get the time stamps of each archive. If one of - -- them is found later than the executable, we need to relink. - - else - Check_Time_Stamps (Exec_Time_Stamp); - end if; - - -- If Need_To_Relink is False, we are done - - if Verbose_Mode and (not Need_To_Relink) then - Write_Line (" -> up to date"); - end if; - end if; - - -- Prepare to link - - if Need_To_Relink then - Link_Done := True; - - Last_Argument := 0; - - -- Specify the executable path name - - Add_Argument (Dash_o, True); - Add_Argument - (Get_Name_String (Data.Exec_Directory.Display_Name) & - Directory_Separator & - Get_Name_String - (Executable_Of - (Project => Main_Project, - In_Tree => Project_Tree, - Main => Main_Id, - Index => 0, - Ada_Main => False)), - True); - - -- Specify the object file of the main source - - Add_Argument - (Object_Dir & Directory_Separator & - Get_Name_String (Source.Object_Name), - True); - - -- Add all the archives, in a correct order - - Add_Archives (For_Gnatmake => False); - - -- Add the switches specified in package Linker of - -- the main project. - - Add_Switches - (Data => Data, - Proc => Linker, - Language => Source.Language, - File_Name => Main_Id); - - -- Add the switches specified in attribute - -- Linker_Options of packages Linker. - - if Link_Options_Switches = null then - Link_Options_Switches := - new Argument_List' - (Linker_Options_Switches (Main_Project, Project_Tree)); - end if; - - Add_Arguments (Link_Options_Switches.all, True); - - -- Add the linking options specified on the - -- command line. - - for Arg in 1 .. Linker_Options.Last loop - Add_Argument (Linker_Options.Table (Arg), True); - end loop; - - -- If there are shared libraries and the run path - -- option is supported, add the run path switch. - - if Lib_Path.Last > 0 then - Add_Argument - (Path_Option.all & - String (Lib_Path.Table (1 .. Lib_Path.Last)), - Verbose_Mode); - end if; - - -- And invoke the linker - - Display_Command (Linker_Name.all, Linker_Path); - Spawn - (Linker_Path.all, - Arguments (1 .. Last_Argument), - Success); - - if not Success then - Report_Error ("could not link ", Main); - end if; - end if; - end Link_Foreign; - - -- Start of processing of Link_Executables - - begin - -- If no mains specified, get mains from attribute Main, if it exists - - if not Mains_Specified then - declare - Element_Id : String_List_Id; - Element : String_Element; - - begin - Element_Id := Data.Mains; - while Element_Id /= Nil_String loop - Element := Project_Tree.String_Elements.Table (Element_Id); - - if Element.Value /= No_Name then - Mains.Add_Main (Get_Name_String (Element.Value)); - end if; - - Element_Id := Element.Next; - end loop; - end; - end if; - - if Mains.Number_Of_Mains = 0 then - - -- If the attribute Main is an empty list or not specified, - -- there is nothing to do. - - if Verbose_Mode then - Write_Line ("No main to link"); - end if; - return; - end if; - - -- Check if -o was used for several mains - - if Output_File_Name /= null and then Mains.Number_Of_Mains > 1 then - Osint.Fail ("cannot specify an executable name for several mains"); - end if; - - -- Check how we are going to do the link - - if not Data.Other_Sources_Present then - - -- Only Ada sources in the main project, and even maybe not - - if Data.Extends = No_Project and then - not Data.Langs (Ada_Language_Index) - then - -- Fail if the main project has no source of any language - - Osint.Fail - ("project """, - Get_Name_String (Data.Name), - """ has no sources, so no main can be linked"); - - else - -- Only Ada sources in the main project, call gnatmake directly - - Last_Argument := 0; - - -- Choose correct linker if there is C++ code in other projects - - if C_Plus_Plus_Is_Used then - Choose_C_Plus_Plus_Link_Process; - Add_Argument (Dash_largs, Verbose_Mode); - Add_C_Plus_Plus_Link_For_Gnatmake; - Add_Argument (Dash_margs, Verbose_Mode); - end if; - - Compile_Link_With_Gnatmake (Mains_Specified); - end if; - - else - -- There are other language sources. First check if there are also - -- sources in Ada. - - if Data.Langs (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 - -- will be deemed to be an Ada main. - - -- Find the mains of the other languages and the Ada mains - - Mains.Reset; - Ada_Mains.Set_Last (0); - Other_Mains.Set_Last (0); - - -- For each main - - loop - declare - Main : constant String := Mains.Next_Main; - Main_Id : File_Name_Type; - - begin - exit when Main'Length = 0; - - -- Get the main file name - - Name_Len := 0; - Add_Str_To_Name_Buffer (Main); - Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len)); - Main_Id := Name_Find; - - -- Check if it is a source of a language other than Ada - - Source_Id := Data.First_Other_Source; - while Source_Id /= No_Other_Source loop - Source := - Project_Tree.Other_Sources.Table (Source_Id); - exit when Source.File_Name = Main_Id; - Source_Id := Source.Next; - end loop; - - -- If it is not, put it in the list of Ada mains - - if Source_Id = No_Other_Source then - Ada_Mains.Increment_Last; - Ada_Mains.Table (Ada_Mains.Last) := new String'(Main); - - -- Otherwise, put it in the list of other mains - - else - Other_Mains.Increment_Last; - Other_Mains.Table (Other_Mains.Last) := Source; - end if; - end; - end loop; - - -- If C++ is one of the other language, create the shell script - -- to do the link. - - if C_Plus_Plus_Is_Used then - Choose_C_Plus_Plus_Link_Process; - end if; - - -- Call gnatmake with the necessary switches for each non-Ada - -- main, if there are some. - - for Main in 1 .. Other_Mains.Last loop - declare - Source : constant Other_Source := Other_Mains.Table (Main); - - begin - Last_Argument := 0; - - -- Add -o if -o was specified - - if Output_File_Name = null then - Add_Argument (Dash_o, True); - Add_Argument - (Get_Name_String - (Executable_Of - (Project => Main_Project, - In_Tree => Project_Tree, - Main => Other_Mains.Table (Main).File_Name, - Index => 0, - Ada_Main => False)), - True); - end if; - - -- Call gnatmake with the -B switch - - Add_Argument (Dash_B, True); - - -- Add to the linking options the object file of the source - - Add_Argument (Dash_largs, Verbose_Mode); - Add_Argument - (Get_Name_String (Source.Object_Name), Verbose_Mode); - - -- If C++ is one of the language, add the --LINK switch - -- to the linking switches. - - if C_Plus_Plus_Is_Used then - Add_C_Plus_Plus_Link_For_Gnatmake; - end if; - - -- Add -margs so that the following switches are for - -- gnatmake - - Add_Argument (Dash_margs, Verbose_Mode); - - -- And link with gnatmake - - Compile_Link_With_Gnatmake (Mains_Specified => False); - end; - end loop; - - -- If there are also Ada mains, call gnatmake for all these mains - - if Ada_Mains.Last /= 0 then - Last_Argument := 0; - - -- Put all the Ada mains as the first arguments - - for Main in 1 .. Ada_Mains.Last loop - Add_Argument (Ada_Mains.Table (Main).all, True); - end loop; - - -- If C++ is one of the languages, add the --LINK switch to - -- the linking switches. - - if Data.Langs (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); - end if; - - -- And link with gnatmake - - Compile_Link_With_Gnatmake (Mains_Specified => False); - end if; - - else - -- No Ada source in main project - - -- First, get the linker to invoke - - if Data.Langs (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 (C_Language_Index); - Linker_Name := Compiler_Names (C_Language_Index); - Linker_Path := Compiler_Paths (C_Language_Index); - end if; - - Link_Done := False; - - Mains.Reset; - - -- Get each main, check if it is a source of the main project, - -- and if it is, invoke the linker. - - loop - declare - Main : constant String := Mains.Next_Main; - Main_Id : File_Name_Type; - - begin - exit when Main'Length = 0; - - -- Get the file name of the main - - Name_Len := 0; - Add_Str_To_Name_Buffer (Main); - Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len)); - Main_Id := Name_Find; - - -- Check if it is a source of the main project file - - Source_Id := Data.First_Other_Source; - while Source_Id /= No_Other_Source loop - Source := - Project_Tree.Other_Sources.Table (Source_Id); - exit when Source.File_Name = Main_Id; - Source_Id := Source.Next; - end loop; - - -- Report an error if it is not - - if Source_Id = No_Other_Source then - Report_Error - (Main, "is not a source of project ", - Get_Name_String (Data.Name)); - - else - Link_Foreign (Main, Main_Id, Source); - end if; - end; - end loop; - - -- If no linking was done, report it, except in Quiet Output - - if (Verbose_Mode or (not Quiet_Output)) and (not Link_Done) then - Osint.Write_Program_Name; - - if Mains.Number_Of_Mains = 1 then - - -- If there is only one executable, report its name too - - Write_Str (": """); - Mains.Reset; - - declare - Main : constant String := Mains.Next_Main; - Main_Id : File_Name_Type; - begin - Name_Len := 0; - Add_Str_To_Name_Buffer (Main); - Main_Id := Name_Find; - Write_Str - (Get_Name_String - (Executable_Of - (Project => Main_Project, - In_Tree => Project_Tree, - Main => Main_Id, - Index => 0, - Ada_Main => False))); - Write_Line (""" up to date"); - end; - - else - Write_Line (": all executables up to date"); - end if; - end if; - end if; - end if; - end Link_Executables; - - ------------------ - -- Report_Error -- - ------------------ - - procedure Report_Error - (S1 : String; - S2 : String := ""; - S3 : String := "") - is - begin - -- If Keep_Going is True, output error message preceded by error header - - if Keep_Going then - Total_Number_Of_Errors := Total_Number_Of_Errors + 1; - Write_Str (Error_Header); - Write_Str (S1); - Write_Str (S2); - Write_Str (S3); - Write_Eol; - - -- Otherwise just fail - - else - Osint.Fail (S1, S2, S3); - end if; - end Report_Error; - - ------------------------- - -- Report_Total_Errors -- - ------------------------- - - procedure Report_Total_Errors (Kind : String) is - begin - if Total_Number_Of_Errors /= 0 then - if Total_Number_Of_Errors = 1 then - Osint.Fail - ("One ", Kind, " error"); - - else - Osint.Fail - ("Total of" & Total_Number_Of_Errors'Img, - ' ' & Kind & " errors"); - end if; - end if; - end Report_Total_Errors; - - -------------- - -- Scan_Arg -- - -------------- - - procedure Scan_Arg (Arg : String) is - begin - pragma Assert (Arg'First = 1); - - if Arg'Length = 0 then - return; - end if; - - -- If preceding switch was -P, a project file name need to be - -- specified, not a switch. - - if Project_File_Name_Expected then - if Arg (1) = '-' then - Osint.Fail ("project file name missing after -P"); - else - Project_File_Name_Expected := False; - Project_File_Name := new String'(Arg); - end if; - - -- If preceding switch was -o, an executable name need to be - -- specified, not a switch. - - elsif Output_File_Name_Expected then - if Arg (1) = '-' then - Osint.Fail ("output file name missing after -o"); - else - Output_File_Name_Expected := False; - Output_File_Name := new String'(Arg); - end if; - - -- Set the processor/language for the following switches - - -- -cargs: Ada compiler arguments - - 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 - Current_Language := Language_Indexes.Get (Lang); - - 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 - Current_Processor := Linker; - - -- -gargs: gprmake - - elsif Arg = "-gargs" then - Current_Processor := None; - - -- A special test is needed for the -o switch within a -largs since - -- that is another way to specify the name of the final executable. - - elsif Current_Processor = Linker and then Arg = "-o" then - Osint.Fail - ("switch -o not allowed within a -largs. Use -o directly."); - - -- If current processor is not gprmake directly, store the option in - -- the appropriate table. - - elsif Current_Processor /= None then - Add_Option (Arg); - - -- Switches start with '-' - - elsif Arg (1) = '-' then - if Arg'Length > 3 and then Arg (1 .. 3) = "-aP" then - Add_Search_Project_Directory (Arg (4 .. Arg'Last)); - - -- Record the switch, so that it is passed to gnatmake, if - -- gnatmake is called. - - Saved_Switches.Append (new String'(Arg)); - - elsif Arg = "-c" then - Compile_Only := True; - - -- Make sure that when a main is specified and switch -c is used, - -- only the main(s) is/are compiled. - - if Mains.Number_Of_Mains > 0 then - Unique_Compile := True; - end if; - - elsif Arg = "-d" then - Display_Compilation_Progress := True; - - elsif Arg = "-eL" then - Follow_Links_For_Files := True; - - elsif Arg = "-f" then - Force_Compilations := True; - - elsif Arg = "-h" then - Usage; - - elsif Arg = "-k" then - Keep_Going := True; - - elsif Arg = "-o" then - if Output_File_Name /= null then - Osint.Fail ("cannot specify several -o switches"); - - else - Output_File_Name_Expected := True; - end if; - - elsif Arg'Length >= 2 and then Arg (2) = 'P' then - if Project_File_Name /= null then - Osint.Fail ("cannot have several project files specified"); - - elsif Arg'Length = 2 then - Project_File_Name_Expected := True; - - else - Project_File_Name := new String'(Arg (3 .. Arg'Last)); - end if; - - elsif Arg = "-p" or else Arg = "--create-missing-dirs" then - Setup_Projects := True; - - elsif Arg = "-q" then - Quiet_Output := True; - - elsif Arg = "-u" then - Unique_Compile := True; - Compile_Only := True; - - elsif Arg = "-v" then - Verbose_Mode := True; - Copyright; - - elsif Arg'Length = 4 and then Arg (1 .. 3) = "-vP" - and then Arg (4) in '0' .. '2' - then - case Arg (4) is - when '0' => - Current_Verbosity := Prj.Default; - when '1' => - Current_Verbosity := Prj.Medium; - when '2' => - Current_Verbosity := Prj.High; - when others => - null; - end case; - - elsif Arg'Length >= 3 and then Arg (2) = 'X' - and then Is_External_Assignment (Arg) - then - -- Is_External_Assignment has side effects when it returns True - - -- Record the -X switch, so that it will be passed to gnatmake, - -- if gnatmake is called. - - Saved_Switches.Append (new String'(Arg)); - - else - Osint.Fail ("illegal option """, Arg, """"); - end if; - - else - -- Not a switch: must be a main - - Mains.Add_Main (Arg); - - -- Make sure that when a main is specified and switch -c is used, - -- only the main(s) is/are compiled. - - if Compile_Only then - Unique_Compile := True; - end if; - end if; - end Scan_Arg; - - ----------------- - -- Strip_CR_LF -- - ----------------- - - function Strip_CR_LF (Text : String) return String is - To : String (1 .. Text'Length); - Index_To : Natural := 0; - - begin - for Index in Text'Range loop - if (Text (Index) /= ASCII.CR) and then (Text (Index) /= ASCII.LF) then - Index_To := Index_To + 1; - To (Index_To) := Text (Index); - end if; - end loop; - - return To (1 .. Index_To); - end Strip_CR_LF; - - ----------- - -- Usage -- - ----------- - - procedure Usage is - begin - if not Usage_Output then - Usage_Output := True; - Copyright; - - Write_Str ("Usage: "); - Osint.Write_Program_Name; - Write_Str (" -P [opts] [name] {"); - Write_Str ("[-cargs:lang opts] "); - Write_Str ("[-largs opts] [-gargs opts]}"); - Write_Eol; - Write_Eol; - Write_Str (" name is zero or more file names"); - Write_Eol; - Write_Eol; - - -- GPRMAKE switches - - Write_Str ("gprmake switches:"); - Write_Eol; - - -- Line for -aP - - Write_Str (" -aPdir Add directory dir to project search path"); - Write_Eol; - - -- Line for -c - - Write_Str (" -c Compile only"); - Write_Eol; - - -- Line for -eL - - Write_Str (" -eL Follow symbolic links when processing " & - "project files"); - Write_Eol; - - -- Line for -f - - Write_Str (" -f Force recompilations"); - Write_Eol; - - -- Line for -k - - Write_Str (" -k Keep going after compilation errors"); - Write_Eol; - - -- Line for -o - - Write_Str (" -o name Choose an alternate executable name"); - Write_Eol; - - -- Line for -p - - Write_Str (" -p Create missing obj, lib and exec dirs"); - Write_Eol; - - -- Line for -P - - Write_Str (" -Pproj Use GNAT Project File proj"); - Write_Eol; - - -- Line for -q - - Write_Str (" -q Be quiet/terse"); - Write_Eol; - - -- Line for -u - - Write_Str - (" -u Unique compilation. Only compile the given files"); - Write_Eol; - - -- Line for -v - - Write_Str (" -v Verbose output"); - Write_Eol; - - -- Line for -vPx - - Write_Str (" -vPx Specify verbosity when parsing Project Files"); - Write_Eol; - - -- Line for -X - - Write_Str (" -Xnm=val Specify an external reference for " & - "Project Files"); - Write_Eol; - Write_Eol; - - -- Line for -cargs - - Write_Line (" -cargs opts opts are passed to the Ada compiler"); - - -- Line for -cargs:lang - - Write_Line (" -cargs: opts"); - Write_Line (" opts are passed to the compiler " & - "for language < lang > "); - - -- Line for -largs - - Write_Str (" -largs opts opts are passed to the linker"); - Write_Eol; - - -- Line for -gargs - - Write_Str (" -gargs opts opts directly interpreted by gprmake"); - Write_Eol; - Write_Eol; - - end if; - end Usage; - -begin - Makeutl.Do_Fail := Report_Error'Access; -end Makegpr; diff --git a/gcc/ada/makegpr.ads b/gcc/ada/makegpr.ads deleted file mode 100644 index 026118f6fbc5..000000000000 --- a/gcc/ada/makegpr.ads +++ /dev/null @@ -1,34 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT COMPILER COMPONENTS -- --- -- --- M A K E G P R -- --- -- --- S p e c -- --- -- --- Copyright (C) 2004-2007, 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- -- --- ware Foundation; either version 3, or (at your option) any later ver- -- --- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- --- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- --- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- --- for more details. You should have received a copy of the GNU General -- --- Public License distributed with GNAT; see file COPYING3. If not, go to -- --- http://www.gnu.org/licenses for a complete copy of the license. -- --- -- --- GNAT was originally developed by the GNAT team at New York University. -- --- Extensive contributions were provided by Ada Core Technologies Inc. -- --- -- ------------------------------------------------------------------------------- - --- The following package implements the facilities to compile, bind and/or --- link a set of Ada and non Ada sources, specified in Project Files. - -package Makegpr is - - procedure Gprmake; - -- The driver of gprmake - -end Makegpr; -- 2.43.5