with Ada.Characters.Handling; use Ada.Characters.Handling;
with Ada.Strings.Fixed; use Ada.Strings.Fixed;
with Bld.IO;
with Csets;
with GNAT.HTable;
with GNAT.Case_Util; use GNAT.Case_Util;
with GNAT.Command_Line; use GNAT.Command_Line;
with GNAT.Directory_Operations; use GNAT.Directory_Operations;
with GNAT.OS_Lib; use GNAT.OS_Lib;
with Erroutc; use Erroutc;
with Err_Vars; use Err_Vars;
with Gnatvsn;
with Namet; use Namet;
with Opt; use Opt;
with Output; use Output;
with Prj; use Prj;
with Prj.Com; use Prj.Com;
with Prj.Err; use Prj.Err;
with Prj.Part;
with Prj.Tree; use Prj.Tree;
with Snames;
with Table;
with Types; use Types;
package body Bld is
function "=" (Left, Right : IO.Position) return Boolean
renames IO."=";
MAKE_ROOT : constant String := "MAKE_ROOT";
Process_All_Project_Files : Boolean := True;
Copyright_Displayed : Boolean := False;
Usage_Displayed : Boolean := False;
type Expression_Kind_Type is (Undecided, Static_String, Other);
Expression_Kind : Expression_Kind_Type := Undecided;
Expression_Value : String_Access := new String (1 .. 10);
Expression_Last : Natural := 0;
C_Suffix : String_Access := new String (1 .. 10);
C_Suffix_Last : Natural := 0;
C_Suffix_Static : Boolean := True;
Cxx_Suffix : String_Access := new String (1 .. 10);
Cxx_Suffix_Last : Natural := 0;
Cxx_Suffix_Static : Boolean := True;
Ada_Spec_Suffix : String_Access := new String (1 .. 10);
Ada_Spec_Suffix_Last : Natural := 0;
Ada_Spec_Suffix_Static : Boolean := True;
Ada_Body_Suffix : String_Access := new String (1 .. 10);
Ada_Body_Suffix_Last : Natural := 0;
Ada_Body_Suffix_Static : Boolean := True;
Languages : String_Access := new String (1 .. 50);
Languages_Last : Natural := 0;
Languages_Static : Boolean := True;
type Source_Kind_Type is (Unknown, Ada_Spec, Ada_Body, C, Cxx, None);
Default_Switches_Package : Name_Id := No_Name;
Default_Switches_Language : Name_Id := No_Name;
Switches_Package : Name_Id := No_Name;
Switches_Language : Source_Kind_Type := Unknown;
Other_Attribute : Boolean := False;
Other_Attribute_Package : Name_Id := No_Name;
Other_Attribute_Name : Name_Id := No_Name;
type Declaration_Type is (False, May_Be, True);
Source_Files_Declaration : Declaration_Type := False;
Source_List_File_Declaration : Declaration_Type := False;
Name_Ide : Name_Id := No_Name;
Name_Compiler_Command : Name_Id := No_Name;
Name_Main_Language : Name_Id := No_Name;
Name_C_Plus_Plus : Name_Id := No_Name;
package Processed_Projects is new GNAT.HTable.Simple_HTable
(Header_Num => Header_Num,
Element => Project_Node_Id,
No_Element => Empty_Node,
Key => Name_Id,
Hash => Hash,
Equal => "=");
package Externals is new GNAT.HTable.Simple_HTable
(Header_Num => Header_Num,
Element => Natural,
No_Element => 0,
Key => Project_Node_Id,
Hash => Hash,
Equal => "=");
package Variable_Names is new Table.Table
(Table_Component_Type => Name_Id,
Table_Index_Type => Natural,
Table_Low_Bound => 1,
Table_Initial => 10,
Table_Increment => 10,
Table_Name => "Bld.Variable_Names");
package Switches is new Table.Table
(Table_Component_Type => Name_Id,
Table_Index_Type => Natural,
Table_Low_Bound => 1,
Table_Initial => 10,
Table_Increment => 10,
Table_Name => "Bld.Switches");
Last_External : Natural := 0;
Last_Case_Construction : Natural := 0;
Saved_Suffix : constant String := ".saved";
Ada_Body_String : aliased String := "ADA_BODY";
Ada_Flags_String : aliased String := "ADA_FLAGS";
Ada_Mains_String : aliased String := "ADA_MAINS";
Ada_Sources_String : aliased String := "ADA_SOURCES";
Ada_Spec_String : aliased String := "ADA_SPEC";
Ar_Cmd_String : aliased String := "AR_CMD";
Ar_Ext_String : aliased String := "AR_EXT";
Base_Dir_String : aliased String := "BASE_DIR";
Cc_String : aliased String := "CC";
C_Ext_String : aliased String := "C_EXT";
Cflags_String : aliased String := "CFLAGS";
Cxx_String : aliased String := "CXX";
Cxx_Ext_String : aliased String := "CXX_EXT";
Cxxflags_String : aliased String := "CXXFLAGS";
Deps_Projects_String : aliased String := "DEPS_PROJECT";
Exec_String : aliased String := "EXEC";
Exec_Dir_String : aliased String := "EXEC_DIR";
Fldflags_String : aliased String := "FLDFLAGS";
Gnatmake_String : aliased String := "GNATMAKE";
Languages_String : aliased String := "LANGUAGES";
Ld_Flags_String : aliased String := "LD_FLAGS";
Libs_String : aliased String := "LIBS";
Main_String : aliased String := "MAIN";
Obj_Ext_String : aliased String := "OBJ_EXT";
Obj_Dir_String : aliased String := "OBJ_DIR";
Project_File_String : aliased String := "PROJECT_FILE";
Src_Dirs_String : aliased String := "SRC_DIRS";
type Reserved_Variable_Array is array (Positive range <>) of String_Access;
Reserved_Variables : constant Reserved_Variable_Array :=
(Ada_Body_String 'Access,
Ada_Flags_String 'Access,
Ada_Mains_String 'Access,
Ada_Sources_String 'Access,
Ada_Spec_String 'Access,
Ar_Cmd_String 'Access,
Ar_Ext_String 'Access,
Base_Dir_String 'Access,
Cc_String 'Access,
C_Ext_String 'Access,
Cflags_String 'Access,
Cxx_String 'Access,
Cxx_Ext_String 'Access,
Cxxflags_String 'Access,
Deps_Projects_String'Access,
Exec_String 'Access,
Exec_Dir_String 'Access,
Fldflags_String 'Access,
Gnatmake_String 'Access,
Languages_String 'Access,
Ld_Flags_String 'Access,
Libs_String 'Access,
Main_String 'Access,
Obj_Ext_String 'Access,
Obj_Dir_String 'Access,
Project_File_String 'Access,
Src_Dirs_String 'Access);
Main_Project_File_Name : String_Access;
Project_Tree : Project_Node_Id;
procedure Add_To_Expression_Value (S : String);
procedure Add_To_Expression_Value (S : Name_Id);
procedure Display_Copyright;
function Equal_String (Left, Right : Name_Id) return Boolean;
procedure Expression
(Project : Project_Node_Id;
First_Term : Project_Node_Id;
Kind : Variable_Kind;
In_Case : Boolean;
Reset : Boolean := False);
procedure New_Line;
procedure Process (Project : Project_Node_Id);
procedure Process_Case_Construction
(Current_Project : Project_Node_Id;
Current_Pkg : Name_Id;
Case_Project : Project_Node_Id;
Case_Pkg : Name_Id;
Name : Name_Id;
Node : Project_Node_Id);
procedure Process_Declarative_Items
(Project : Project_Node_Id;
Pkg : Name_Id;
In_Case : Boolean;
Item : Project_Node_Id);
procedure Process_Externals (Project : Project_Node_Id);
procedure Put (S : String; With_Substitution : Boolean := False);
procedure Put (S : Name_Id);
procedure Put (P : Positive);
procedure Put_Attribute
(Project : Project_Node_Id;
Pkg : Name_Id;
Name : Name_Id;
Index : Name_Id);
procedure Put_Directory_Separator;
procedure Put_Include_Project
(Included_Project_Path : Name_Id;
Included_Project : Project_Node_Id;
Including_Project_Name : String);
procedure Put_Line (S : String);
procedure Put_L_Name (N : Name_Id);
procedure Put_M_Name (N : Name_Id);
procedure Put_U_Name (N : Name_Id);
procedure Special_Put_U_Name (S : Name_Id);
procedure Put_Variable
(Project : Project_Node_Id;
Pkg : Name_Id;
Name : Name_Id);
procedure Recursive_Process (Project : Project_Node_Id);
procedure Reset_Suffixes_And_Languages;
function Source_Kind_Of (File_Name : Name_Id) return Source_Kind_Type;
function Suffix_Of
(Static : Boolean;
Value : String_Access;
Last : Natural;
Default : String) return String;
procedure Usage;
procedure Add_To_Expression_Value (S : String) is
begin
while Expression_Last + S'Length > Expression_Value'Last loop
declare
New_Value : constant String_Access :=
new String (1 .. 2 * Expression_Value'Last);
begin
New_Value (1 .. Expression_Last) :=
Expression_Value (1 .. Expression_Last);
Free (Expression_Value);
Expression_Value := New_Value;
end;
end loop;
Expression_Value (Expression_Last + 1 .. Expression_Last + S'Length)
:= S;
Expression_Last := Expression_Last + S'Length;
end Add_To_Expression_Value;
procedure Add_To_Expression_Value (S : Name_Id) is
begin
Get_Name_String (S);
Add_To_Expression_Value (S => Name_Buffer (1 .. Name_Len));
end Add_To_Expression_Value;
procedure Display_Copyright is
begin
if not Copyright_Displayed then
Copyright_Displayed := True;
Write_Str ("GPR2MAKE ");
Write_Str (Gnatvsn.Gnat_Version_String);
Write_Str (" Copyright 2002-2004 Free Software Foundation, Inc.");
Write_Eol;
Write_Eol;
end if;
end Display_Copyright;
function Equal_String (Left, Right : Name_Id) return Boolean is
begin
Get_Name_String (Left);
declare
Left_Value : constant String :=
To_Lower (Name_Buffer (1 .. Name_Len));
begin
Get_Name_String (Right);
return Left_Value = To_Lower (Name_Buffer (1 .. Name_Len));
end;
end Equal_String;
procedure Expression
(Project : Project_Node_Id;
First_Term : Project_Node_Id;
Kind : Variable_Kind;
In_Case : Boolean;
Reset : Boolean := False)
is
Term : Project_Node_Id := First_Term;
Current_Term : Project_Node_Id := Empty_Node;
begin
if In_Case then
Expression_Kind := Other;
elsif Reset then
Expression_Kind := Undecided;
Expression_Last := 0;
end if;
while Term /= Empty_Node loop
Current_Term := Tree.Current_Term (Term);
case Kind_Of (Current_Term) is
when N_Literal_String =>
if Kind = List then
Put (" ");
end if;
if Expression_Kind = Undecided
or else Expression_Kind = Static_String
then
Expression_Kind := Static_String;
if Kind = List then
Add_To_Expression_Value (" ");
end if;
Add_To_Expression_Value (String_Value_Of (Current_Term));
end if;
Put (String_Value_Of (Current_Term));
when N_Literal_String_List =>
declare
String_Node : Project_Node_Id :=
First_Expression_In_List (Current_Term);
begin
if String_Node = Empty_Node then
if Expression_Kind = Undecided then
Expression_Kind := Static_String;
end if;
else
Expression
(Project => Project,
First_Term => Tree.First_Term (String_Node),
Kind => Single,
In_Case => In_Case);
loop
String_Node :=
Next_Expression_In_List (String_Node);
exit when String_Node = Empty_Node;
Put (" ");
Add_To_Expression_Value (" ");
Expression
(Project => Project,
First_Term => Tree.First_Term (String_Node),
Kind => Single,
In_Case => In_Case);
end loop;
end if;
end;
when N_Variable_Reference | N_Attribute_Reference =>
Expression_Kind := Other;
declare
Term_Project : Project_Node_Id :=
Project_Node_Of (Current_Term);
Term_Package : constant Project_Node_Id :=
Package_Node_Of (Current_Term);
Name : constant Name_Id := Name_Of (Current_Term);
Term_Package_Name : Name_Id := No_Name;
begin
if Term_Project = Empty_Node then
Term_Project := Project;
end if;
if Term_Package /= Empty_Node then
Term_Package_Name := Name_Of (Term_Package);
end if;
if Kind = List then
Put (" ");
end if;
Put ("$(");
if Kind_Of (Current_Term) = N_Variable_Reference then
Put_Variable
(Project => Term_Project,
Pkg => Term_Package_Name,
Name => Name);
else
if Name = Snames.Name_Default_Switches then
if Default_Switches_Package /= Term_Package_Name
or else not Equal_String
(Default_Switches_Language,
Associative_Array_Index_Of
(Current_Term))
then
Error_Msg_Name_1 := Term_Package_Name;
Error_Msg
("reference to `%''Default_Switches` " &
"not allowed here",
Location_Of (Current_Term));
end if;
elsif Name = Snames.Name_Switches then
if Switches_Package /= Term_Package_Name
or else Source_Kind_Of (Associative_Array_Index_Of
(Current_Term))
/= Switches_Language
then
Error_Msg_Name_1 := Term_Package_Name;
Error_Msg
("reference to `%''Switches` " &
"not allowed here",
Location_Of (Current_Term));
end if;
else
if not Other_Attribute
or else Other_Attribute_Package /= Term_Package_Name
or else Other_Attribute_Name /= Name
then
if Term_Package_Name = No_Name then
Error_Msg_Name_1 := Name;
Error_Msg
("reference to % not allowed here",
Location_Of (Current_Term));
else
Error_Msg_Name_1 := Term_Package_Name;
Error_Msg_Name_2 := Name;
Error_Msg
("reference to `%''%` not allowed here",
Location_Of (Current_Term));
end if;
end if;
end if;
Put_Attribute
(Project => Term_Project,
Pkg => Term_Package_Name,
Name => Name,
Index => Associative_Array_Index_Of (Current_Term));
end if;
Put (")");
end;
when N_External_Value =>
Expression_Kind := Other;
Put ("$(");
Put_U_Name (Name_Of (Project));
Put (".external.");
Put (Externals.Get (Current_Term));
Put (")");
when others =>
pragma Assert
(False,
"illegal node kind in an expression");
raise Program_Error;
end case;
Term := Next_Term (Term);
end loop;
end Expression;
procedure Gpr2make is
begin
loop
case Getopt ("h q v R") is
when ASCII.NUL =>
exit;
when 'h' =>
Usage;
when 'q' =>
Opt.Quiet_Output := True;
when 'v' =>
Opt.Verbose_Mode := True;
Display_Copyright;
when 'R' =>
Process_All_Project_Files := False;
when others =>
raise Program_Error;
end case;
end loop;
loop
declare
S : constant String := Get_Argument (Do_Expansion => True);
begin
exit when S'Length = 0;
if Main_Project_File_Name /= null then
Fail ("only one project file may be specified");
else
Main_Project_File_Name := new String'(S);
end if;
end;
end loop;
if Main_Project_File_Name = null then
Usage;
return;
end if;
Csets.Initialize;
Namet.Initialize;
Snames.Initialize;
Prj.Initialize;
Prj.Part.Parse (Project_Tree, Main_Project_File_Name.all, False);
if Project_Tree /= Empty_Node then
Name_Len := 3;
Name_Buffer (1 .. Name_Len) := "ide";
Name_Ide := Name_Find;
Name_Len := 16;
Name_Buffer (1 .. Name_Len) := "compiler_command";
Name_Compiler_Command := Name_Find;
Name_Len := 13;
Name_Buffer (1 .. Name_Len) := "main_language";
Name_Main_Language := Name_Find;
Name_Len := 3;
Name_Buffer (1 .. Name_Len) := "c++";
Name_C_Plus_Plus := Name_Find;
Process (Project_Tree);
if Compilation_Errors then
if not Verbose_Mode then
Write_Eol;
end if;
Prj.Err.Finalize;
Write_Eol;
IO.Delete_All;
Fail ("no Makefile created");
end if;
end if;
end Gpr2make;
procedure New_Line is
begin
IO.New_Line;
end New_Line;
procedure Process (Project : Project_Node_Id) is
begin
Processed_Projects.Reset;
Recursive_Process (Project);
end Process;
procedure Process_Case_Construction
(Current_Project : Project_Node_Id;
Current_Pkg : Name_Id;
Case_Project : Project_Node_Id;
Case_Pkg : Name_Id;
Name : Name_Id;
Node : Project_Node_Id)
is
Case_Project_Name : constant Name_Id := Name_Of (Case_Project);
Before : IO.Position;
Start : IO.Position;
After : IO.Position;
procedure Put_Case_Construction;
procedure Recursive_Process
(Case_Item : Project_Node_Id;
Branch_Number : Positive);
procedure Put_Variable_Name;
procedure Put_Case_Construction is
begin
Put_U_Name (Case_Project_Name);
Put (".case.");
Put (Last_Case_Construction);
end Put_Case_Construction;
procedure Recursive_Process
(Case_Item : Project_Node_Id;
Branch_Number : Positive)
is
Choice_String : Project_Node_Id := First_Choice_Of (Case_Item);
Before : IO.Position;
Start : IO.Position;
After : IO.Position;
No_Lines : Boolean := False;
begin
if Case_Item /= Empty_Node then
IO.Mark (Before);
if Choice_String = Empty_Node then
Put_Line ("# when others => ...");
IO.Mark (Start);
Process_Declarative_Items
(Project => Current_Project,
Pkg => Current_Pkg,
In_Case => True,
Item => First_Declarative_Item_Of (Case_Item));
IO.Mark (After);
if Start = After then
IO.Release (Before);
end if;
else
Put ("# when """);
Put (String_Value_Of (Choice_String));
Put ("""");
if Next_Literal_String (Choice_String) /= Empty_Node then
Put (" | ...");
end if;
Put (" => ...");
New_Line;
Put ("ifeq ($(");
Put_Variable_Name;
Put ("),");
Put (String_Value_Of (Choice_String));
Put (")");
New_Line;
if Next_Literal_String (Choice_String) /= Empty_Node then
loop
Put_Case_Construction;
Put (":=");
Put (Branch_Number);
New_Line;
Put_Line ("endif");
Choice_String := Next_Literal_String (Choice_String);
exit when Choice_String = Empty_Node;
Put ("ifeq ($(");
Put_Variable_Name;
Put ("),");
Put (String_Value_Of (Choice_String));
Put (")");
New_Line;
end loop;
Put ("ifeq ($(");
Put_Case_Construction;
Put ("),");
Put (Branch_Number);
Put (")");
New_Line;
end if;
IO.Mark (Start);
Process_Declarative_Items
(Project => Current_Project,
Pkg => Current_Pkg,
In_Case => True,
Item => First_Declarative_Item_Of (Case_Item));
IO.Mark (After);
No_Lines := Start = After;
if No_Lines then
IO.Release (Before);
end if;
if Next_Case_Item (Case_Item) /= Empty_Node then
if not No_Lines then
IO.Mark (Before);
Put_Line ("else");
IO.Mark (Start);
end if;
Recursive_Process
(Case_Item => Next_Case_Item (Case_Item),
Branch_Number => Branch_Number + 1);
if not No_Lines then
IO.Mark (After);
if After = Start then
IO.Release (Before);
end if;
end if;
end if;
if not No_Lines then
Put_Line ("endif");
end if;
end if;
end if;
end Recursive_Process;
procedure Put_Variable_Name is
begin
Put_Variable (Case_Project, Case_Pkg, Name);
end Put_Variable_Name;
begin
Last_Case_Construction := Last_Case_Construction + 1;
IO.Mark (Before);
New_Line;
Put ("# case ");
Put_M_Name (Case_Project_Name);
if Case_Pkg /= No_Name then
Put (".");
Put_M_Name (Case_Pkg);
end if;
Put (".");
Put_M_Name (Name);
Put (" is ...");
New_Line;
IO.Mark (Start);
Recursive_Process
(Case_Item => First_Case_Item_Of (Node),
Branch_Number => 1);
IO.Mark (After);
if Start = After then
IO.Release (Before);
else
Put_Line ("# end case;");
New_Line;
end if;
end Process_Case_Construction;
procedure Process_Declarative_Items
(Project : Project_Node_Id;
Pkg : Name_Id;
In_Case : Boolean;
Item : Project_Node_Id)
is
Current_Declarative_Item : Project_Node_Id := Item;
Current_Item : Project_Node_Id := Empty_Node;
Project_Name : constant String :=
To_Upper (Get_Name_String (Name_Of (Project)));
Item_Name : Name_Id := No_Name;
begin
while Current_Declarative_Item /= Empty_Node loop
Current_Item := Current_Item_Node (Current_Declarative_Item);
Current_Declarative_Item := Next_Declarative_Item
(Current_Declarative_Item);
Other_Attribute := False;
case Kind_Of (Current_Item) is
when N_Package_Declaration =>
Item_Name := Name_Of (Current_Item);
declare
Real_Project : constant Project_Node_Id :=
Project_Of_Renamed_Package_Of
(Current_Item);
Before_Package : IO.Position;
Start_Of_Package : IO.Position;
End_Of_Package : IO.Position;
Decl_Item : Project_Node_Id;
begin
if Real_Project /= Empty_Node then
Decl_Item :=
First_Declarative_Item_Of
(Project_Declaration_Of (Real_Project));
while Decl_Item /= Empty_Node loop
Current_Item := Current_Item_Node (Decl_Item);
exit when Kind_Of (Current_Item)
= N_Package_Declaration
and then Name_Of (Current_Item) = Item_Name;
Decl_Item := Next_Declarative_Item (Decl_Item);
end loop;
end if;
IO.Mark (Before_Package);
New_Line;
Put ("# package ");
Put_M_Name (Item_Name);
Put (" is ...");
New_Line;
IO.Mark (Start_Of_Package);
Process_Declarative_Items
(Project => Project,
Pkg => Item_Name,
In_Case => False,
Item => First_Declarative_Item_Of (Current_Item));
Variable_Names.Init;
IO.Mark (End_Of_Package);
if End_Of_Package = Start_Of_Package then
IO.Release (Before_Package);
else
Put ("# end ");
Put_M_Name (Item_Name);
Put (";");
New_Line;
New_Line;
end if;
end;
when N_Variable_Declaration | N_Typed_Variable_Declaration =>
Item_Name := Name_Of (Current_Item);
Put ("# ");
Put_M_Name (Item_Name);
Put (" := ...");
New_Line;
if Pkg /= No_Name then
declare
Found : Boolean := False;
begin
for
Index in Variable_Names.First .. Variable_Names.Last
loop
if Variable_Names.Table (Index) = Item_Name then
Found := True;
exit;
end if;
end loop;
if not Found then
Variable_Names.Increment_Last;
Variable_Names.Table (Variable_Names.Last) :=
Item_Name;
end if;
end;
end if;
Put_Variable (Project, Pkg, Item_Name);
Put (":=");
Expression
(Project => Project,
First_Term => Tree.First_Term (Expression_Of (Current_Item)),
Kind => Expression_Kind_Of (Current_Item),
In_Case => In_Case);
New_Line;
when N_Attribute_Declaration =>
Item_Name := Name_Of (Current_Item);
declare
Index : constant Name_Id :=
Associative_Array_Index_Of (Current_Item);
Pos_Comment : IO.Position;
Put_Declaration : Boolean := True;
begin
if Item_Name = Snames.Name_Default_Switches then
Default_Switches_Package := Pkg;
Default_Switches_Language := Index;
elsif Item_Name = Snames.Name_Switches then
Switches_Package := Pkg;
Switches_Language := Source_Kind_Of (Index);
else
Other_Attribute := True;
Other_Attribute_Package := Pkg;
Other_Attribute_Name := Item_Name;
end if;
IO.Mark (Pos_Comment);
Put ("# for ");
Put_M_Name (Item_Name);
if Index /= No_Name then
Put (" (""");
Put (Index);
Put (""")");
end if;
Put (" use ...");
New_Line;
Put_Attribute (Project, Pkg, Item_Name, Index);
Put (":=");
Expression
(Project => Project,
First_Term =>
Tree.First_Term (Expression_Of (Current_Item)),
Kind => Expression_Kind_Of (Current_Item),
In_Case => In_Case,
Reset => True);
New_Line;
if Item_Name = Snames.Name_Default_Switches then
Get_Name_String (Index);
To_Lower (Name_Buffer (1 .. Name_Len));
Put_Declaration :=
Name_Buffer (1 .. Name_Len) = "c" or else
Name_Buffer (1 .. Name_Len) = "c++";
elsif Item_Name = Snames.Name_Switches then
Put_Declaration :=
Switches_Language = Unknown
or else Switches_Language = C
or else Switches_Language = Cxx;
end if;
Put_Declaration := Put_Declaration and
(Pkg = No_Name
or else Pkg = Snames.Name_Naming
or else Pkg = Snames.Name_Compiler
or else Pkg = Name_Ide
or else Pkg = Snames.Name_Linker);
if Put_Declaration then
if Pkg = No_Name then
if Item_Name = Snames.Name_Languages then
Put ("LANGUAGES:=");
if Expression_Kind = Static_String then
Put (To_Lower (Expression_Value
(1 .. Expression_Last)));
else
Put ("$(shell gprcmd to_lower $(");
Put_Attribute
(Project, No_Name, Item_Name, No_Name);
Put ("))");
end if;
New_Line;
if Expression_Kind /= Static_String then
Languages_Static := False;
elsif Languages_Static then
To_Lower
(Expression_Value (1 .. Expression_Last));
if Languages_Last = 0 then
if Languages'Last < Expression_Last + 2 then
Free (Languages);
Languages :=
new String (1 .. Expression_Last + 2);
end if;
Languages (1) := ' ';
Languages (2 .. Expression_Last + 1) :=
Expression_Value (1 .. Expression_Last);
Languages_Last := Expression_Last + 2;
Languages (Languages_Last) := ' ';
else
Languages_Static :=
Languages (2 .. Languages_Last - 1) =
Expression_Value (1 .. Expression_Last);
end if;
end if;
elsif Item_Name = Snames.Name_Source_Dirs then
Put (Project_Name &
".src_dirs:=$(foreach name,$(");
Put_Attribute (Project, Pkg, Item_Name, No_Name);
Put ("),$(shell gprcmd extend $(");
Put (Project_Name);
Put_Line (".base_dir) '""$(name)""'))");
elsif Item_Name = Snames.Name_Source_Files then
Put (Project_Name);
Put (".src_files:=$(");
Put_Attribute (Project, Pkg, Item_Name, No_Name);
Put (")");
New_Line;
if In_Case then
if Source_Files_Declaration = False then
Source_Files_Declaration := May_Be;
end if;
if Source_Files_Declaration /= True then
Put_Line ("src_files.specified:=TRUE");
end if;
else
Source_Files_Declaration := True;
end if;
elsif Item_Name = Snames.Name_Source_List_File then
Put ("src.list_file:=" &
"$(strip $(shell gprcmd to_absolute $(");
Put (Project_Name);
Put (".base_dir) '$(");
Put_Attribute (Project, Pkg, Item_Name, No_Name);
Put_Line (")'))");
if In_Case then
if Source_List_File_Declaration = False then
Source_List_File_Declaration := May_Be;
end if;
if Source_Files_Declaration /= True
and then Source_List_File_Declaration /= True
then
Put_Line ("src_list_file.specified:=TRUE");
end if;
else
Source_List_File_Declaration := True;
end if;
elsif Item_Name = Snames.Name_Object_Dir then
Put (Project_Name);
Put (".obj_dir:=" &
"$(strip $(shell gprcmd to_absolute $(");
Put (Project_Name);
Put (".base_dir) '$(");
Put_Attribute (Project, Pkg, Item_Name, No_Name);
Put_Line (")'))");
elsif Item_Name = Snames.Name_Exec_Dir then
Put ("EXEC_DIR:=" &
"$(strip $(shell gprcmd to_absolute $(");
Put (Project_Name);
Put (".base_dir) '$(");
Put_Attribute (Project, Pkg, Item_Name, No_Name);
Put_Line (")'))");
elsif Item_Name = Snames.Name_Main then
Put ("ADA_MAINS:=$(");
Put_Attribute (Project, Pkg, Item_Name, No_Name);
Put (")");
New_Line;
elsif Item_Name = Name_Main_Language then
Put ("MAIN:=");
if Expression_Kind = Static_String then
Put (To_Lower (Expression_Value
(1 .. Expression_Last)));
else
Put ("$(shell gprcmd to_lower $(");
Put_Attribute
(Project, No_Name, Item_Name, No_Name);
Put ("))");
end if;
New_Line;
else
Put_Declaration := False;
end if;
elsif Pkg = Snames.Name_Compiler then
if Item_Name = Snames.Name_Switches then
declare
Found : Boolean := False;
begin
for J in Switches.First .. Switches.Last loop
if Switches.Table (J) = Index then
Found := True;
exit;
end if;
end loop;
if not Found then
Switches.Increment_Last;
Switches.Table (Switches.Last) := Index;
end if;
end;
elsif Item_Name = Snames.Name_Default_Switches then
Get_Name_String (Index);
To_Lower (Name_Buffer (1 .. Name_Len));
if Name_Buffer (1 .. Name_Len) = "c" then
Put ("CFLAGS:=$(");
Put_Attribute (Project, Pkg, Item_Name, Index);
Put (")");
New_Line;
elsif Name_Buffer (1 .. Name_Len) = "c++" then
Put ("CXXFLAGS:=$(");
Put_Attribute (Project, Pkg, Item_Name, Index);
Put (")");
New_Line;
end if;
else
Put_Declaration := False;
end if;
elsif Pkg = Name_Ide then
if Item_Name = Name_Compiler_Command then
declare
Index_Name : Name_Id := No_Name;
begin
Get_Name_String (Index);
To_Lower (Name_Buffer (1 .. Name_Len));
Index_Name := Name_Find;
if Index_Name = Snames.Name_Ada then
Put ("GNATMAKE:=$(");
Put_Attribute
(Project, Pkg, Item_Name, Index);
Put (")");
New_Line;
elsif Index_Name = Snames.Name_C then
Put ("CC:=$(");
Put_Attribute
(Project, Pkg, Item_Name, Index);
Put (")");
New_Line;
elsif Index_Name = Name_C_Plus_Plus then
Put ("CXX:=$(");
Put_Attribute
(Project, Pkg, Item_Name, Index);
Put (")");
New_Line;
end if;
end;
else
Put_Declaration := False;
end if;
elsif Pkg = Snames.Name_Naming then
if Item_Name = Snames.Name_Body_Suffix then
declare
Index_Name : Name_Id := No_Name;
begin
Get_Name_String (Index);
To_Lower (Name_Buffer (1 .. Name_Len));
Index_Name := Name_Find;
if Index_Name = Snames.Name_C then
Put ("C_EXT:=$(");
Put_Attribute
(Project, Pkg, Item_Name, Index);
Put (")");
New_Line;
if Expression_Kind /= Static_String then
C_Suffix_Static := False;
elsif C_Suffix_Static then
if C_Suffix_Last = 0 then
if C_Suffix'Last < Expression_Last then
Free (C_Suffix);
C_Suffix := new String'
(Expression_Value
(1 .. Expression_Last));
else
C_Suffix (1 .. Expression_Last) :=
Expression_Value
(1 .. Expression_Last);
end if;
C_Suffix_Last := Expression_Last;
else
C_Suffix_Static :=
Expression_Value
(1 .. Expression_Last) =
C_Suffix (1 .. C_Suffix_Last);
end if;
end if;
elsif Index_Name = Name_C_Plus_Plus then
Put ("CXX_EXT:=$(");
Put_Attribute
(Project, Pkg, Item_Name, Index);
Put (")");
New_Line;
if Expression_Kind /= Static_String then
Cxx_Suffix_Static := False;
elsif Cxx_Suffix_Static then
if Cxx_Suffix_Last = 0 then
if
Cxx_Suffix'Last < Expression_Last
then
Free (Cxx_Suffix);
Cxx_Suffix := new String'
(Expression_Value
(1 .. Expression_Last));
else
Cxx_Suffix (1 .. Expression_Last) :=
Expression_Value
(1 .. Expression_Last);
end if;
Cxx_Suffix_Last := Expression_Last;
else
Cxx_Suffix_Static :=
Expression_Value
(1 .. Expression_Last) =
Cxx_Suffix (1 .. Cxx_Suffix_Last);
end if;
end if;
elsif Index_Name = Snames.Name_Ada then
Put ("ADA_BODY:=$(");
Put_Attribute
(Project, Pkg, Item_Name, Index);
Put (")");
New_Line;
if Expression_Kind /= Static_String then
Ada_Body_Suffix_Static := False;
elsif Ada_Body_Suffix_Static then
if Ada_Body_Suffix_Last = 0 then
if
Ada_Body_Suffix'Last < Expression_Last
then
Free (Ada_Body_Suffix);
Ada_Body_Suffix := new String'
(Expression_Value
(1 .. Expression_Last));
else
Ada_Body_Suffix
(1 .. Expression_Last) :=
Expression_Value
(1 .. Expression_Last);
end if;
Ada_Body_Suffix_Last := Expression_Last;
else
Ada_Body_Suffix_Static :=
Expression_Value
(1 .. Expression_Last) =
Ada_Body_Suffix
(1 .. Ada_Body_Suffix_Last);
end if;
end if;
end if;
end;
elsif Item_Name = Snames.Name_Spec_Suffix then
declare
Index_Name : Name_Id := No_Name;
begin
Get_Name_String (Index);
To_Lower (Name_Buffer (1 .. Name_Len));
Index_Name := Name_Find;
if Index_Name = Snames.Name_Ada then
Put ("ADA_SPEC:=$(");
Put_Attribute
(Project, Pkg, Item_Name, Index);
Put (")");
New_Line;
if Expression_Kind /= Static_String then
Ada_Spec_Suffix_Static := False;
elsif Ada_Spec_Suffix_Static then
if Ada_Spec_Suffix_Last = 0 then
if
Ada_Spec_Suffix'Last < Expression_Last
then
Free (Ada_Spec_Suffix);
Ada_Spec_Suffix := new String'
(Expression_Value
(1 .. Expression_Last));
else
Ada_Spec_Suffix
(1 .. Expression_Last) :=
Expression_Value
(1 .. Expression_Last);
end if;
Ada_Spec_Suffix_Last := Expression_Last;
else
Ada_Spec_Suffix_Static :=
Expression_Value
(1 .. Expression_Last) =
Ada_Spec_Suffix
(1 .. Ada_Spec_Suffix_Last);
end if;
end if;
end if;
end;
else
Put_Declaration := False;
end if;
elsif Pkg = Snames.Name_Linker then
if Item_Name = Snames.Name_Linker_Options then
Put ("ifeq ($(");
Put (Project_Name);
Put (".root),False)");
New_Line;
Put (" FLDFLAGS:=$(shell gprcmd linkopts $(");
Put (Project_Name);
Put (".base_dir) $(");
Put_Attribute
(Project, Pkg, Item_Name, No_Name);
Put (")) $(FLDFLAGS)");
New_Line;
Put ("endif");
New_Line;
else
Put_Declaration := False;
end if;
end if;
end if;
if not Put_Declaration then
IO.Release (Pos_Comment);
end if;
end;
when N_Case_Construction =>
declare
Case_Project : Project_Node_Id := Project;
Case_Pkg : Name_Id := No_Name;
Variable_Node : constant Project_Node_Id :=
Case_Variable_Reference_Of (Current_Item);
Variable_Name : constant Name_Id := Name_Of (Variable_Node);
begin
if Project_Node_Of (Variable_Node) /= Empty_Node then
Case_Project := Project_Node_Of (Variable_Node);
end if;
if Package_Node_Of (Variable_Node) /= Empty_Node then
Case_Pkg := Name_Of (Package_Node_Of (Variable_Node));
end if;
if Pkg /= No_Name
and then Case_Pkg = No_Name
and then Case_Project = Project
then
for
Index in Variable_Names.First .. Variable_Names.Last
loop
if Variable_Names.Table (Index) = Variable_Name then
Case_Pkg := Pkg;
exit;
end if;
end loop;
end if;
Process_Case_Construction
(Current_Project => Project,
Current_Pkg => Pkg,
Case_Project => Case_Project,
Case_Pkg => Case_Pkg,
Name => Variable_Name,
Node => Current_Item);
end;
when others =>
null;
end case;
end loop;
end Process_Declarative_Items;
procedure Process_Externals (Project : Project_Node_Id) is
Project_Name : constant Name_Id := Name_Of (Project);
No_External_Yet : Boolean := True;
procedure Expression (First_Term : Project_Node_Id);
procedure Process_Declarative_Items (Item : Project_Node_Id);
procedure Expression (First_Term : Project_Node_Id) is
Term : Project_Node_Id := First_Term;
Current_Term : Project_Node_Id := Empty_Node;
Default : Project_Node_Id;
begin
while Term /= Empty_Node loop
Current_Term := Tree.Current_Term (Term);
if Kind_Of (Current_Term) = N_External_Value then
if No_External_Yet then
No_External_Yet := False;
New_Line;
Put_Line ("# external references");
New_Line;
end if;
Last_External := Last_External + 1;
Externals.Set (Current_Term, Last_External);
Default := External_Default_Of (Current_Term);
Get_Name_String
(String_Value_Of (External_Reference_Of (Current_Term)));
declare
External_Name : constant String :=
Name_Buffer (1 .. Name_Len);
begin
Put ("# external (""");
Put (External_Name);
if Default /= Empty_Node then
Put (""", """);
Put (String_Value_Of (Default));
end if;
Put (""")");
New_Line;
if Default = Empty_Node then
Put_U_Name (Project_Name);
Put (".external.");
Put (Last_External);
Put (":=$(");
Put (External_Name, With_Substitution => True);
Put (")");
New_Line;
else
Put ("ifeq ($(");
Put (External_Name, With_Substitution => True);
Put ("),)");
New_Line;
Put (" ");
Put_U_Name (Project_Name);
Put (".external.");
Put (Last_External);
Put (":=");
Put (String_Value_Of (Default));
New_Line;
Put_Line ("else");
Put (" ");
Put_U_Name (Project_Name);
Put (".external.");
Put (Last_External);
Put (":=$(");
Put (External_Name, With_Substitution => True);
Put (")");
New_Line;
Put_Line ("endif");
end if;
end;
end if;
Term := Next_Term (Term);
end loop;
end Expression;
procedure Process_Declarative_Items (Item : Project_Node_Id) is
Current_Declarative_Item : Project_Node_Id := Item;
Current_Item : Project_Node_Id := Empty_Node;
begin
while Current_Declarative_Item /= Empty_Node loop
Current_Item := Current_Item_Node (Current_Declarative_Item);
Current_Declarative_Item := Next_Declarative_Item
(Current_Declarative_Item);
case Kind_Of (Current_Item) is
when N_Package_Declaration =>
if
Project_Of_Renamed_Package_Of (Current_Item) = Empty_Node
then
Process_Declarative_Items
(First_Declarative_Item_Of (Current_Item));
end if;
when N_Attribute_Declaration |
N_Typed_Variable_Declaration |
N_Variable_Declaration =>
Expression
(First_Term => Tree.First_Term
(Expression_Of (Current_Item)));
when N_Case_Construction =>
declare
Case_Item : Project_Node_Id :=
First_Case_Item_Of (Current_Item);
begin
while Case_Item /= Empty_Node loop
Process_Declarative_Items
(First_Declarative_Item_Of (Case_Item));
Case_Item := Next_Case_Item (Case_Item);
end loop;
end;
when others =>
null;
end case;
end loop;
end Process_Declarative_Items;
begin
Process_Declarative_Items
(First_Declarative_Item_Of (Project_Declaration_Of (Project)));
if not No_External_Yet then
Put_Line ("# end of external references");
New_Line;
end if;
end Process_Externals;
procedure Put (S : String; With_Substitution : Boolean := False) is
begin
IO.Put (S);
if With_Substitution then
for J in Reserved_Variables'Range loop
if S = Reserved_Variables (J).all then
IO.Put (Saved_Suffix);
exit;
end if;
end loop;
end if;
end Put;
procedure Put (P : Positive) is
Image : constant String := P'Img;
begin
Put (Image (Image'First + 1 .. Image'Last));
end Put;
procedure Put (S : Name_Id) is
begin
Get_Name_String (S);
Put (Name_Buffer (1 .. Name_Len));
end Put;
procedure Put_Attribute
(Project : Project_Node_Id;
Pkg : Name_Id;
Name : Name_Id;
Index : Name_Id)
is
begin
Put_U_Name (Name_Of (Project));
if Pkg /= No_Name then
Put (".");
Put_L_Name (Pkg);
end if;
Put (".");
Put_L_Name (Name);
if Index /= No_Name then
Put (".");
if Name = Snames.Name_Switches then
Get_Name_String (Index);
Put (Name_Buffer (1 .. Name_Len));
else
Special_Put_U_Name (Index);
end if;
end if;
end Put_Attribute;
procedure Put_Directory_Separator is
begin
Put (S => (1 => Directory_Separator));
end Put_Directory_Separator;
procedure Put_Include_Project
(Included_Project_Path : Name_Id;
Included_Project : Project_Node_Id;
Including_Project_Name : String)
is
begin
if Included_Project_Path /= No_Name then
Get_Name_String (Included_Project_Path);
declare
Included_Project_Name : constant String :=
Get_Name_String (Name_Of (Included_Project));
Included_Directory_Path : constant String :=
Dir_Name (Name_Buffer (1 .. Name_Len));
Last : Natural := Included_Directory_Path'Last;
begin
if Last >= Included_Directory_Path'First
and then (Included_Directory_Path (Last) = Directory_Separator
or else
Included_Directory_Path (Last) = '/')
then
Last := Last - 1;
end if;
Put ("BASE_DIR=");
if not Is_Absolute_Path (Included_Directory_Path) then
Put ("$(");
Put (Including_Project_Name);
Put (".base_dir)/");
end if;
Put (Included_Directory_Path
(Included_Directory_Path'First .. Last));
New_Line;
Put ("include $(BASE_DIR)");
Put_Directory_Separator;
Put ("Makefile.");
Put (To_Lower (Included_Project_Name));
New_Line;
New_Line;
end;
end if;
end Put_Include_Project;
procedure Put_Line (S : String) is
begin
IO.Put (S);
IO.New_Line;
end Put_Line;
procedure Put_L_Name (N : Name_Id) is
begin
Put (To_Lower (Get_Name_String (N)));
end Put_L_Name;
procedure Put_M_Name (N : Name_Id) is
Name : String := Get_Name_String (N);
begin
To_Mixed (Name);
Put (Name);
end Put_M_Name;
procedure Put_U_Name (N : Name_Id) is
begin
Put (To_Upper (Get_Name_String (N)));
end Put_U_Name;
procedure Put_Variable
(Project : Project_Node_Id;
Pkg : Name_Id;
Name : Name_Id)
is
begin
Put_U_Name (Name_Of (Project));
if Pkg /= No_Name then
Put (".");
Put_L_Name (Pkg);
end if;
Put (".");
Put_U_Name (Name);
end Put_Variable;
procedure Recursive_Process (Project : Project_Node_Id) is
With_Clause : Project_Node_Id;
Last_Case : Natural := Last_Case_Construction;
There_Are_Cases : Boolean := False;
May_Be_C_Sources : Boolean := False;
May_Be_Cxx_Sources : Boolean := False;
Post_Processing : Boolean := False;
Src_Files_Init : IO.Position;
Src_List_File_Init : IO.Position;
begin
if Project /= Empty_Node then
declare
Declaration_Node : constant Project_Node_Id :=
Project_Declaration_Of (Project);
Name : constant Name_Id := Name_Of (Project);
Directory : constant Name_Id := Directory_Of (Project);
Lname : constant String := To_Lower (Get_Name_String (Name));
Uname : constant String := To_Upper (Lname);
begin
if Processed_Projects.Get (Name) = Empty_Node then
Processed_Projects.Set (Name, Project);
if Process_All_Project_Files then
With_Clause := First_With_Clause_Of (Project);
while With_Clause /= Empty_Node loop
Recursive_Process (Project_Node_Of (With_Clause));
With_Clause := Next_With_Clause_Of (With_Clause);
end loop;
Recursive_Process (Extended_Project_Of (Declaration_Node));
end if;
Source_Files_Declaration := False;
Source_List_File_Declaration := False;
Get_Name_String (Directory);
if Name_Buffer (Name_Len) /= Directory_Separator then
Name_Len := Name_Len + 1;
Name_Buffer (Name_Len) := Directory_Separator;
end if;
Name_Buffer (Name_Len + 1 .. Name_Len + 9) := "Makefile.";
Name_Len := Name_Len + 9;
Name_Buffer (Name_Len + 1 .. Name_Len + Lname'Length) :=
Lname;
Name_Len := Name_Len + Lname'Length;
IO.Create (Name_Buffer (1 .. Name_Len));
if not Opt.Quiet_Output then
Write_Str ("creating """);
Write_Str (IO.Name_Of_File);
Write_Line ("""");
end if;
New_Line;
Put ("# ");
Put_Line (IO.Name_Of_File);
New_Line;
Put ("ifeq ($(");
Put (Uname);
Put (".project),)");
New_Line;
Put (Uname);
Put (".project=True");
New_Line;
New_Line;
Put_Line ("ifeq ($(BASE_DIR),)");
Put (" ");
Put (Uname);
Put (".root=True");
New_Line;
Put (" ");
Put (Uname);
Put (".base_dir:=$(shell gprcmd pwd)");
New_Line;
New_Line;
Put (" ifeq ($(");
Put (MAKE_ROOT);
Put ("),)");
New_Line;
Put (" MAKE_ROOT=$(shell gprcmd prefix)");
New_Line;
Put (" endif");
New_Line;
New_Line;
Put (" ifeq ($(");
Put (MAKE_ROOT);
Put ("),)");
New_Line;
Put (" $(error ");
Put (MAKE_ROOT);
Put (" variable is undefined, ");
Put ("Makefile.prolog cannot be loaded)");
New_Line;
Put_Line (" else");
Put (" include $(");
Put (MAKE_ROOT);
Put (")");
Put_Directory_Separator;
Put ("share");
Put_Directory_Separator;
Put ("gnat");
Put_Directory_Separator;
Put ("Makefile.prolog");
New_Line;
Put_Line (" endif");
Put (" OBJ_EXT:=");
Put (Get_Object_Suffix.all);
New_Line;
Put_Line ("else");
Put (" ");
Put (Uname);
Put (".root=False");
New_Line;
Put (" ");
Put (Uname);
Put (".base_dir:=$(BASE_DIR)");
New_Line;
Put_Line ("endif");
New_Line;
With_Clause := First_With_Clause_Of (Project);
while With_Clause /= Empty_Node loop
Put_Include_Project
(String_Value_Of (With_Clause),
Project_Node_Of (With_Clause),
Uname);
With_Clause := Next_With_Clause_Of (With_Clause);
end loop;
Put_Include_Project
(Extended_Project_Path_Of (Project),
Extended_Project_Of (Declaration_Node),
Uname);
Put_Line ("CFLAGS:=");
Put_Line ("CXXFLAGS:=");
IO.Mark (Src_Files_Init);
Put_Line ("src_files.specified:=FALSE");
IO.Mark (Src_List_File_Init);
Put_Line ("src_list_file.specified:=FALSE");
Put_Line ("LANGUAGES:=ada");
Put (Uname);
Put (".src_dirs:=$(");
Put (Uname);
Put (".base_dir)");
New_Line;
Put (Uname);
Put (".obj_dir:=$(");
Put (Uname);
Put (".base_dir)");
New_Line;
Put ("PROJECT_FILE:=");
Put (Lname);
New_Line;
Put ("# project ");
Put_M_Name (Name);
New_Line;
Process_Externals (Project);
New_Line;
Switches.Init;
Reset_Suffixes_And_Languages;
Last_Case := Last_Case_Construction;
Process_Declarative_Items
(Project => Project,
Pkg => No_Name,
In_Case => False,
Item => First_Declarative_Item_Of (Declaration_Node));
There_Are_Cases := Last_Case /= Last_Case_Construction;
if C_Suffix_Static and then C_Suffix_Last = 0 then
C_Suffix_Last := 2;
C_Suffix (1 .. 2) := ".c";
end if;
if Cxx_Suffix_Static and then Cxx_Suffix_Last = 0 then
Cxx_Suffix_Last := 3;
Cxx_Suffix (1 .. 3) := ".cc";
end if;
if Ada_Body_Suffix_Static and then Ada_Body_Suffix_Last = 0 then
Ada_Body_Suffix_Last := 4;
Ada_Body_Suffix (1 .. 4) := ".adb";
end if;
if Ada_Spec_Suffix_Static and then Ada_Spec_Suffix_Last = 0 then
Ada_Spec_Suffix_Last := 4;
Ada_Spec_Suffix (1 .. 4) := ".ads";
end if;
if Languages_Static and then Languages_Last = 0 then
Languages_Last := 5;
Languages (1 .. 5) := " ada ";
end if;
May_Be_C_Sources := (not Languages_Static)
or else Index
(Source => Languages (1 .. Languages_Last),
Pattern => " c ") /= 0;
May_Be_Cxx_Sources := (not Languages_Static)
or else Index
(Source => Languages (1 .. Languages_Last),
Pattern => " c++ ") /= 0;
New_Line;
if Switches.Last >= Switches.First then
for Index in Switches.First .. Switches.Last loop
Get_Name_String (Switches.Table (Index));
declare
File : constant String :=
Name_Buffer (1 .. Name_Len);
Source_Kind : Source_Kind_Type := Unknown;
begin
if Ada_Body_Suffix_Static then
if File'Length > Ada_Body_Suffix_Last
and then
File (File'Last - Ada_Body_Suffix_Last + 1 ..
File'Last) =
Ada_Body_Suffix
(1 .. Ada_Body_Suffix_Last)
then
Source_Kind := Ada_Body;
end if;
end if;
if Source_Kind = Unknown
and then Ada_Spec_Suffix_Static
then
if File'Length > Ada_Spec_Suffix_Last
and then
File (File'Last - Ada_Spec_Suffix_Last + 1 ..
File'Last) =
Ada_Spec_Suffix
(1 .. Ada_Spec_Suffix_Last)
then
Source_Kind := Ada_Spec;
end if;
end if;
if Source_Kind = Unknown
and then C_Suffix_Static
then
if File'Length > C_Suffix_Last
and then
File (File'Last - C_Suffix_Last + 1
.. File'Last) =
C_Suffix (1 .. C_Suffix_Last)
then
Source_Kind := C;
end if;
end if;
if Source_Kind = Unknown
and then Cxx_Suffix_Static
then
if File'Length > Cxx_Suffix_Last
and then
File (File'Last - Cxx_Suffix_Last + 1
.. File'Last) =
Cxx_Suffix (1 .. Cxx_Suffix_Last)
then
Source_Kind := Cxx;
end if;
end if;
if Source_Kind = Unknown
and then Ada_Body_Suffix_Static
and then Ada_Spec_Suffix_Static
and then C_Suffix_Static
and then Cxx_Suffix_Static
then
Source_Kind := None;
end if;
if (Source_Kind = Unknown and
(May_Be_C_Sources or May_Be_Cxx_Sources))
or else (May_Be_C_Sources and Source_Kind = C)
or else (May_Be_Cxx_Sources and Source_Kind = Cxx)
then
if not Post_Processing then
Post_Processing := True;
Put_Line
("# post-processing of Compiler'Switches");
end if;
New_Line;
Put ("# for Switches (""");
Put (File);
Put (""") use ...");
New_Line;
if There_Are_Cases then
Put ("ifneq ($(");
Put (Uname);
Put (".compiler.switches.");
Put (File);
Put ("),)");
New_Line;
end if;
if May_Be_C_Sources
and then
(Source_Kind = Unknown or else Source_Kind = C)
then
if Source_Kind = C then
Put (File (1 .. File'Last - C_Suffix_Last));
Put (Get_Object_Suffix.all);
Put (": ");
Put (File);
New_Line;
else
Put ("ifeq ($(filter %$(C_EXT),");
Put (File);
Put ("),");
Put (File);
Put (")");
New_Line;
Put ("$(subst $(C_EXT),$(OBJ_EXT),");
Put (File);
Put ("): ");
Put (File);
New_Line;
end if;
Put (ASCII.HT & "@echo $(CC) -c $(");
Put (Uname);
Put (".compiler.switches.");
Put (File);
Put (") $< -o $(OBJ_DIR)/$@");
New_Line;
Put_Line ("ifndef FAKE_COMPILE");
Put (ASCII.HT & "@$(CC) -c $(");
Put (Uname);
Put (".compiler.switches.");
Put (File);
Put (") $(C_INCLUDES) $(DEP_CFLAGS) " &
"$< -o $(OBJ_DIR)/$@");
New_Line;
Put_Line (ASCII.HT & "@$(post-compile)");
Put_Line ("endif");
if Source_Kind = Unknown then
Put_Line ("endif");
end if;
end if;
if May_Be_Cxx_Sources
and then
(Source_Kind = Unknown
or else
Source_Kind = Cxx)
then
if Source_Kind = Cxx then
Put (File (1 .. File'Last - Cxx_Suffix_Last));
Put (Get_Object_Suffix.all);
Put (": ");
Put (File);
New_Line;
else
Put ("ifeq ($(filter %$(CXX_EXT),");
Put (File);
Put ("),");
Put (File);
Put (")");
New_Line;
Put ("$(subst $(CXX_EXT),$(OBJ_EXT),");
Put (File);
Put ("): $(");
Put (Uname);
Put (".absolute.");
Put (File);
Put (")");
New_Line;
end if;
Put (ASCII.HT & "@echo $(CXX) -c $(");
Put (Uname);
Put (".compiler.switches.");
Put (File);
Put (") $< -o $(OBJ_DIR)/$@");
New_Line;
Put_Line ("ifndef FAKE_COMPILE");
Put (ASCII.HT & "@$(CXX) -c $(");
Put (Uname);
Put (".compiler.switches.");
Put (File);
Put (") $(C_INCLUDES) $(DEP_CFLAGS) " &
"$< -o $(OBJ_DIR)/$@");
New_Line;
Put_Line (ASCII.HT & "@$(post-compile)");
Put_Line ("endif");
if Source_Kind = Unknown then
Put_Line ("endif");
end if;
end if;
if There_Are_Cases then
Put_Line ("endif");
end if;
New_Line;
end if;
end;
end loop;
if Post_Processing then
Put_Line
("# end of post-processing of Compiler'Switches");
New_Line;
end if;
end if;
Put ("SRC_DIRS:=$(");
Put (Uname);
Put (".src_dirs) $(filter-out $(");
Put (Uname);
Put (".src_dirs),$(SRC_DIRS))");
New_Line;
Put ("OBJ_DIR:=$(");
Put (Uname);
Put (".obj_dir)");
New_Line;
New_Line;
if Source_Files_Declaration = True then
IO.Suppress (Src_Files_Init);
IO.Suppress (Src_List_File_Init);
else
if Source_Files_Declaration = May_Be then
Put_Line ("# get the source files, if necessary");
Put_Line ("ifeq ($(src_files.specified),FALSE)");
else
Put_Line ("# get the source files");
IO.Suppress (Src_Files_Init);
end if;
if Source_List_File_Declaration /= May_Be then
IO.Suppress (Src_List_File_Init);
end if;
case Source_List_File_Declaration is
when True =>
if Source_Files_Declaration = May_Be then
Put (" ");
end if;
Put (Uname);
Put (".src_files:= $(shell gprcmd cat " &
"$(src.list_file))");
New_Line;
when False =>
if Source_Files_Declaration = May_Be then
Put (" ");
end if;
Put (Uname);
Put (".src_files:= $(foreach name,$(");
Put (Uname);
Put (".src_dirs),$(notdir $(wildcard $(name)/*)))");
New_Line;
when May_Be =>
if Source_Files_Declaration = May_Be then
Put (" ");
end if;
Put_Line ("ifeq ($(src_list_file.specified),TRUE)");
if Source_Files_Declaration = May_Be then
Put (" ");
end if;
Put (" ");
Put (Uname);
Put (".src_files:= $(shell gprcmd cat " &
"$(SRC__$LIST_FILE))");
New_Line;
if Source_Files_Declaration = May_Be then
Put (" ");
end if;
Put_Line ("else");
if Source_Files_Declaration = May_Be then
Put (" ");
end if;
Put (" ");
Put (Uname);
Put (".src_files:= $(foreach name,$(");
Put (Uname);
Put (".src_dirs),$(notdir $(wildcard $(name)/*)))");
New_Line;
if Source_Files_Declaration = May_Be then
Put (" ");
end if;
Put_Line ("endif");
end case;
if Source_Files_Declaration = May_Be then
Put_Line ("endif");
end if;
New_Line;
end if;
if not Languages_Static then
Put_Line
("# get the C source files, if C is one of the languages");
Put_Line ("ifeq ($(filter c,$(LANGUAGES)),c)");
Put (" C_SRCS:=$(filter %$(C_EXT),$(");
Put (Uname);
Put (".src_files))");
New_Line;
Put_Line (" C_SRCS_DEFINED:=True");
Put_Line ("else");
Put_Line (" C_SRCS=");
Put_Line ("endif");
New_Line;
Put_Line
("# get the C++ source files, " &
"if C++ is one of the languages");
Put_Line ("ifeq ($(filter c++,$(LANGUAGES)),c++)");
Put (" CXX_SRCS:=$(filter %$(CXX_EXT),$(");
Put (Uname);
Put (".src_files))");
New_Line;
Put_Line (" CXX_SRCS_DEFINED:=True");
Put_Line ("else");
Put_Line (" CXX_SRCS=");
Put_Line ("endif");
New_Line;
else
if Ada.Strings.Fixed.Index
(Languages (1 .. Languages_Last), " c ") /= 0
then
Put_Line ("# get the C sources");
Put ("C_SRCS:=$(filter %$(C_EXT),$(");
Put (Uname);
Put (".src_files))");
New_Line;
Put_Line ("C_SRCS_DEFINED:=True");
else
Put_Line ("# no C sources");
Put_Line ("C_SRCS=");
end if;
New_Line;
if Ada.Strings.Fixed.Index
(Languages (1 .. Languages_Last), " c++ ") /= 0
then
Put_Line ("# get the C++ sources");
Put ("CXX_SRCS:=$(filter %$(CXX_EXT),$(");
Put (Uname);
Put (".src_files))");
New_Line;
Put_Line ("CXX_SRCS_DEFINED:=True");
else
Put_Line ("# no C++ sources");
Put_Line ("CXX_SRCS=");
end if;
New_Line;
end if;
declare
C_Present : constant Boolean :=
(not Languages_Static) or else
Ada.Strings.Fixed.Index
(Languages (1 .. Languages_Last), " c ")
/= 0;
Cxx_Present : constant Boolean :=
(not Languages_Static) or else
Ada.Strings.Fixed.Index
(Languages (1 .. Languages_Last), " c++ ")
/= 0;
begin
if C_Present or Cxx_Present then
Put ("# if there are ");
if C_Present then
if Cxx_Present then
Put ("C or C++");
else
Put ("C");
end if;
else
Put ("C++");
end if;
Put (" sources, add the library");
New_Line;
Put ("ifneq ($(strip");
if C_Present then
Put (" $(C_SRCS)");
end if;
if Cxx_Present then
Put (" $(CXX_SRCS)");
end if;
Put ("),)");
New_Line;
Put (" LIBS:=$(");
Put (Uname);
Put (".obj_dir)/lib");
Put (Lname);
Put ("$(AR_EXT) $(LIBS)");
New_Line;
Put_Line ("endif");
New_Line;
end if;
end;
Put_Line ("ifeq ($(CFLAGS),)");
Put_Line (" CFLAGS:=$(CFLAGS.saved)");
Put_Line ("endif");
New_Line;
Put_Line ("ifeq ($(CXXFLAGS),)");
Put_Line (" CXXFLAGS:=$(CXXFLAGS.saved)");
Put_Line ("endif");
New_Line;
Put ("ifeq ($(");
Put (Uname);
Put_Line (".root),True)");
Put (" include $(");
Put (MAKE_ROOT);
Put (")");
Put_Directory_Separator;
Put ("share");
Put_Directory_Separator;
Put ("gnat");
Put_Directory_Separator;
Put ("Makefile.generic");
New_Line;
Put_Line ("else");
Put (" DEPS_PROJECTS:=$(strip $(DEPS_PROJECTS) $(");
Put (Uname);
Put (".base_dir)/");
Put (Lname);
Put (")");
New_Line;
Put_Line ("endif");
New_Line;
Put_Line ("endif");
New_Line;
IO.Close;
end if;
end;
end if;
end Recursive_Process;
procedure Reset_Suffixes_And_Languages is
begin
C_Suffix_Last := 0;
C_Suffix_Static := True;
Cxx_Suffix_Last := 0;
Cxx_Suffix_Static := True;
Ada_Body_Suffix_Last := 0;
Ada_Body_Suffix_Static := True;
Ada_Spec_Suffix_Last := 0;
Ada_Spec_Suffix_Static := True;
Languages_Last := 0;
Languages_Static := True;
end Reset_Suffixes_And_Languages;
function Source_Kind_Of (File_Name : Name_Id) return Source_Kind_Type is
Source_C_Suffix : constant String :=
Suffix_Of (C_Suffix_Static, C_Suffix, C_Suffix_Last, ".c");
Source_Cxx_Suffix : constant String :=
Suffix_Of (Cxx_Suffix_Static, Cxx_Suffix, Cxx_Suffix_Last, ".cc");
Body_Ada_Suffix : constant String :=
Suffix_Of
(Ada_Body_Suffix_Static,
Ada_Body_Suffix,
Ada_Body_Suffix_Last,
".adb");
Spec_Ada_Suffix : constant String :=
Suffix_Of
(Ada_Spec_Suffix_Static,
Ada_Spec_Suffix,
Ada_Spec_Suffix_Last,
".ads");
begin
Get_Name_String (File_Name);
if Source_C_Suffix /= ""
and then Name_Len > Source_C_Suffix'Length
and then Name_Buffer (Name_Len - Source_C_Suffix'Length + 1
.. Name_Len) = Source_C_Suffix
then
return C;
elsif Source_Cxx_Suffix /= ""
and then Name_Len > Source_Cxx_Suffix'Length
and then Name_Buffer (Name_Len - Source_Cxx_Suffix'Length + 1
.. Name_Len) = Source_Cxx_Suffix
then
return Cxx;
elsif Body_Ada_Suffix /= ""
and then Name_Len > Body_Ada_Suffix'Length
and then Name_Buffer (Name_Len - Body_Ada_Suffix'Length + 1
.. Name_Len) = Body_Ada_Suffix
then
return Ada_Body;
elsif Spec_Ada_Suffix /= ""
and then Name_Len > Spec_Ada_Suffix'Length
and then Name_Buffer (Name_Len - Spec_Ada_Suffix'Length + 1
.. Name_Len) = Spec_Ada_Suffix
then
return Ada_Body;
elsif Source_C_Suffix = "" or else Source_Cxx_Suffix = "" then
return Unknown;
else
return None;
end if;
end Source_Kind_Of;
procedure Special_Put_U_Name (S : Name_Id) is
begin
Get_Name_String (S);
To_Upper (Name_Buffer (1 .. Name_Len));
if Name_Buffer (1 .. Name_Len) = "C++" then
Put ("CXX");
else
Put (Name_Buffer (1 .. Name_Len));
end if;
end Special_Put_U_Name;
function Suffix_Of
(Static : Boolean;
Value : String_Access;
Last : Natural;
Default : String) return String
is
begin
if Static then
if Last = 0 then
return Default;
else
return Value (1 .. Last);
end if;
else
return "";
end if;
end Suffix_Of;
procedure Usage is
begin
if not Usage_Displayed then
Usage_Displayed := True;
Display_Copyright;
Write_Line ("Usage: gpr2make switches project-file");
Write_Eol;
Write_Line (" -h Display this usage");
Write_Line (" -q Quiet output");
Write_Line (" -v Verbose mode");
Write_Line (" -R not Recursive: only one project file");
Write_Eol;
end if;
end Usage;
end Bld;