with Ada.Command_Line; use Ada.Command_Line;
with Ada.Strings.Fixed; use Ada.Strings.Fixed;
with Ada.Text_IO; use Ada.Text_IO;
with Ada.Unchecked_Deallocation;
with Csets;
with Gnatvsn;
with GNAT.Directory_Operations; use GNAT.Directory_Operations;
with GNAT.Dynamic_Tables;
with GNAT.Expect; use GNAT.Expect;
with GNAT.HTable;
with GNAT.OS_Lib; use GNAT.OS_Lib;
with GNAT.Regpat; use GNAT.Regpat;
with Makeutl; use Makeutl;
with MLib.Tgt; use MLib.Tgt;
with Namet; use Namet;
with Output; use Output;
with Opt; use Opt;
with Osint; use Osint;
with Prj; use Prj;
with Prj.Pars;
with Prj.Util; use Prj.Util;
with Snames; use Snames;
with System;
with System.Case_Util; use System.Case_Util;
with Table;
with Types; use Types;
package body Makegpr is
Max_In_Archives : constant := 50;
No_Argument : aliased Argument_List := (1 .. 0 => null);
FD : Process_Descriptor;
Line_Matcher : constant Pattern_Matcher := Compile ("^.*?\n", Single_Line);
Name_Ide : Name_Id;
Name_Compiler_Command : Name_Id;
Unique_Compile : Boolean := False;
type Source_Index_Rec is record
Project : Project_Id;
Id : Other_Source_Id;
Found : Boolean := False;
end record;
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);
Last_Source : Natural := 0;
Compiler_Names : array (First_Language_Indexes) of String_Access;
Gnatmake_String : constant String_Access := new String'("gnatmake");
GCC_String : constant String_Access := new String'("gcc");
G_Plus_Plus_String : constant String_Access := new String'("g++");
Default_Compiler_Names : constant array
(First_Language_Indexes range
Ada_Language_Index .. C_Plus_Plus_Language_Index)
of String_Access :=
(Ada_Language_Index => Gnatmake_String,
C_Language_Index => GCC_String,
C_Plus_Plus_Language_Index => G_Plus_Plus_String);
Compiler_Paths : array (First_Language_Indexes) of String_Access;
Compiler_Is_Gcc : array (First_Language_Indexes) of Boolean;
Archive_Builder_Path : String_Access := null;
Archive_Indexer_Path : String_Access := null;
Copyright_Output : Boolean := False;
Usage_Output : Boolean := False;
Output_File_Name : String_Access := null;
Output_File_Name_Expected : Boolean := False;
Project_File_Name : String_Access := null;
Project_File_Name_Expected : Boolean := False;
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";
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;
Project_Tree : constant Project_Tree_Ref := new Project_Tree_Data;
Main_Project : Project_Id;
type Processor is (None, Linker, Compiler);
Current_Processor : Processor := None;
Current_Language : Language_Index := Ada_Language_Index;
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;
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");
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");
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");
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");
package Sources_Compiled is new GNAT.HTable.Simple_HTable
(Header_Num => Header_Num,
Element => Boolean,
No_Element => False,
Key => Name_Id,
Hash => Hash,
Equal => "=");
package X_Switches is new Table.Table
(Table_Component_Type => String_Access,
Table_Index_Type => Integer,
Table_Low_Bound => 1,
Table_Initial => 2,
Table_Increment => 100,
Table_Name => "Makegpr.X_Switches");
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);
Arguments_Displayed : Booleans :=
new Boolean_Array (1 .. Initial_Argument_Count);
Last_Argument : Natural := 0;
package Cache_Args is new Table.Table
(Table_Component_Type => String_Access,
Table_Index_Type => Integer,
Table_Low_Bound => 1,
Table_Initial => 200,
Table_Increment => 50,
Table_Name => "Makegpr.Cache_Args");
Dash_B_String : aliased String := "-B";
Dash_B : constant String_Access := Dash_B_String'Access;
Dash_c_String : aliased String := "-c";
Dash_c : constant String_Access := Dash_c_String'Access;
Dash_cargs_String : aliased String := "-cargs";
Dash_cargs : constant String_Access := Dash_cargs_String'Access;
Dash_d_String : aliased String := "-d";
Dash_d : constant String_Access := Dash_d_String'Access;
Dash_f_String : aliased String := "-f";
Dash_f : constant String_Access := Dash_f_String'Access;
Dash_k_String : aliased String := "-k";
Dash_k : constant String_Access := Dash_k_String'Access;
Dash_largs_String : aliased String := "-largs";
Dash_largs : constant String_Access := Dash_largs_String'Access;
Dash_M_String : aliased String := "-M";
Dash_M : constant String_Access := Dash_M_String'Access;
Dash_margs_String : aliased String := "-margs";
Dash_margs : constant String_Access := Dash_margs_String'Access;
Dash_o_String : aliased String := "-o";
Dash_o : constant String_Access := Dash_o_String'Access;
Dash_P_String : aliased String := "-P";
Dash_P : constant String_Access := Dash_P_String'Access;
Dash_q_String : aliased String := "-q";
Dash_q : constant String_Access := Dash_q_String'Access;
Dash_u_String : aliased String := "-u";
Dash_u : constant String_Access := Dash_u_String'Access;
Dash_v_String : aliased String := "-v";
Dash_v : constant String_Access := Dash_v_String'Access;
Dash_vP1_String : aliased String := "-vP1";
Dash_vP1 : constant String_Access := Dash_vP1_String'Access;
Dash_vP2_String : aliased String := "-vP2";
Dash_vP2 : constant String_Access := Dash_vP2_String'Access;
Dash_x_String : aliased String := "-x";
Dash_x : constant String_Access := Dash_x_String'Access;
r_String : aliased String := "r";
r : constant String_Access := r_String'Access;
CPATH : constant String := "CPATH";
Current_Include_Paths : array (First_Language_Indexes) of String_Access;
C_Plus_Plus_Is_Used : Boolean := False;
Link_Options_Switches : Argument_List_Access := null;
Total_Number_Of_Errors : Natural := 0;
Need_To_Rebuild_Global_Archive : Boolean := False;
Error_Header : constant String := "*** ERROR: ";
Need_To_Relink : Boolean := False;
Global_Archive_Exists : Boolean := False;
Path_Option : String_Access;
package Lib_Path is new Table.Table
(Table_Component_Type => Character,
Table_Index_Type => Integer,
Table_Low_Bound => 1,
Table_Initial => 200,
Table_Increment => 50,
Table_Name => "Makegpr.Lib_Path");
procedure Add_Archives (For_Gnatmake : Boolean);
procedure Add_Argument (Arg : String_Access; Display : Boolean);
procedure Add_Argument (Arg : String; Display : Boolean);
procedure Add_Arguments (Args : Argument_List; Display : Boolean);
procedure Add_Option (Arg : String);
procedure Add_Search_Directories
(Data : Project_Data;
Language : First_Language_Indexes);
procedure Add_Source_Id (Project : Project_Id; Id : Other_Source_Id);
procedure Add_Switches
(Data : Project_Data;
Proc : Processor;
Language : Language_Index;
File_Name : Name_Id);
procedure Build_Global_Archive;
procedure Build_Library (Project : Project_Id; Unconditionally : Boolean);
procedure Check (Option : String);
procedure Check_Archive_Builder;
procedure Check_Compilation_Needed
(Source : Other_Source;
Need_To_Compile : out Boolean);
procedure Check_For_C_Plus_Plus;
procedure Compile
(Source_Id : Other_Source_Id;
Data : Project_Data;
Local_Errors : in out Boolean);
procedure Compile_Individual_Sources;
procedure Compile_Link_With_Gnatmake (Mains_Specified : Boolean);
procedure Compile_Sources;
procedure Copyright;
procedure Create_Archive_Dependency_File
(Name : String;
First_Source : Other_Source_Id);
procedure Create_Global_Archive_Dependency_File (Name : String);
procedure Display_Command
(Name : String;
Path : String_Access;
CPATH : String_Access := null);
procedure Get_Compiler (For_Language : First_Language_Indexes);
procedure Get_Imported_Directories
(Project : Project_Id;
Data : in out Project_Data);
procedure Initialize;
function Is_Included_In_Global_Archive
(Object_Name : Name_Id;
Project : Project_Id) return Boolean;
procedure Link_Executables;
procedure Report_Error (S1 : String; S2 : String := ""; S3 : String := "");
procedure Report_Total_Errors (Kind : String);
procedure Scan_Arg (Arg : String);
function Strip_CR_LF (Text : String) return String;
procedure Usage;
procedure Add_Archives (For_Gnatmake : Boolean) is
Last_Arg : constant Natural := Last_Argument;
procedure Recursive_Add_Archives (Project : Project_Id);
procedure Recursive_Add_Archives (Project : Project_Id) is
Data : Project_Data;
Imported : Project_List;
Prj : Project_Id;
procedure Add_Archive_Path;
procedure Add_Archive_Path is
Increment : Positive;
Prev_Last : Positive;
begin
if Data.Library then
if not For_Gnatmake then
if Data.Library_Kind = Static then
Add_Argument
(Get_Name_String (Data.Library_Dir) &
Directory_Separator &
"lib" & Get_Name_String (Data.Library_Name) &
'.' & Archive_Ext,
Verbose_Mode);
else
Add_Argument
("-l" & Get_Name_String (Data.Library_Name),
Verbose_Mode);
Get_Name_String (Data.Library_Dir);
Add_Argument
("-L" & Name_Buffer (1 .. Name_Len),
Verbose_Mode);
if Path_Option /= null then
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
Lib_Path.Set_Last (Name_Len);
end if;
for Index in 1 .. Name_Len loop
Lib_Path.Table (Index) := Name_Buffer (Index);
end loop;
end if;
end if;
end if;
elsif Project = Main_Project and then Global_Archive_Exists then
Add_Argument
(Get_Name_String (Data.Object_Directory) &
Directory_Separator &
"lib" & Get_Name_String (Data.Name) &
'.' & Archive_Ext,
Verbose_Mode);
end if;
end Add_Archive_Path;
begin
if Project /= No_Project then
Data := Project_Tree.Projects.Table (Project);
if not Data.Seen then
Project_Tree.Projects.Table (Project).Seen := True;
Recursive_Add_Archives (Data.Extends);
Imported := Data.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 Project = Main_Project
or else Data.Other_Sources_Present
then
Add_Archive_Path;
end if;
end if;
end if;
end Recursive_Add_Archives;
begin
for Project in Project_Table.First ..
Project_Table.Last (Project_Tree.Projects)
loop
Project_Tree.Projects.Table (Project).Seen := False;
end loop;
if Path_Option = null then
Path_Option := MLib.Linker_Library_Path_Option;
end if;
Lib_Path.Set_Last (0);
Recursive_Add_Archives (Main_Project);
declare
First : Positive := Last_Arg + 1;
Last : Natural := Last_Argument;
Temp : String_Access;
begin
while First < Last loop
Temp := Arguments (First);
Arguments (First) := Arguments (Last);
Arguments (Last) := Temp;
First := First + 1;
Last := Last - 1;
end loop;
end;
end Add_Archives;
procedure Add_Argument (Arg : String_Access; Display : Boolean) is
begin
if Arg /= null or else Arg'Length = 0 then
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;
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;
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
if Arg'Length > 0 then
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 Argument = null then
Argument := new String'(Arg);
Cache_Args.Increment_Last;
Cache_Args.Table (Cache_Args.Last) := Argument;
end if;
Add_Argument (Argument, Display);
end if;
end Add_Argument;
procedure Add_Arguments (Args : Argument_List; Display : Boolean) is
begin
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);
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;
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;
procedure Add_Option (Arg : String) is
Option : constant String_Access := new String'(Arg);
begin
case Current_Processor is
when None =>
null;
when Linker =>
Linker_Options.Increment_Last;
Linker_Options.Table (Linker_Options.Last) := Option;
when Compiler =>
Comp_Opts.Increment_Last (Options (Current_Language));
Options (Current_Language).Table
(Comp_Opts.Last (Options (Current_Language))) := Option;
end case;
end Add_Option;
procedure Add_Source_Id (Project : Project_Id; Id : Other_Source_Id) is
begin
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;
procedure Add_Search_Directories
(Data : Project_Data;
Language : First_Language_Indexes)
is
begin
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;
procedure Add_Switches
(Data : Project_Data;
Proc : Processor;
Language : Language_Index;
File_Name : Name_Id)
is
Switches : Variable_Value;
Pkg : Package_Id;
Defaults : Array_Element_Id;
Switches_Array : Array_Element_Id;
Element_Id : String_List_Id;
Element : String_Element;
begin
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
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 => File_Name,
Src_Index => 0,
In_Array => Switches_Array,
In_Tree => Project_Tree);
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 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
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;
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.Name) & '.' & Archive_Ext;
Archive_Dep_Name : constant String :=
"lib" & Get_Name_String (Data.Name) & ".deps";
Need_To_Rebuild : Boolean := Need_To_Rebuild_Global_Archive;
File : Prj.Util.Text_File;
Object_Path : Name_Id;
Time_Stamp : Time_Stamp_Type;
Saved_Last_Argument : Natural;
First_Object : Natural;
Discard : Boolean;
begin
Check_Archive_Builder;
Change_Dir (Get_Name_String (Data.Object_Directory));
if not Need_To_Rebuild then
if Verbose_Mode then
Write_Str (" Checking ");
Write_Line (Archive_Name);
end if;
if not Is_Regular_File (Archive_Name) then
Need_To_Rebuild := True;
if Verbose_Mode then
Write_Line (" -> archive does not exist");
end if;
else
Open (File, Archive_Dep_Name);
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
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;
while not End_Of_File (File) loop
Get_Line (File, Name_Buffer, Name_Len);
Object_Path := Name_Find;
Source_Id := No_Other_Source;
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
Source_Id := S_Id;
Source_Indexes (S).Found := True;
exit;
end if;
end loop;
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;
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 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 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;
Global_Archive_Exists := Last_Source /= 0;
else
if Is_Regular_File (Archive_Name) then
Delete_File (Archive_Name, Discard);
end if;
Last_Argument := 0;
Add_Arguments (Archive_Builder_Options.all, True);
Add_Argument (Archive_Name, True);
First_Object := Last_Argument;
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);
if Is_Included_In_Global_Archive
(Source.Object_Name, Proj)
then
Add_Argument
(Get_Name_String (Source.Object_Path), Verbose_Mode);
end if;
Source_Id := Source.Next;
end loop;
end if;
end loop;
Global_Archive_Exists := Last_Argument > First_Object;
if Global_Archive_Exists then
Need_To_Relink := True;
Saved_Last_Argument := Last_Argument;
Last_Argument := First_Object + Max_In_Archives;
loop
if Last_Argument > Saved_Last_Argument then
Last_Argument := Saved_Last_Argument;
end if;
Display_Command (Archive_Builder, Archive_Builder_Path);
Spawn
(Archive_Builder_Path.all,
Arguments (1 .. Last_Argument),
Success);
exit when not Success;
exit when Last_Argument = Saved_Last_Argument;
Arguments (1) := r;
Arguments (3 .. Saved_Last_Argument - Last_Argument + 2) :=
Arguments (Last_Argument + 1 .. Saved_Last_Argument);
Saved_Last_Argument := Saved_Last_Argument - Last_Argument + 2;
end loop;
if 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
if Is_Regular_File (Archive_Dep_Name) then
Delete_File (Archive_Dep_Name, Success);
end if;
Report_Error
("running" & Archive_Indexer & " for project """,
Get_Name_String (Data.Name),
""" failed");
return;
end if;
end if;
Create_Global_Archive_Dependency_File (Archive_Dep_Name);
else
if Is_Regular_File (Archive_Dep_Name) then
Delete_File (Archive_Dep_Name, Success);
end if;
Report_Error
("building archive for project """,
Get_Name_String (Data.Name),
""" failed");
end if;
end if;
end if;
end Build_Global_Archive;
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.Name) & '.' & Archive_Ext;
Archive_Dep_Name : constant String :=
"lib" & Get_Name_String (Data.Name) & ".deps";
Need_To_Rebuild : Boolean := Unconditionally;
File : Prj.Util.Text_File;
Object_Name : Name_Id;
Time_Stamp : Time_Stamp_Type;
Driver_Name : Name_Id := No_Name;
Lib_Opts : Argument_List_Access := No_Argument'Access;
begin
Check_Archive_Builder;
if not Need_To_Rebuild then
if Verbose_Mode then
Write_Str (" Checking ");
Write_Line (Archive_Name);
end if;
if not Is_Regular_File (Archive_Name) then
Need_To_Rebuild := True;
if Verbose_Mode then
Write_Line (" -> archive does not exist");
end if;
else
Open (File, Archive_Dep_Name);
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
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;
while not End_Of_File (File) loop
Get_Line (File, Name_Buffer, Name_Len);
Object_Name := Name_Find;
Source_Id := No_Other_Source;
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
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 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;
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 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 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
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;
if Need_To_Rebuild then
Need_To_Relink := True;
Last_Argument := 0;
if not Data.Languages (Ada_Language_Index) then
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 Data.Library_Kind = Static then
MLib.Build_Library
(Ofiles => Arguments (1 .. Last_Argument),
Afiles => No_Argument,
Output_File => Get_Name_String (Data.Library_Name),
Output_Dir => Get_Name_String (Data.Library_Dir));
else
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;
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 := Library_Options.Values;
Element : String_Element;
begin
while Current /= Nil_String loop
Element := Project_Tree.String_Elements.
Table (Current);
Get_Name_String (Element.Value);
if Name_Len /= 0 then
Library_Opts.Increment_Last;
Library_Opts.Table (Library_Opts.Last) :=
new String'(Name_Buffer (1 .. Name_Len));
end if;
Current := Element.Next;
end loop;
end;
end if;
Lib_Opts :=
new Argument_List'(Argument_List
(Library_Opts.Table (1 .. Library_Opts.Last)));
end;
MLib.Tgt.Build_Dynamic_Library
(Ofiles => Arguments (1 .. Last_Argument),
Foreign => Arguments (1 .. Last_Argument),
Afiles => No_Argument,
Options => No_Argument,
Options_2 => Lib_Opts.all,
Interfaces => No_Argument,
Lib_Filename => Get_Name_String (Data.Library_Name),
Lib_Dir => Get_Name_String (Data.Library_Dir),
Symbol_Data => No_Symbols,
Driver_Name => Driver_Name,
Lib_Version => "",
Auto_Init => False);
end if;
end if;
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;
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;
procedure Check_Archive_Builder is
begin
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 Archive_Indexer /= "" then
Archive_Indexer_Path := Locate_Exec_On_Path (Archive_Indexer);
end if;
end if;
end Check_Archive_Builder;
procedure Check_Compilation_Needed
(Source : Other_Source;
Need_To_Compile : out Boolean)
is
Source_Name : constant String := Get_Name_String (Source.File_Name);
Source_Path : constant String := Get_Name_String (Source.Path_Name);
Object_Name : constant String := Get_Name_String (Source.Object_Name);
Dep_Name : constant String := Get_Name_String (Source.Dep_Name);
Source_In_Dependencies : Boolean := False;
Dep_File : Prj.Util.Text_File;
Start : Natural;
Finish : Natural;
begin
Need_To_Compile := True;
if Verbose_Mode then
Write_Str (" Checking ");
Write_Str (Source_Name);
Write_Line (" ... ");
end if;
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 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 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;
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;
Open (Dep_File, Dep_Name);
if not Is_Valid (Dep_File) then
if Verbose_Mode then
Write_Str (" -> could not open dependency file ");
Write_Line (Dep_Name);
end if;
return;
end if;
declare
End_Of_File_Reached : Boolean := False;
begin
loop
if End_Of_File (Dep_File) then
End_Of_File_Reached := True;
exit;
end if;
Get_Line (Dep_File, Name_Buffer, Name_Len);
exit when Name_Len > 0 and then Name_Buffer (1) /= '#';
end loop;
if End_Of_File_Reached then
if Verbose_Mode then
Write_Str (" -> dependency file ");
Write_Str (Dep_Name);
Write_Line (" is empty");
end if;
Close (Dep_File);
return;
end if;
end;
Start := 1;
Finish := Index (Name_Buffer (1 .. Name_Len), ": ");
if Finish = 0 or else Name_Buffer (1 .. Finish - 1) /= Object_Name then
if Verbose_Mode then
Write_Str (" -> dependency file ");
Write_Str (Dep_Name);
Write_Line (" has wrong format");
end if;
Close (Dep_File);
return;
else
Start := Finish + 2;
Line_Loop : loop
declare
Line : constant String := Name_Buffer (1 .. Name_Len);
Last : constant Natural := Name_Len;
begin
Name_Loop : loop
while Start < Last and then Line (Start) = ' ' loop
Start := Start + 1;
end loop;
exit Name_Loop when Start = Last
and then Line (Start) = '\';
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;
Finish := Start;
while Finish < Last and then Line (Finish + 1) /= ' ' loop
Finish := Finish + 1;
end loop;
declare
Src_Name : constant String :=
Normalize_Pathname
(Name => Line (Start .. Finish),
Case_Sensitive => False);
Src_TS : Time_Stamp_Type;
begin
if Src_Name = Source_Path then
Source_In_Dependencies := True;
end if;
Name_Len := 0;
Add_Str_To_Name_Buffer (Src_Name);
Src_TS := File_Stamp (Name_Find);
if 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;
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;
exit Line_Loop when Finish = Last;
Start := Finish + 1;
end loop Name_Loop;
end;
Get_Line (Dep_File, Name_Buffer, Name_Len);
Start := 1;
end loop Line_Loop;
end if;
Close (Dep_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 Verbose_Mode then
Write_Line (" -> up to date");
end if;
Need_To_Compile := False;
end Check_Compilation_Needed;
procedure Check_For_C_Plus_Plus is
begin
C_Plus_Plus_Is_Used := False;
for Project in Project_Table.First ..
Project_Table.Last (Project_Tree.Projects)
loop
if
Project_Tree.Projects.Table (Project).Languages
(C_Plus_Plus_Language_Index)
then
C_Plus_Plus_Is_Used := True;
exit;
end if;
end loop;
end Check_For_C_Plus_Plus;
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 Compiler_Names (Source.Language) = null then
Get_Compiler (Source.Language);
end if;
if not Compiler_Is_Gcc (Source.Language) then
Last_Argument := 0;
Add_Argument (Dash_M, True);
Add_Argument (Get_Name_String (Source.Path_Name), True);
Add_Switches
(Data, Compiler, Source.Language, Source.File_Name);
for
J in 1 .. Comp_Opts.Last (Options (Source.Language))
loop
Add_Argument (Options (Source.Language).Table (J), True);
end loop;
Add_Search_Directories (Data, Source.Language);
Display_Command
(Compiler_Names (Source.Language).all,
Compiler_Paths (Source.Language));
begin
Non_Blocking_Spawn
(FD,
Compiler_Paths (Source.Language).all,
Arguments (1 .. Last_Argument),
Buffer_Size => 0,
Err_To_Out => True);
declare
Dep_File : Ada.Text_IO.File_Type;
Result : Expect_Match;
Status : Integer;
begin
Create (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
Put_Line (Dep_File, S);
end;
end loop;
Close (FD, Status);
Close (Dep_File);
Delete_File (Get_Name_String (Source.Dep_Name), Success);
exception
when Process_Died =>
Close (FD, Status);
Close (Dep_File);
when others =>
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
when Invalid_Process =>
Delete_File (Get_Name_String (Source.Dep_Name), Success);
end;
end if;
Last_Argument := 0;
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_Switches
(Data, Compiler, Source.Language, Source.File_Name);
Add_Argument (Get_Name_String (Source.Path_Name), True);
if Data.Library and then Data.Library_Kind /= Static then
Add_Argument (PIC_Option, True);
end if;
Add_Argument (Dash_o, True);
Add_Argument (Get_Name_String (Source.Object_Name), True);
if Compiler_Is_Gcc (Source.Language) then
Add_Argument
("-Wp,-MD," & Get_Name_String (Source.Dep_Name),
Verbose_Mode);
end if;
for J in 1 .. Comp_Opts.Last (Options (Source.Language)) loop
Add_Argument (Options (Source.Language).Table (J), True);
end loop;
Add_Search_Directories (Data, Source.Language);
if Compiler_Is_Gcc (Source.Language) then
CPATH := Current_Include_Paths (Source.Language);
end if;
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);
if Success then
Source.Object_TS := File_Stamp (Source.Object_Name);
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
Project_Tree.Other_Sources.Table (Source_Id) := Source;
end if;
else
Local_Errors := True;
Report_Error
("compilation of ",
Get_Name_String (Source.Path_Name),
" failed");
end if;
end Compile;
procedure Compile_Individual_Sources is
Data : Project_Data :=
Project_Tree.Projects.Table (Main_Project);
Source_Id : Other_Source_Id;
Source : Other_Source;
Source_Name : Name_Id;
Project_Name : String := Get_Name_String (Data.Name);
Dummy : Boolean := False;
Ada_Is_A_Language : constant Boolean :=
Data.Languages (Ada_Language_Index);
begin
Ada_Mains.Init;
To_Mixed (Project_Name);
Compile_Only := True;
Get_Imported_Directories (Main_Project, Data);
Project_Tree.Projects.Table (Main_Project) := Data;
Change_Dir (Get_Name_String (Data.Object_Directory));
if not Data.Other_Sources_Present then
if Ada_Is_A_Language then
Mains.Reset;
loop
declare
Main : constant String := Mains.Next_Main;
begin
exit when Main'Length = 0;
Ada_Mains.Increment_Last;
Ada_Mains.Table (Ada_Mains.Last) := new String'(Main);
end;
end loop;
else
Osint.Fail
("project ", Project_Name, " contains no source");
end if;
else
Mains.Reset;
loop
declare
Main : constant String := Mains.Next_Main;
begin
Name_Len := Main'Length;
exit when Name_Len = 0;
Name_Buffer (1 .. Name_Len) := Main;
Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
Source_Name := Name_Find;
if not Sources_Compiled.Get (Source_Name) then
Sources_Compiled.Set (Source_Name, True);
Source_Id := Data.First_Other_Source;
while Source_Id /= No_Other_Source loop
Source :=
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
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;
procedure Compile_Link_With_Gnatmake (Mains_Specified : Boolean) is
Data : constant Project_Data :=
Project_Tree.Projects.Table (Main_Project);
Success : Boolean;
begin
Get_Compiler (Ada_Language_Index);
Add_Argument (Dash_P, True);
Add_Argument (Get_Name_String (Data.Path_Name), True);
for Index in 1 .. X_Switches.Last loop
Add_Argument (X_Switches.Table (Index), True);
end loop;
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;
if Output_File_Name /= null then
Add_Argument (Dash_o, True);
Add_Argument (Output_File_Name, True);
end if;
if Compile_Only then
Add_Argument (Dash_c, True);
end if;
if Display_Compilation_Progress then
Add_Argument (Dash_d, True);
end if;
if Keep_Going then
Add_Argument (Dash_k, True);
end if;
if Force_Compilations then
Add_Argument (Dash_f, True);
end if;
if Verbose_Mode then
Add_Argument (Dash_v, True);
end if;
if Quiet_Output then
Add_Argument (Dash_q, True);
end if;
case Current_Verbosity is
when Default =>
null;
when Medium =>
Add_Argument (Dash_vP1, True);
when High =>
Add_Argument (Dash_vP2, True);
end case;
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
if Linker_Options.Last /= 0 then
Add_Argument (Dash_largs, True);
else
Add_Argument (Dash_largs, Verbose_Mode);
end if;
Add_Archives (For_Gnatmake => True);
for Arg in 1 .. Linker_Options.Last loop
Add_Argument (Linker_Options.Table (Arg), True);
end loop;
end if;
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);
if not Success then
Report_Error
("invocation of ",
Compiler_Names (Ada_Language_Index).all,
" failed");
end if;
end Compile_Link_With_Gnatmake;
procedure Compile_Sources is
Data : Project_Data;
Source_Id : Other_Source_Id;
Source : Other_Source;
Local_Errors : Boolean := False;
Need_To_Compile : Boolean;
Need_To_Rebuild_Archive : Boolean := Force_Compilations;
Total_Number_Of_Sources : Int := 0;
Current_Source_Number : Int := 0;
begin
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;
for Project in Project_Table.First ..
Project_Table.Last (Project_Tree.Projects)
loop
Local_Errors := False;
Data := Project_Tree.Projects.Table (Project);
if (not Data.Virtual) and then Data.Other_Sources_Present then
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;
Change_Dir (Get_Name_String (Data.Object_Directory));
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;
if not Need_To_Compile then
Check_Compilation_Needed (Source, Need_To_Compile);
end if;
if Need_To_Compile then
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;
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 not Local_Errors
and then Data.Library
and then not Data.Languages (Ada_Language_Index)
and then not Compile_Only
then
Build_Library (Project, Need_To_Rebuild_Archive);
end if;
end if;
end loop;
end Compile_Sources;
procedure Copyright is
begin
if not Copyright_Output then
Copyright_Output := True;
Write_Eol;
Write_Str ("GPRMAKE ");
Write_Str (Gnatvsn.Gnat_Version_String);
Write_Str (" Copyright 2004 Free Software Foundation, Inc.");
Write_Eol;
end if;
end Copyright;
procedure Create_Archive_Dependency_File
(Name : String;
First_Source : Other_Source_Id)
is
Source_Id : Other_Source_Id := First_Source;
Source : Other_Source;
Dep_File : Ada.Text_IO.File_Type;
begin
Create (Dep_File, Append_File, Name);
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;
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 (Dep_File, Append_File, Name);
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);
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;
procedure Display_Command
(Name : String;
Path : String_Access;
CPATH : String_Access := null)
is
begin
if Verbose_Mode or (not Quiet_Output) then
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;
for Arg in 1 .. Last_Argument loop
if Arguments_Displayed (Arg) then
Write_Char (' ');
Write_Str (Arguments (Arg).all);
end if;
end loop;
Write_Eol;
end if;
end Display_Command;
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);
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);
begin
if Compiler_Names (For_Language) = null then
if Compiler = Nil_Variable_Value then
if For_Language in Default_Compiler_Names'Range then
Compiler_Names (For_Language) :=
Default_Compiler_Names (For_Language);
else
Osint.Fail
("unknow compiler name for language """,
Get_Name_String (Language_Names.Table (For_Language)),
"""");
end if;
else
Compiler_Names (For_Language) :=
new String'(Get_Name_String (Compiler.Value));
end if;
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;
Compiler_Paths (For_Language) :=
Locate_Exec_On_Path (Compiler_Names (For_Language).all);
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;
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);
procedure Recursive_Get_Dirs (Prj : Project_Id);
procedure Add (Source_Dirs : String_List_Id) is
Element_Id : String_List_Id := Source_Dirs;
Element : String_Element;
Add_Arg : Boolean := True;
begin
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 Name_Len > 0 then
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
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;
procedure Recursive_Get_Dirs (Prj : Project_Id) is
Data : Project_Data;
Imported : Project_List;
begin
if Prj /= No_Project then
Data := Project_Tree.Projects.Table (Prj);
if not Data.Seen then
Project_Tree.Projects.Table (Prj).Seen := True;
if not Data.Virtual then
Add (Data.Source_Dirs);
end if;
Recursive_Get_Dirs (Data.Extends);
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;
begin
for J in Project_Table.First ..
Project_Table.Last (Project_Tree.Projects)
loop
Project_Tree.Projects.Table (J).Seen := False;
end loop;
Last_Argument := 0;
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));
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;
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;
Prj.Pars.Parse
(Project => Main_Project,
In_Tree => Project_Tree,
Project_File_Name => Project_File_Name.all,
Packages_To_Check => Packages_To_Check);
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;
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;
Check_For_C_Plus_Plus;
Compile_Sources;
Report_Total_Errors ("compilation");
if not Compile_Only
and then not Data.Library
and then Data.Object_Directory /= No_Name
then
Build_Global_Archive;
Link_Executables;
end if;
Report_Total_Errors ("linking");
end;
end if;
end Gprmake;
procedure Initialize is
begin
Csets.Initialize;
Namet.Initialize;
Snames.Initialize;
Prj.Initialize (Project_Tree);
Mains.Delete;
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;
X_Switches.Set_Last (0);
Scan_Args : for Next_Arg in 1 .. Argument_Count loop
Scan_Arg (Argument (Next_Arg));
end loop Scan_Args;
if Project_File_Name_Expected then
Osint.Fail ("project file name missing after -P");
elsif Output_File_Name_Expected then
Osint.Fail ("output file name missing after -o");
end if;
if Project_File_Name = null then
Usage;
Exit_Program (E_Success);
end if;
Osint.Add_Default_Search_Dirs;
end Initialize;
function Is_Included_In_Global_Archive
(Object_Name : Name_Id;
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;
procedure Link_Executables is
Data : constant Project_Data :=
Project_Tree.Projects.Table (Main_Project);
Mains_Specified : constant Boolean := Mains.Number_Of_Mains /= 0;
Object_Dir : constant String := Get_Name_String (Data.Object_Directory);
Source_Id : Other_Source_Id;
Source : Other_Source;
Success : Boolean;
Linker_Name : String_Access;
Linker_Path : String_Access;
Link_Done : Boolean := False;
procedure Add_C_Plus_Plus_Link_For_Gnatmake;
procedure Check_Time_Stamps (Exec_Time_Stamp : Time_Stamp_Type);
procedure Choose_C_Plus_Plus_Link_Process;
procedure Link_Foreign
(Main : String;
Main_Id : Name_Id;
Source : Other_Source);
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;
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);
if Data.Other_Sources_Present then
declare
Archive_Path : constant String :=
Get_Name_String
(Prj_Data.Object_Directory) &
Directory_Separator &
"lib" &
Get_Name_String (Prj_Data.Name) &
'.' & Archive_Ext;
Archive_TS : Time_Stamp_Type;
begin
Name_Len := 0;
Add_Str_To_Name_Buffer
(Archive_Path);
Archive_TS := File_Stamp (Name_Find);
if 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;
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;
procedure Link_Foreign
(Main : String;
Main_Id : Name_Id;
Source : Other_Source)
is
Executable_Name : constant String :=
Get_Name_String
(Executable_Of
(Project => Main_Project,
In_Tree => Project_Tree,
Main => Main_Id,
Index => 0,
Ada_Main => False));
Executable_Path : constant String :=
Get_Name_String
(Data.Exec_Directory) &
Directory_Separator &
Executable_Name;
Exec_Time_Stamp : Time_Stamp_Type;
begin
if not Need_To_Relink then
Name_Len := 0;
Add_Str_To_Name_Buffer (Executable_Path);
Exec_Time_Stamp := File_Stamp (Name_Find);
if Verbose_Mode then
Write_Str (" Checking executable ");
Write_Line (Executable_Name);
end if;
if Exec_Time_Stamp = Empty_Time_Stamp then
Need_To_Relink := True;
if Verbose_Mode then
Write_Line (" -> not found");
end if;
else
Check_Time_Stamps (Exec_Time_Stamp);
end if;
if Verbose_Mode and (not Need_To_Relink) then
Write_Line (" -> up to date");
end if;
end if;
if Need_To_Relink then
Link_Done := True;
Last_Argument := 0;
Add_Argument (Dash_o, True);
Add_Argument
(Get_Name_String (Data.Exec_Directory) &
Directory_Separator &
Get_Name_String
(Executable_Of
(Project => Main_Project,
In_Tree => Project_Tree,
Main => Main_Id,
Index => 0,
Ada_Main => False)),
True);
Add_Argument
(Object_Dir & Directory_Separator &
Get_Name_String (Source.Object_Name),
True);
Add_Archives (For_Gnatmake => False);
Add_Switches
(Data => Data,
Proc => Linker,
Language => Source.Language,
File_Name => Main_Id);
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);
for Arg in 1 .. Linker_Options.Last loop
Add_Argument (Linker_Options.Table (Arg), True);
end loop;
if Lib_Path.Last > 0 then
Add_Argument
(Path_Option.all &
String (Lib_Path.Table (1 .. Lib_Path.Last)),
Verbose_Mode);
end if;
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;
begin
if not Mains_Specified then
declare
Element_Id : String_List_Id := Data.Mains;
Element : String_Element;
begin
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 Verbose_Mode then
Write_Line ("No main to link");
end if;
return;
end if;
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;
if not Data.Other_Sources_Present then
if not Data.Languages (Ada_Language_Index) then
Osint.Fail
("project """,
Get_Name_String (Data.Name),
""" has no sources, so no main can be linked");
else
Last_Argument := 0;
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
if Data.Languages (Ada_Language_Index) then
Mains.Reset;
Ada_Mains.Set_Last (0);
Other_Mains.Set_Last (0);
loop
declare
Main : constant String := Mains.Next_Main;
Main_Id : Name_Id;
begin
exit when Main'Length = 0;
Name_Len := 0;
Add_Str_To_Name_Buffer (Main);
Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
Main_Id := Name_Find;
Source_Id := Data.First_Other_Source;
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 Source_Id = No_Other_Source then
Ada_Mains.Increment_Last;
Ada_Mains.Table (Ada_Mains.Last) := new String'(Main);
else
Other_Mains.Increment_Last;
Other_Mains.Table (Other_Mains.Last) := Source;
end if;
end;
end loop;
if C_Plus_Plus_Is_Used then
Choose_C_Plus_Plus_Link_Process;
end if;
for Main in 1 .. Other_Mains.Last loop
declare
Source : constant Other_Source := Other_Mains.Table (Main);
begin
Last_Argument := 0;
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;
Add_Argument (Dash_B, True);
Add_Argument (Dash_largs, Verbose_Mode);
Add_Argument
(Get_Name_String (Source.Object_Name), Verbose_Mode);
if C_Plus_Plus_Is_Used then
Add_C_Plus_Plus_Link_For_Gnatmake;
end if;
Add_Argument (Dash_margs, Verbose_Mode);
Compile_Link_With_Gnatmake (Mains_Specified => False);
end;
end loop;
if Ada_Mains.Last /= 0 then
Last_Argument := 0;
for Main in 1 .. Ada_Mains.Last loop
Add_Argument (Ada_Mains.Table (Main).all, True);
end loop;
if Data.Languages (C_Plus_Plus_Language_Index) then
Add_Argument (Dash_largs, Verbose_Mode);
Add_C_Plus_Plus_Link_For_Gnatmake;
Add_Argument (Dash_margs, Verbose_Mode);
end if;
Compile_Link_With_Gnatmake (Mains_Specified => False);
end if;
else
if Data.Languages (C_Plus_Plus_Language_Index) then
Get_Compiler (C_Plus_Plus_Language_Index);
Linker_Name := Compiler_Names (C_Plus_Plus_Language_Index);
Linker_Path := Compiler_Paths (C_Plus_Plus_Language_Index);
else
Get_Compiler (C_Language_Index);
Linker_Name := Compiler_Names (C_Language_Index);
Linker_Path := Compiler_Paths (C_Language_Index);
end if;
Link_Done := False;
Mains.Reset;
loop
declare
Main : constant String := Mains.Next_Main;
Main_Id : Name_Id;
begin
exit when Main'Length = 0;
Name_Len := 0;
Add_Str_To_Name_Buffer (Main);
Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
Main_Id := Name_Find;
Source_Id := Data.First_Other_Source;
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 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 (Verbose_Mode or (not Quiet_Output)) and (not Link_Done) then
Osint.Write_Program_Name;
if Mains.Number_Of_Mains = 1 then
Write_Str (": """);
Mains.Reset;
declare
Main : constant String := Mains.Next_Main;
Main_Id : Name_Id;
begin
Name_Len := 0;
Add_Str_To_Name_Buffer (Main);
Main_Id := Name_Find;
Write_Str
(Get_Name_String
(Executable_Of
(Project => Main_Project,
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;
procedure Report_Error
(S1 : String;
S2 : String := "";
S3 : String := "")
is
begin
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;
else
Osint.Fail (S1, S2, S3);
end if;
end Report_Error;
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;
procedure Scan_Arg (Arg : String) is
begin
pragma Assert (Arg'First = 1);
if Arg'Length = 0 then
return;
end if;
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;
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;
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;
elsif Arg = "-gargs" then
Current_Processor := None;
elsif Current_Processor = Linker and then Arg = "-o" then
Osint.Fail
("switch -o not allowed within a -largs. Use -o directly.");
elsif Current_Processor /= None then
Add_Option (Arg);
elsif Arg (1) = '-' then
if Arg = "-c" then
Compile_Only := True;
if Mains.Number_Of_Mains > 0 then
Unique_Compile := True;
end if;
elsif Arg = "-d" then
Display_Compilation_Progress := True;
elsif Arg = "-f" then
Force_Compilations := True;
elsif Arg = "-h" then
Usage;
elsif Arg = "-k" then
Keep_Going := True;
elsif Arg = "-o" then
if Output_File_Name /= null then
Osint.Fail ("cannot specify several -o switches");
else
Output_File_Name_Expected := True;
end if;
elsif Arg'Length >= 2 and then Arg (2) = 'P' then
if Project_File_Name /= null then
Osint.Fail ("cannot have several project files specified");
elsif Arg'Length = 2 then
Project_File_Name_Expected := True;
else
Project_File_Name := new String'(Arg (3 .. Arg'Last));
end if;
elsif Arg = "-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
X_Switches.Increment_Last;
X_Switches.Table (X_Switches.Last) := new String'(Arg);
else
Osint.Fail ("illegal option """, Arg, """");
end if;
else
Mains.Add_Main (Arg);
if Compile_Only then
Unique_Compile := True;
end if;
end if;
end Scan_Arg;
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;
procedure Usage is
begin
if not Usage_Output then
Usage_Output := True;
Copyright;
Write_Str ("Usage: ");
Osint.Write_Program_Name;
Write_Str (" -P<project file> [opts] [name] {");
for Lang in First_Language_Indexes loop
Write_Str ("[-cargs:lang opts] ");
end loop;
Write_Str ("[-largs opts] [-gargs opts]}");
Write_Eol;
Write_Eol;
Write_Str (" name is zero or more file names");
Write_Eol;
Write_Eol;
Write_Str ("gprmake switches:");
Write_Eol;
Write_Str (" -c Compile only");
Write_Eol;
Write_Str (" -f Force recompilations");
Write_Eol;
Write_Str (" -k Keep going after compilation errors");
Write_Eol;
Write_Str (" -o name Choose an alternate executable name");
Write_Eol;
Write_Str (" -Pproj Use GNAT Project File proj");
Write_Eol;
Write_Str (" -q Be quiet/terse");
Write_Eol;
Write_Str
(" -u Unique compilation. Only compile the given files");
Write_Eol;
Write_Str (" -v Verbose output");
Write_Eol;
Write_Str (" -vPx Specify verbosity when parsing Project Files");
Write_Eol;
Write_Str (" -Xnm=val Specify an external reference for " &
"Project Files");
Write_Eol;
Write_Eol;
Write_Line (" -cargs opts opts are passed to the Ada compiler");
Write_Line (" -cargs:<lang> opts");
Write_Line (" opts are passed to the compiler " &
"for language < lang > ");
Write_Str (" -largs opts opts are passed to the linker");
Write_Eol;
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;