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