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