1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 2002-2003 Free Software Foundation, Inc. --
11 -- GNAT is free software; you can redistribute it and/or modify it under --
12 -- terms of the GNU General Public License as published by the Free Soft- --
13 -- ware Foundation; either version 2, or (at your option) any later ver- --
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
17 -- for more details. You should have received a copy of the GNU General --
18 -- Public License distributed with GNAT; see file COPYING. If not, write --
19 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
20 -- MA 02111-1307, USA. --
22 -- GNAT was originally developed by the GNAT team at New York University. --
23 -- Extensive contributions were provided by Ada Core Technologies Inc. --
25 ------------------------------------------------------------------------------
27 -- This package is still a work in progress.
29 with Ada.Characters.Handling; use Ada.Characters.Handling;
30 with Ada.Strings.Fixed; use Ada.Strings.Fixed;
36 with GNAT.Case_Util; use GNAT.Case_Util;
37 with GNAT.Command_Line; use GNAT.Command_Line;
38 with GNAT.Directory_Operations; use GNAT.Directory_Operations;
39 with GNAT.OS_Lib; use GNAT.OS_Lib;
41 with Erroutc; use Erroutc;
42 with Err_Vars; use Err_Vars;
44 with Namet; use Namet;
46 with Output; use Output;
48 with Prj.Com; use Prj.Com;
49 with Prj.Err; use Prj.Err;
51 with Prj.Tree; use Prj.Tree;
54 with Types; use Types;
58 function "=" (Left, Right : IO.Position) return Boolean
61 MAKE_ROOT : constant String := "MAKE_ROOT";
63 Process_All_Project_Files : Boolean := True;
64 -- Set to False by command line switch -R
66 Copyright_Displayed : Boolean := False;
67 -- To avoid displaying the Copyright line several times
69 Usage_Displayed : Boolean := False;
70 -- To avoid displaying the usage several times
72 type Expression_Kind_Type is (Undecided, Static_String, Other);
74 Expression_Kind : Expression_Kind_Type := Undecided;
75 -- After procedure Expression has been called, this global variable
76 -- indicates if the expression is a static string or not.
77 -- If it is a static string, then Expression_Value (1 .. Expression_Last)
78 -- is the static value of the expression.
80 Expression_Value : String_Access := new String (1 .. 10);
81 Expression_Last : Natural := 0;
83 -- The following variables indicates if the suffixs and the languages
84 -- are statically specified and, if they are, their values.
86 C_Suffix : String_Access := new String (1 .. 10);
87 C_Suffix_Last : Natural := 0;
88 C_Suffix_Static : Boolean := True;
90 Cxx_Suffix : String_Access := new String (1 .. 10);
91 Cxx_Suffix_Last : Natural := 0;
92 Cxx_Suffix_Static : Boolean := True;
94 Ada_Spec_Suffix : String_Access := new String (1 .. 10);
95 Ada_Spec_Suffix_Last : Natural := 0;
96 Ada_Spec_Suffix_Static : Boolean := True;
98 Ada_Body_Suffix : String_Access := new String (1 .. 10);
99 Ada_Body_Suffix_Last : Natural := 0;
100 Ada_Body_Suffix_Static : Boolean := True;
102 Languages : String_Access := new String (1 .. 50);
103 Languages_Last : Natural := 0;
104 Languages_Static : Boolean := True;
106 type Source_Kind_Type is (Unknown, Ada_Spec, Ada_Body, C, Cxx, None);
107 -- Used when post-processing Compiler'Switches to indicate the language
110 -- The following variables are used to controlled what attributes
111 -- Default_Switches and Switches are allowed in expressions.
113 Default_Switches_Project : Project_Node_Id := Empty_Node;
114 Default_Switches_Package : Name_Id := No_Name;
115 Default_Switches_Language : Name_Id := No_Name;
117 Switches_Project : Project_Node_Id := Empty_Node;
118 Switches_Package : Name_Id := No_Name;
119 Switches_Language : Source_Kind_Type := Unknown;
121 -- Other attribute references are only allowed in attribute declarations
122 -- of the same package and of the same name.
123 -- Other_Attribute is True only during attribute declarations other than
124 -- Switches or Default_Switches.
126 Other_Attribute : Boolean := False;
127 Other_Attribute_Package : Name_Id := No_Name;
128 Other_Attribute_Name : Name_Id := No_Name;
130 type Declaration_Type is (False, May_Be, True);
132 Source_Files_Declaration : Declaration_Type := False;
134 Source_List_File_Declaration : Declaration_Type := False;
136 -- Names that are not in Snames
138 Name_Ide : Name_Id := No_Name;
139 Name_Compiler_Command : Name_Id := No_Name;
140 Name_Main_Language : Name_Id := No_Name;
141 Name_C_Plus_Plus : Name_Id := No_Name;
143 package Processed_Projects is new GNAT.HTable.Simple_HTable
144 (Header_Num => Header_Num,
145 Element => Project_Node_Id,
146 No_Element => Empty_Node,
150 -- This hash table contains all processed projects.
151 -- It is used to avoid processing the same project file several times.
153 package Externals is new GNAT.HTable.Simple_HTable
154 (Header_Num => Header_Num,
157 Key => Project_Node_Id,
160 -- This hash table is used to store all the external references.
161 -- For each project file, the tree is first traversed and all
162 -- external references are put in variables. Each of these variables
163 -- are identified by a number, so that the can be referred to
164 -- later during the second traversal of the tree.
166 package Variable_Names is new Table.Table
167 (Table_Component_Type => Name_Id,
168 Table_Index_Type => Natural,
169 Table_Low_Bound => 1,
171 Table_Increment => 10,
172 Table_Name => "Bld.Variable_Names");
173 -- This table stores all the variables declared in a package.
174 -- It is used to distinguish project level and package level
175 -- variables identified by simple names.
176 -- This table is reset for each package.
178 package Switches is new Table.Table
179 (Table_Component_Type => Name_Id,
180 Table_Index_Type => Natural,
181 Table_Low_Bound => 1,
183 Table_Increment => 10,
184 Table_Name => "Bld.Switches");
185 -- This table stores all the indexs of associative array attribute
186 -- Compiler'Switches specified in a project file. It is reset for
187 -- each project file. At the end of processing of a project file
188 -- this table is traversed to output targets for those files
189 -- that may be C or C++ source files.
191 Last_External : Natural := 0;
192 -- For each external reference, this variable in incremented by 1,
193 -- and a Makefile variable <PROJECT>__EXTERNAL__<Last_External> is
194 -- declared. See procedure Process_Externals.
196 Last_Case_Construction : Natural := 0;
197 -- For each case construction, this variable is incremented by 1,
198 -- and a Makefile variable <PROJECT>__CASE__<Last_Case_Construction> is
199 -- declared. See procedure Process_Declarative_Items.
201 Saved_Suffix : constant String := ".saved";
202 -- Prefix to be added to the name of reserved variables (see below) when
203 -- used in external references.
205 -- A number of environment variables, whose names are used in the
206 -- Makefiles are saved at the beginning of the main Makefile.
207 -- Each reference to any such environment variable is replaced
208 -- in the Makefiles with the name of the saved variable.
210 Ada_Body_String : aliased String := "ADA_BODY";
211 Ada_Flags_String : aliased String := "ADA_FLAGS";
212 Ada_Mains_String : aliased String := "ADA_MAINS";
213 Ada_Sources_String : aliased String := "ADA_SOURCES";
214 Ada_Spec_String : aliased String := "ADA_SPEC";
215 Ar_Cmd_String : aliased String := "AR_CMD";
216 Ar_Ext_String : aliased String := "AR_EXT";
217 Base_Dir_String : aliased String := "BASE_DIR";
218 Cc_String : aliased String := "CC";
219 C_Ext_String : aliased String := "C_EXT";
220 Cflags_String : aliased String := "CFLAGS";
221 Cxx_String : aliased String := "CXX";
222 Cxx_Ext_String : aliased String := "CXX_EXT";
223 Cxxflags_String : aliased String := "CXXFLAGS";
224 Deps_Projects_String : aliased String := "DEPS_PROJECT";
225 Exec_String : aliased String := "EXEC";
226 Exec_Dir_String : aliased String := "EXEC_DIR";
227 Gnatmake_String : aliased String := "GNATMAKE";
228 Languages_String : aliased String := "LANGUAGES";
229 Ld_Flags_String : aliased String := "LD_FLAGS";
230 Libs_String : aliased String := "LIBS";
231 Main_String : aliased String := "MAIN";
232 Obj_Ext_String : aliased String := "OBJ_EXT";
233 Obj_Dir_String : aliased String := "OBJ_DIR";
234 Project_File_String : aliased String := "PROJECT_FILE";
235 Src_Dirs_String : aliased String := "SRC_DIRS";
237 type Reserved_Variable_Array is array (Positive range <>) of String_Access;
238 Reserved_Variables : constant Reserved_Variable_Array :=
239 (Ada_Body_String 'Access,
240 Ada_Flags_String 'Access,
241 Ada_Mains_String 'Access,
242 Ada_Sources_String 'Access,
243 Ada_Spec_String 'Access,
244 Ar_Cmd_String 'Access,
245 Ar_Ext_String 'Access,
246 Base_Dir_String 'Access,
248 C_Ext_String 'Access,
249 Cflags_String 'Access,
251 Cxx_Ext_String 'Access,
252 Cxxflags_String 'Access,
253 Deps_Projects_String'Access,
255 Exec_Dir_String 'Access,
256 Gnatmake_String 'Access,
257 Languages_String 'Access,
258 Ld_Flags_String 'Access,
261 Obj_Ext_String 'Access,
262 Obj_Dir_String 'Access,
263 Project_File_String 'Access,
264 Src_Dirs_String 'Access);
266 Main_Project_File_Name : String_Access;
267 -- The name of the main project file, given as argument.
269 Project_Tree : Project_Node_Id;
270 -- The result of the parsing of the main project file.
272 procedure Add_To_Expression_Value (S : String);
273 procedure Add_To_Expression_Value (S : Name_Id);
274 -- Add a string to variable Expression_Value
276 procedure Display_Copyright;
277 -- Display name of the tool and the copyright
279 function Equal_String (Left, Right : Name_Id) return Boolean;
280 -- Return True if Left and Right are the same string, without considering
284 (Project : Project_Node_Id;
285 First_Term : Project_Node_Id;
286 Kind : Variable_Kind;
288 Reset : Boolean := False);
289 -- Process an expression.
290 -- If In_Case is True, all expressions are not static.
293 -- Add a line terminator in the Makefile
295 procedure Process (Project : Project_Node_Id);
296 -- Process the project tree, result of the parsing.
298 procedure Process_Case_Construction
299 (Current_Project : Project_Node_Id;
300 Current_Pkg : Name_Id;
301 Case_Project : Project_Node_Id;
304 Node : Project_Node_Id);
305 -- Process a case construction.
306 -- The Makefile declations may be suppressed if no declarative
307 -- items in the case items are to be put in the Makefile.
309 procedure Process_Declarative_Items
310 (Project : Project_Node_Id;
313 Item : Project_Node_Id);
314 -- Process the declarative items for a project, a package
316 -- If In_Case is True, all expressions are not static
318 procedure Process_Externals (Project : Project_Node_Id);
319 -- Look for all external references in one project file, populate the
320 -- table Externals, and output the necessary declarations, if any.
322 procedure Put (S : String; With_Substitution : Boolean := False);
323 -- Add a string to the Makefile.
324 -- When With_Substitution is True, if the string is one of the reserved
325 -- variables, replace it with the name of the corresponding saved
328 procedure Put (S : Name_Id);
329 -- Add a string to the Makefile.
331 procedure Put (P : Positive);
332 -- Add the image of a number to the Makefile, without leading space
334 procedure Put_Attribute
335 (Project : Project_Node_Id;
339 -- Put the full name of an attribute in the Makefile
341 procedure Put_Directory_Separator;
342 -- Add a directory separator to the Makefile
344 procedure Put_Include_Project
345 (Included_Project_Path : Name_Id;
346 Included_Project : Project_Node_Id;
347 Including_Project_Name : String);
348 -- Output an include directive for a project
350 procedure Put_Line (S : String);
351 -- Add a string and a line terminator to the Makefile
353 procedure Put_L_Name (N : Name_Id);
354 -- Put a name in lower case in the Makefile
356 procedure Put_M_Name (N : Name_Id);
357 -- Put a name in mixed case in the Makefile
359 procedure Put_U_Name (N : Name_Id);
360 -- Put a name in upper case in the Makefile
362 procedure Special_Put_U_Name (S : Name_Id);
363 -- Put a name in upper case in the Makefile.
364 -- If "C++" change it to "CXX".
366 procedure Put_Variable
367 (Project : Project_Node_Id;
370 -- Put the full name of a variable in the Makefile
372 procedure Recursive_Process (Project : Project_Node_Id);
373 -- Process a project file and the project files it depends on iteratively
374 -- without processing twice the same project file.
376 procedure Reset_Suffixes_And_Languages;
377 -- Indicate that all suffixes and languages have the default values
379 function Source_Kind_Of (File_Name : Name_Id) return Source_Kind_Type;
380 -- From a source file name, returns the source kind of the file
384 Value : String_Access;
388 -- Returns the current suffix, if it is statically known, or ""
389 -- if it is not statically known. Used on C_Suffix, Cxx_Suffix,
390 -- Ada_Body_Suffix and Ada_Spec_Suffix.
393 -- Display the usage of gnatbuild
395 -----------------------------
396 -- Add_To_Expression_Value --
397 -----------------------------
399 procedure Add_To_Expression_Value (S : String) is
401 -- Check that the buffer is large enough.
402 -- If it is not, double it until it is large enough.
404 while Expression_Last + S'Length > Expression_Value'Last loop
406 New_Value : constant String_Access :=
407 new String (1 .. 2 * Expression_Value'Last);
410 New_Value (1 .. Expression_Last) :=
411 Expression_Value (1 .. Expression_Last);
412 Free (Expression_Value);
413 Expression_Value := New_Value;
417 Expression_Value (Expression_Last + 1 .. Expression_Last + S'Length)
419 Expression_Last := Expression_Last + S'Length;
420 end Add_To_Expression_Value;
422 procedure Add_To_Expression_Value (S : Name_Id) is
425 Add_To_Expression_Value (S => Name_Buffer (1 .. Name_Len));
426 end Add_To_Expression_Value;
428 -----------------------
429 -- Display_Copyright --
430 -----------------------
432 procedure Display_Copyright is
434 if not Copyright_Displayed then
435 Copyright_Displayed := True;
436 Write_Str ("GPR2MAKE ");
437 Write_Str (Gnatvsn.Gnat_Version_String);
438 Write_Str (" Copyright 2002-2003 Free Software Foundation, Inc.");
442 end Display_Copyright;
448 function Equal_String (Left, Right : Name_Id) return Boolean is
450 Get_Name_String (Left);
453 Left_Value : constant String :=
454 To_Lower (Name_Buffer (1 .. Name_Len));
457 Get_Name_String (Right);
458 return Left_Value = To_Lower (Name_Buffer (1 .. Name_Len));
467 (Project : Project_Node_Id;
468 First_Term : Project_Node_Id;
469 Kind : Variable_Kind;
471 Reset : Boolean := False)
473 Term : Project_Node_Id := First_Term;
474 -- The term in the expression list
476 Current_Term : Project_Node_Id := Empty_Node;
477 -- The current term node id
481 Expression_Kind := Other;
484 Expression_Kind := Undecided;
485 Expression_Last := 0;
488 while Term /= Empty_Node loop
490 Current_Term := Tree.Current_Term (Term);
492 case Kind_Of (Current_Term) is
494 when N_Literal_String =>
495 -- If we are in a string list, we precede this literal string
496 -- with a space; it does not matter if the output list
497 -- has a leading space.
498 -- Otherwise we just output the literal string:
499 -- if it is not the first term of the expression, it will
500 -- concatenate with was previously output.
506 -- If in a static string expression, add to expression value
508 if Expression_Kind = Undecided
509 or else Expression_Kind = Static_String
511 Expression_Kind := Static_String;
514 Add_To_Expression_Value (" ");
517 Add_To_Expression_Value (String_Value_Of (Current_Term));
520 Put (String_Value_Of (Current_Term));
522 when N_Literal_String_List =>
523 -- For string list, we repetedly call Expression with each
524 -- element of the list.
527 String_Node : Project_Node_Id :=
528 First_Expression_In_List (Current_Term);
531 if String_Node /= Empty_Node then
533 -- If String_Node is nil, it is an empty list,
534 -- there is nothing to do
538 First_Term => Tree.First_Term (String_Node),
543 -- Add the other element of the literal string list
544 -- one after the other
547 Next_Expression_In_List (String_Node);
549 exit when String_Node = Empty_Node;
552 Add_To_Expression_Value (" ");
555 First_Term => Tree.First_Term (String_Node),
562 when N_Variable_Reference | N_Attribute_Reference =>
563 -- A variable or attribute reference is never static
565 Expression_Kind := Other;
567 -- A variable or an attribute is identified by:
568 -- - its project name,
569 -- - its package name, if any,
571 -- - its index (if an associative array attribute).
574 Term_Project : Project_Node_Id :=
575 Project_Node_Of (Current_Term);
576 Term_Package : constant Project_Node_Id :=
577 Package_Node_Of (Current_Term);
579 Name : constant Name_Id := Name_Of (Current_Term);
581 Term_Package_Name : Name_Id := No_Name;
584 if Term_Project = Empty_Node then
585 Term_Project := Project;
588 if Term_Package /= Empty_Node then
589 Term_Package_Name := Name_Of (Term_Package);
592 -- If we are in a string list, we precede this variable or
593 -- attribute reference with a space; it does not matter if
594 -- the output list has a leading space.
602 if Kind_Of (Current_Term) = N_Variable_Reference then
604 (Project => Term_Project,
605 Pkg => Term_Package_Name,
609 -- Attribute reference.
611 -- If it is a Default_Switches attribute, check if it
612 -- is allowed in this expression (same package and same
615 if Name = Snames.Name_Default_Switches then
616 if Default_Switches_Package /= Term_Package_Name
617 or else not Equal_String
618 (Default_Switches_Language,
619 Associative_Array_Index_Of
622 -- This Default_Switches attribute is not allowed
623 -- here; report an error and continue.
624 -- The Makefiles created will be deleted at the
627 Error_Msg_Name_1 := Term_Package_Name;
629 ("reference to `%''Default_Switches` " &
631 Location_Of (Current_Term));
634 -- If it is a Switches attribute, check if it is allowed
635 -- in this expression (same package and same source
638 elsif Name = Snames.Name_Switches then
639 if Switches_Package /= Term_Package_Name
640 or else Source_Kind_Of (Associative_Array_Index_Of
644 -- This Switches attribute is not allowed here;
645 -- report an error and continue. The Makefiles
646 -- created will be deleted at the end.
648 Error_Msg_Name_1 := Term_Package_Name;
650 ("reference to `%''Switches` " &
652 Location_Of (Current_Term));
656 -- Other attribute references are only allowed in
657 -- the declaration of an atribute of the same
658 -- package and of the same name.
660 if not Other_Attribute
661 or else Other_Attribute_Package /= Term_Package_Name
662 or else Other_Attribute_Name /= Name
664 if Term_Package_Name = No_Name then
665 Error_Msg_Name_1 := Name;
667 ("reference to % not allowed here",
668 Location_Of (Current_Term));
671 Error_Msg_Name_1 := Term_Package_Name;
672 Error_Msg_Name_2 := Name;
674 ("reference to `%''%` not allowed here",
675 Location_Of (Current_Term));
681 (Project => Term_Project,
682 Pkg => Term_Package_Name,
684 Index => Associative_Array_Index_Of (Current_Term));
690 when N_External_Value =>
691 -- An external reference is never static
693 Expression_Kind := Other;
695 -- As the external references have already been processed,
696 -- we just output the name of the variable that corresponds
697 -- to this external reference node.
700 Put_U_Name (Name_Of (Project));
702 Put (Externals.Get (Current_Term));
707 -- Should never happen
711 "illegal node kind in an expression");
715 Term := Next_Term (Term);
723 procedure Gpr2make is
725 -- First, get the switches, if any
728 case Getopt ("h q v R") is
740 Opt.Quiet_Output := True;
745 Opt.Verbose_Mode := True;
748 -- -R: no Recursivity
751 Process_All_Project_Files := False;
758 -- Now, get the project file (maximum one)
762 S : constant String := Get_Argument (Do_Expansion => True);
764 exit when S'Length = 0;
766 if Main_Project_File_Name /= null then
767 Fail ("only one project file may be specified");
770 Main_Project_File_Name := new String'(S);
775 -- If no project file specified, display the usage and exit
777 if Main_Project_File_Name = null then
782 -- Do the necessary initializations
791 -- Parse the project file(s)
793 Prj.Part.Parse (Project_Tree, Main_Project_File_Name.all, False);
795 -- If parsing was successful, process the project tree
797 if Project_Tree /= Empty_Node then
799 -- Create some Name_Ids that are not in Snames
802 Name_Buffer (1 .. Name_Len) := "ide";
803 Name_Ide := Name_Find;
806 Name_Buffer (1 .. Name_Len) := "compiler_command";
807 Name_Compiler_Command := Name_Find;
810 Name_Buffer (1 .. Name_Len) := "main_language";
811 Name_Main_Language := Name_Find;
814 Name_Buffer (1 .. Name_Len) := "c++";
815 Name_C_Plus_Plus := Name_Find;
817 Process (Project_Tree);
819 if Compilation_Errors then
820 if not Verbose_Mode then
827 Fail ("no Makefile created");
836 procedure New_Line is
845 procedure Process (Project : Project_Node_Id) is
847 Processed_Projects.Reset;
848 Recursive_Process (Project);
851 -------------------------------
852 -- Process_Case_Construction --
853 -------------------------------
855 procedure Process_Case_Construction
856 (Current_Project : Project_Node_Id;
857 Current_Pkg : Name_Id;
858 Case_Project : Project_Node_Id;
861 Node : Project_Node_Id)
863 Case_Project_Name : constant Name_Id := Name_Of (Case_Project);
864 Before : IO.Position;
868 procedure Put_Case_Construction;
869 -- Output the variable $<PROJECT>__CASE__#, specific to
870 -- this case construction. It contains the number of the
873 procedure Recursive_Process
874 (Case_Item : Project_Node_Id;
875 Branch_Number : Positive);
876 -- A recursive procedure. Calls itself for each branch, increasing
877 -- Branch_Number by 1 each time.
879 procedure Put_Variable_Name;
880 -- Output the case variable
882 ---------------------------
883 -- Put_Case_Construction --
884 ---------------------------
886 procedure Put_Case_Construction is
888 Put_U_Name (Case_Project_Name);
890 Put (Last_Case_Construction);
891 end Put_Case_Construction;
893 -----------------------
894 -- Recursive_Process --
895 -----------------------
897 procedure Recursive_Process
898 (Case_Item : Project_Node_Id;
899 Branch_Number : Positive)
901 Choice_String : Project_Node_Id := First_Choice_Of (Case_Item);
903 Before : IO.Position;
907 No_Lines : Boolean := False;
910 -- Nothing to do if Case_Item is empty.
911 -- That should happen only if the case construvtion is totally empty.
915 if Case_Item /= Empty_Node then
916 -- Remember where we are, to be able to come back here if this
917 -- case item is empty.
921 if Choice_String = Empty_Node then
924 -- Output a comment "# when others => ..."
926 Put_Line ("# when others => ...");
928 -- Remember where we are, to detect if there is anything
929 -- put in the Makefile for this branch.
933 -- Process the declarative items of this branch
935 Process_Declarative_Items
936 (Project => Current_Project,
939 Item => First_Declarative_Item_Of (Case_Item));
944 -- If we are at the same place, the branch is totally empty:
945 -- suppress it completely.
947 if Start = After then
951 -- Case Item with one or several case labels
954 -- # case <label> => ...
956 -- # case <first_Label> | ... =>
957 -- depending on the number of case labels.
960 Put (String_Value_Of (Choice_String));
963 if Next_Literal_String (Choice_String) /= Empty_Node then
970 -- Check if the case variable is equal to the first case label
974 Put (String_Value_Of (Choice_String));
978 if Next_Literal_String (Choice_String) /= Empty_Node then
979 -- Several choice strings. We need to use an auxiliary
980 -- variable <PROJECT.case.# to detect if we should follow
984 Put_Case_Construction;
991 Choice_String := Next_Literal_String (Choice_String);
993 exit when Choice_String = Empty_Node;
998 Put (String_Value_Of (Choice_String));
1003 -- Now, we test the auxiliary variable
1006 Put_Case_Construction;
1008 Put (Branch_Number);
1013 -- Remember where we are before calling
1014 -- Process_Declarative_Items.
1018 Process_Declarative_Items
1019 (Project => Current_Project,
1022 Item => First_Declarative_Item_Of (Case_Item));
1024 -- Check where we are now, to detect if some lines have been
1025 -- added to the Makefile.
1029 No_Lines := Start = After;
1031 -- If no lines have been added, then suppress completely this
1035 IO.Release (Before);
1038 -- If there is a next branch, process it
1040 if Next_Case_Item (Case_Item) /= Empty_Node then
1041 -- If this branch has not been suppressed, we need an "else"
1043 if not No_Lines then
1044 -- Mark the position of the "else"
1050 -- Mark the position before the next branch
1056 (Case_Item => Next_Case_Item (Case_Item),
1057 Branch_Number => Branch_Number + 1);
1059 if not No_Lines then
1063 -- If we are at the same place, suppress the useless
1066 if After = Start then
1067 IO.Release (Before);
1072 -- If the branch has not been suppressed, we need an "endif"
1074 if not No_Lines then
1079 end Recursive_Process;
1081 -----------------------
1082 -- Put_Variable_Name --
1083 -----------------------
1085 procedure Put_Variable_Name is
1087 Put_Variable (Case_Project, Case_Pkg, Name);
1088 end Put_Variable_Name;
1090 -- Start of procedure Process_Case_Construction
1093 Last_Case_Construction := Last_Case_Construction + 1;
1095 -- Remember where we are in case we suppress completely the case
1102 -- Output a comment line for this case construction
1105 Put_M_Name (Case_Project_Name);
1107 if Case_Pkg /= No_Name then
1109 Put_M_Name (Case_Pkg);
1117 -- Remember where we are, to detect if all branches have been suppressed
1121 -- Start at the first case item
1124 (Case_Item => First_Case_Item_Of (Node),
1125 Branch_Number => 1);
1131 -- If we are at the same position, it means that all branches have been
1132 -- suppressed: then we suppress completely the case construction.
1134 if Start = After then
1135 IO.Release (Before);
1138 -- If the case construction is not completely suppressed, we issue
1139 -- a comment indicating the end of the case construction.
1141 Put_Line ("# end case;");
1145 end Process_Case_Construction;
1147 -------------------------------
1148 -- Process_Declarative_Items --
1149 -------------------------------
1151 procedure Process_Declarative_Items
1152 (Project : Project_Node_Id;
1155 Item : Project_Node_Id)
1157 Current_Declarative_Item : Project_Node_Id := Item;
1158 Current_Item : Project_Node_Id := Empty_Node;
1160 Project_Name : constant String :=
1161 To_Upper (Get_Name_String (Name_Of (Project)));
1162 Item_Name : Name_Id := No_Name;
1165 -- For each declarative item
1167 while Current_Declarative_Item /= Empty_Node loop
1170 Current_Item := Current_Item_Node (Current_Declarative_Item);
1172 -- And set Current_Declarative_Item to the next declarative item
1173 -- ready for the next iteration
1175 Current_Declarative_Item := Next_Declarative_Item
1176 (Current_Declarative_Item);
1178 -- By default, indicate that Default_Switches and Switches
1179 -- attribute references are not allowed in expressions.
1181 Default_Switches_Project := Empty_Node;
1182 Switches_Project := Empty_Node;
1183 Other_Attribute := False;
1185 -- Write_Line (Project_Node_Kind'Image (Kind_Of (Current_Item)));
1187 case Kind_Of (Current_Item) is
1189 when N_Package_Declaration =>
1190 Item_Name := Name_Of (Current_Item);
1193 Real_Project : constant Project_Node_Id :=
1194 Project_Of_Renamed_Package_Of
1197 Before_Package : IO.Position;
1198 Start_Of_Package : IO.Position;
1199 End_Of_Package : IO.Position;
1201 Decl_Item : Project_Node_Id;
1204 -- If it is a renaming package, we go to the original
1205 -- package. This is guaranteed to work, otherwise the
1206 -- parsing of the project file tree would have already
1209 if Real_Project /= Empty_Node then
1211 First_Declarative_Item_Of
1212 (Project_Declaration_Of (Real_Project));
1214 -- Traverse the declarative items of the project,
1215 -- until we find the renamed package.
1217 while Decl_Item /= Empty_Node loop
1218 Current_Item := Current_Item_Node (Decl_Item);
1219 exit when Kind_Of (Current_Item)
1220 = N_Package_Declaration
1221 and then Name_Of (Current_Item) = Item_Name;
1222 Decl_Item := Next_Declarative_Item (Decl_Item);
1226 -- Remember where we are, in case we want to completely
1227 -- suppress this package.
1229 IO.Mark (Before_Package);
1233 -- Output comment line for this package
1236 Put_M_Name (Item_Name);
1240 -- Record where we are before calling
1241 -- Process_Declarative_Items.
1243 IO.Mark (Start_Of_Package);
1245 -- And process the declarative items of this package
1247 Process_Declarative_Items
1248 (Project => Project,
1251 Item => First_Declarative_Item_Of (Current_Item));
1253 -- Reset the local variables once we have finished with
1256 Variable_Names.Init;
1259 IO.Mark (End_Of_Package);
1261 -- If we are at the same place, suppress completely the
1264 if End_Of_Package = Start_Of_Package then
1265 IO.Release (Before_Package);
1269 -- otherwise, utput comment line for end of package
1272 Put_M_Name (Item_Name);
1280 when N_Variable_Declaration | N_Typed_Variable_Declaration =>
1281 Item_Name := Name_Of (Current_Item);
1283 -- Output comment line for this variable
1286 Put_M_Name (Item_Name);
1290 -- If we are inside a package, the variable is a local
1291 -- variable, not a project level variable.
1292 -- So we check if its name is included in the Variables
1293 -- table; if it is not already, we put it in the table.
1295 if Pkg /= No_Name then
1297 Found : Boolean := False;
1301 Index in Variable_Names.First .. Variable_Names.Last
1303 if Variable_Names.Table (Index) = Item_Name then
1310 Variable_Names.Increment_Last;
1311 Variable_Names.Table (Variable_Names.Last) :=
1317 -- Output the line <variable_Name>:=<expression>
1319 Put_Variable (Project, Pkg, Item_Name);
1324 (Project => Project,
1325 First_Term => Tree.First_Term (Expression_Of (Current_Item)),
1326 Kind => Expression_Kind_Of (Current_Item),
1327 In_Case => In_Case);
1331 when N_Attribute_Declaration =>
1332 Item_Name := Name_Of (Current_Item);
1335 Index : constant Name_Id :=
1336 Associative_Array_Index_Of (Current_Item);
1338 Pos_Comment : IO.Position;
1339 Put_Declaration : Boolean := True;
1342 -- If it is a Default_Switches attribute register the
1343 -- project, the package and the language to indicate
1344 -- what Default_Switches attribute references are allowed
1347 if Item_Name = Snames.Name_Default_Switches then
1348 Default_Switches_Project := Project;
1349 Default_Switches_Package := Pkg;
1350 Default_Switches_Language := Index;
1352 -- If it is a Switches attribute register the project,
1353 -- the package and the source kind to indicate what
1354 -- Switches attribute references are allowed in expressions.
1356 elsif Item_Name = Snames.Name_Switches then
1357 Switches_Project := Project;
1358 Switches_Package := Pkg;
1359 Switches_Language := Source_Kind_Of (Index);
1362 -- Set Other_Attribute to True to indicate that we are
1363 -- in the declaration of an attribute other than
1364 -- Switches or Default_Switches.
1366 Other_Attribute := True;
1367 Other_Attribute_Package := Pkg;
1368 Other_Attribute_Name := Item_Name;
1371 -- Record where we are to be able to suppress the
1374 IO.Mark (Pos_Comment);
1376 -- Output comment line for this attribute
1379 Put_M_Name (Item_Name);
1381 if Index /= No_Name then
1390 -- Output the line <attribute_name>:=<expression>
1392 Put_Attribute (Project, Pkg, Item_Name, Index);
1395 (Project => Project,
1397 Tree.First_Term (Expression_Of (Current_Item)),
1398 Kind => Expression_Kind_Of (Current_Item),
1403 -- Remove any Default_Switches attribute declaration for
1404 -- languages other than C or C++.
1406 if Item_Name = Snames.Name_Default_Switches then
1407 Get_Name_String (Index);
1408 To_Lower (Name_Buffer (1 .. Name_Len));
1410 Name_Buffer (1 .. Name_Len) = "c" or else
1411 Name_Buffer (1 .. Name_Len) = "c++";
1413 -- Remove any Switches attribute declaration for source
1414 -- kinds other than C, C++ or unknown.
1416 elsif Item_Name = Snames.Name_Switches then
1418 Switches_Language = Unknown
1419 or else Switches_Language = C
1420 or else Switches_Language = Cxx;
1424 -- Attributes in packages other than Naming, Compiler or
1425 -- IDE are of no interest; suppress their declarations.
1427 Put_Declaration := Put_Declaration and
1429 or else Pkg = Snames.Name_Naming
1430 or else Pkg = Snames.Name_Compiler
1431 or else Pkg = Name_Ide);
1433 if Put_Declaration then
1434 -- Some attributes are converted into reserved variables
1436 if Pkg = No_Name then
1438 -- Project level attribute
1440 if Item_Name = Snames.Name_Languages then
1442 -- for Languages use ...
1444 -- Attribute Languages is converted to variable
1445 -- LANGUAGES. The actual string is put in lower
1448 Put ("LANGUAGES:=");
1450 -- If the expression is static (expected to be so
1451 -- most of the cases), then just give to LANGUAGES
1452 -- the lower case value of the expression.
1454 if Expression_Kind = Static_String then
1455 Put (To_Lower (Expression_Value
1456 (1 .. Expression_Last)));
1459 -- Otherwise, call to_lower on the value
1460 -- of the attribute.
1462 Put ("$(shell gprcmd to_lower $(");
1464 (Project, No_Name, Item_Name, No_Name);
1470 -- Record value of Languages if expression is
1471 -- static and if Languages_Static is True.
1473 if Expression_Kind /= Static_String then
1474 Languages_Static := False;
1476 elsif Languages_Static then
1478 (Expression_Value (1 .. Expression_Last));
1480 if Languages_Last = 0 then
1481 if Languages'Last < Expression_Last + 2 then
1484 new String (1 .. Expression_Last + 2);
1487 Languages (1) := ' ';
1488 Languages (2 .. Expression_Last + 1) :=
1489 Expression_Value (1 .. Expression_Last);
1490 Languages_Last := Expression_Last + 2;
1491 Languages (Languages_Last) := ' ';
1495 Languages (2 .. Languages_Last - 1) =
1496 Expression_Value (1 .. Expression_Last);
1500 elsif Item_Name = Snames.Name_Source_Dirs then
1502 -- for Source_Dirs use ...
1504 -- String list attribute Source_Dirs is converted
1505 -- to variable <PROJECT>.src_dirs, each element
1506 -- being an absolute directory name.
1509 ".src_dirs:=$(shell gprcmd extend $(");
1511 Put (".base_dir) '$(");
1512 Put_Attribute (Project, Pkg, Item_Name, No_Name);
1515 elsif Item_Name = Snames.Name_Source_Files then
1517 -- for Source_Files use ...
1519 -- String list Source_Files is converted to
1520 -- variable <PROJECT>.src_files
1523 Put (".src_files:=$(");
1524 Put_Attribute (Project, Pkg, Item_Name, No_Name);
1529 if Source_Files_Declaration = False then
1530 Source_Files_Declaration := May_Be;
1533 if Source_Files_Declaration /= True then
1535 -- Variable src_files.specified is set to
1536 -- TRUE. It will be tested to decide if there
1537 -- is a need to look for source files either
1538 -- in the source directories or in a source
1541 Put_Line ("src_files.specified:=TRUE");
1545 Source_Files_Declaration := True;
1548 elsif Item_Name = Snames.Name_Source_List_File then
1550 -- for Source_List_File use ...
1552 -- Single string Source_List_File is converted to
1553 -- variable src.list_file. It will be used
1554 -- later, if necessary, to get the source
1555 -- file names from the specified file.
1556 -- The file name is converted to an absolute path
1557 -- name if necessary.
1559 Put ("src.list_file:=" &
1560 "$(strip $(shell gprcmd to_absolute $(");
1562 Put (".base_dir) $(");
1563 Put_Attribute (Project, Pkg, Item_Name, No_Name);
1567 if Source_List_File_Declaration = False then
1568 Source_List_File_Declaration := May_Be;
1571 if Source_Files_Declaration /= True
1572 and then Source_List_File_Declaration /= True
1574 -- Variable src_list_file.specified is set to
1575 -- TRUE. It will be tested later, if
1576 -- necessary, to read the source list file.
1578 Put_Line ("src_list_file.specified:=TRUE");
1582 Source_List_File_Declaration := True;
1585 elsif Item_Name = Snames.Name_Object_Dir then
1587 -- for Object_Dir use ...
1589 -- Single string attribute Object_Dir is converted
1590 -- to variable <PROJECT>.obj_dir. The directory is
1591 -- converted to an absolute path name,
1596 "$(strip $(shell gprcmd to_absolute $(");
1598 Put (".base_dir) $(");
1599 Put_Attribute (Project, Pkg, Item_Name, No_Name);
1602 elsif Item_Name = Snames.Name_Exec_Dir then
1604 -- for Exec_Dir use ...
1606 -- Single string attribute Exec_Dir is converted
1607 -- to variable EXEC_DIR. The directory is
1608 -- converted to an absolute path name,
1612 "$(strip $(shell gprcmd to_absolute $(");
1614 Put (".base_dir) $(");
1615 Put_Attribute (Project, Pkg, Item_Name, No_Name);
1618 elsif Item_Name = Snames.Name_Main then
1620 -- for Mains use ...
1622 -- String list attribute Main is converted to
1623 -- variable ADA_MAINS.
1625 Put ("ADA_MAINS:=$(");
1626 Put_Attribute (Project, Pkg, Item_Name, No_Name);
1630 elsif Item_Name = Name_Main_Language then
1632 -- for Main_Language use ...
1636 -- If the expression is static (expected to be so
1637 -- most of the cases), then just give to MAIN
1638 -- the lower case value of the expression.
1640 if Expression_Kind = Static_String then
1641 Put (To_Lower (Expression_Value
1642 (1 .. Expression_Last)));
1645 -- Otherwise, call to_lower on the value
1646 -- of the attribute.
1648 Put ("$(shell gprcmd to_lower $(");
1650 (Project, No_Name, Item_Name, No_Name);
1657 -- Other attribute are of no interest; suppress
1658 -- their declarations.
1660 Put_Declaration := False;
1663 elsif Pkg = Snames.Name_Compiler then
1664 -- Attribute of package Compiler
1666 if Item_Name = Snames.Name_Switches then
1668 -- for Switches (<file_name>) use ...
1670 -- As the C and C++ extension may not be known
1671 -- statically, at the end of the processing of this
1672 -- project file, a test will done to decide if the
1673 -- file name (the index) has a C or C++ extension.
1674 -- The index is recorded in the table Switches,
1675 -- making sure that it appears only once.
1678 Found : Boolean := False;
1680 for J in Switches.First .. Switches.Last loop
1681 if Switches.Table (J) = Index then
1688 Switches.Increment_Last;
1689 Switches.Table (Switches.Last) := Index;
1693 elsif Item_Name = Snames.Name_Default_Switches then
1694 Get_Name_String (Index);
1695 To_Lower (Name_Buffer (1 .. Name_Len));
1697 if Name_Buffer (1 .. Name_Len) = "c" then
1699 Put_Attribute (Project, Pkg, Item_Name, Index);
1703 elsif Name_Buffer (1 .. Name_Len) = "c++" then
1704 Put ("CXXFLAGS:=$(");
1705 Put_Attribute (Project, Pkg, Item_Name, Index);
1710 -- Other attribute are of no interest; suppress
1711 -- their declarations.
1713 Put_Declaration := False;
1716 elsif Pkg = Name_Ide then
1718 -- Attributes of package IDE
1720 if Item_Name = Name_Compiler_Command then
1722 -- for Compiler_Command (<language>) use ...
1725 Index_Name : Name_Id := No_Name;
1728 Get_Name_String (Index);
1729 To_Lower (Name_Buffer (1 .. Name_Len));
1730 Index_Name := Name_Find;
1732 -- Only "Ada", "C" and "C++" are of interest
1734 if Index_Name = Snames.Name_Ada then
1736 -- For "Ada", we set the variable $GNATMAKE
1738 Put ("GNATMAKE:=$(");
1740 (Project, Pkg, Item_Name, Index);
1744 elsif Index_Name = Snames.Name_C then
1746 -- For "C", we set the variable $CC
1750 (Project, Pkg, Item_Name, Index);
1754 elsif Index_Name = Name_C_Plus_Plus then
1756 -- For "C++", we set the variable $CXX
1760 (Project, Pkg, Item_Name, Index);
1766 -- Other attribute are of no interest; suppress
1767 -- their declarations.
1769 Put_Declaration := False;
1772 elsif Pkg = Snames.Name_Naming then
1773 -- Attributes of package Naming
1775 if Item_Name = Snames.Name_Body_Suffix then
1777 -- for Body_Suffix (<language>) use ...
1780 Index_Name : Name_Id := No_Name;
1783 Get_Name_String (Index);
1784 To_Lower (Name_Buffer (1 .. Name_Len));
1785 Index_Name := Name_Find;
1787 -- Languages "C", "C++" & "Ada" are of interest
1789 if Index_Name = Snames.Name_C then
1791 -- For "C", we set the variable C_EXT
1795 (Project, Pkg, Item_Name, Index);
1799 if Expression_Kind /= Static_String then
1800 C_Suffix_Static := False;
1802 elsif C_Suffix_Static then
1803 if C_Suffix_Last = 0 then
1804 if C_Suffix'Last < Expression_Last then
1806 C_Suffix := new String'
1808 (1 .. Expression_Last));
1811 C_Suffix (1 .. Expression_Last) :=
1813 (1 .. Expression_Last);
1816 C_Suffix_Last := Expression_Last;
1821 (1 .. Expression_Last) =
1822 C_Suffix (1 .. C_Suffix_Last);
1826 elsif Index_Name = Name_C_Plus_Plus then
1828 -- For "C++", we set the variable CXX_EXT
1830 Put ("CXX_EXT:=$(");
1832 (Project, Pkg, Item_Name, Index);
1836 if Expression_Kind /= Static_String then
1837 Cxx_Suffix_Static := False;
1839 elsif Cxx_Suffix_Static then
1840 if Cxx_Suffix_Last = 0 then
1842 Cxx_Suffix'Last < Expression_Last
1845 Cxx_Suffix := new String'
1847 (1 .. Expression_Last));
1850 Cxx_Suffix (1 .. Expression_Last) :=
1852 (1 .. Expression_Last);
1855 Cxx_Suffix_Last := Expression_Last;
1858 Cxx_Suffix_Static :=
1860 (1 .. Expression_Last) =
1861 Cxx_Suffix (1 .. Cxx_Suffix_Last);
1865 elsif Item_Name = Snames.Name_Ada then
1867 -- For "Ada", we set the variable ADA_BODY
1869 Put ("ADA_BODY:=$(");
1871 (Project, Pkg, Item_Name, Index);
1875 if Expression_Kind /= Static_String then
1876 Ada_Body_Suffix_Static := False;
1878 elsif Ada_Body_Suffix_Static then
1879 if Ada_Body_Suffix_Last = 0 then
1881 Ada_Body_Suffix'Last < Expression_Last
1883 Free (Ada_Body_Suffix);
1884 Ada_Body_Suffix := new String'
1886 (1 .. Expression_Last));
1890 (1 .. Expression_Last) :=
1892 (1 .. Expression_Last);
1895 Ada_Body_Suffix_Last := Expression_Last;
1898 Ada_Body_Suffix_Static :=
1900 (1 .. Expression_Last) =
1902 (1 .. Ada_Body_Suffix_Last);
1908 elsif Item_Name = Snames.Name_Spec_Suffix then
1910 -- for Spec_Suffix (<language>) use ...
1913 Index_Name : Name_Id := No_Name;
1916 Get_Name_String (Index);
1917 To_Lower (Name_Buffer (1 .. Name_Len));
1918 Index_Name := Name_Find;
1920 -- Only "Ada" is of interest
1922 if Index_Name = Snames.Name_Ada then
1924 -- For "Ada", we set the variable ADA_SPEC
1926 Put ("ADA_SPEC:=$(");
1928 (Project, Pkg, Item_Name, Index);
1932 if Expression_Kind /= Static_String then
1933 Ada_Spec_Suffix_Static := False;
1935 elsif Ada_Spec_Suffix_Static then
1936 if Ada_Spec_Suffix_Last = 0 then
1938 Ada_Spec_Suffix'Last < Expression_Last
1940 Free (Ada_Spec_Suffix);
1941 Ada_Spec_Suffix := new String'
1943 (1 .. Expression_Last));
1947 (1 .. Expression_Last) :=
1949 (1 .. Expression_Last);
1952 Ada_Spec_Suffix_Last := Expression_Last;
1955 Ada_Spec_Suffix_Static :=
1957 (1 .. Expression_Last) =
1959 (1 .. Ada_Spec_Suffix_Last);
1965 -- Other attribute are of no interest; suppress
1966 -- their declarations.
1968 Put_Declaration := False;
1973 -- Suppress the attribute declaration if not needed
1975 if not Put_Declaration then
1976 IO.Release (Pos_Comment);
1980 when N_Case_Construction =>
1982 -- case <typed_string_variable> is ...
1985 Case_Project : Project_Node_Id := Project;
1986 Case_Pkg : Name_Id := No_Name;
1987 Variable_Node : constant Project_Node_Id :=
1988 Case_Variable_Reference_Of (Current_Item);
1989 Variable_Name : constant Name_Id := Name_Of (Variable_Node);
1992 if Project_Node_Of (Variable_Node) /= Empty_Node then
1993 Case_Project := Project_Node_Of (Variable_Node);
1996 if Package_Node_Of (Variable_Node) /= Empty_Node then
1997 Case_Pkg := Name_Of (Package_Node_Of (Variable_Node));
2000 -- If we are in a package, and no package is specified
2001 -- for the case variable, we look into the table
2002 -- Variables_Names to decide if it is a variable local
2003 -- to the package or a project level variable.
2006 and then Case_Pkg = No_Name
2007 and then Case_Project = Project
2010 Index in Variable_Names.First .. Variable_Names.Last
2012 if Variable_Names.Table (Index) = Variable_Name then
2019 -- The real work is done in Process_Case_Construction.
2021 Process_Case_Construction
2022 (Current_Project => Project,
2024 Case_Project => Case_Project,
2025 Case_Pkg => Case_Pkg,
2026 Name => Variable_Name,
2027 Node => Current_Item);
2035 end Process_Declarative_Items;
2037 -----------------------
2038 -- Process_Externals --
2039 -----------------------
2040 procedure Process_Externals (Project : Project_Node_Id) is
2041 Project_Name : constant Name_Id := Name_Of (Project);
2043 No_External_Yet : Boolean := True;
2045 procedure Expression (First_Term : Project_Node_Id);
2046 -- Look for external reference in the term of an expression.
2047 -- If one is found, build the Makefile external reference variable.
2049 procedure Process_Declarative_Items (Item : Project_Node_Id);
2050 -- Traverse the declarative items of a project file to find all
2051 -- external references.
2057 procedure Expression (First_Term : Project_Node_Id) is
2058 Term : Project_Node_Id := First_Term;
2059 -- The term in the expression list
2061 Current_Term : Project_Node_Id := Empty_Node;
2062 -- The current term node id
2064 Default : Project_Node_Id;
2067 -- Check each term of the expression
2069 while Term /= Empty_Node loop
2070 Current_Term := Tree.Current_Term (Term);
2072 if Kind_Of (Current_Term) = N_External_Value then
2074 -- If it is the first external reference of this project file,
2077 if No_External_Yet then
2078 No_External_Yet := False;
2081 Put_Line ("# external references");
2086 -- Increase Last_External and record the node of the external
2087 -- reference in table Externals, so that the external reference
2088 -- variable can be identified later.
2090 Last_External := Last_External + 1;
2091 Externals.Set (Current_Term, Last_External);
2093 Default := External_Default_Of (Current_Term);
2096 (String_Value_Of (External_Reference_Of (Current_Term)));
2099 External_Name : constant String :=
2100 Name_Buffer (1 .. Name_Len);
2103 -- Output a comment for this external reference
2105 Put ("# external (""");
2106 Put (External_Name);
2108 if Default /= Empty_Node then
2110 Put (String_Value_Of (Default));
2116 -- If there is no default, output one line:
2118 -- <PROJECT>__EXTERNAL__#:=$(<external name>)
2120 if Default = Empty_Node then
2121 Put_U_Name (Project_Name);
2123 Put (Last_External);
2125 Put (External_Name, With_Substitution => True);
2130 -- When there is a default, output the following lines:
2132 -- ifeq ($(<external_name),)
2133 -- <PROJECT>__EXTERNAL__#:=<default>
2135 -- <PROJECT>__EXTERNAL__#:=$(<external_name>)
2139 Put (External_Name, With_Substitution => True);
2144 Put_U_Name (Project_Name);
2146 Put (Last_External);
2148 Put (String_Value_Of (Default));
2154 Put_U_Name (Project_Name);
2156 Put (Last_External);
2158 Put (External_Name, With_Substitution => True);
2167 Term := Next_Term (Term);
2171 -------------------------------
2172 -- Process_Declarative_Items --
2173 -------------------------------
2175 procedure Process_Declarative_Items (Item : Project_Node_Id) is
2176 Current_Declarative_Item : Project_Node_Id := Item;
2177 Current_Item : Project_Node_Id := Empty_Node;
2180 -- For each declarative item
2182 while Current_Declarative_Item /= Empty_Node loop
2183 Current_Item := Current_Item_Node (Current_Declarative_Item);
2185 -- Set Current_Declarative_Item to the next declarative item
2186 -- ready for the next iteration
2188 Current_Declarative_Item := Next_Declarative_Item
2189 (Current_Declarative_Item);
2191 -- Write_Line (Project_Node_Kind'Image (Kind_Of (Current_Item)));
2193 case Kind_Of (Current_Item) is
2195 when N_Package_Declaration =>
2197 -- Recursive call the declarative items of a package
2200 Project_Of_Renamed_Package_Of (Current_Item) = Empty_Node
2202 Process_Declarative_Items
2203 (First_Declarative_Item_Of (Current_Item));
2206 when N_Attribute_Declaration |
2207 N_Typed_Variable_Declaration |
2208 N_Variable_Declaration =>
2210 -- Process the expression to look for external references
2213 (First_Term => Tree.First_Term
2214 (Expression_Of (Current_Item)));
2216 when N_Case_Construction =>
2218 -- Recursive calls to process the declarative items of
2222 Case_Item : Project_Node_Id :=
2223 First_Case_Item_Of (Current_Item);
2226 while Case_Item /= Empty_Node loop
2227 Process_Declarative_Items
2228 (First_Declarative_Item_Of (Case_Item));
2229 Case_Item := Next_Case_Item (Case_Item);
2237 end Process_Declarative_Items;
2239 -- Start of procedure Process_Externals
2242 Process_Declarative_Items
2243 (First_Declarative_Item_Of (Project_Declaration_Of (Project)));
2245 if not No_External_Yet then
2246 Put_Line ("# end of external references");
2249 end Process_Externals;
2255 procedure Put (S : String; With_Substitution : Boolean := False) is
2259 -- If With_Substitution is True, check if S is one of the reserved
2260 -- variables. If it is, append to it the Saved_Suffix.
2262 if With_Substitution then
2263 for J in Reserved_Variables'Range loop
2264 if S = Reserved_Variables (J).all then
2265 IO.Put (Saved_Suffix);
2272 procedure Put (P : Positive) is
2273 Image : constant String := P'Img;
2276 Put (Image (Image'First + 1 .. Image'Last));
2279 procedure Put (S : Name_Id) is
2281 Get_Name_String (S);
2282 Put (Name_Buffer (1 .. Name_Len));
2289 procedure Put_Attribute
2290 (Project : Project_Node_Id;
2296 Put_U_Name (Name_Of (Project));
2298 if Pkg /= No_Name then
2306 if Index /= No_Name then
2309 -- For attribute Switches, we don't want to change the file name
2311 if Name = Snames.Name_Switches then
2312 Get_Name_String (Index);
2313 Put (Name_Buffer (1 .. Name_Len));
2316 Special_Put_U_Name (Index);
2321 -----------------------------
2322 -- Put_Directory_Separator --
2323 -----------------------------
2325 procedure Put_Directory_Separator is
2327 Put (S => (1 => Directory_Separator));
2328 end Put_Directory_Separator;
2330 -------------------------
2331 -- Put_Include_Project --
2332 -------------------------
2334 procedure Put_Include_Project
2335 (Included_Project_Path : Name_Id;
2336 Included_Project : Project_Node_Id;
2337 Including_Project_Name : String)
2340 -- If path is null, there is nothing to do.
2341 -- This happens when there is no project being extended.
2343 if Included_Project_Path /= No_Name then
2344 Get_Name_String (Included_Project_Path);
2347 Included_Project_Name : constant String :=
2348 Get_Name_String (Name_Of (Included_Project));
2349 Included_Directory_Path : constant String :=
2350 Dir_Name (Name_Buffer (1 .. Name_Len));
2351 Last : Natural := Included_Directory_Path'Last;
2354 -- Remove a possible directory separator at the end of the
2357 if Last >= Included_Directory_Path'First
2358 and then Included_Directory_Path (Last) = Directory_Separator
2365 -- If it is a relative path, precede the directory with
2366 -- $(<PROJECT>.base_dir)/
2368 if not Is_Absolute_Path (Included_Directory_Path) then
2370 Put (Including_Project_Name);
2371 Put (".base_dir)" & Directory_Separator);
2374 Put (Included_Directory_Path
2375 (Included_Directory_Path'First .. Last));
2378 -- Include the Makefile
2380 Put ("include $(BASE_DIR)");
2381 Put_Directory_Separator;
2383 Put (To_Lower (Included_Project_Name));
2389 end Put_Include_Project;
2395 procedure Put_Line (S : String) is
2405 procedure Put_L_Name (N : Name_Id) is
2407 Put (To_Lower (Get_Name_String (N)));
2414 procedure Put_M_Name (N : Name_Id) is
2415 Name : String := Get_Name_String (N);
2426 procedure Put_U_Name (N : Name_Id) is
2428 Put (To_Upper (Get_Name_String (N)));
2435 procedure Put_Variable
2436 (Project : Project_Node_Id;
2441 Put_U_Name (Name_Of (Project));
2443 if Pkg /= No_Name then
2452 -----------------------
2453 -- Recursive_Process --
2454 -----------------------
2456 procedure Recursive_Process (Project : Project_Node_Id) is
2457 With_Clause : Project_Node_Id;
2458 Last_Case : Natural := Last_Case_Construction;
2459 There_Are_Cases : Boolean := False;
2460 May_Be_C_Sources : Boolean := False;
2461 May_Be_Cxx_Sources : Boolean := False;
2462 Post_Processing : Boolean := False;
2463 Src_Files_Init : IO.Position;
2464 Src_List_File_Init : IO.Position;
2466 -- Nothing to do if Project is nil.
2468 if Project /= Empty_Node then
2470 Declaration_Node : constant Project_Node_Id :=
2471 Project_Declaration_Of (Project);
2472 -- Used to get the project being extended, if any, and the
2473 -- declarative items of the project to be processed.
2475 Name : constant Name_Id := Name_Of (Project);
2476 -- Name of the project being processed
2478 Directory : constant Name_Id := Directory_Of (Project);
2479 -- Directory of the project being processed. Used as default
2480 -- for the object directory and the source directories.
2482 Lname : constant String := To_Lower (Get_Name_String (Name));
2483 -- <project>: name of the project in lower case
2485 Uname : constant String := To_Upper (Lname);
2486 -- <PROJECT>: name of the project in upper case
2489 -- Nothing to do if project file has already been processed
2491 if Processed_Projects.Get (Name) = Empty_Node then
2493 -- Put project name in table Processed_Projects to avoid
2494 -- processing the project several times.
2496 Processed_Projects.Set (Name, Project);
2498 -- Process all the projects imported, if any
2500 if Process_All_Project_Files then
2501 With_Clause := First_With_Clause_Of (Project);
2503 while With_Clause /= Empty_Node loop
2504 Recursive_Process (Project_Node_Of (With_Clause));
2505 With_Clause := Next_With_Clause_Of (With_Clause);
2508 -- Process the project being extended, if any.
2509 -- If there is no project being extended,
2510 -- Process_Declarative_Items will be called with Empty_Node
2511 -- and nothing will happen.
2513 Recursive_Process (Extended_Project_Of (Declaration_Node));
2516 Source_Files_Declaration := False;
2517 Source_List_File_Declaration := False;
2519 -- Build in Name_Buffer the path name of the Makefile
2521 -- Start with the directory of the project file
2523 Get_Name_String (Directory);
2525 -- Add a directory separator, if needed
2527 if Name_Buffer (Name_Len) /= Directory_Separator then
2528 Name_Len := Name_Len + 1;
2529 Name_Buffer (Name_Len) := Directory_Separator;
2532 -- Add the filename of the Makefile: "Makefile.<project>"
2534 Name_Buffer (Name_Len + 1 .. Name_Len + 9) := "Makefile.";
2535 Name_Len := Name_Len + 9;
2537 Name_Buffer (Name_Len + 1 .. Name_Len + Lname'Length) :=
2539 Name_Len := Name_Len + Lname'Length;
2541 IO.Create (Name_Buffer (1 .. Name_Len));
2543 -- Display the Makefile being created, but only if not in
2546 if not Opt.Quiet_Output then
2547 Write_Str ("creating """);
2548 Write_Str (IO.Name_Of_File);
2552 -- And create the Makefile
2556 -- Outut a comment with the path name of the Makefile
2558 Put_Line (IO.Name_Of_File);
2562 -- The Makefile is a big ifeq to avoid multiple inclusion
2563 -- ifeq ($(<PROJECT>.project),)
2564 -- <PROJECT>.project:=True
2570 Put (".project),)");
2574 Put (".project=True");
2579 -- If it is the main Makefile (BASE_DIR is empty)
2581 Put_Line ("ifeq ($(BASE_DIR),)");
2583 -- Set <PROJECT>.root to True
2592 Put (".base_dir:=$(shell gprcmd pwd)");
2595 -- Include some utility functions and saved all reserved
2596 -- env. vars. by including Makefile.prolog.
2605 Put (" variable is undefined, ");
2606 Put ("Makefile.prolog cannot be loaded)");
2611 Put (" include $(");
2614 Put_Directory_Separator;
2616 Put_Directory_Separator;
2618 Put_Directory_Separator;
2619 Put ("Makefile.prolog");
2622 Put_Line (" endif");
2624 -- Initialize some defaults
2627 Put (Get_Object_Suffix.all);
2632 -- When not the main Makefile, set <PROJECT>.root to False
2636 Put (".root=False");
2641 Put (".base_dir:=$(BASE_DIR)");
2647 -- For each imported project, if any, set BASE_DIR to the
2648 -- directory of the imported project, and add an include
2649 -- directive for the Makefile of the imported project.
2651 With_Clause := First_With_Clause_Of (Project);
2653 while With_Clause /= Empty_Node loop
2655 (String_Value_Of (With_Clause),
2656 Project_Node_Of (With_Clause),
2658 With_Clause := Next_With_Clause_Of (With_Clause);
2661 -- Do the same if there is a project being extended.
2662 -- If there is no project being extended, Put_Include_Project
2663 -- will return immediately.
2666 (Extended_Project_Path_Of (Project),
2667 Extended_Project_Of (Declaration_Node),
2670 -- Set defaults to some variables
2672 IO.Mark (Src_Files_Init);
2673 Put_Line ("src_files.specified:=FALSE");
2675 IO.Mark (Src_List_File_Init);
2676 Put_Line ("src_list_file.specified:=FALSE");
2678 -- <PROJECT>.src_dirs is set by default to the project
2682 Put (".src_dirs:=$(");
2687 -- <PROJECT>.obj_dir is set by default to the project
2691 Put (".obj_dir:=$(");
2696 -- PROJECT_FILE:=<project>
2698 Put ("PROJECT_FILE:=");
2702 -- Output a comment indicating the name of the project being
2709 -- Process the external references of this project file
2711 Process_Externals (Project);
2715 -- Reset the compiler switches, the suffixes and the languages
2718 Reset_Suffixes_And_Languages;
2720 -- Record the current value of Last_Case_Construction to
2721 -- detect if there are case constructions in this project file.
2723 Last_Case := Last_Case_Construction;
2725 -- Process the declarative items of this project file
2727 Process_Declarative_Items
2728 (Project => Project,
2731 Item => First_Declarative_Item_Of (Declaration_Node));
2733 -- Set There_Are_Case to True if there are case constructions
2734 -- in this project file.
2736 There_Are_Cases := Last_Case /= Last_Case_Construction;
2738 -- If the suffixs and the languages have not been specified,
2739 -- give them the default values.
2741 if C_Suffix_Static and then C_Suffix_Last = 0 then
2743 C_Suffix (1 .. 2) := ".c";
2746 if Cxx_Suffix_Static and then Cxx_Suffix_Last = 0 then
2747 Cxx_Suffix_Last := 3;
2748 Cxx_Suffix (1 .. 3) := ".cc";
2751 if Ada_Body_Suffix_Static and then Ada_Body_Suffix_Last = 0 then
2752 Ada_Body_Suffix_Last := 4;
2753 Ada_Body_Suffix (1 .. 4) := ".adb";
2756 if Ada_Spec_Suffix_Static and then Ada_Spec_Suffix_Last = 0 then
2757 Ada_Spec_Suffix_Last := 4;
2758 Ada_Spec_Suffix (1 .. 4) := ".ads";
2761 if Languages_Static and then Languages_Last = 0 then
2762 Languages_Last := 5;
2763 Languages (1 .. 5) := " ada ";
2766 -- There may be C sources if the languages are not known
2767 -- statically or if the languages include "C".
2769 May_Be_C_Sources := (not Languages_Static)
2771 (Source => Languages (1 .. Languages_Last),
2772 Pattern => " c ") /= 0;
2774 -- There may be C++ sources if the languages are not known
2775 -- statically or if the languages include "C++".
2777 May_Be_Cxx_Sources := (not Languages_Static)
2779 (Source => Languages (1 .. Languages_Last),
2780 Pattern => " c++ ") /= 0;
2784 -- If there are attribute Switches specified in package
2785 -- Compiler of this project, post-process them.
2787 if Switches.Last >= Switches.First then
2789 -- Output a comment indicating this post-processing
2791 for Index in Switches.First .. Switches.Last loop
2792 Get_Name_String (Switches.Table (Index));
2795 File : constant String :=
2796 Name_Buffer (1 .. Name_Len);
2797 Source_Kind : Source_Kind_Type := Unknown;
2800 -- First, attempt to determine the language
2802 if Ada_Body_Suffix_Static then
2803 if File'Length > Ada_Body_Suffix_Last
2805 File (File'Last - Ada_Body_Suffix_Last + 1 ..
2808 (1 .. Ada_Body_Suffix_Last)
2810 Source_Kind := Ada_Body;
2814 if Source_Kind = Unknown
2815 and then Ada_Spec_Suffix_Static
2817 if File'Length > Ada_Spec_Suffix_Last
2819 File (File'Last - Ada_Spec_Suffix_Last + 1 ..
2822 (1 .. Ada_Spec_Suffix_Last)
2824 Source_Kind := Ada_Spec;
2828 if Source_Kind = Unknown
2829 and then C_Suffix_Static
2831 if File'Length > C_Suffix_Last
2833 File (File'Last - C_Suffix_Last + 1
2835 C_Suffix (1 .. C_Suffix_Last)
2841 if Source_Kind = Unknown
2842 and then Cxx_Suffix_Static
2844 if File'Length > Cxx_Suffix_Last
2846 File (File'Last - Cxx_Suffix_Last + 1
2848 Cxx_Suffix (1 .. Cxx_Suffix_Last)
2854 -- If we still don't know the language, and all
2855 -- suffixs are static, then it cannot any of the
2856 -- processed languages.
2858 if Source_Kind = Unknown
2859 and then Ada_Body_Suffix_Static
2860 and then Ada_Spec_Suffix_Static
2861 and then C_Suffix_Static
2862 and then Cxx_Suffix_Static
2864 Source_Kind := None;
2867 -- If it can be "C" or "C++", post-process
2869 if (Source_Kind = Unknown and
2870 (May_Be_C_Sources or May_Be_Cxx_Sources))
2871 or else (May_Be_C_Sources and Source_Kind = C)
2872 or else (May_Be_Cxx_Sources and Source_Kind = Cxx)
2874 if not Post_Processing then
2875 Post_Processing := True;
2877 ("# post-processing of Compiler'Switches");
2882 -- Output a comment:
2883 -- # for Switches (<file>) use ...
2885 Put ("# for Switches (""");
2887 Put (""") use ...");
2890 if There_Are_Cases then
2892 -- Check that effectively there was Switches
2893 -- specified for this file: the attribute
2894 -- declaration may be in a case branch which was
2899 Put (".compiler.switches.");
2907 (Source_Kind = Unknown or else Source_Kind = C)
2909 -- If it is definitely a C file, no need to test
2911 if Source_Kind = C then
2912 Put (File (1 .. File'Last - C_Suffix_Last));
2913 Put (Get_Object_Suffix.all);
2919 -- May be a C file: test to know
2921 Put ("ifeq ($(filter %$(C_EXT),");
2928 -- If it is, output a rule for the object
2930 Put ("$(subst $(C_EXT),$(OBJ_EXT),");
2937 Put (ASCII.HT & "@echo $(CC) -c $(");
2939 Put (".compiler.switches.");
2941 Put (") $< -o $(OBJ_DIR)/$@");
2944 -- If FAKE_COMPILE is defined, do not issue
2945 -- the compile command.
2947 Put_Line ("ifndef FAKE_COMPILE");
2949 Put (ASCII.HT & "@$(CC) -c $(");
2951 Put (".compiler.switches.");
2953 Put (") $(C_INCLUDES) $(DEP_CFLAGS) " &
2954 "$< -o $(OBJ_DIR)/$@");
2957 Put_Line (ASCII.HT & "@$(post-compile)");
2961 if Source_Kind = Unknown then
2966 -- Now, test if it is a C++ file
2968 if May_Be_Cxx_Sources
2970 (Source_Kind = Unknown
2974 -- No need to test if definitely a C++ file
2976 if Source_Kind = Cxx then
2977 Put (File (1 .. File'Last - Cxx_Suffix_Last));
2978 Put (Get_Object_Suffix.all);
2984 -- May be a C++ file: test to know
2986 Put ("ifeq ($(filter %$(CXX_EXT),");
2993 -- If it is, output a rule for the object
2995 Put ("$(subst $(CXX_EXT),$(OBJ_EXT),");
3005 Put (ASCII.HT & "@echo $(CXX) -c $(");
3007 Put (".compiler.switches.");
3009 Put (") $< -o $(OBJ_DIR)/$@");
3012 -- If FAKE_COMPILE is defined, do not issue
3013 -- the compile command
3015 Put_Line ("ifndef FAKE_COMPILE");
3017 Put (ASCII.HT & "@$(CXX) -c $(");
3019 Put (".compiler.switches.");
3021 Put (") $(C_INCLUDES) $(DEP_CFLAGS) " &
3022 "$< -o $(OBJ_DIR)/$@");
3025 Put_Line (ASCII.HT & "@$(post-compile)");
3029 if Source_Kind = Unknown then
3035 if There_Are_Cases then
3044 -- Output a comment indication end of post-processing
3045 -- of Switches, if we have done some post-processing
3047 if Post_Processing then
3049 ("# end of post-processing of Compiler'Switches");
3055 -- Add source dirs of this project file to variable SRC_DIRS
3057 Put ("SRC_DIRS:=$(SRC_DIRS) $(");
3062 -- Set OBJ_DIR to the object directory
3064 Put ("OBJ_DIR:=$(");
3071 if Source_Files_Declaration = True then
3073 -- It is guaranteed that Source_Files has been specified.
3074 -- We then suppress the two lines that initialize
3075 -- the variables src_files.specified and
3076 -- src_list_file.specified. Nothing else to do.
3078 IO.Suppress (Src_Files_Init);
3079 IO.Suppress (Src_List_File_Init);
3082 if Source_Files_Declaration = May_Be then
3084 -- Need to test if attribute Source_Files was specified
3086 Put_Line ("# get the source files, if necessary");
3087 Put_Line ("ifeq ($(src_files.specified),FALSE)");
3090 Put_Line ("# get the source files");
3092 -- We may suppress initialization of src_files.specified
3094 IO.Suppress (Src_Files_Init);
3097 if Source_List_File_Declaration /= May_Be then
3098 IO.Suppress (Src_List_File_Init);
3101 case Source_List_File_Declaration is
3103 -- Source_List_File was specified
3106 if Source_Files_Declaration = May_Be then
3111 Put (".src_files:= $(shell gprcmd cat " &
3112 "$(src.list_file))");
3115 -- Source_File_List was NOT specified
3118 if Source_Files_Declaration = May_Be then
3123 Put (".src_files:= $(foreach name,$(");
3125 Put (".src_dirs),$(notdir $(wildcard $(name)/*)))");
3129 if Source_Files_Declaration = May_Be then
3133 Put_Line ("ifeq ($(src_list_file.specified),TRUE)");
3135 -- Get the source files from the file
3137 if Source_Files_Declaration = May_Be then
3143 Put (".src_files:= $(shell gprcmd cat " &
3144 "$(SRC__$LIST_FILE))");
3147 if Source_Files_Declaration = May_Be then
3153 -- Otherwise get source from the source directories
3155 if Source_Files_Declaration = May_Be then
3161 Put (".src_files:= $(foreach name,$(");
3163 Put (".src_dirs),$(notdir $(wildcard $(name)/*)))");
3166 if Source_Files_Declaration = May_Be then
3173 if Source_Files_Declaration = May_Be then
3180 if not Languages_Static then
3182 -- If Languages include "c", get the C sources
3185 ("# get the C source files, if C is one of the languages");
3187 Put_Line ("ifeq ($(filter c,$(LANGUAGES)),c)");
3189 Put (" C_SRCS:=$(filter %$(C_EXT),$(");
3191 Put (".src_files))");
3193 Put_Line (" C_SRCS_DEFINED:=True");
3195 -- Otherwise set C_SRCS to empty
3198 Put_Line (" C_SRCS=");
3202 -- If Languages include "C++", get the C++ sources
3205 ("# get the C++ source files, " &
3206 "if C++ is one of the languages");
3208 Put_Line ("ifeq ($(filter c++,$(LANGUAGES)),c++)");
3210 Put (" CXX_SRCS:=$(filter %$(CXX_EXT),$(");
3212 Put (".src_files))");
3214 Put_Line (" CXX_SRCS_DEFINED:=True");
3216 -- Otherwise set CXX_SRCS to empty
3219 Put_Line (" CXX_SRCS=");
3224 if Ada.Strings.Fixed.Index
3225 (Languages (1 .. Languages_Last), " c ") /= 0
3227 Put_Line ("# get the C sources");
3228 Put ("C_SRCS:=$(filter %$(C_EXT),$(");
3230 Put (".src_files))");
3232 Put_Line ("C_SRCS_DEFINED:=True");
3235 Put_Line ("# no C sources");
3237 Put_Line ("C_SRCS=");
3242 if Ada.Strings.Fixed.Index
3243 (Languages (1 .. Languages_Last), " c++ ") /= 0
3245 Put_Line ("# get the C++ sources");
3246 Put ("CXX_SRCS:=$(filter %$(CXX_EXT),$(");
3248 Put (".src_files))");
3250 Put_Line ("CXX_SRCS_DEFINED:=True");
3253 Put_Line ("# no C++ sources");
3255 Put_Line ("CXX_SRCS=");
3262 C_Present : constant Boolean :=
3263 (not Languages_Static) or else
3264 Ada.Strings.Fixed.Index
3265 (Languages (1 .. Languages_Last), " c ")
3268 Cxx_Present : constant Boolean :=
3269 (not Languages_Static) or else
3270 Ada.Strings.Fixed.Index
3271 (Languages (1 .. Languages_Last), " c++ ")
3275 if C_Present or Cxx_Present then
3277 -- If there are C or C++ sources,
3278 -- add a library name to variable LIBS.
3280 Put ("# if there are ");
3294 Put (" sources, add the library");
3297 Put ("ifneq ($(strip");
3304 Put (" $(CXX_SRCS)");
3312 Put (".obj_dir)/lib");
3314 Put ("$(AR_EXT) $(LIBS)");
3324 -- If this is the main Makefile, include Makefile.Generic
3328 Put_Line (".root),True)");
3330 -- Include Makefile.generic
3332 Put (" include $(");
3335 Put_Directory_Separator;
3337 Put_Directory_Separator;
3339 Put_Directory_Separator;
3340 Put ("Makefile.generic");
3343 -- If it is not the main Makefile, add the project to
3344 -- variable DEPS_PROJECTS.
3348 Put (" DEPS_PROJECTS:=$(strip $(DEPS_PROJECTS) $(");
3350 Put (".base_dir)/");
3361 -- Close the Makefile, so that another Makefile can be created
3362 -- with the same File_Type variable.
3368 end Recursive_Process;
3370 ----------------------------------
3371 -- Reset_Suffixes_And_Languages --
3372 ----------------------------------
3374 procedure Reset_Suffixes_And_Languages is
3376 -- Last = 0 indicates that this is the default, which is static,
3380 C_Suffix_Static := True;
3381 Cxx_Suffix_Last := 0;
3382 Cxx_Suffix_Static := True;
3383 Ada_Body_Suffix_Last := 0;
3384 Ada_Body_Suffix_Static := True;
3385 Ada_Spec_Suffix_Last := 0;
3386 Ada_Spec_Suffix_Static := True;
3387 Languages_Last := 0;
3388 Languages_Static := True;
3389 end Reset_Suffixes_And_Languages;
3391 --------------------
3392 -- Source_Kind_Of --
3393 --------------------
3395 function Source_Kind_Of (File_Name : Name_Id) return Source_Kind_Type is
3396 Source_C_Suffix : constant String :=
3397 Suffix_Of (C_Suffix_Static, C_Suffix, C_Suffix_Last, ".c");
3399 Source_Cxx_Suffix : constant String :=
3400 Suffix_Of (Cxx_Suffix_Static, Cxx_Suffix, Cxx_Suffix_Last, ".cc");
3402 Body_Ada_Suffix : constant String :=
3404 (Ada_Body_Suffix_Static,
3406 Ada_Body_Suffix_Last,
3409 Spec_Ada_Suffix : constant String :=
3411 (Ada_Spec_Suffix_Static,
3413 Ada_Spec_Suffix_Last,
3417 -- Get the name of the file
3419 Get_Name_String (File_Name);
3421 -- If the C suffix is static, check if it is a C file
3423 if Source_C_Suffix /= ""
3424 and then Name_Len > Source_C_Suffix'Length
3425 and then Name_Buffer (Name_Len - Source_C_Suffix'Length + 1
3426 .. Name_Len) = Source_C_Suffix
3430 -- If the C++ suffix is static, check if it is a C++ file
3432 elsif Source_Cxx_Suffix /= ""
3433 and then Name_Len > Source_Cxx_Suffix'Length
3434 and then Name_Buffer (Name_Len - Source_Cxx_Suffix'Length + 1
3435 .. Name_Len) = Source_Cxx_Suffix
3439 -- If the Ada body suffix is static, check if it is an Ada body
3441 elsif Body_Ada_Suffix /= ""
3442 and then Name_Len > Body_Ada_Suffix'Length
3443 and then Name_Buffer (Name_Len - Body_Ada_Suffix'Length + 1
3444 .. Name_Len) = Body_Ada_Suffix
3448 -- If the Ada spec suffix is static, check if it is an Ada spec
3450 elsif Spec_Ada_Suffix /= ""
3451 and then Name_Len > Spec_Ada_Suffix'Length
3452 and then Name_Buffer (Name_Len - Spec_Ada_Suffix'Length + 1
3453 .. Name_Len) = Spec_Ada_Suffix
3457 -- If the C or C++ suffix is not static, then return Unknown
3459 elsif Source_C_Suffix = "" or else Source_Cxx_Suffix = "" then
3462 -- Otherwise return None
3469 ------------------------
3470 -- Special_Put_U_Name --
3471 ------------------------
3473 procedure Special_Put_U_Name (S : Name_Id) is
3475 Get_Name_String (S);
3476 To_Upper (Name_Buffer (1 .. Name_Len));
3478 -- If string is "C++", change it to "CXX"
3480 if Name_Buffer (1 .. Name_Len) = "C++" then
3483 Put (Name_Buffer (1 .. Name_Len));
3485 end Special_Put_U_Name;
3493 Value : String_Access;
3501 -- If the suffix is static, Last = 0 indicates that it is the default
3502 -- suffix: return the default.
3507 -- Otherwise, return the current suffix
3510 return Value (1 .. Last);
3513 -- If the suffix is not static, return ""
3526 if not Usage_Displayed then
3527 Usage_Displayed := True;
3529 Write_Line ("Usage: gpr2make switches project-file");
3531 Write_Line (" -h Display this usage");
3532 Write_Line (" -q Quiet output");
3533 Write_Line (" -v Verbose mode");
3534 Write_Line (" -R not Recursive: only one project file");