OSDN Git Service

* sysdep.c: Problem discovered during IA64 VMS port.
[pf3gnuchains/gcc-fork.git] / gcc / ada / bld.adb
1 ------------------------------------------------------------------------------
2 --                                                                          --
3 --                         GNAT COMPILER COMPONENTS                         --
4 --                                                                          --
5 --                                  B L D                                   --
6 --                                                                          --
7 --                                 B o d y                                  --
8 --                                                                          --
9 --          Copyright (C) 2002-2003 Free Software Foundation, Inc.          --
10 --                                                                          --
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.                                                      --
21 --                                                                          --
22 -- GNAT was originally developed  by the GNAT team at  New York University. --
23 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
24 --                                                                          --
25 ------------------------------------------------------------------------------
26
27 --  This package is still a work in progress.
28
29 with Ada.Characters.Handling; use Ada.Characters.Handling;
30 with Ada.Strings.Fixed;       use Ada.Strings.Fixed;
31
32 with Bld.IO;
33 with Csets;
34
35 with GNAT.HTable;
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;
40
41 with Erroutc;  use Erroutc;
42 with Err_Vars; use Err_Vars;
43 with Gnatvsn;
44 with Namet;    use Namet;
45 with Opt;      use Opt;
46 with Output;   use Output;
47 with Prj;      use Prj;
48 with Prj.Com;  use Prj.Com;
49 with Prj.Err;  use Prj.Err;
50 with Prj.Part;
51 with Prj.Tree; use Prj.Tree;
52 with Snames;
53 with Table;
54 with Types;    use Types;
55
56 package body Bld is
57
58    function "=" (Left, Right : IO.Position) return Boolean
59      renames IO."=";
60
61    MAKE_ROOT : constant String := "MAKE_ROOT";
62
63    Process_All_Project_Files : Boolean := True;
64    --  Set to False by command line switch -R
65
66    Copyright_Displayed : Boolean := False;
67    --  To avoid displaying the Copyright line several times
68
69    Usage_Displayed     : Boolean := False;
70    --  To avoid displaying the usage several times
71
72    type Expression_Kind_Type is (Undecided, Static_String, Other);
73
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.
79
80    Expression_Value  : String_Access := new String (1 .. 10);
81    Expression_Last   : Natural := 0;
82
83    --  The following variables indicates if the suffixs and the languages
84    --  are statically specified and, if they are, their values.
85
86    C_Suffix          : String_Access := new String (1 .. 10);
87    C_Suffix_Last     : Natural := 0;
88    C_Suffix_Static   : Boolean := True;
89
90    Cxx_Suffix        : String_Access := new String (1 .. 10);
91    Cxx_Suffix_Last   : Natural := 0;
92    Cxx_Suffix_Static : Boolean := True;
93
94    Ada_Spec_Suffix        : String_Access := new String (1 .. 10);
95    Ada_Spec_Suffix_Last   : Natural := 0;
96    Ada_Spec_Suffix_Static : Boolean := True;
97
98    Ada_Body_Suffix        : String_Access := new String (1 .. 10);
99    Ada_Body_Suffix_Last   : Natural := 0;
100    Ada_Body_Suffix_Static : Boolean := True;
101
102    Languages              : String_Access := new String (1 .. 50);
103    Languages_Last         : Natural := 0;
104    Languages_Static       : Boolean := True;
105
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
108    --  of a source.
109
110    --  The following variables are used to controlled what attributes
111    --  Default_Switches and Switches are allowed in expressions.
112
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;
116
117    Switches_Project          : Project_Node_Id  := Empty_Node;
118    Switches_Package          : Name_Id          := No_Name;
119    Switches_Language         : Source_Kind_Type := Unknown;
120
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.
125
126    Other_Attribute           : Boolean          := False;
127    Other_Attribute_Package   : Name_Id          := No_Name;
128    Other_Attribute_Name      : Name_Id          := No_Name;
129
130    type Declaration_Type is (False, May_Be, True);
131
132    Source_Files_Declaration     : Declaration_Type := False;
133
134    Source_List_File_Declaration : Declaration_Type := False;
135
136    --  Names that are not in Snames
137
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;
142
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,
147       Key        => Name_Id,
148       Hash       => Hash,
149       Equal      => "=");
150    --  This hash table contains all processed projects.
151    --  It is used to avoid processing the same project file several times.
152
153    package Externals is new GNAT.HTable.Simple_HTable
154      (Header_Num => Header_Num,
155       Element    => Natural,
156       No_Element => 0,
157       Key        => Project_Node_Id,
158       Hash       => Hash,
159       Equal      => "=");
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.
165
166    package Variable_Names is new Table.Table
167      (Table_Component_Type => Name_Id,
168       Table_Index_Type     => Natural,
169       Table_Low_Bound      => 1,
170       Table_Initial        => 10,
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.
177
178    package Switches is new Table.Table
179      (Table_Component_Type => Name_Id,
180       Table_Index_Type     => Natural,
181       Table_Low_Bound      => 1,
182       Table_Initial        => 10,
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.
190
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.
195
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.
200
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.
204
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.
209
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";
236
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,
247       Cc_String           'Access,
248       C_Ext_String        'Access,
249       Cflags_String       'Access,
250       Cxx_String          'Access,
251       Cxx_Ext_String      'Access,
252       Cxxflags_String     'Access,
253       Deps_Projects_String'Access,
254       Exec_String         'Access,
255       Exec_Dir_String     'Access,
256       Gnatmake_String     'Access,
257       Languages_String    'Access,
258       Ld_Flags_String     'Access,
259       Libs_String         'Access,
260       Main_String         'Access,
261       Obj_Ext_String      'Access,
262       Obj_Dir_String      'Access,
263       Project_File_String 'Access,
264       Src_Dirs_String     'Access);
265
266    Main_Project_File_Name : String_Access;
267    --  The name of the main project file, given as argument.
268
269    Project_Tree : Project_Node_Id;
270    --  The result of the parsing of the main project file.
271
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
275
276    procedure Display_Copyright;
277    --  Display name of the tool and the copyright
278
279    function Equal_String (Left, Right : Name_Id) return Boolean;
280    --  Return True if Left and Right are the same string, without considering
281    --  the case.
282
283    procedure Expression
284      (Project    : Project_Node_Id;
285       First_Term : Project_Node_Id;
286       Kind       : Variable_Kind;
287       In_Case    : Boolean;
288       Reset      : Boolean := False);
289    --  Process an expression.
290    --  If In_Case is True, all expressions are not static.
291
292    procedure New_Line;
293    --  Add a line terminator in the Makefile
294
295    procedure Process (Project : Project_Node_Id);
296    --  Process the project tree, result of the parsing.
297
298    procedure Process_Case_Construction
299      (Current_Project : Project_Node_Id;
300       Current_Pkg     : Name_Id;
301       Case_Project    : Project_Node_Id;
302       Case_Pkg        : Name_Id;
303       Name            : Name_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.
308
309    procedure Process_Declarative_Items
310      (Project : Project_Node_Id;
311       Pkg     : Name_Id;
312       In_Case : Boolean;
313       Item    : Project_Node_Id);
314    --  Process the declarative items for a project, a package
315    --  or a case item.
316    --  If In_Case is True, all expressions are not static
317
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.
321
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
326    --  variable.
327
328    procedure Put (S : Name_Id);
329    --  Add a string to the Makefile.
330
331    procedure Put (P : Positive);
332    --  Add the image of a number to the Makefile, without leading space
333
334    procedure Put_Attribute
335      (Project : Project_Node_Id;
336       Pkg     : Name_Id;
337       Name    : Name_Id;
338       Index   : Name_Id);
339    --  Put the full name of an attribute in the Makefile
340
341    procedure Put_Directory_Separator;
342    --  Add a directory separator to the Makefile
343
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
349
350    procedure Put_Line (S : String);
351    --  Add a string and a line terminator to the Makefile
352
353    procedure Put_L_Name (N : Name_Id);
354    --  Put a name in lower case in the Makefile
355
356    procedure Put_M_Name (N : Name_Id);
357    --  Put a name in mixed case in the Makefile
358
359    procedure Put_U_Name (N : Name_Id);
360    --  Put a name in upper case in the Makefile
361
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".
365
366    procedure Put_Variable
367      (Project : Project_Node_Id;
368       Pkg     : Name_Id;
369       Name    : Name_Id);
370    --  Put the full name of a variable in the Makefile
371
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.
375
376    procedure Reset_Suffixes_And_Languages;
377    --  Indicate that all suffixes and languages have the default values
378
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
381
382    function Suffix_Of
383      (Static  : Boolean;
384       Value   : String_Access;
385       Last    : Natural;
386       Default : String)
387       return    String;
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.
391
392    procedure Usage;
393    --  Display the usage of gnatbuild
394
395    -----------------------------
396    -- Add_To_Expression_Value --
397    -----------------------------
398
399    procedure Add_To_Expression_Value (S : String) is
400    begin
401       --  Check that the buffer is large enough.
402       --  If it is not, double it until it is large enough.
403
404       while Expression_Last + S'Length > Expression_Value'Last loop
405          declare
406             New_Value : constant String_Access :=
407                           new String (1 .. 2 * Expression_Value'Last);
408
409          begin
410             New_Value (1 .. Expression_Last) :=
411               Expression_Value (1 .. Expression_Last);
412             Free (Expression_Value);
413             Expression_Value := New_Value;
414          end;
415       end loop;
416
417       Expression_Value (Expression_Last + 1 .. Expression_Last + S'Length)
418         := S;
419       Expression_Last := Expression_Last + S'Length;
420    end Add_To_Expression_Value;
421
422    procedure Add_To_Expression_Value (S : Name_Id) is
423    begin
424       Get_Name_String (S);
425       Add_To_Expression_Value (S => Name_Buffer (1 .. Name_Len));
426    end Add_To_Expression_Value;
427
428    -----------------------
429    -- Display_Copyright --
430    -----------------------
431
432    procedure Display_Copyright is
433    begin
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.");
439          Write_Eol;
440          Write_Eol;
441       end if;
442    end Display_Copyright;
443
444    ------------------
445    -- Equal_String --
446    ------------------
447
448    function Equal_String (Left, Right : Name_Id) return Boolean is
449    begin
450       Get_Name_String (Left);
451
452       declare
453          Left_Value : constant String :=
454                         To_Lower (Name_Buffer (1 .. Name_Len));
455
456       begin
457          Get_Name_String (Right);
458          return Left_Value = To_Lower (Name_Buffer (1 .. Name_Len));
459       end;
460    end Equal_String;
461
462    ----------------
463    -- Expression --
464    ----------------
465
466    procedure Expression
467      (Project    : Project_Node_Id;
468       First_Term : Project_Node_Id;
469       Kind       : Variable_Kind;
470       In_Case    : Boolean;
471       Reset      : Boolean := False)
472    is
473       Term : Project_Node_Id := First_Term;
474       --  The term in the expression list
475
476       Current_Term : Project_Node_Id := Empty_Node;
477       --  The current term node id
478
479    begin
480       if In_Case then
481          Expression_Kind := Other;
482
483       elsif Reset then
484          Expression_Kind := Undecided;
485          Expression_Last := 0;
486       end if;
487
488       while Term /= Empty_Node loop
489
490          Current_Term := Tree.Current_Term (Term);
491
492          case Kind_Of (Current_Term) is
493
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.
501
502                if Kind = List then
503                   Put (" ");
504                end if;
505
506                --  If in a static string expression, add to expression value
507
508                if Expression_Kind = Undecided
509                  or else Expression_Kind = Static_String
510                then
511                   Expression_Kind := Static_String;
512
513                   if Kind = List then
514                      Add_To_Expression_Value (" ");
515                   end if;
516
517                   Add_To_Expression_Value (String_Value_Of (Current_Term));
518                end if;
519
520                Put (String_Value_Of (Current_Term));
521
522             when N_Literal_String_List =>
523                --  For string list, we repetedly call Expression with each
524                --  element of the list.
525
526                declare
527                   String_Node : Project_Node_Id :=
528                                   First_Expression_In_List (Current_Term);
529
530                begin
531                   if String_Node /= Empty_Node then
532
533                      --  If String_Node is nil, it is an empty list,
534                      --  there is nothing to do
535
536                      Expression
537                        (Project    => Project,
538                         First_Term => Tree.First_Term (String_Node),
539                         Kind       => Single,
540                         In_Case    => In_Case);
541
542                      loop
543                         --  Add the other element of the literal string list
544                         --  one after the other
545
546                         String_Node :=
547                           Next_Expression_In_List (String_Node);
548
549                         exit when String_Node = Empty_Node;
550
551                         Put (" ");
552                         Add_To_Expression_Value (" ");
553                         Expression
554                           (Project    => Project,
555                            First_Term => Tree.First_Term (String_Node),
556                            Kind       => Single,
557                            In_Case    => In_Case);
558                      end loop;
559                   end if;
560                end;
561
562             when N_Variable_Reference | N_Attribute_Reference =>
563                --  A variable or attribute reference is never static
564
565                Expression_Kind := Other;
566
567                --  A variable or an attribute is identified by:
568                --   - its project name,
569                --   - its package name, if any,
570                --   - its name, and
571                --   - its index (if an associative array attribute).
572
573                declare
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);
578
579                   Name : constant Name_Id := Name_Of (Current_Term);
580
581                   Term_Package_Name : Name_Id := No_Name;
582
583                begin
584                   if Term_Project = Empty_Node then
585                      Term_Project := Project;
586                   end if;
587
588                   if Term_Package /= Empty_Node then
589                      Term_Package_Name := Name_Of (Term_Package);
590                   end if;
591
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.
595
596                   if Kind = List then
597                      Put (" ");
598                   end if;
599
600                   Put ("$(");
601
602                   if Kind_Of (Current_Term) = N_Variable_Reference then
603                      Put_Variable
604                        (Project => Term_Project,
605                         Pkg     => Term_Package_Name,
606                         Name    => Name);
607
608                   else
609                      --  Attribute reference.
610
611                      --  If it is a Default_Switches attribute, check if it
612                      --  is allowed in this expression (same package and same
613                      --  language).
614
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
620                                            (Current_Term))
621                         then
622                            --  This Default_Switches attribute is not allowed
623                            --  here; report an error and continue.
624                            --  The Makefiles created will be deleted at the
625                            --  end.
626
627                            Error_Msg_Name_1 := Term_Package_Name;
628                            Error_Msg
629                              ("reference to `%''Default_Switches` " &
630                               "not allowed here",
631                               Location_Of (Current_Term));
632                         end if;
633
634                      --  If it is a Switches attribute, check if it is allowed
635                      --  in this expression (same package and same source
636                      --  kind).
637
638                      elsif Name = Snames.Name_Switches then
639                         if Switches_Package /= Term_Package_Name
640                           or else Source_Kind_Of (Associative_Array_Index_Of
641                                                     (Current_Term))
642                                     /= Switches_Language
643                         then
644                            --  This Switches attribute is not allowed here;
645                            --  report an error and continue. The Makefiles
646                            --  created will be deleted at the end.
647
648                            Error_Msg_Name_1 := Term_Package_Name;
649                            Error_Msg
650                              ("reference to `%''Switches` " &
651                               "not allowed here",
652                               Location_Of (Current_Term));
653                         end if;
654
655                      else
656                         --  Other attribute references are only allowed in
657                         --  the declaration of an atribute of the same
658                         --  package and of the same name.
659
660                         if not Other_Attribute
661                           or else Other_Attribute_Package /= Term_Package_Name
662                           or else Other_Attribute_Name /= Name
663                         then
664                            if Term_Package_Name = No_Name then
665                               Error_Msg_Name_1 := Name;
666                               Error_Msg
667                                 ("reference to % not allowed here",
668                                  Location_Of (Current_Term));
669
670                            else
671                               Error_Msg_Name_1 := Term_Package_Name;
672                               Error_Msg_Name_2 := Name;
673                               Error_Msg
674                                 ("reference to `%''%` not allowed here",
675                                  Location_Of (Current_Term));
676                            end if;
677                         end if;
678                      end if;
679
680                      Put_Attribute
681                        (Project => Term_Project,
682                         Pkg     => Term_Package_Name,
683                         Name    => Name,
684                         Index   => Associative_Array_Index_Of (Current_Term));
685                   end if;
686
687                   Put (")");
688                end;
689
690             when N_External_Value =>
691                --  An external reference is never static
692
693                Expression_Kind := Other;
694
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.
698
699                Put ("$(");
700                Put_U_Name (Name_Of (Project));
701                Put (".external.");
702                Put (Externals.Get (Current_Term));
703                Put (")");
704
705             when others =>
706
707                --  Should never happen
708
709                pragma Assert
710                  (False,
711                   "illegal node kind in an expression");
712                raise Program_Error;
713          end case;
714
715          Term := Next_Term (Term);
716       end loop;
717    end Expression;
718
719    --------------
720    -- Gpr2make --
721    --------------
722
723    procedure Gpr2make is
724    begin
725       --  First, get the switches, if any
726
727       loop
728          case Getopt ("h q v R") is
729             when ASCII.NUL =>
730                exit;
731
732             --  -h: Help
733
734             when 'h' =>
735                Usage;
736
737             --  -q: Quiet
738
739             when 'q' =>
740                Opt.Quiet_Output := True;
741
742             --  -v: Verbose
743
744             when 'v' =>
745                Opt.Verbose_Mode := True;
746                Display_Copyright;
747
748             --  -R: no Recursivity
749
750             when 'R' =>
751                Process_All_Project_Files := False;
752
753             when others =>
754                raise Program_Error;
755          end case;
756       end loop;
757
758       --  Now, get the project file (maximum one)
759
760       loop
761          declare
762             S : constant String := Get_Argument (Do_Expansion => True);
763          begin
764             exit when S'Length = 0;
765
766             if Main_Project_File_Name /= null then
767                Fail ("only one project file may be specified");
768
769             else
770                Main_Project_File_Name := new String'(S);
771             end if;
772          end;
773       end loop;
774
775       --  If no project file specified, display the usage and exit
776
777       if Main_Project_File_Name = null then
778          Usage;
779          return;
780       end if;
781
782       --  Do the necessary initializations
783
784       Csets.Initialize;
785       Namet.Initialize;
786
787       Snames.Initialize;
788
789       Prj.Initialize;
790
791       --  Parse the project file(s)
792
793       Prj.Part.Parse (Project_Tree, Main_Project_File_Name.all, False);
794
795       --  If parsing was successful, process the project tree
796
797       if Project_Tree /= Empty_Node then
798
799          --  Create some Name_Ids that are not in Snames
800
801          Name_Len                    := 3;
802          Name_Buffer (1 .. Name_Len) := "ide";
803          Name_Ide                    := Name_Find;
804
805          Name_Len                    := 16;
806          Name_Buffer (1 .. Name_Len) := "compiler_command";
807          Name_Compiler_Command       := Name_Find;
808
809          Name_Len                    := 13;
810          Name_Buffer (1 .. Name_Len) := "main_language";
811          Name_Main_Language          := Name_Find;
812
813          Name_Len                    := 3;
814          Name_Buffer (1 .. Name_Len) := "c++";
815          Name_C_Plus_Plus            := Name_Find;
816
817          Process (Project_Tree);
818
819          if Compilation_Errors then
820             if not Verbose_Mode then
821                Write_Eol;
822             end if;
823
824             Prj.Err.Finalize;
825             Write_Eol;
826             IO.Delete_All;
827             Fail ("no Makefile created");
828          end if;
829       end if;
830    end Gpr2make;
831
832    --------------
833    -- New_Line --
834    --------------
835
836    procedure New_Line is
837    begin
838       IO.New_Line;
839    end New_Line;
840
841    -------------
842    -- Process --
843    -------------
844
845    procedure Process (Project : Project_Node_Id) is
846    begin
847       Processed_Projects.Reset;
848       Recursive_Process (Project);
849    end Process;
850
851    -------------------------------
852    -- Process_Case_Construction --
853    -------------------------------
854
855    procedure Process_Case_Construction
856      (Current_Project : Project_Node_Id;
857       Current_Pkg     : Name_Id;
858       Case_Project    : Project_Node_Id;
859       Case_Pkg        : Name_Id;
860       Name            : Name_Id;
861       Node            : Project_Node_Id)
862    is
863       Case_Project_Name : constant Name_Id := Name_Of (Case_Project);
864       Before            : IO.Position;
865       Start             : IO.Position;
866       After             : IO.Position;
867
868       procedure Put_Case_Construction;
869       --  Output the variable $<PROJECT>__CASE__#, specific to
870       --  this case construction. It contains the number of the
871       --  branch to follow.
872
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.
878
879       procedure Put_Variable_Name;
880       --  Output the case variable
881
882       ---------------------------
883       -- Put_Case_Construction --
884       ---------------------------
885
886       procedure Put_Case_Construction is
887       begin
888          Put_U_Name (Case_Project_Name);
889          Put (".case.");
890          Put (Last_Case_Construction);
891       end Put_Case_Construction;
892
893       -----------------------
894       -- Recursive_Process --
895       -----------------------
896
897       procedure Recursive_Process
898         (Case_Item     : Project_Node_Id;
899          Branch_Number : Positive)
900       is
901          Choice_String : Project_Node_Id := First_Choice_Of (Case_Item);
902
903          Before : IO.Position;
904          Start  : IO.Position;
905          After  : IO.Position;
906
907          No_Lines : Boolean := False;
908
909       begin
910          --  Nothing to do if Case_Item is empty.
911          --  That should happen only if the case construvtion is totally empty.
912          --    case Var is
913          --    end case;
914
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.
918
919             IO.Mark (Before);
920
921             if Choice_String = Empty_Node then
922                --  when others =>
923
924                --  Output a comment "# when others => ..."
925
926                Put_Line ("# when others => ...");
927
928                --  Remember where we are, to detect if there is anything
929                --  put in the Makefile for this branch.
930
931                IO.Mark (Start);
932
933                --  Process the declarative items of this branch
934
935                Process_Declarative_Items
936                  (Project => Current_Project,
937                   Pkg     => Current_Pkg,
938                   In_Case => True,
939                   Item    => First_Declarative_Item_Of (Case_Item));
940
941                --  Where are we now?
942                IO.Mark (After);
943
944                --  If we are at the same place, the branch is totally empty:
945                --  suppress it completely.
946
947                if Start = After then
948                   IO.Release (Before);
949                end if;
950             else
951                --  Case Item with one or several case labels
952
953                --  Output a comment
954                --    # case <label> => ...
955                --  or
956                --    # case <first_Label> | ... =>
957                --  depending on the number of case labels.
958
959                Put ("# when """);
960                Put (String_Value_Of (Choice_String));
961                Put ("""");
962
963                if Next_Literal_String (Choice_String) /= Empty_Node then
964                   Put (" | ...");
965                end if;
966
967                Put (" => ...");
968                New_Line;
969
970                --  Check if the case variable is equal to the first case label
971                Put ("ifeq ($(");
972                Put_Variable_Name;
973                Put ("),");
974                Put (String_Value_Of (Choice_String));
975                Put (")");
976                New_Line;
977
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
981                   --  this branch.
982
983                   loop
984                      Put_Case_Construction;
985                      Put (":=");
986                      Put (Branch_Number);
987                      New_Line;
988
989                      Put_Line ("endif");
990
991                      Choice_String := Next_Literal_String (Choice_String);
992
993                      exit when Choice_String = Empty_Node;
994
995                      Put ("ifeq ($(");
996                      Put_Variable_Name;
997                      Put ("),");
998                      Put (String_Value_Of (Choice_String));
999                      Put (")");
1000                      New_Line;
1001                   end loop;
1002
1003                   --  Now, we test the auxiliary variable
1004
1005                   Put ("ifeq ($(");
1006                   Put_Case_Construction;
1007                   Put ("),");
1008                   Put (Branch_Number);
1009                   Put (")");
1010                   New_Line;
1011                end if;
1012
1013                --  Remember where we are before calling
1014                --  Process_Declarative_Items.
1015
1016                IO.Mark (Start);
1017
1018                Process_Declarative_Items
1019                  (Project => Current_Project,
1020                   Pkg     => Current_Pkg,
1021                   In_Case => True,
1022                   Item    => First_Declarative_Item_Of (Case_Item));
1023
1024                --  Check where we are now, to detect if some lines have been
1025                --  added to the Makefile.
1026
1027                IO.Mark (After);
1028
1029                No_Lines := Start = After;
1030
1031                --  If no lines have been added, then suppress completely this
1032                --  branch.
1033
1034                if No_Lines then
1035                   IO.Release (Before);
1036                end if;
1037
1038                --  If there is a next branch, process it
1039
1040                if Next_Case_Item (Case_Item) /= Empty_Node then
1041                   --  If this branch has not been suppressed, we need an "else"
1042
1043                   if not No_Lines then
1044                      --  Mark the position of the "else"
1045
1046                      IO.Mark (Before);
1047
1048                      Put_Line ("else");
1049
1050                      --  Mark the position before the next branch
1051
1052                      IO.Mark (Start);
1053                   end if;
1054
1055                   Recursive_Process
1056                     (Case_Item => Next_Case_Item (Case_Item),
1057                      Branch_Number => Branch_Number + 1);
1058
1059                   if not No_Lines then
1060                      --  Where are we?
1061                      IO.Mark (After);
1062
1063                      --  If we are at the same place, suppress the useless
1064                      --  "else".
1065
1066                      if After = Start then
1067                         IO.Release (Before);
1068                      end if;
1069                   end if;
1070                end if;
1071
1072                --  If the branch has not been suppressed, we need an "endif"
1073
1074                if not No_Lines then
1075                   Put_Line ("endif");
1076                end if;
1077             end if;
1078          end if;
1079       end Recursive_Process;
1080
1081       -----------------------
1082       -- Put_Variable_Name --
1083       -----------------------
1084
1085       procedure Put_Variable_Name is
1086       begin
1087          Put_Variable (Case_Project, Case_Pkg, Name);
1088       end Put_Variable_Name;
1089
1090       --  Start of procedure Process_Case_Construction
1091
1092    begin
1093       Last_Case_Construction := Last_Case_Construction + 1;
1094
1095       --  Remember where we are in case we suppress completely the case
1096       --  construction.
1097
1098       IO.Mark (Before);
1099
1100       New_Line;
1101
1102       --  Output a comment line for this case construction
1103
1104       Put ("# case ");
1105       Put_M_Name (Case_Project_Name);
1106
1107       if Case_Pkg /= No_Name then
1108          Put (".");
1109          Put_M_Name (Case_Pkg);
1110       end if;
1111
1112       Put (".");
1113       Put_M_Name (Name);
1114       Put (" is ...");
1115       New_Line;
1116
1117       --  Remember where we are, to detect if all branches have been suppressed
1118
1119       IO.Mark (Start);
1120
1121       --  Start at the first case item
1122
1123       Recursive_Process
1124         (Case_Item     => First_Case_Item_Of (Node),
1125          Branch_Number => 1);
1126
1127       --  Where are we?
1128
1129       IO.Mark (After);
1130
1131       --  If we are at the same position, it means that all branches have been
1132       --  suppressed: then we suppress completely the case construction.
1133
1134       if Start = After then
1135          IO.Release (Before);
1136
1137       else
1138          --  If the case construction is not completely suppressed, we issue
1139          --  a comment indicating the end of the case construction.
1140
1141          Put_Line ("# end case;");
1142
1143          New_Line;
1144       end if;
1145    end Process_Case_Construction;
1146
1147    -------------------------------
1148    -- Process_Declarative_Items --
1149    -------------------------------
1150
1151    procedure Process_Declarative_Items
1152      (Project : Project_Node_Id;
1153       Pkg     : Name_Id;
1154       In_Case : Boolean;
1155       Item    : Project_Node_Id)
1156    is
1157       Current_Declarative_Item : Project_Node_Id := Item;
1158       Current_Item             : Project_Node_Id := Empty_Node;
1159
1160       Project_Name : constant String :=
1161                        To_Upper (Get_Name_String (Name_Of (Project)));
1162       Item_Name    : Name_Id := No_Name;
1163
1164    begin
1165       --  For each declarative item
1166
1167       while Current_Declarative_Item /= Empty_Node loop
1168          --  Get its data
1169
1170          Current_Item := Current_Item_Node (Current_Declarative_Item);
1171
1172          --  And set Current_Declarative_Item to the next declarative item
1173          --  ready for the next iteration
1174
1175          Current_Declarative_Item := Next_Declarative_Item
1176                                             (Current_Declarative_Item);
1177
1178          --  By default, indicate that Default_Switches and Switches
1179          --  attribute references are not allowed in expressions.
1180
1181          Default_Switches_Project := Empty_Node;
1182          Switches_Project         := Empty_Node;
1183          Other_Attribute          := False;
1184
1185          --  Write_Line (Project_Node_Kind'Image (Kind_Of (Current_Item)));
1186
1187          case Kind_Of (Current_Item) is
1188
1189             when N_Package_Declaration =>
1190                Item_Name := Name_Of (Current_Item);
1191
1192                declare
1193                   Real_Project : constant Project_Node_Id :=
1194                                    Project_Of_Renamed_Package_Of
1195                                      (Current_Item);
1196
1197                   Before_Package   : IO.Position;
1198                   Start_Of_Package : IO.Position;
1199                   End_Of_Package   : IO.Position;
1200
1201                   Decl_Item : Project_Node_Id;
1202
1203                begin
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
1207                   --  failed.
1208
1209                   if Real_Project /= Empty_Node then
1210                      Decl_Item :=
1211                        First_Declarative_Item_Of
1212                          (Project_Declaration_Of (Real_Project));
1213
1214                      --  Traverse the declarative items of the project,
1215                      --  until we find the renamed package.
1216
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);
1223                      end loop;
1224                   end if;
1225
1226                   --  Remember where we are, in case we want to completely
1227                   --  suppress this package.
1228
1229                   IO.Mark (Before_Package);
1230
1231                   New_Line;
1232
1233                   --  Output comment line for this package
1234
1235                   Put ("# package ");
1236                   Put_M_Name (Item_Name);
1237                   Put (" is ...");
1238                   New_Line;
1239
1240                   --  Record where we are before calling
1241                   --  Process_Declarative_Items.
1242
1243                   IO.Mark (Start_Of_Package);
1244
1245                   --  And process the declarative items of this package
1246
1247                   Process_Declarative_Items
1248                     (Project => Project,
1249                      Pkg     => Item_Name,
1250                      In_Case => False,
1251                      Item    => First_Declarative_Item_Of (Current_Item));
1252
1253                   --  Reset the local variables once we have finished with
1254                   --  this package.
1255
1256                   Variable_Names.Init;
1257
1258                   --  Where are we?
1259                   IO.Mark (End_Of_Package);
1260
1261                   --  If we are at the same place, suppress completely the
1262                   --  package.
1263
1264                   if End_Of_Package = Start_Of_Package then
1265                      IO.Release (Before_Package);
1266
1267                   else
1268
1269                      --  otherwise, utput comment line for end of package
1270
1271                      Put ("# end ");
1272                      Put_M_Name (Item_Name);
1273                      Put (";");
1274                      New_Line;
1275
1276                      New_Line;
1277                   end if;
1278                end;
1279
1280             when N_Variable_Declaration | N_Typed_Variable_Declaration =>
1281                Item_Name := Name_Of (Current_Item);
1282
1283                --  Output comment line for this variable
1284
1285                Put ("# ");
1286                Put_M_Name (Item_Name);
1287                Put (" := ...");
1288                New_Line;
1289
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.
1294
1295                if Pkg /= No_Name then
1296                   declare
1297                      Found : Boolean := False;
1298
1299                   begin
1300                      for
1301                        Index in Variable_Names.First .. Variable_Names.Last
1302                      loop
1303                         if Variable_Names.Table (Index) = Item_Name then
1304                            Found := True;
1305                            exit;
1306                         end if;
1307                      end loop;
1308
1309                      if not Found then
1310                         Variable_Names.Increment_Last;
1311                         Variable_Names.Table (Variable_Names.Last) :=
1312                           Item_Name;
1313                      end if;
1314                   end;
1315                end if;
1316
1317                --  Output the line <variable_Name>:=<expression>
1318
1319                Put_Variable (Project, Pkg, Item_Name);
1320
1321                Put (":=");
1322
1323                Expression
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);
1328
1329                New_Line;
1330
1331             when N_Attribute_Declaration =>
1332                Item_Name := Name_Of (Current_Item);
1333
1334                declare
1335                   Index : constant Name_Id :=
1336                             Associative_Array_Index_Of (Current_Item);
1337
1338                   Pos_Comment     : IO.Position;
1339                   Put_Declaration : Boolean := True;
1340
1341                begin
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
1345                   --  in expressions.
1346
1347                   if Item_Name = Snames.Name_Default_Switches then
1348                      Default_Switches_Project  := Project;
1349                      Default_Switches_Package  := Pkg;
1350                      Default_Switches_Language := Index;
1351
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.
1355
1356                   elsif Item_Name = Snames.Name_Switches then
1357                      Switches_Project  := Project;
1358                      Switches_Package  := Pkg;
1359                      Switches_Language := Source_Kind_Of (Index);
1360
1361                   else
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.
1365
1366                      Other_Attribute         := True;
1367                      Other_Attribute_Package := Pkg;
1368                      Other_Attribute_Name    := Item_Name;
1369                   end if;
1370
1371                   --  Record where we are to be able to suppress the
1372                   --  declaration.
1373
1374                   IO.Mark (Pos_Comment);
1375
1376                   --  Output comment line for this attribute
1377
1378                   Put ("# for ");
1379                   Put_M_Name (Item_Name);
1380
1381                   if Index /= No_Name then
1382                      Put (" (""");
1383                      Put (Index);
1384                      Put (""")");
1385                   end if;
1386
1387                   Put (" use ...");
1388                   New_Line;
1389
1390                   --  Output the line <attribute_name>:=<expression>
1391
1392                   Put_Attribute (Project, Pkg, Item_Name, Index);
1393                   Put (":=");
1394                   Expression
1395                     (Project    => Project,
1396                      First_Term =>
1397                        Tree.First_Term (Expression_Of (Current_Item)),
1398                      Kind        => Expression_Kind_Of (Current_Item),
1399                      In_Case     => In_Case,
1400                      Reset       => True);
1401                   New_Line;
1402
1403                   --  Remove any Default_Switches attribute declaration for
1404                   --  languages other than C or C++.
1405
1406                   if Item_Name = Snames.Name_Default_Switches then
1407                      Get_Name_String (Index);
1408                      To_Lower (Name_Buffer (1 .. Name_Len));
1409                      Put_Declaration :=
1410                        Name_Buffer (1 .. Name_Len) = "c" or else
1411                        Name_Buffer (1 .. Name_Len) = "c++";
1412
1413                   --  Remove any Switches attribute declaration for source
1414                   --  kinds other than C, C++ or unknown.
1415
1416                   elsif Item_Name = Snames.Name_Switches then
1417                      Put_Declaration :=
1418                        Switches_Language = Unknown
1419                        or else Switches_Language = C
1420                        or else Switches_Language = Cxx;
1421
1422                   end if;
1423
1424                   --  Attributes in packages other than Naming, Compiler or
1425                   --  IDE are of no interest; suppress their declarations.
1426
1427                   Put_Declaration := Put_Declaration and
1428                     (Pkg = No_Name
1429                        or else Pkg = Snames.Name_Naming
1430                        or else Pkg = Snames.Name_Compiler
1431                        or else Pkg = Name_Ide);
1432
1433                   if Put_Declaration then
1434                      --  Some attributes are converted into reserved variables
1435
1436                      if Pkg = No_Name then
1437
1438                         --  Project level attribute
1439
1440                         if Item_Name = Snames.Name_Languages then
1441
1442                            --  for Languages use ...
1443
1444                            --  Attribute Languages is converted to variable
1445                            --  LANGUAGES. The actual string is put in lower
1446                            --  case.
1447
1448                            Put ("LANGUAGES:=");
1449
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.
1453
1454                            if Expression_Kind = Static_String then
1455                               Put (To_Lower (Expression_Value
1456                                                (1 .. Expression_Last)));
1457
1458                            else
1459                               --  Otherwise, call to_lower on the value
1460                               --  of the attribute.
1461
1462                               Put ("$(shell gprcmd to_lower $(");
1463                               Put_Attribute
1464                                 (Project, No_Name, Item_Name, No_Name);
1465                               Put ("))");
1466                            end if;
1467
1468                            New_Line;
1469
1470                            --  Record value of Languages if expression is
1471                            --  static and if Languages_Static is True.
1472
1473                            if Expression_Kind /= Static_String then
1474                               Languages_Static := False;
1475
1476                            elsif Languages_Static then
1477                               To_Lower
1478                                 (Expression_Value (1 .. Expression_Last));
1479
1480                               if Languages_Last = 0 then
1481                                  if Languages'Last < Expression_Last + 2 then
1482                                     Free (Languages);
1483                                     Languages :=
1484                                       new String (1 .. Expression_Last + 2);
1485                                  end if;
1486
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) := ' ';
1492
1493                               else
1494                                  Languages_Static :=
1495                                    Languages (2 .. Languages_Last - 1) =
1496                                    Expression_Value (1 .. Expression_Last);
1497                               end if;
1498                            end if;
1499
1500                         elsif Item_Name = Snames.Name_Source_Dirs then
1501
1502                            --  for Source_Dirs use ...
1503
1504                            --  String list attribute Source_Dirs is converted
1505                            --  to variable <PROJECT>.src_dirs, each element
1506                            --  being an absolute directory name.
1507
1508                            Put (Project_Name &
1509                                 ".src_dirs:=$(shell gprcmd extend $(");
1510                            Put (Project_Name);
1511                            Put (".base_dir) '$(");
1512                            Put_Attribute (Project, Pkg, Item_Name, No_Name);
1513                            Put_Line (")')");
1514
1515                         elsif Item_Name = Snames.Name_Source_Files then
1516
1517                            --  for Source_Files use ...
1518
1519                            --  String list Source_Files is converted to
1520                            --  variable <PROJECT>.src_files
1521
1522                            Put (Project_Name);
1523                            Put (".src_files:=$(");
1524                            Put_Attribute (Project, Pkg, Item_Name, No_Name);
1525                            Put (")");
1526                            New_Line;
1527
1528                            if In_Case then
1529                               if Source_Files_Declaration = False then
1530                                  Source_Files_Declaration := May_Be;
1531                               end if;
1532
1533                               if Source_Files_Declaration /= True then
1534
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
1539                                  --  list file.
1540
1541                                  Put_Line ("src_files.specified:=TRUE");
1542                               end if;
1543
1544                            else
1545                               Source_Files_Declaration := True;
1546                            end if;
1547
1548                         elsif Item_Name = Snames.Name_Source_List_File then
1549
1550                            --  for Source_List_File use ...
1551
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.
1558
1559                            Put ("src.list_file:=" &
1560                                 "$(strip $(shell gprcmd to_absolute $(");
1561                            Put (Project_Name);
1562                            Put (".base_dir) $(");
1563                            Put_Attribute (Project, Pkg, Item_Name, No_Name);
1564                            Put_Line (")))");
1565
1566                            if In_Case then
1567                               if Source_List_File_Declaration = False then
1568                                  Source_List_File_Declaration := May_Be;
1569                               end if;
1570
1571                               if Source_Files_Declaration /= True
1572                                 and then Source_List_File_Declaration /= True
1573                               then
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.
1577
1578                                  Put_Line ("src_list_file.specified:=TRUE");
1579                               end if;
1580
1581                            else
1582                               Source_List_File_Declaration := True;
1583                            end if;
1584
1585                         elsif Item_Name = Snames.Name_Object_Dir then
1586
1587                            --  for Object_Dir use ...
1588
1589                            --  Single string attribute Object_Dir is converted
1590                            --  to variable <PROJECT>.obj_dir. The directory is
1591                            --  converted to an absolute path name,
1592                            --  if necessary.
1593
1594                            Put (Project_Name);
1595                            Put (".obj_dir:=" &
1596                                 "$(strip $(shell gprcmd to_absolute $(");
1597                            Put (Project_Name);
1598                            Put (".base_dir) $(");
1599                            Put_Attribute (Project, Pkg, Item_Name, No_Name);
1600                            Put_Line (")))");
1601
1602                         elsif Item_Name = Snames.Name_Exec_Dir then
1603
1604                            --  for Exec_Dir use ...
1605
1606                            --  Single string attribute Exec_Dir is converted
1607                            --  to variable EXEC_DIR. The directory is
1608                            --  converted to an absolute path name,
1609                            --  if necessary.
1610
1611                            Put ("EXEC_DIR:=" &
1612                                 "$(strip $(shell gprcmd to_absolute $(");
1613                            Put (Project_Name);
1614                            Put (".base_dir) $(");
1615                            Put_Attribute (Project, Pkg, Item_Name, No_Name);
1616                            Put_Line (")))");
1617
1618                         elsif Item_Name = Snames.Name_Main then
1619
1620                            --  for Mains use ...
1621
1622                            --  String list attribute Main is converted to
1623                            --  variable ADA_MAINS.
1624
1625                            Put ("ADA_MAINS:=$(");
1626                            Put_Attribute (Project, Pkg, Item_Name, No_Name);
1627                            Put (")");
1628                            New_Line;
1629
1630                         elsif Item_Name = Name_Main_Language then
1631
1632                            --  for Main_Language use ...
1633
1634                            Put ("MAIN:=");
1635
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.
1639
1640                            if Expression_Kind = Static_String then
1641                               Put (To_Lower (Expression_Value
1642                                                (1 .. Expression_Last)));
1643
1644                            else
1645                               --  Otherwise, call to_lower on the value
1646                               --  of the attribute.
1647
1648                               Put ("$(shell gprcmd to_lower $(");
1649                               Put_Attribute
1650                                 (Project, No_Name, Item_Name, No_Name);
1651                               Put ("))");
1652                            end if;
1653
1654                            New_Line;
1655
1656                         else
1657                            --  Other attribute are of no interest; suppress
1658                            --  their declarations.
1659
1660                            Put_Declaration := False;
1661                         end if;
1662
1663                      elsif Pkg = Snames.Name_Compiler then
1664                         --  Attribute of package Compiler
1665
1666                         if Item_Name = Snames.Name_Switches then
1667
1668                            --  for Switches (<file_name>) use ...
1669
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.
1676
1677                            declare
1678                               Found : Boolean := False;
1679                            begin
1680                               for J in Switches.First .. Switches.Last loop
1681                                  if Switches.Table (J) = Index then
1682                                     Found := True;
1683                                     exit;
1684                                  end if;
1685                               end loop;
1686
1687                               if not Found then
1688                                  Switches.Increment_Last;
1689                                  Switches.Table (Switches.Last) := Index;
1690                               end if;
1691                            end;
1692
1693                         elsif Item_Name = Snames.Name_Default_Switches then
1694                            Get_Name_String (Index);
1695                            To_Lower (Name_Buffer (1 .. Name_Len));
1696
1697                            if Name_Buffer (1 .. Name_Len) = "c" then
1698                               Put ("CFLAGS:=$(");
1699                               Put_Attribute (Project, Pkg, Item_Name, Index);
1700                               Put (")");
1701                               New_Line;
1702
1703                            elsif Name_Buffer (1 .. Name_Len) = "c++" then
1704                               Put ("CXXFLAGS:=$(");
1705                               Put_Attribute (Project, Pkg, Item_Name, Index);
1706                               Put (")");
1707                               New_Line;
1708                            end if;
1709                         else
1710                            --  Other attribute are of no interest; suppress
1711                            --  their declarations.
1712
1713                            Put_Declaration := False;
1714                         end if;
1715
1716                      elsif Pkg = Name_Ide then
1717
1718                         --  Attributes of package IDE
1719
1720                         if Item_Name = Name_Compiler_Command then
1721
1722                            --  for Compiler_Command (<language>) use ...
1723
1724                            declare
1725                               Index_Name : Name_Id := No_Name;
1726
1727                            begin
1728                               Get_Name_String (Index);
1729                               To_Lower (Name_Buffer (1 .. Name_Len));
1730                               Index_Name := Name_Find;
1731
1732                               --  Only "Ada", "C" and "C++" are of interest
1733
1734                               if Index_Name = Snames.Name_Ada then
1735
1736                                  --  For "Ada", we set the variable $GNATMAKE
1737
1738                                  Put ("GNATMAKE:=$(");
1739                                  Put_Attribute
1740                                    (Project, Pkg, Item_Name, Index);
1741                                  Put (")");
1742                                  New_Line;
1743
1744                               elsif Index_Name = Snames.Name_C then
1745
1746                                  --  For "C", we set the variable $CC
1747
1748                                  Put ("CC:=$(");
1749                                  Put_Attribute
1750                                    (Project, Pkg, Item_Name, Index);
1751                                  Put (")");
1752                                  New_Line;
1753
1754                               elsif Index_Name = Name_C_Plus_Plus then
1755
1756                                  --  For "C++", we set the variable $CXX
1757
1758                                  Put ("CXX:=$(");
1759                                  Put_Attribute
1760                                    (Project, Pkg, Item_Name, Index);
1761                                  Put (")");
1762                                  New_Line;
1763                               end if;
1764                            end;
1765                         else
1766                            --  Other attribute are of no interest; suppress
1767                            --  their declarations.
1768
1769                            Put_Declaration := False;
1770                         end if;
1771
1772                      elsif Pkg = Snames.Name_Naming then
1773                         --  Attributes of package Naming
1774
1775                         if Item_Name = Snames.Name_Body_Suffix then
1776
1777                            --  for Body_Suffix (<language>) use ...
1778
1779                            declare
1780                               Index_Name : Name_Id := No_Name;
1781
1782                            begin
1783                               Get_Name_String (Index);
1784                               To_Lower (Name_Buffer (1 .. Name_Len));
1785                               Index_Name := Name_Find;
1786
1787                               --  Languages "C", "C++" & "Ada" are of interest
1788
1789                               if Index_Name = Snames.Name_C then
1790
1791                                  --  For "C", we set the variable C_EXT
1792
1793                                  Put ("C_EXT:=$(");
1794                                  Put_Attribute
1795                                    (Project, Pkg, Item_Name, Index);
1796                                  Put (")");
1797                                  New_Line;
1798
1799                                  if Expression_Kind /= Static_String then
1800                                     C_Suffix_Static := False;
1801
1802                                  elsif C_Suffix_Static then
1803                                     if C_Suffix_Last = 0 then
1804                                        if C_Suffix'Last < Expression_Last then
1805                                           Free (C_Suffix);
1806                                           C_Suffix := new String'
1807                                             (Expression_Value
1808                                                (1 .. Expression_Last));
1809
1810                                        else
1811                                           C_Suffix (1 .. Expression_Last) :=
1812                                             Expression_Value
1813                                             (1 .. Expression_Last);
1814                                        end if;
1815
1816                                        C_Suffix_Last := Expression_Last;
1817
1818                                     else
1819                                        C_Suffix_Static :=
1820                                          Expression_Value
1821                                            (1 .. Expression_Last) =
1822                                          C_Suffix (1 .. C_Suffix_Last);
1823                                     end if;
1824                                  end if;
1825
1826                               elsif Index_Name = Name_C_Plus_Plus then
1827
1828                                  --  For "C++", we set the variable CXX_EXT
1829
1830                                  Put ("CXX_EXT:=$(");
1831                                  Put_Attribute
1832                                    (Project, Pkg, Item_Name, Index);
1833                                  Put (")");
1834                                  New_Line;
1835
1836                                  if Expression_Kind /= Static_String then
1837                                     Cxx_Suffix_Static := False;
1838
1839                                  elsif Cxx_Suffix_Static then
1840                                     if Cxx_Suffix_Last = 0 then
1841                                        if
1842                                          Cxx_Suffix'Last < Expression_Last
1843                                        then
1844                                           Free (Cxx_Suffix);
1845                                           Cxx_Suffix := new String'
1846                                             (Expression_Value
1847                                                (1 .. Expression_Last));
1848
1849                                        else
1850                                           Cxx_Suffix (1 .. Expression_Last) :=
1851                                             Expression_Value
1852                                             (1 .. Expression_Last);
1853                                        end if;
1854
1855                                        Cxx_Suffix_Last := Expression_Last;
1856
1857                                     else
1858                                        Cxx_Suffix_Static :=
1859                                          Expression_Value
1860                                            (1 .. Expression_Last) =
1861                                          Cxx_Suffix (1 .. Cxx_Suffix_Last);
1862                                     end if;
1863                                  end if;
1864
1865                               elsif Item_Name = Snames.Name_Ada then
1866
1867                                  --  For "Ada", we set the variable ADA_BODY
1868
1869                                  Put ("ADA_BODY:=$(");
1870                                  Put_Attribute
1871                                    (Project, Pkg, Item_Name, Index);
1872                                  Put (")");
1873                                  New_Line;
1874
1875                                  if Expression_Kind /= Static_String then
1876                                     Ada_Body_Suffix_Static := False;
1877
1878                                  elsif Ada_Body_Suffix_Static then
1879                                     if Ada_Body_Suffix_Last = 0 then
1880                                        if
1881                                          Ada_Body_Suffix'Last < Expression_Last
1882                                        then
1883                                           Free (Ada_Body_Suffix);
1884                                           Ada_Body_Suffix := new String'
1885                                             (Expression_Value
1886                                                (1 .. Expression_Last));
1887
1888                                        else
1889                                           Ada_Body_Suffix
1890                                             (1 .. Expression_Last) :=
1891                                             Expression_Value
1892                                               (1 .. Expression_Last);
1893                                        end if;
1894
1895                                        Ada_Body_Suffix_Last := Expression_Last;
1896
1897                                     else
1898                                        Ada_Body_Suffix_Static :=
1899                                          Expression_Value
1900                                          (1 .. Expression_Last) =
1901                                          Ada_Body_Suffix
1902                                          (1 .. Ada_Body_Suffix_Last);
1903                                     end if;
1904                                  end if;
1905                               end if;
1906                            end;
1907
1908                         elsif Item_Name = Snames.Name_Spec_Suffix then
1909
1910                            --  for Spec_Suffix (<language>) use ...
1911
1912                            declare
1913                               Index_Name : Name_Id := No_Name;
1914
1915                            begin
1916                               Get_Name_String (Index);
1917                               To_Lower (Name_Buffer (1 .. Name_Len));
1918                               Index_Name := Name_Find;
1919
1920                               --  Only "Ada" is of interest
1921
1922                               if Index_Name = Snames.Name_Ada then
1923
1924                                  --  For "Ada", we set the variable ADA_SPEC
1925
1926                                  Put ("ADA_SPEC:=$(");
1927                                  Put_Attribute
1928                                    (Project, Pkg, Item_Name, Index);
1929                                  Put (")");
1930                                  New_Line;
1931
1932                                  if Expression_Kind /= Static_String then
1933                                     Ada_Spec_Suffix_Static := False;
1934
1935                                  elsif Ada_Spec_Suffix_Static then
1936                                     if Ada_Spec_Suffix_Last = 0 then
1937                                        if
1938                                          Ada_Spec_Suffix'Last < Expression_Last
1939                                        then
1940                                           Free (Ada_Spec_Suffix);
1941                                           Ada_Spec_Suffix := new String'
1942                                             (Expression_Value
1943                                                (1 .. Expression_Last));
1944
1945                                        else
1946                                           Ada_Spec_Suffix
1947                                             (1 .. Expression_Last) :=
1948                                             Expression_Value
1949                                               (1 .. Expression_Last);
1950                                        end if;
1951
1952                                        Ada_Spec_Suffix_Last := Expression_Last;
1953
1954                                     else
1955                                        Ada_Spec_Suffix_Static :=
1956                                          Expression_Value
1957                                          (1 .. Expression_Last) =
1958                                          Ada_Spec_Suffix
1959                                          (1 .. Ada_Spec_Suffix_Last);
1960                                     end if;
1961                                  end if;
1962                               end if;
1963                            end;
1964                         else
1965                            --  Other attribute are of no interest; suppress
1966                            --  their declarations.
1967
1968                            Put_Declaration := False;
1969                         end if;
1970                      end if;
1971                   end if;
1972
1973                   --  Suppress the attribute declaration if not needed
1974
1975                   if not Put_Declaration then
1976                      IO.Release (Pos_Comment);
1977                   end if;
1978                end;
1979
1980             when N_Case_Construction =>
1981
1982                --  case <typed_string_variable> is ...
1983
1984                declare
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);
1990
1991                begin
1992                   if Project_Node_Of (Variable_Node) /= Empty_Node then
1993                      Case_Project := Project_Node_Of (Variable_Node);
1994                   end if;
1995
1996                   if Package_Node_Of (Variable_Node) /= Empty_Node then
1997                      Case_Pkg := Name_Of (Package_Node_Of (Variable_Node));
1998                   end if;
1999
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.
2004
2005                   if Pkg /= No_Name
2006                     and then Case_Pkg = No_Name
2007                     and then Case_Project = Project
2008                   then
2009                      for
2010                        Index in Variable_Names.First .. Variable_Names.Last
2011                      loop
2012                         if Variable_Names.Table (Index) = Variable_Name then
2013                            Case_Pkg := Pkg;
2014                            exit;
2015                         end if;
2016                      end loop;
2017                   end if;
2018
2019                   --  The real work is done in Process_Case_Construction.
2020
2021                   Process_Case_Construction
2022                     (Current_Project => Project,
2023                      Current_Pkg     => Pkg,
2024                      Case_Project    => Case_Project,
2025                      Case_Pkg        => Case_Pkg,
2026                      Name            => Variable_Name,
2027                      Node            => Current_Item);
2028                end;
2029
2030             when others =>
2031                null;
2032
2033          end case;
2034       end loop;
2035    end Process_Declarative_Items;
2036
2037    -----------------------
2038    -- Process_Externals --
2039    -----------------------
2040    procedure Process_Externals (Project : Project_Node_Id) is
2041       Project_Name : constant Name_Id := Name_Of (Project);
2042
2043       No_External_Yet : Boolean := True;
2044
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.
2048
2049       procedure Process_Declarative_Items (Item : Project_Node_Id);
2050       --  Traverse the declarative items of a project file to find all
2051       --  external references.
2052
2053       ----------------
2054       -- Expression --
2055       ----------------
2056
2057       procedure Expression (First_Term : Project_Node_Id) is
2058          Term : Project_Node_Id := First_Term;
2059          --  The term in the expression list
2060
2061          Current_Term : Project_Node_Id := Empty_Node;
2062          --  The current term node id
2063
2064          Default : Project_Node_Id;
2065
2066       begin
2067          --  Check each term of the expression
2068
2069          while Term /= Empty_Node loop
2070             Current_Term := Tree.Current_Term (Term);
2071
2072             if Kind_Of (Current_Term) = N_External_Value then
2073
2074                --  If it is the first external reference of this project file,
2075                --  output a comment
2076
2077                if No_External_Yet then
2078                   No_External_Yet := False;
2079                   New_Line;
2080
2081                   Put_Line ("# external references");
2082
2083                   New_Line;
2084                end if;
2085
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.
2089
2090                Last_External := Last_External + 1;
2091                Externals.Set (Current_Term, Last_External);
2092
2093                Default := External_Default_Of (Current_Term);
2094
2095                Get_Name_String
2096                  (String_Value_Of (External_Reference_Of (Current_Term)));
2097
2098                declare
2099                   External_Name : constant String :=
2100                                     Name_Buffer (1 .. Name_Len);
2101
2102                begin
2103                   --  Output a comment for this external reference
2104
2105                   Put ("# external (""");
2106                   Put (External_Name);
2107
2108                   if Default /= Empty_Node then
2109                      Put (""", """);
2110                      Put (String_Value_Of (Default));
2111                   end if;
2112
2113                   Put (""")");
2114                   New_Line;
2115
2116                   --  If there is no default, output one line:
2117
2118                   --  <PROJECT>__EXTERNAL__#:=$(<external name>)
2119
2120                   if Default = Empty_Node then
2121                      Put_U_Name (Project_Name);
2122                      Put (".external.");
2123                      Put (Last_External);
2124                      Put (":=$(");
2125                      Put (External_Name, With_Substitution => True);
2126                      Put (")");
2127                      New_Line;
2128
2129                   else
2130                      --  When there is a default, output the following lines:
2131
2132                      --  ifeq ($(<external_name),)
2133                      --     <PROJECT>__EXTERNAL__#:=<default>
2134                      --  else
2135                      --     <PROJECT>__EXTERNAL__#:=$(<external_name>)
2136                      --  endif
2137
2138                      Put ("ifeq ($(");
2139                      Put (External_Name, With_Substitution => True);
2140                      Put ("),)");
2141                      New_Line;
2142
2143                      Put ("   ");
2144                      Put_U_Name (Project_Name);
2145                      Put (".external.");
2146                      Put (Last_External);
2147                      Put (":=");
2148                      Put (String_Value_Of (Default));
2149                      New_Line;
2150
2151                      Put_Line ("else");
2152
2153                      Put ("   ");
2154                      Put_U_Name (Project_Name);
2155                      Put (".external.");
2156                      Put (Last_External);
2157                      Put (":=$(");
2158                      Put (External_Name, With_Substitution => True);
2159                      Put (")");
2160                      New_Line;
2161
2162                      Put_Line ("endif");
2163                   end if;
2164                end;
2165             end if;
2166
2167             Term := Next_Term (Term);
2168          end loop;
2169       end Expression;
2170
2171       -------------------------------
2172       -- Process_Declarative_Items --
2173       -------------------------------
2174
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;
2178
2179       begin
2180          --  For each declarative item
2181
2182          while Current_Declarative_Item /= Empty_Node loop
2183             Current_Item := Current_Item_Node (Current_Declarative_Item);
2184
2185             --  Set Current_Declarative_Item to the next declarative item
2186             --  ready for the next iteration
2187
2188             Current_Declarative_Item := Next_Declarative_Item
2189                                           (Current_Declarative_Item);
2190
2191             --  Write_Line (Project_Node_Kind'Image (Kind_Of (Current_Item)));
2192
2193             case Kind_Of (Current_Item) is
2194
2195                when N_Package_Declaration =>
2196
2197                   --  Recursive call the declarative items of a package
2198
2199                   if
2200                     Project_Of_Renamed_Package_Of (Current_Item) = Empty_Node
2201                   then
2202                      Process_Declarative_Items
2203                        (First_Declarative_Item_Of (Current_Item));
2204                   end if;
2205
2206                when N_Attribute_Declaration      |
2207                     N_Typed_Variable_Declaration |
2208                     N_Variable_Declaration        =>
2209
2210                   --  Process the expression to look for external references
2211
2212                   Expression
2213                     (First_Term => Tree.First_Term
2214                                       (Expression_Of (Current_Item)));
2215
2216                when N_Case_Construction =>
2217
2218                   --  Recursive calls to process the declarative items of
2219                   --  each case item.
2220
2221                   declare
2222                      Case_Item : Project_Node_Id :=
2223                        First_Case_Item_Of (Current_Item);
2224
2225                   begin
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);
2230                      end loop;
2231                   end;
2232
2233                when others =>
2234                   null;
2235             end case;
2236          end loop;
2237       end Process_Declarative_Items;
2238
2239       --  Start of procedure Process_Externals
2240
2241    begin
2242       Process_Declarative_Items
2243         (First_Declarative_Item_Of (Project_Declaration_Of (Project)));
2244
2245       if not No_External_Yet then
2246          Put_Line ("# end of external references");
2247          New_Line;
2248       end if;
2249    end Process_Externals;
2250
2251    ---------
2252    -- Put --
2253    ---------
2254
2255    procedure Put (S : String; With_Substitution : Boolean := False) is
2256    begin
2257       IO.Put (S);
2258
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.
2261
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);
2266                exit;
2267             end if;
2268          end loop;
2269       end if;
2270    end Put;
2271
2272    procedure Put (P : Positive) is
2273       Image : constant String := P'Img;
2274
2275    begin
2276       Put (Image (Image'First + 1 .. Image'Last));
2277    end Put;
2278
2279    procedure Put (S : Name_Id) is
2280    begin
2281       Get_Name_String (S);
2282       Put (Name_Buffer (1 .. Name_Len));
2283    end Put;
2284
2285    -------------------
2286    -- Put_Attribute --
2287    -------------------
2288
2289    procedure Put_Attribute
2290      (Project : Project_Node_Id;
2291       Pkg     : Name_Id;
2292       Name    : Name_Id;
2293       Index   : Name_Id)
2294    is
2295    begin
2296       Put_U_Name (Name_Of (Project));
2297
2298       if Pkg /= No_Name then
2299          Put (".");
2300          Put_L_Name (Pkg);
2301       end if;
2302
2303       Put (".");
2304       Put_L_Name (Name);
2305
2306       if Index /= No_Name then
2307          Put (".");
2308
2309          --  For attribute Switches, we don't want to change the file name
2310
2311          if Name = Snames.Name_Switches then
2312             Get_Name_String (Index);
2313             Put (Name_Buffer (1 .. Name_Len));
2314
2315          else
2316             Special_Put_U_Name (Index);
2317          end if;
2318       end if;
2319    end Put_Attribute;
2320
2321    -----------------------------
2322    -- Put_Directory_Separator --
2323    -----------------------------
2324
2325    procedure Put_Directory_Separator is
2326    begin
2327       Put (S => (1 => Directory_Separator));
2328    end Put_Directory_Separator;
2329
2330    -------------------------
2331    -- Put_Include_Project --
2332    -------------------------
2333
2334    procedure Put_Include_Project
2335      (Included_Project_Path  : Name_Id;
2336       Included_Project       : Project_Node_Id;
2337       Including_Project_Name : String)
2338    is
2339    begin
2340       --  If path is null, there is nothing to do.
2341       --  This happens when there is no project being extended.
2342
2343       if Included_Project_Path /= No_Name then
2344          Get_Name_String (Included_Project_Path);
2345
2346          declare
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;
2352
2353          begin
2354             --  Remove a possible directory separator at the end of the
2355             --  directory.
2356
2357             if Last >= Included_Directory_Path'First
2358               and then Included_Directory_Path (Last) = Directory_Separator
2359             then
2360                Last := Last - 1;
2361             end if;
2362
2363             Put ("BASE_DIR=");
2364
2365             --  If it is a relative path, precede the directory with
2366             --  $(<PROJECT>.base_dir)/
2367
2368             if not Is_Absolute_Path (Included_Directory_Path) then
2369                Put ("$(");
2370                Put (Including_Project_Name);
2371                Put (".base_dir)" & Directory_Separator);
2372             end if;
2373
2374             Put (Included_Directory_Path
2375                    (Included_Directory_Path'First .. Last));
2376             New_Line;
2377
2378             --  Include the Makefile
2379
2380             Put ("include $(BASE_DIR)");
2381             Put_Directory_Separator;
2382             Put ("Makefile.");
2383             Put (To_Lower (Included_Project_Name));
2384             New_Line;
2385
2386             New_Line;
2387          end;
2388       end if;
2389    end Put_Include_Project;
2390
2391    --------------
2392    -- Put_Line --
2393    --------------
2394
2395    procedure Put_Line (S : String) is
2396    begin
2397       IO.Put (S);
2398       IO.New_Line;
2399    end Put_Line;
2400
2401    ----------------
2402    -- Put_L_Name --
2403    ----------------
2404
2405    procedure Put_L_Name (N : Name_Id) is
2406    begin
2407       Put (To_Lower (Get_Name_String (N)));
2408    end Put_L_Name;
2409
2410    ----------------
2411    -- Put_M_Name --
2412    ----------------
2413
2414    procedure Put_M_Name (N : Name_Id) is
2415       Name : String := Get_Name_String (N);
2416
2417    begin
2418       To_Mixed (Name);
2419       Put (Name);
2420    end Put_M_Name;
2421
2422    ----------------
2423    -- Put_U_Name --
2424    ----------------
2425
2426    procedure Put_U_Name (N : Name_Id) is
2427    begin
2428       Put (To_Upper (Get_Name_String (N)));
2429    end Put_U_Name;
2430
2431    ------------------
2432    -- Put_Variable --
2433    ------------------
2434
2435    procedure Put_Variable
2436      (Project : Project_Node_Id;
2437       Pkg     : Name_Id;
2438       Name    : Name_Id)
2439    is
2440    begin
2441       Put_U_Name (Name_Of (Project));
2442
2443       if Pkg /= No_Name then
2444          Put (".");
2445          Put_L_Name (Pkg);
2446       end if;
2447
2448       Put (".");
2449       Put_U_Name (Name);
2450    end Put_Variable;
2451
2452    -----------------------
2453    -- Recursive_Process --
2454    -----------------------
2455
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;
2465    begin
2466       --  Nothing to do if Project is nil.
2467
2468       if Project /= Empty_Node then
2469          declare
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.
2474
2475             Name : constant Name_Id := Name_Of (Project);
2476             --  Name of the project being processed
2477
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.
2481
2482             Lname : constant String := To_Lower (Get_Name_String (Name));
2483             --  <project>: name of the project in lower case
2484
2485             Uname : constant String := To_Upper (Lname);
2486             --  <PROJECT>: name of the project in upper case
2487
2488          begin
2489             --  Nothing to do if project file has already been processed
2490
2491             if Processed_Projects.Get (Name) = Empty_Node then
2492
2493                --  Put project name in table Processed_Projects to avoid
2494                --  processing the project several times.
2495
2496                Processed_Projects.Set (Name, Project);
2497
2498                --  Process all the projects imported, if any
2499
2500                if Process_All_Project_Files then
2501                   With_Clause := First_With_Clause_Of (Project);
2502
2503                   while With_Clause /= Empty_Node loop
2504                      Recursive_Process (Project_Node_Of (With_Clause));
2505                      With_Clause := Next_With_Clause_Of (With_Clause);
2506                   end loop;
2507
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.
2512
2513                   Recursive_Process (Extended_Project_Of (Declaration_Node));
2514                end if;
2515
2516                Source_Files_Declaration     := False;
2517                Source_List_File_Declaration := False;
2518
2519                --  Build in Name_Buffer the path name of the Makefile
2520
2521                --  Start with the directory of the project file
2522
2523                Get_Name_String (Directory);
2524
2525                --  Add a directory separator, if needed
2526
2527                if Name_Buffer (Name_Len) /= Directory_Separator then
2528                   Name_Len := Name_Len + 1;
2529                   Name_Buffer (Name_Len) := Directory_Separator;
2530                end if;
2531
2532                --  Add the filename of the Makefile: "Makefile.<project>"
2533
2534                Name_Buffer (Name_Len + 1 .. Name_Len + 9) := "Makefile.";
2535                Name_Len := Name_Len + 9;
2536
2537                Name_Buffer (Name_Len + 1 .. Name_Len + Lname'Length) :=
2538                  Lname;
2539                Name_Len := Name_Len + Lname'Length;
2540
2541                IO.Create (Name_Buffer (1 .. Name_Len));
2542
2543                --  Display the Makefile being created, but only if not in
2544                --  quiet output.
2545
2546                if not Opt.Quiet_Output then
2547                   Write_Str ("creating """);
2548                   Write_Str (IO.Name_Of_File);
2549                   Write_Line ("""");
2550                end if;
2551
2552                --  And create the Makefile
2553
2554                New_Line;
2555
2556                --  Outut a comment with the path name of the Makefile
2557                Put ("# ");
2558                Put_Line (IO.Name_Of_File);
2559
2560                New_Line;
2561
2562                --  The Makefile is a big ifeq to avoid multiple inclusion
2563                --  ifeq ($(<PROJECT>.project),)
2564                --  <PROJECT>.project:=True
2565                --    ...
2566                --  endif
2567
2568                Put ("ifeq ($(");
2569                Put (Uname);
2570                Put (".project),)");
2571                New_Line;
2572
2573                Put (Uname);
2574                Put (".project=True");
2575                New_Line;
2576
2577                New_Line;
2578
2579                --  If it is the main Makefile (BASE_DIR is empty)
2580
2581                Put_Line ("ifeq ($(BASE_DIR),)");
2582
2583                --  Set <PROJECT>.root to True
2584
2585                Put ("   ");
2586                Put (Uname);
2587                Put (".root=True");
2588                New_Line;
2589
2590                Put ("   ");
2591                Put (Uname);
2592                Put (".base_dir:=$(shell gprcmd pwd)");
2593                New_Line;
2594
2595                --  Include some utility functions and saved all reserved
2596                --  env. vars. by including Makefile.prolog.
2597
2598                Put ("   ifeq ($(");
2599                Put (MAKE_ROOT);
2600                Put ("),)");
2601                New_Line;
2602
2603                Put ("      $(error ");
2604                Put (MAKE_ROOT);
2605                Put (" variable is undefined, ");
2606                Put ("Makefile.prolog cannot be loaded)");
2607                New_Line;
2608
2609                Put_Line ("   else");
2610
2611                Put  ("      include $(");
2612                Put (MAKE_ROOT);
2613                Put (")");
2614                Put_Directory_Separator;
2615                Put ("share");
2616                Put_Directory_Separator;
2617                Put ("make");
2618                Put_Directory_Separator;
2619                Put ("Makefile.prolog");
2620                New_Line;
2621
2622                Put_Line ("   endif");
2623
2624                --  Initialize some defaults
2625
2626                Put ("   OBJ_EXT:=");
2627                Put (Get_Object_Suffix.all);
2628                New_Line;
2629
2630                Put_Line ("else");
2631
2632                --  When not the main Makefile, set <PROJECT>.root to False
2633
2634                Put ("   ");
2635                Put (Uname);
2636                Put (".root=False");
2637                New_Line;
2638
2639                Put ("   ");
2640                Put (Uname);
2641                Put (".base_dir:=$(BASE_DIR)");
2642                New_Line;
2643
2644                Put_Line ("endif");
2645                New_Line;
2646
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.
2650
2651                With_Clause := First_With_Clause_Of (Project);
2652
2653                while With_Clause /= Empty_Node loop
2654                   Put_Include_Project
2655                     (String_Value_Of (With_Clause),
2656                      Project_Node_Of (With_Clause),
2657                      Uname);
2658                   With_Clause := Next_With_Clause_Of (With_Clause);
2659                end loop;
2660
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.
2664
2665                Put_Include_Project
2666                  (Extended_Project_Path_Of (Project),
2667                   Extended_Project_Of (Declaration_Node),
2668                   Uname);
2669
2670                --  Set defaults to some variables
2671
2672                IO.Mark (Src_Files_Init);
2673                Put_Line ("src_files.specified:=FALSE");
2674
2675                IO.Mark (Src_List_File_Init);
2676                Put_Line ("src_list_file.specified:=FALSE");
2677
2678                --  <PROJECT>.src_dirs is set by default to the project
2679                --  directory.
2680
2681                Put (Uname);
2682                Put (".src_dirs:=$(");
2683                Put (Uname);
2684                Put (".base_dir)");
2685                New_Line;
2686
2687                --  <PROJECT>.obj_dir is set by default to the project
2688                --  directory.
2689
2690                Put (Uname);
2691                Put (".obj_dir:=$(");
2692                Put (Uname);
2693                Put (".base_dir)");
2694                New_Line;
2695
2696                --  PROJECT_FILE:=<project>
2697
2698                Put ("PROJECT_FILE:=");
2699                Put (Lname);
2700                New_Line;
2701
2702                --  Output a comment indicating the name of the project being
2703                --  processed.
2704
2705                Put ("# project ");
2706                Put_M_Name (Name);
2707                New_Line;
2708
2709                --  Process the external references of this project file
2710
2711                Process_Externals (Project);
2712
2713                New_Line;
2714
2715                --  Reset the compiler switches, the suffixes and the languages
2716
2717                Switches.Init;
2718                Reset_Suffixes_And_Languages;
2719
2720                --  Record the current value of Last_Case_Construction to
2721                --  detect if there are case constructions in this project file.
2722
2723                Last_Case := Last_Case_Construction;
2724
2725                --  Process the declarative items of this project file
2726
2727                Process_Declarative_Items
2728                  (Project => Project,
2729                   Pkg     => No_Name,
2730                   In_Case => False,
2731                   Item    => First_Declarative_Item_Of (Declaration_Node));
2732
2733                --  Set There_Are_Case to True if there are case constructions
2734                --  in this project file.
2735
2736                There_Are_Cases := Last_Case /= Last_Case_Construction;
2737
2738                --  If the suffixs and the languages have not been specified,
2739                --  give them the default values.
2740
2741                if C_Suffix_Static and then C_Suffix_Last = 0 then
2742                   C_Suffix_Last := 2;
2743                   C_Suffix (1 .. 2) := ".c";
2744                end if;
2745
2746                if Cxx_Suffix_Static and then Cxx_Suffix_Last = 0 then
2747                   Cxx_Suffix_Last := 3;
2748                   Cxx_Suffix (1 .. 3) := ".cc";
2749                end if;
2750
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";
2754                end if;
2755
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";
2759                end if;
2760
2761                if Languages_Static and then Languages_Last = 0 then
2762                   Languages_Last := 5;
2763                   Languages (1 .. 5) := " ada ";
2764                end if;
2765
2766                --  There may be C sources if the languages are not known
2767                --  statically or if the languages include "C".
2768
2769                May_Be_C_Sources := (not Languages_Static)
2770                  or else Index
2771                  (Source => Languages (1 .. Languages_Last),
2772                   Pattern => " c ") /= 0;
2773
2774                --  There may be C++ sources if the languages are not known
2775                --  statically or if the languages include "C++".
2776
2777                May_Be_Cxx_Sources := (not Languages_Static)
2778                  or else Index
2779                  (Source => Languages (1 .. Languages_Last),
2780                   Pattern => " c++ ") /= 0;
2781
2782                New_Line;
2783
2784                --  If there are attribute Switches specified in package
2785                --  Compiler of this project, post-process them.
2786
2787                if Switches.Last >= Switches.First then
2788
2789                   --  Output a comment indicating this post-processing
2790
2791                   for Index in Switches.First .. Switches.Last loop
2792                      Get_Name_String (Switches.Table (Index));
2793
2794                      declare
2795                         File        : constant String :=
2796                                         Name_Buffer (1 .. Name_Len);
2797                         Source_Kind : Source_Kind_Type := Unknown;
2798
2799                      begin
2800                         --  First, attempt to determine the language
2801
2802                         if Ada_Body_Suffix_Static then
2803                            if File'Length > Ada_Body_Suffix_Last
2804                              and then
2805                                File (File'Last - Ada_Body_Suffix_Last + 1 ..
2806                                        File'Last) =
2807                                           Ada_Body_Suffix
2808                                             (1 .. Ada_Body_Suffix_Last)
2809                            then
2810                               Source_Kind := Ada_Body;
2811                            end if;
2812                         end if;
2813
2814                         if Source_Kind = Unknown
2815                           and then Ada_Spec_Suffix_Static
2816                         then
2817                            if File'Length > Ada_Spec_Suffix_Last
2818                              and then
2819                                File (File'Last - Ada_Spec_Suffix_Last + 1 ..
2820                                        File'Last) =
2821                                          Ada_Spec_Suffix
2822                                            (1 .. Ada_Spec_Suffix_Last)
2823                            then
2824                               Source_Kind := Ada_Spec;
2825                            end if;
2826                         end if;
2827
2828                         if Source_Kind = Unknown
2829                           and then C_Suffix_Static
2830                         then
2831                            if File'Length > C_Suffix_Last
2832                              and then
2833                                File (File'Last - C_Suffix_Last + 1
2834                                        .. File'Last) =
2835                                               C_Suffix (1 .. C_Suffix_Last)
2836                            then
2837                               Source_Kind := C;
2838                            end if;
2839                         end if;
2840
2841                         if Source_Kind = Unknown
2842                           and then Cxx_Suffix_Static
2843                         then
2844                            if File'Length > Cxx_Suffix_Last
2845                              and then
2846                                File (File'Last - Cxx_Suffix_Last + 1
2847                                          .. File'Last) =
2848                                               Cxx_Suffix (1 .. Cxx_Suffix_Last)
2849                            then
2850                               Source_Kind := Cxx;
2851                            end if;
2852                         end if;
2853
2854                         --  If we still don't know the language, and all
2855                         --  suffixs are static, then it cannot any of the
2856                         --  processed languages.
2857
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
2863                         then
2864                            Source_Kind := None;
2865                         end if;
2866
2867                         --  If it can be "C" or "C++", post-process
2868
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)
2873                         then
2874                            if not Post_Processing then
2875                               Post_Processing := True;
2876                               Put_Line
2877                                 ("# post-processing of Compiler'Switches");
2878                            end if;
2879
2880                            New_Line;
2881
2882                            --  Output a comment:
2883                            --  # for Switches (<file>) use ...
2884
2885                            Put ("# for Switches (""");
2886                            Put (File);
2887                            Put (""") use ...");
2888                            New_Line;
2889
2890                            if There_Are_Cases then
2891
2892                               --  Check that effectively there was Switches
2893                               --  specified for this file: the attribute
2894                               --  declaration may be in a case branch which was
2895                               --  not followed.
2896
2897                               Put ("ifneq ($(");
2898                               Put (Uname);
2899                               Put (".compiler.switches.");
2900                               Put (File);
2901                               Put ("),)");
2902                               New_Line;
2903                            end if;
2904
2905                            if May_Be_C_Sources
2906                              and then
2907                              (Source_Kind = Unknown or else Source_Kind = C)
2908                            then
2909                               --  If it is definitely a C file, no need to test
2910
2911                               if Source_Kind = C then
2912                                  Put (File (1 .. File'Last - C_Suffix_Last));
2913                                  Put (Get_Object_Suffix.all);
2914                                  Put (": ");
2915                                  Put (File);
2916                                  New_Line;
2917
2918                               else
2919                                  --  May be a C file: test to know
2920
2921                                  Put ("ifeq ($(filter %$(C_EXT),");
2922                                  Put (File);
2923                                  Put ("),");
2924                                  Put (File);
2925                                  Put (")");
2926                                  New_Line;
2927
2928                                  --  If it is, output a rule for the object
2929
2930                                  Put ("$(subst $(C_EXT),$(OBJ_EXT),");
2931                                  Put (File);
2932                                  Put ("): ");
2933                                  Put (File);
2934                                  New_Line;
2935                               end if;
2936
2937                               Put (ASCII.HT & "@echo $(CC) -c $(");
2938                               Put (Uname);
2939                               Put (".compiler.switches.");
2940                               Put (File);
2941                               Put (") $< -o $(OBJ_DIR)/$@");
2942                               New_Line;
2943
2944                               --  If FAKE_COMPILE is defined, do not issue
2945                               --  the compile command.
2946
2947                               Put_Line ("ifndef FAKE_COMPILE");
2948
2949                               Put (ASCII.HT & "@$(CC) -c $(");
2950                               Put (Uname);
2951                               Put (".compiler.switches.");
2952                               Put (File);
2953                               Put (") $(C_INCLUDES) $(DEP_CFLAGS) " &
2954                                      "$< -o $(OBJ_DIR)/$@");
2955                               New_Line;
2956
2957                               Put_Line (ASCII.HT & "@$(post-compile)");
2958
2959                               Put_Line ("endif");
2960
2961                               if Source_Kind = Unknown then
2962                                  Put_Line ("endif");
2963                               end if;
2964                            end if;
2965
2966                            --  Now, test if it is a C++ file
2967
2968                            if May_Be_Cxx_Sources
2969                              and then
2970                                (Source_Kind = Unknown
2971                                   or else
2972                                 Source_Kind = Cxx)
2973                            then
2974                               --  No need to test if definitely a C++ file
2975
2976                               if Source_Kind = Cxx then
2977                                  Put (File (1 .. File'Last - Cxx_Suffix_Last));
2978                                  Put (Get_Object_Suffix.all);
2979                                  Put (": ");
2980                                  Put (File);
2981                                  New_Line;
2982
2983                               else
2984                                  --  May be a C++ file: test to know
2985
2986                                  Put ("ifeq ($(filter %$(CXX_EXT),");
2987                                  Put (File);
2988                                  Put ("),");
2989                                  Put (File);
2990                                  Put (")");
2991                                  New_Line;
2992
2993                                  --  If it is, output a rule for the object
2994
2995                                  Put ("$(subst $(CXX_EXT),$(OBJ_EXT),");
2996                                  Put (File);
2997                                  Put ("): $(");
2998                                  Put (Uname);
2999                                  Put (".absolute.");
3000                                  Put (File);
3001                                  Put (")");
3002                                  New_Line;
3003                               end if;
3004
3005                               Put (ASCII.HT & "@echo $(CXX) -c $(");
3006                               Put (Uname);
3007                               Put (".compiler.switches.");
3008                               Put (File);
3009                               Put (") $< -o $(OBJ_DIR)/$@");
3010                               New_Line;
3011
3012                               --  If FAKE_COMPILE is defined, do not issue
3013                               --  the compile command
3014
3015                               Put_Line ("ifndef FAKE_COMPILE");
3016
3017                               Put (ASCII.HT & "@$(CXX) -c $(");
3018                               Put (Uname);
3019                               Put (".compiler.switches.");
3020                               Put (File);
3021                               Put (") $(C_INCLUDES) $(DEP_CFLAGS) " &
3022                                      "$< -o $(OBJ_DIR)/$@");
3023                               New_Line;
3024
3025                               Put_Line (ASCII.HT & "@$(post-compile)");
3026
3027                               Put_Line ("endif");
3028
3029                               if Source_Kind = Unknown then
3030                                  Put_Line ("endif");
3031                               end if;
3032
3033                            end if;
3034
3035                            if There_Are_Cases then
3036                               Put_Line ("endif");
3037                            end if;
3038
3039                            New_Line;
3040                         end if;
3041                      end;
3042                   end loop;
3043
3044                   --  Output a comment indication end of post-processing
3045                   --  of Switches, if we have done some post-processing
3046
3047                   if Post_Processing then
3048                      Put_Line
3049                        ("# end of post-processing of Compiler'Switches");
3050
3051                      New_Line;
3052                   end if;
3053                end if;
3054
3055                --  Add source dirs of this project file to variable SRC_DIRS
3056
3057                Put ("SRC_DIRS:=$(SRC_DIRS) $(");
3058                Put (Uname);
3059                Put (".src_dirs)");
3060                New_Line;
3061
3062                --  Set OBJ_DIR to the object directory
3063
3064                Put ("OBJ_DIR:=$(");
3065                Put (Uname);
3066                Put (".obj_dir)");
3067                New_Line;
3068
3069                New_Line;
3070
3071                if Source_Files_Declaration = True then
3072
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.
3077
3078                   IO.Suppress (Src_Files_Init);
3079                   IO.Suppress (Src_List_File_Init);
3080
3081                else
3082                   if Source_Files_Declaration = May_Be then
3083
3084                      --  Need to test if attribute Source_Files was specified
3085
3086                      Put_Line ("# get the source files, if necessary");
3087                      Put_Line ("ifeq ($(src_files.specified),FALSE)");
3088
3089                   else
3090                      Put_Line ("# get the source files");
3091
3092                      --  We may suppress initialization of src_files.specified
3093
3094                      IO.Suppress (Src_Files_Init);
3095                   end if;
3096
3097                   if Source_List_File_Declaration /= May_Be then
3098                      IO.Suppress (Src_List_File_Init);
3099                   end if;
3100
3101                   case Source_List_File_Declaration is
3102
3103                      --  Source_List_File was specified
3104
3105                      when True =>
3106                         if Source_Files_Declaration = May_Be then
3107                            Put ("   ");
3108                         end if;
3109
3110                         Put (Uname);
3111                         Put (".src_files:= $(shell gprcmd cat " &
3112                              "$(src.list_file))");
3113                         New_Line;
3114
3115                      --  Source_File_List was NOT specified
3116
3117                      when False =>
3118                         if Source_Files_Declaration = May_Be then
3119                            Put ("   ");
3120                         end if;
3121
3122                         Put (Uname);
3123                         Put (".src_files:= $(foreach name,$(");
3124                         Put (Uname);
3125                         Put (".src_dirs),$(notdir $(wildcard $(name)/*)))");
3126                         New_Line;
3127
3128                      when May_Be =>
3129                         if Source_Files_Declaration = May_Be then
3130                            Put ("   ");
3131                         end if;
3132
3133                         Put_Line ("ifeq ($(src_list_file.specified),TRUE)");
3134
3135                         --  Get the source files from the file
3136
3137                         if Source_Files_Declaration = May_Be then
3138                            Put ("   ");
3139                         end if;
3140
3141                         Put ("   ");
3142                         Put (Uname);
3143                         Put (".src_files:= $(shell gprcmd cat " &
3144                              "$(SRC__$LIST_FILE))");
3145                         New_Line;
3146
3147                         if Source_Files_Declaration = May_Be then
3148                            Put ("   ");
3149                         end if;
3150
3151                         Put_Line ("else");
3152
3153                         --  Otherwise get source from the source directories
3154
3155                         if Source_Files_Declaration = May_Be then
3156                            Put ("   ");
3157                         end if;
3158
3159                         Put ("   ");
3160                         Put (Uname);
3161                         Put (".src_files:= $(foreach name,$(");
3162                         Put (Uname);
3163                         Put (".src_dirs),$(notdir $(wildcard $(name)/*)))");
3164                         New_Line;
3165
3166                         if Source_Files_Declaration = May_Be then
3167                            Put ("   ");
3168                         end if;
3169
3170                         Put_Line ("endif");
3171                   end case;
3172
3173                   if Source_Files_Declaration = May_Be then
3174                      Put_Line ("endif");
3175                   end if;
3176
3177                   New_Line;
3178                end if;
3179
3180                if not Languages_Static then
3181
3182                   --  If Languages include "c", get the C sources
3183
3184                   Put_Line
3185                     ("# get the C source files, if C is one of the languages");
3186
3187                   Put_Line ("ifeq ($(filter c,$(LANGUAGES)),c)");
3188
3189                   Put ("   C_SRCS:=$(filter %$(C_EXT),$(");
3190                   Put (Uname);
3191                   Put (".src_files))");
3192                   New_Line;
3193                   Put_Line ("   C_SRCS_DEFINED:=True");
3194
3195                   --  Otherwise set C_SRCS to empty
3196
3197                   Put_Line ("else");
3198                   Put_Line ("   C_SRCS=");
3199                   Put_Line ("endif");
3200                   New_Line;
3201
3202                   --  If Languages include "C++", get the C++ sources
3203
3204                   Put_Line
3205                     ("# get the C++ source files, " &
3206                        "if C++ is one of the languages");
3207
3208                   Put_Line ("ifeq ($(filter c++,$(LANGUAGES)),c++)");
3209
3210                   Put ("   CXX_SRCS:=$(filter %$(CXX_EXT),$(");
3211                   Put (Uname);
3212                   Put (".src_files))");
3213                   New_Line;
3214                   Put_Line ("   CXX_SRCS_DEFINED:=True");
3215
3216                   --  Otherwise set CXX_SRCS to empty
3217
3218                   Put_Line ("else");
3219                   Put_Line ("   CXX_SRCS=");
3220                   Put_Line ("endif");
3221                   New_Line;
3222
3223                else
3224                   if Ada.Strings.Fixed.Index
3225                     (Languages (1 .. Languages_Last), " c ") /= 0
3226                   then
3227                      Put_Line ("# get the C sources");
3228                      Put ("C_SRCS:=$(filter %$(C_EXT),$(");
3229                      Put (Uname);
3230                      Put (".src_files))");
3231                      New_Line;
3232                      Put_Line ("C_SRCS_DEFINED:=True");
3233
3234                   else
3235                      Put_Line ("# no C sources");
3236
3237                      Put_Line ("C_SRCS=");
3238                   end if;
3239
3240                   New_Line;
3241
3242                   if Ada.Strings.Fixed.Index
3243                     (Languages (1 .. Languages_Last), " c++ ") /= 0
3244                   then
3245                      Put_Line ("# get the C++ sources");
3246                      Put ("CXX_SRCS:=$(filter %$(CXX_EXT),$(");
3247                      Put (Uname);
3248                      Put (".src_files))");
3249                      New_Line;
3250                      Put_Line ("CXX_SRCS_DEFINED:=True");
3251
3252                   else
3253                      Put_Line ("# no C++ sources");
3254
3255                      Put_Line ("CXX_SRCS=");
3256                   end if;
3257
3258                   New_Line;
3259                end if;
3260
3261                declare
3262                   C_Present : constant Boolean :=
3263                                 (not Languages_Static) or else
3264                                 Ada.Strings.Fixed.Index
3265                                   (Languages (1 .. Languages_Last), " c ")
3266                                    /= 0;
3267
3268                   Cxx_Present : constant Boolean :=
3269                                   (not Languages_Static) or else
3270                                   Ada.Strings.Fixed.Index
3271                                     (Languages (1 .. Languages_Last), " c++ ")
3272                                      /= 0;
3273
3274                begin
3275                   if C_Present or Cxx_Present then
3276
3277                      --  If there are C or C++ sources,
3278                      --  add a library name to variable LIBS.
3279
3280                      Put ("# if there are ");
3281
3282                      if C_Present then
3283                         if Cxx_Present then
3284                            Put ("C or C++");
3285
3286                         else
3287                            Put ("C");
3288                         end if;
3289
3290                      else
3291                         Put ("C++");
3292                      end if;
3293
3294                      Put (" sources, add the library");
3295                      New_Line;
3296
3297                      Put ("ifneq ($(strip");
3298
3299                      if C_Present then
3300                         Put (" $(C_SRCS)");
3301                      end if;
3302
3303                      if Cxx_Present then
3304                         Put (" $(CXX_SRCS)");
3305                      end if;
3306
3307                      Put ("),)");
3308                      New_Line;
3309
3310                      Put ("   LIBS:=$(");
3311                      Put (Uname);
3312                      Put (".obj_dir)/lib");
3313                      Put (Lname);
3314                      Put ("$(AR_EXT) $(LIBS)");
3315                      New_Line;
3316
3317                      Put_Line ("endif");
3318
3319                      New_Line;
3320
3321                   end if;
3322                end;
3323
3324                --  If this is the main Makefile, include Makefile.Generic
3325
3326                Put ("ifeq ($(");
3327                Put (Uname);
3328                Put_Line (".root),True)");
3329
3330                --  Include Makefile.generic
3331
3332                Put ("   include $(");
3333                Put (MAKE_ROOT);
3334                Put (")");
3335                Put_Directory_Separator;
3336                Put ("share");
3337                Put_Directory_Separator;
3338                Put ("make");
3339                Put_Directory_Separator;
3340                Put ("Makefile.generic");
3341                New_Line;
3342
3343                --  If it is not the main Makefile, add the project to
3344                --  variable DEPS_PROJECTS.
3345
3346                Put_Line ("else");
3347
3348                Put ("   DEPS_PROJECTS:=$(strip $(DEPS_PROJECTS) $(");
3349                Put (Uname);
3350                Put (".base_dir)/");
3351                Put (Lname);
3352                Put (")");
3353                New_Line;
3354
3355                Put_Line ("endif");
3356                New_Line;
3357
3358                Put_Line ("endif");
3359                New_Line;
3360
3361                --  Close the Makefile, so that another Makefile can be created
3362                --  with the same File_Type variable.
3363
3364                IO.Close;
3365             end if;
3366          end;
3367       end if;
3368    end Recursive_Process;
3369
3370    ----------------------------------
3371    -- Reset_Suffixes_And_Languages --
3372    ----------------------------------
3373
3374    procedure Reset_Suffixes_And_Languages is
3375    begin
3376       --  Last = 0 indicates that this is the default, which is static,
3377       --  of course.
3378
3379       C_Suffix_Last           := 0;
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;
3390
3391    --------------------
3392    -- Source_Kind_Of --
3393    --------------------
3394
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");
3398
3399       Source_Cxx_Suffix : constant String :=
3400         Suffix_Of (Cxx_Suffix_Static, Cxx_Suffix, Cxx_Suffix_Last, ".cc");
3401
3402       Body_Ada_Suffix   : constant String :=
3403         Suffix_Of
3404           (Ada_Body_Suffix_Static,
3405            Ada_Body_Suffix,
3406            Ada_Body_Suffix_Last,
3407            ".adb");
3408
3409       Spec_Ada_Suffix   : constant String :=
3410         Suffix_Of
3411           (Ada_Spec_Suffix_Static,
3412            Ada_Spec_Suffix,
3413            Ada_Spec_Suffix_Last,
3414            ".ads");
3415
3416    begin
3417       --  Get the name of the file
3418
3419       Get_Name_String (File_Name);
3420
3421       --  If the C suffix is static, check if it is a C file
3422
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
3427       then
3428          return C;
3429
3430       --  If the C++ suffix is static, check if it is a C++ file
3431
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
3436       then
3437          return Cxx;
3438
3439       --  If the Ada body suffix is static, check if it is an Ada body
3440
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
3445       then
3446          return Ada_Body;
3447
3448       --  If the Ada spec suffix is static, check if it is an Ada spec
3449
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
3454       then
3455          return Ada_Body;
3456
3457       --  If the C or C++ suffix is not static, then return Unknown
3458
3459       elsif Source_C_Suffix = "" or else Source_Cxx_Suffix = "" then
3460          return Unknown;
3461
3462       --  Otherwise return None
3463
3464       else
3465          return None;
3466       end if;
3467    end Source_Kind_Of;
3468
3469    ------------------------
3470    -- Special_Put_U_Name --
3471    ------------------------
3472
3473    procedure Special_Put_U_Name (S : Name_Id) is
3474    begin
3475       Get_Name_String (S);
3476       To_Upper (Name_Buffer (1 .. Name_Len));
3477
3478       --  If string is "C++", change it to "CXX"
3479
3480       if Name_Buffer (1 .. Name_Len) = "C++" then
3481          Put ("CXX");
3482       else
3483          Put (Name_Buffer (1 .. Name_Len));
3484       end if;
3485    end Special_Put_U_Name;
3486
3487    ---------------
3488    -- Suffix_Of --
3489    ---------------
3490
3491    function Suffix_Of
3492      (Static  : Boolean;
3493       Value   : String_Access;
3494       Last    : Natural;
3495       Default : String)
3496       return    String
3497    is
3498    begin
3499       if Static then
3500
3501          --  If the suffix is static, Last = 0 indicates that it is the default
3502          --  suffix: return the default.
3503
3504          if Last = 0 then
3505             return Default;
3506
3507          --  Otherwise, return the current suffix
3508
3509          else
3510             return Value (1 .. Last);
3511          end if;
3512
3513       --  If the suffix is not static, return ""
3514
3515       else
3516          return "";
3517       end if;
3518    end Suffix_Of;
3519
3520    -----------
3521    -- Usage --
3522    -----------
3523
3524    procedure Usage is
3525    begin
3526       if not Usage_Displayed then
3527          Usage_Displayed := True;
3528          Display_Copyright;
3529          Write_Line ("Usage: gpr2make switches project-file");
3530          Write_Eol;
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");
3535          Write_Eol;
3536       end if;
3537    end Usage;
3538 end Bld;