| ------------------------------------------------------------------------------ |
| -- -- |
| -- GNAT COMPILER COMPONENTS -- |
| -- -- |
| -- M A K E G P R -- |
| -- -- |
| -- B o d y -- |
| -- -- |
| -- Copyright (C) 2004 Free Software Foundation, Inc. -- |
| -- -- |
| -- GNAT is free software; you can redistribute it and/or modify it under -- |
| -- terms of the GNU General Public License as published by the Free Soft- -- |
| -- ware Foundation; either version 2, 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 COPYING. If not, write -- |
| -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, -- |
| -- MA 02111-1307, USA. -- |
| -- -- |
| -- GNAT was originally developed by the GNAT team at New York University. -- |
| -- Extensive contributions were provided by Ada Core Technologies Inc. -- |
| -- -- |
| ------------------------------------------------------------------------------ |
| |
| 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 Csets; |
| with Gnatvsn; |
| |
| 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 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.Com; use Prj.Com; |
| with Prj.Pars; |
| with Prj.Util; use Prj.Util; |
| with Snames; use Snames; |
| with System; |
| with System.Case_Util; use System.Case_Util; |
| with Table; |
| with Types; use Types; |
| |
| package body Makegpr is |
| |
| Max_In_Archives : constant := 50; |
| -- The maximum number of arguments for a single invocation of the |
| -- Archive Indexer (ar). |
| |
| Cpp_Linker : constant String := "c++linker"; |
| -- The name of a linking script, built one the fly, when there are C++ |
| -- sources and the C++ compiler is not g++. |
| |
| 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 |
| |
| 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 => Name_Id, |
| Hash => Hash, |
| Equal => "="); |
| |
| package X_Switches is new Table.Table |
| (Table_Component_Type => String_Access, |
| Table_Index_Type => Integer, |
| Table_Low_Bound => 1, |
| Table_Initial => 2, |
| Table_Increment => 100, |
| Table_Name => "Makegpr.X_Switches"); |
| -- Table to store the -X 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 => 50, |
| 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_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 |
| |
| package Lib_Path is new Table.Table |
| (Table_Component_Type => Character, |
| Table_Index_Type => Integer, |
| Table_Low_Bound => 1, |
| Table_Initial => 200, |
| Table_Increment => 50, |
| 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 : Name_Id); |
| -- 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 depenency file for the main project |
| |
| procedure Display_Command |
| (Name : String; |
| Path : String_Access; |
| CPATH : String_Access := null); |
| -- Display the command for a spawned process, if in Verbose_Mode or |
| -- not in Quiet_Output. |
| |
| 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 : Name_Id; |
| 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) & |
| Directory_Separator & |
| "lib" & Get_Name_String (Data.Library_Name) & |
| '.' & Archive_Ext, |
| Verbose_Mode); |
| |
| else |
| -- As we first insert in the reverse order, |
| -- -L<dir> is put after -l<lib> |
| |
| Add_Argument |
| ("-l" & Get_Name_String (Data.Library_Name), |
| Verbose_Mode); |
| |
| Get_Name_String (Data.Library_Dir); |
| |
| 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) & |
| Directory_Separator & |
| "lib" & Get_Name_String (Data.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 := 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 |
| |
| 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_Lists.Table (Imported).Project; |
| |
| if Prj /= No_Project then |
| while Projects.Table (Prj).Extended_By /= No_Project loop |
| Prj := Projects.Table (Prj).Extended_By; |
| end loop; |
| |
| Recursive_Add_Archives (Prj); |
| end if; |
| |
| Imported := 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 1 .. Projects.Last loop |
| 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_Arg + 1; |
| Last : Natural := Last_Argument; |
| Temp : String_Access; |
| |
| begin |
| 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 : Name_Id) |
| 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); |
| |
| when Compiler => |
| Pkg := Value_Of (Name_Compiler, Data.Decl.Packages); |
| 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 => Packages.Table (Pkg).Decl.Arrays); |
| |
| Switches := |
| Prj.Util.Value_Of |
| (Index => File_Name, |
| Src_Index => 0, |
| In_Array => Switches_Array); |
| |
| -- 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 => Packages.Table (Pkg).Decl.Arrays); |
| Switches := Prj.Util.Value_Of |
| (Index => Language_Names.Table (Language), |
| Src_Index => 0, |
| In_Array => Defaults); |
| 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 := 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 := Projects.Table (Main_Project); |
| Source_Id : Other_Source_Id; |
| Source : Other_Source; |
| Success : Boolean; |
| |
| Archive_Name : constant String := |
| "lib" & Get_Name_String (Data.Name) & '.' & Archive_Ext; |
| -- The name of the archive file for this project |
| |
| Archive_Dep_Name : constant String := |
| "lib" & Get_Name_String (Data.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 : Name_Id; |
| Time_Stamp : Time_Stamp_Type; |
| |
| Saved_Last_Argument : Natural; |
| First_Object : Natural; |
| |
| Discard : Boolean; |
| |
| begin |
| Check_Archive_Builder; |
| |
| Change_Dir (Get_Name_String (Data.Object_Directory)); |
| |
| 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 |
| -- 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. |
| |
| for Proj in 1 .. Projects.Last loop |
| Data := Projects.Table (Proj); |
| |
| if not Data.Library then |
| Last_Source := 0; |
| Source_Id := Data.First_Other_Source; |
| |
| while Source_Id /= No_Other_Source loop |
| Add_Source_Id (Proj, Source_Id); |
| Source_Id := Other_Sources.Table (Source_Id).Next; |
| end loop; |
| end if; |
| 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 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 |
| Source_Id := Source_Indexes (S).Id; |
| Source := Other_Sources.Table (Source_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_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 1 .. Projects.Last loop |
| Data := Projects.Table (Proj); |
| |
| if not Data.Library then |
| Source_Id := Data.First_Other_Source; |
| |
| while Source_Id /= No_Other_Source loop |
| Source := Other_Sources.Table (Source_Id); |
| |
| -- Only include object file name that have not been |
| -- overriden in extending projects. |
| |
| if Is_Included_In_Global_Archive |
| (Source.Object_Name, Proj) |
| then |
| Add_Argument |
| (Get_Name_String (Source.Object_Path), Verbose_Mode); |
| 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); |
| |
| Spawn |
| (Archive_Builder_Path.all, |
| Arguments (1 .. Last_Argument), |
| Success); |
| |
| exit when not Success; |
| |
| exit when 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 the archive was built, run the archive indexer (ranlib), |
| -- if there is one. |
| |
| 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.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.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 := Projects.Table (Project); |
| Source_Id : Other_Source_Id; |
| Source : Other_Source; |
| |
| Archive_Name : constant String := |
| "lib" & Get_Name_String (Data.Name) & '.' & Archive_Ext; |
| -- The name of the archive file for this project |
| |
| Archive_Dep_Name : constant String := |
| "lib" & Get_Name_String (Data.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 : Name_Id; |
| Time_Stamp : Time_Stamp_Type; |
| Driver_Name : Name_Id := No_Name; |
| |
| Lib_Opts : Argument_List_Access := No_Argument'Unrestricted_Access; |
| begin |
| 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 |
| -- 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 := 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 |
| 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 := 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 := 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.Languages (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 := 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), |
| Afiles => No_Argument, |
| Output_File => Get_Name_String (Data.Library_Name), |
| Output_Dir => Get_Name_String (Data.Library_Dir)); |
| |
| 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); |
| |
| begin |
| if not Library_Options.Default then |
| declare |
| Current : String_List_Id := Library_Options.Values; |
| Element : String_Element; |
| |
| begin |
| while Current /= Nil_String loop |
| Element := 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), |
| Foreign => Arguments (1 .. Last_Argument), |
| Afiles => No_Argument, |
| Options => No_Argument, |
| Options_2 => Lib_Opts.all, |
| Interfaces => No_Argument, |
| Lib_Filename => Get_Name_String (Data.Library_Name), |
| Lib_Dir => Get_Name_String (Data.Library_Dir), |
| 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; |
| use Ada.Text_IO; |
| 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); |
| Dep_Name : constant String := Get_Name_String (Source.Dep_Name); |
| |
| 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; |
| |
| begin |
| -- 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; |
| |
| 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 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), ": "); |
| |
| -- First line must start with name of object file, followed by colon |
| |
| if Finish = 0 or else Name_Buffer (1 .. Finish - 1) /= 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 : constant String := Name_Buffer (1 .. Name_Len); |
| Last : constant 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 and then Line (Finish + 1) /= ' ' loop |
| Finish := Finish + 1; |
| end loop; |
| |
| -- Check this source |
| |
| declare |
| Src_Name : constant String := |
| Normalize_Pathname |
| (Name => Line (Start .. Finish), |
| Case_Sensitive => False); |
| Src_TS : Time_Stamp_Type; |
| |
| begin |
| -- If it is original source, set Source_In_Dependencies |
| |
| if Src_Name = Source_Path then |
| Source_In_Dependencies := True; |
| end if; |
| |
| Name_Len := 0; |
| Add_Str_To_Name_Buffer (Src_Name); |
| Src_TS := File_Stamp (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; |
| |
| 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, and we don't 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 1 .. Projects.Last loop |
| if |
| Projects.Table (Project).Languages (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 : in Project_Data; |
| Local_Errors : in out Boolean) |
| is |
| Source : Other_Source := 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; |
| |
| 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, function 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 |
| |
| 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 := Projects.Table (Main_Project); |
| Source_Id : Other_Source_Id; |
| Source : Other_Source; |
| Source_Name : Name_Id; |
| Project_Name : String := Get_Name_String (Data.Name); |
| Dummy : Boolean := False; |
| |
| Ada_Is_A_Language : constant Boolean := |
| Data.Languages (Ada_Language_Index); |
| |
| begin |
| Ada_Mains.Init; |
| To_Mixed (Project_Name); |
| Compile_Only := True; |
| |
| Get_Imported_Directories (Main_Project, Data); |
| Projects.Table (Main_Project) := Data; |
| |
| -- Compilation will occur in the object directory |
| |
| Change_Dir (Get_Name_String (Data.Object_Directory)); |
| |
| 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 := 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 := 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_Name), True); |
| |
| -- Add the -X switches, if any |
| |
| for Index in 1 .. X_Switches.Last loop |
| Add_Argument (X_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; |
| |
| -- -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 |
| |
| begin |
| -- Loop through project files |
| |
| for Project in 1 .. Projects.Last loop |
| Local_Errors := False; |
| Data := 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; |
| Projects.Table (Project) := Data; |
| end if; |
| |
| Need_To_Rebuild_Archive := Force_Compilations; |
| |
| -- Compilation will occur in the object directory |
| |
| Change_Dir (Get_Name_String (Data.Object_Directory)); |
| |
| Source_Id := Data.First_Other_Source; |
| |
| -- Process each source one by one |
| |
| while Source_Id /= No_Other_Source loop |
| Source := Other_Sources.Table (Source_Id); |
| 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; |
| |
| -- 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.Languages (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 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 := First_Source; |
| Source : Other_Source; |
| Dep_File : Ada.Text_IO.File_Type; |
| use Ada.Text_IO; |
| |
| 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); |
| |
| while Source_Id /= No_Other_Source loop |
| Source := 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; |
| |
| use Ada.Text_IO; |
| |
| 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 1 .. Projects.Last loop |
| if not Projects.Table (Project).Library then |
| Source_Id := Projects.Table (Project).First_Other_Source; |
| |
| while Source_Id /= No_Other_Source loop |
| Source := 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) |
| is |
| 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); |
| 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 := Projects.Table (Main_Project); |
| |
| Ide : constant Package_Id := |
| Value_Of (Name_Ide, In_Packages => Data.Decl.Packages); |
| -- 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); |
| -- 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 |
| ("unknow 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 := Source_Dirs; |
| Element : String_Element; |
| Add_Arg : Boolean := True; |
| |
| begin |
| -- Add each source directory path name, preceded by "-I" to Arguments |
| |
| while Element_Id /= Nil_String loop |
| Element := String_Elements.Table (Element_Id); |
| |
| if Element.Value /= No_Name then |
| Get_Name_String (Element.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 again. |
| |
| 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 := 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. |
| |
| 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); |
| |
| Imported := Data.Imported_Projects; |
| |
| -- Call itself for all imported projects, if any |
| |
| while Imported /= Empty_Project_List loop |
| Recursive_Get_Dirs (Project_Lists.Table (Imported).Project); |
| Imported := 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 1 .. Projects.Last loop |
| Projects.Table (J).Seen := False; |
| end loop; |
| |
| -- Empty Arguments |
| |
| Last_Argument := 0; |
| |
| -- Process this project individually, project data are already known |
| |
| 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_Lists.Table (Imported_Projects).Project); |
| Imported_Projects := 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, |
| 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 := 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 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 |
| -- Do some necessary package initializations |
| |
| Csets.Initialize; |
| Namet.Initialize; |
| Snames.Initialize; |
| Prj.Initialize; |
| Mains.Delete; |
| |
| -- 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 -X switch table is empty |
| |
| X_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 : Name_Id; |
| Project : Project_Id) return Boolean |
| is |
| Data : Project_Data := Projects.Table (Project); |
| Source : Other_Source_Id; |
| |
| begin |
| while Data.Extended_By /= No_Project loop |
| Data := Projects.Table (Data.Extended_By); |
| Source := Data.First_Other_Source; |
| |
| while Source /= No_Other_Source loop |
| if Other_Sources.Table (Source).Object_Name = Object_Name then |
| return False; |
| else |
| Source := 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 := 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); |
| -- 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 : Name_Id; |
| 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 |
| if Compiler_Is_Gcc (C_Plus_Plus_Language_Index) then |
| Add_Argument |
| ("--LINK=" & Compiler_Names (C_Plus_Plus_Language_Index).all, |
| Verbose_Mode); |
| |
| else |
| Add_Argument |
| ("--LINK=" & |
| Object_Dir & Directory_Separator & |
| Cpp_Linker, |
| Verbose_Mode); |
| end if; |
| 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 1 .. Projects.Last loop |
| Prj_Data := 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) & |
| Directory_Separator & |
| "lib" & |
| Get_Name_String (Prj_Data.Name) & |
| '.' & Archive_Ext; |
| Archive_TS : Time_Stamp_Type; |
| begin |
| Name_Len := 0; |
| Add_Str_To_Name_Buffer |
| (Archive_Path); |
| Archive_TS := File_Stamp (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; |
| |
| if not Compiler_Is_Gcc (C_Plus_Plus_Language_Index) then |
| Change_Dir (Object_Dir); |
| |
| declare |
| File : Ada.Text_IO.File_Type; |
| use Ada.Text_IO; |
| |
| begin |
| Create (File, Out_File, Cpp_Linker); |
| |
| Put_Line (File, "#!/bin/sh"); |
| |
| Put_Line (File, "LIBGCC=`gcc -print-libgcc-file-name`"); |
| Put_Line |
| (File, |
| Compiler_Names (C_Plus_Plus_Language_Index).all & |
| " $* ${LIBGCC}"); |
| |
| Close (File); |
| Set_Executable (Cpp_Linker); |
| end; |
| end if; |
| end Choose_C_Plus_Plus_Link_Process; |
| |
| ------------------ |
| -- Link_Foreign -- |
| ------------------ |
| |
| procedure Link_Foreign |
| (Main : String; |
| Main_Id : Name_Id; |
| Source : Other_Source) |
| is |
| Executable_Name : constant String := |
| Get_Name_String |
| (Executable_Of |
| (Project => Main_Project, |
| Main => Main_Id, |
| Index => 0, |
| Ada_Main => False)); |
| -- File name of the executable |
| |
| Executable_Path : constant String := |
| Get_Name_String |
| (Data.Exec_Directory) & |
| 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 (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) & |
| Directory_Separator & |
| Get_Name_String |
| (Executable_Of |
| (Project => Main_Project, |
| 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)); |
| 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 := Data.Mains; |
| Element : String_Element; |
| |
| begin |
| while Element_Id /= Nil_String loop |
| Element := 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 not Data.Languages (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.Languages (Ada_Language_Index) then |
| |
| -- There is a mix of Ada and other language sources in the main |
| -- project. Any main that is not a source of the other languages |
| -- 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 : Name_Id; |
| |
| 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; |
| Source_Id := Data.First_Other_Source; |
| |
| -- Check if it is a source of a language other than Ada |
| |
| while Source_Id /= No_Other_Source loop |
| Source := 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, |
| 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.Languages (C_Plus_Plus_Language_Index) then |
| Add_Argument (Dash_largs, Verbose_Mode); |
| Add_C_Plus_Plus_Link_For_Gnatmake; |
| Add_Argument (Dash_margs, Verbose_Mode); |
| 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.Languages (C_Plus_Plus_Language_Index) then |
| Get_Compiler (C_Plus_Plus_Language_Index); |
| Linker_Name := Compiler_Names (C_Plus_Plus_Language_Index); |
| Linker_Path := Compiler_Paths (C_Plus_Plus_Language_Index); |
| |
| else |
| Get_Compiler (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 : Name_Id; |
| 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; |
| Source_Id := Data.First_Other_Source; |
| |
| -- Check if it is a source of the main project file |
| |
| while Source_Id /= No_Other_Source loop |
| Source := 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 : Name_Id; |
| begin |
| Name_Len := 0; |
| Add_Str_To_Name_Buffer (Main); |
| Main_Id := Name_Find; |
| Write_Str |
| (Get_Name_String |
| (Executable_Of |
| (Project => Main_Project, |
| 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 = "-c" then |
| Compile_Only := 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 = "-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 they can be passed to gnatmake, |
| -- if gnatmake is called. |
| |
| X_Switches.Increment_Last; |
| X_Switches.Table (X_Switches.Last) := new String'(Arg); |
| |
| else |
| Osint.Fail ("illegal option """, Arg, """"); |
| end if; |
| |
| else |
| -- Not a switch: must be a main |
| |
| Mains.Add_Main (Arg); |
| 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<project file> [opts] [name] {"); |
| |
| for Lang in First_Language_Indexes loop |
| Write_Str ("[-cargs:lang opts] "); |
| end loop; |
| |
| 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 -c |
| |
| Write_Str (" -c Compile only"); |
| 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 (" -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:<lang> 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; |