gcc/ada/prj-makr.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --                             P R J . M A K R                              --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --          Copyright (C) 2001-2009, 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 3,  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 COPYING3.  If not, go to --
  19 -- http://www.gnu.org/licenses for a complete copy of the license.          --
  20 --                                                                          --
  21 -- GNAT was originally developed  by the GNAT team at  New York University. --
  22 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  23 --                                                                          --
  24 ------------------------------------------------------------------------------
  25
  26 with Csets;
  27 with Opt;
  28 with Output;
  29 with Osint;    use Osint;
  30 with Prj;      use Prj;
  31 with Prj.Com;
  32 with Prj.Part;
  33 with Prj.PP;
  34 with Prj.Tree; use Prj.Tree;
  35 with Prj.Util; use Prj.Util;
  36 with Snames;   use Snames;
  37 with Table;    use Table;
  38
  39 with Ada.Characters.Handling;   use Ada.Characters.Handling;
  40 with GNAT.Directory_Operations; use GNAT.Directory_Operations;
  41
  42 with System.Case_Util;          use System.Case_Util;
  43 with System.CRTL;
  44
  45 package body Prj.Makr is
  46
  47    --  Packages of project files where unknown attributes are errors
  48
  49    --  All the following need comments ??? All global variables and
  50    --  subprograms must be fully commented.
  51
  52    Very_Verbose : Boolean := False;
  53    --  Set in call to Initialize to indicate very verbose output
  54
  55    Project_File : Boolean := False;
  56    --  True when gnatname is creating/modifying a project file. False when
  57    --  gnatname is creating a configuration pragmas file.
  58
  59    Tree : constant Project_Node_Tree_Ref := new Project_Node_Tree_Data;
  60    --  The project tree where the project file is parsed
  61
  62    Args : Argument_List_Access;
  63    --  The list of arguments for calls to the compiler to get the unit names
  64    --  and kinds (spec or body) in the Ada sources.
  65
  66    Path_Name : String_Access;
  67
  68    Path_Last : Natural;
  69
  70    Directory_Last    : Natural := 0;
  71
  72    Output_Name      : String_Access;
  73    Output_Name_Last : Natural;
  74    Output_Name_Id   : Name_Id;
  75
  76    Project_Naming_File_Name : String_Access;
  77    --  String (1 .. Output_Name'Length +  Naming_File_Suffix'Length);
  78
  79    Project_Naming_Last : Natural;
  80    Project_Naming_Id   : Name_Id := No_Name;
  81
  82    Source_List_Path : String_Access;
  83    --  (1 .. Output_Name'Length + Source_List_File_Suffix'Length);
  84    Source_List_Last : Natural;
  85
  86    Source_List_FD : File_Descriptor;
  87
  88    Project_Node        : Project_Node_Id := Empty_Node;
  89    Project_Declaration : Project_Node_Id := Empty_Node;
  90    Source_Dirs_List    : Project_Node_Id := Empty_Node;
  91
  92    Project_Naming_Node     : Project_Node_Id := Empty_Node;
  93    Project_Naming_Decl     : Project_Node_Id := Empty_Node;
  94    Naming_Package          : Project_Node_Id := Empty_Node;
  95    Naming_Package_Comments : Project_Node_Id := Empty_Node;
  96
  97    Source_Files_Comments     : Project_Node_Id := Empty_Node;
  98    Source_Dirs_Comments      : Project_Node_Id := Empty_Node;
  99    Source_List_File_Comments : Project_Node_Id := Empty_Node;
 100
 101    Naming_String : aliased String := "naming";
 102
 103    Gnatname_Packages : aliased String_List := (1 => Naming_String'Access);
 104
 105    Packages_To_Check_By_Gnatname : constant String_List_Access :=
 106                                      Gnatname_Packages'Access;
 107
 108    function Dup (Fd : File_Descriptor) return File_Descriptor;
 109
 110    procedure Dup2 (Old_Fd, New_Fd : File_Descriptor);
 111
 112    Gcc      : constant String := "gcc";
 113    Gcc_Path : String_Access := null;
 114
 115    Non_Empty_Node : constant Project_Node_Id := 1;
 116    --  Used for the With_Clause of the naming project
 117
 118    type Matched_Type is (True, False, Excluded);
 119
 120    Naming_File_Suffix      : constant String := "_naming";
 121    Source_List_File_Suffix : constant String := "_source_list.txt";
 122
 123    Output_FD : File_Descriptor;
 124    --  To save the project file and its naming project file
 125
 126    procedure Write_Eol;
 127    --  Output an empty line
 128
 129    procedure Write_A_Char (C : Character);
 130    --  Write one character to Output_FD
 131
 132    procedure Write_A_String (S : String);
 133    --  Write a String to Output_FD
 134
 135    package Processed_Directories is new Table.Table
 136      (Table_Component_Type => String_Access,
 137       Table_Index_Type     => Natural,
 138       Table_Low_Bound      => 0,
 139       Table_Initial        => 10,
 140       Table_Increment      => 100,
 141       Table_Name           => "Prj.Makr.Processed_Directories");
 142    --  The list of already processed directories for each section, to avoid
 143    --  processing several times the same directory in the same section.
 144
 145    package Source_Directories is new Table.Table
 146      (Table_Component_Type => String_Access,
 147       Table_Index_Type     => Natural,
 148       Table_Low_Bound      => 0,
 149       Table_Initial        => 10,
 150       Table_Increment      => 100,
 151       Table_Name           => "Prj.Makr.Source_Directories");
 152    --  The complete list of directories to be put in attribute Source_Dirs in
 153    --  the project file.
 154
 155    type Source is record
 156       File_Name : Name_Id;
 157       Unit_Name : Name_Id;
 158       Index     : Int := 0;
 159       Spec      : Boolean;
 160    end record;
 161
 162    package Sources is new Table.Table
 163      (Table_Component_Type => Source,
 164       Table_Index_Type     => Natural,
 165       Table_Low_Bound      => 0,
 166       Table_Initial        => 10,
 167       Table_Increment      => 100,
 168       Table_Name           => "Prj.Makr.Sources");
 169    --  The list of Ada sources found, with their unit name and kind, to be put
 170    --  in the source attribute and package Naming of the project file, or in
 171    --  the pragmas Source_File_Name in the configuration pragmas file.
 172
 173    ---------
 174    -- Dup --
 175    ---------
 176
 177    function Dup  (Fd : File_Descriptor) return File_Descriptor is
 178    begin
 179       return File_Descriptor (System.CRTL.dup (Integer (Fd)));
 180    end Dup;
 181
 182    ----------
 183    -- Dup2 --
 184    ----------
 185
 186    procedure Dup2 (Old_Fd, New_Fd : File_Descriptor) is
 187       Fd : Integer;
 188       pragma Warnings (Off, Fd);
 189    begin
 190       Fd := System.CRTL.dup2 (Integer (Old_Fd), Integer (New_Fd));
 191    end Dup2;
 192
 193    --------------
 194    -- Finalize --
 195    --------------
 196
 197    procedure Finalize is
 198       Discard : Boolean;
 199       pragma Warnings (Off, Discard);
 200
 201       Current_Source_Dir : Project_Node_Id := Empty_Node;
 202
 203    begin
 204       if Project_File then
 205          --  If there were no already existing project file, or if the parsing
 206          --  was unsuccessful, create an empty project node with the correct
 207          --  name and its project declaration node.
 208
 209          if No (Project_Node) then
 210             Project_Node :=
 211               Default_Project_Node (Of_Kind => N_Project, In_Tree => Tree);
 212             Set_Name_Of (Project_Node, Tree, To => Output_Name_Id);
 213             Set_Project_Declaration_Of
 214               (Project_Node, Tree,
 215                To => Default_Project_Node
 216                  (Of_Kind => N_Project_Declaration, In_Tree => Tree));
 217
 218          end if;
 219
 220       end if;
 221
 222       --  Delete the file if it already exists
 223
 224       Delete_File
 225         (Path_Name (Directory_Last + 1 .. Path_Last),
 226          Success => Discard);
 227
 228       --  Create a new one
 229
 230       if Opt.Verbose_Mode then
 231          Output.Write_Str ("Creating new file """);
 232          Output.Write_Str (Path_Name (Directory_Last + 1 .. Path_Last));
 233          Output.Write_Line ("""");
 234       end if;
 235
 236       Output_FD := Create_New_File
 237         (Path_Name (Directory_Last + 1 .. Path_Last),
 238          Fmode => Text);
 239
 240       --  Fails if project file cannot be created
 241
 242       if Output_FD = Invalid_FD then
 243          Prj.Com.Fail
 244            ("cannot create new """ & Path_Name (1 .. Path_Last) & """");
 245       end if;
 246
 247       if Project_File then
 248
 249          --  Delete the source list file, if it already exists
 250
 251          declare
 252             Discard : Boolean;
 253             pragma Warnings (Off, Discard);
 254          begin
 255             Delete_File
 256               (Source_List_Path (1 .. Source_List_Last),
 257                Success => Discard);
 258          end;
 259
 260          --  And create a new source list file, fail if file cannot be created
 261
 262          Source_List_FD := Create_New_File
 263            (Name  => Source_List_Path (1 .. Source_List_Last),
 264             Fmode => Text);
 265
 266          if Source_List_FD = Invalid_FD then
 267             Prj.Com.Fail
 268               ("cannot create file """
 269                & Source_List_Path (1 .. Source_List_Last)
 270                & """");
 271          end if;
 272
 273          if Opt.Verbose_Mode then
 274             Output.Write_Str ("Naming project file name is """);
 275             Output.Write_Str
 276               (Project_Naming_File_Name (1 .. Project_Naming_Last));
 277             Output.Write_Line ("""");
 278          end if;
 279
 280          --  Create the naming project node
 281
 282          Project_Naming_Node :=
 283            Default_Project_Node (Of_Kind => N_Project, In_Tree => Tree);
 284          Set_Name_Of (Project_Naming_Node, Tree, To => Project_Naming_Id);
 285          Project_Naming_Decl :=
 286            Default_Project_Node
 287              (Of_Kind => N_Project_Declaration, In_Tree => Tree);
 288          Set_Project_Declaration_Of
 289            (Project_Naming_Node, Tree, Project_Naming_Decl);
 290          Naming_Package :=
 291            Default_Project_Node
 292              (Of_Kind => N_Package_Declaration, In_Tree => Tree);
 293          Set_Name_Of (Naming_Package, Tree, To => Name_Naming);
 294
 295          --  Add an attribute declaration for Source_Files as an empty list (to
 296          --  indicate there are no sources in the naming project) and a package
 297          --  Naming (that will be filled later).
 298
 299          declare
 300             Decl_Item : constant Project_Node_Id :=
 301                           Default_Project_Node
 302                             (Of_Kind => N_Declarative_Item, In_Tree => Tree);
 303
 304             Attribute : constant Project_Node_Id :=
 305                           Default_Project_Node
 306                             (Of_Kind       => N_Attribute_Declaration,
 307                              In_Tree       => Tree,
 308                              And_Expr_Kind => List);
 309
 310             Expression : constant Project_Node_Id :=
 311                            Default_Project_Node
 312                              (Of_Kind       => N_Expression,
 313                               In_Tree       => Tree,
 314                               And_Expr_Kind => List);
 315
 316             Term      : constant Project_Node_Id :=
 317                           Default_Project_Node
 318                             (Of_Kind       => N_Term,
 319                              In_Tree       => Tree,
 320                              And_Expr_Kind => List);
 321
 322             Empty_List : constant Project_Node_Id :=
 323                            Default_Project_Node
 324                              (Of_Kind => N_Literal_String_List,
 325                               In_Tree => Tree);
 326
 327          begin
 328             Set_First_Declarative_Item_Of
 329               (Project_Naming_Decl, Tree, To => Decl_Item);
 330             Set_Next_Declarative_Item (Decl_Item, Tree, Naming_Package);
 331             Set_Current_Item_Node (Decl_Item, Tree, To => Attribute);
 332             Set_Name_Of (Attribute, Tree, To => Name_Source_Files);
 333             Set_Expression_Of (Attribute, Tree, To => Expression);
 334             Set_First_Term (Expression, Tree, To => Term);
 335             Set_Current_Term (Term, Tree, To => Empty_List);
 336          end;
 337
 338          --  Add a with clause on the naming project in the main project, if
 339          --  there is not already one.
 340
 341          declare
 342             With_Clause : Project_Node_Id :=
 343                                   First_With_Clause_Of (Project_Node, Tree);
 344
 345          begin
 346             while Present (With_Clause) loop
 347                exit when
 348                  Prj.Tree.Name_Of (With_Clause, Tree) = Project_Naming_Id;
 349                With_Clause := Next_With_Clause_Of (With_Clause, Tree);
 350             end loop;
 351
 352             if No (With_Clause) then
 353                With_Clause := Default_Project_Node
 354                  (Of_Kind => N_With_Clause, In_Tree => Tree);
 355                Set_Next_With_Clause_Of
 356                  (With_Clause, Tree,
 357                   To => First_With_Clause_Of (Project_Node, Tree));
 358                Set_First_With_Clause_Of
 359                  (Project_Node, Tree, To => With_Clause);
 360                Set_Name_Of (With_Clause, Tree, To => Project_Naming_Id);
 361
 362                --  We set the project node to something different than
 363                --  Empty_Node, so that Prj.PP does not generate a limited
 364                --  with clause.
 365
 366                Set_Project_Node_Of (With_Clause, Tree, Non_Empty_Node);
 367
 368                Name_Len := Project_Naming_Last;
 369                Name_Buffer (1 .. Name_Len) :=
 370                  Project_Naming_File_Name (1 .. Project_Naming_Last);
 371                Set_String_Value_Of (With_Clause, Tree, To => Name_Find);
 372             end if;
 373          end;
 374
 375          Project_Declaration := Project_Declaration_Of (Project_Node, Tree);
 376
 377          --  Add a package Naming in the main project, that is a renaming of
 378          --  package Naming in the naming project.
 379
 380          declare
 381             Decl_Item  : constant Project_Node_Id :=
 382                            Default_Project_Node
 383                              (Of_Kind => N_Declarative_Item,
 384                               In_Tree => Tree);
 385
 386             Naming : constant Project_Node_Id :=
 387                            Default_Project_Node
 388                              (Of_Kind => N_Package_Declaration,
 389                               In_Tree => Tree);
 390
 391          begin
 392             Set_Next_Declarative_Item
 393               (Decl_Item, Tree,
 394                To => First_Declarative_Item_Of (Project_Declaration, Tree));
 395             Set_First_Declarative_Item_Of
 396               (Project_Declaration, Tree, To => Decl_Item);
 397             Set_Current_Item_Node (Decl_Item, Tree, To => Naming);
 398             Set_Name_Of (Naming, Tree, To => Name_Naming);
 399             Set_Project_Of_Renamed_Package_Of
 400               (Naming, Tree, To => Project_Naming_Node);
 401
 402             --  Attach the comments, if any, that were saved for package
 403             --  Naming.
 404
 405             Tree.Project_Nodes.Table (Naming).Comments :=
 406               Naming_Package_Comments;
 407          end;
 408
 409          --  Add an attribute declaration for Source_Dirs, initialized as an
 410          --  empty list.
 411
 412          declare
 413             Decl_Item  : constant Project_Node_Id :=
 414                            Default_Project_Node
 415                              (Of_Kind => N_Declarative_Item,
 416                               In_Tree => Tree);
 417
 418             Attribute : constant Project_Node_Id :=
 419                            Default_Project_Node
 420                              (Of_Kind       => N_Attribute_Declaration,
 421                               In_Tree       => Tree,
 422                               And_Expr_Kind => List);
 423
 424             Expression : constant Project_Node_Id :=
 425                            Default_Project_Node
 426                              (Of_Kind       => N_Expression,
 427                               In_Tree       => Tree,
 428                               And_Expr_Kind => List);
 429
 430             Term  : constant Project_Node_Id :=
 431                            Default_Project_Node
 432                              (Of_Kind       => N_Term, In_Tree => Tree,
 433                               And_Expr_Kind => List);
 434
 435          begin
 436             Set_Next_Declarative_Item
 437               (Decl_Item, Tree,
 438                To => First_Declarative_Item_Of (Project_Declaration, Tree));
 439             Set_First_Declarative_Item_Of
 440               (Project_Declaration, Tree, To => Decl_Item);
 441             Set_Current_Item_Node (Decl_Item, Tree, To => Attribute);
 442             Set_Name_Of (Attribute, Tree, To => Name_Source_Dirs);
 443             Set_Expression_Of (Attribute, Tree, To => Expression);
 444             Set_First_Term (Expression, Tree, To => Term);
 445             Source_Dirs_List :=
 446               Default_Project_Node
 447                 (Of_Kind       => N_Literal_String_List,
 448                  In_Tree       => Tree,
 449                  And_Expr_Kind => List);
 450             Set_Current_Term (Term, Tree, To => Source_Dirs_List);
 451
 452             --  Attach the comments, if any, that were saved for attribute
 453             --  Source_Dirs.
 454
 455             Tree.Project_Nodes.Table (Attribute).Comments :=
 456               Source_Dirs_Comments;
 457          end;
 458
 459          --  Put the source directories in attribute Source_Dirs
 460
 461          for Source_Dir_Index in 1 .. Source_Directories.Last loop
 462             declare
 463                Expression : constant Project_Node_Id :=
 464                               Default_Project_Node
 465                                 (Of_Kind       => N_Expression,
 466                                  In_Tree       => Tree,
 467                                  And_Expr_Kind => Single);
 468
 469                Term       : constant Project_Node_Id :=
 470                               Default_Project_Node
 471                                 (Of_Kind       => N_Term,
 472                                  In_Tree       => Tree,
 473                                  And_Expr_Kind => Single);
 474
 475                Value      : constant Project_Node_Id :=
 476                               Default_Project_Node
 477                                 (Of_Kind       => N_Literal_String,
 478                                  In_Tree       => Tree,
 479                                  And_Expr_Kind => Single);
 480
 481             begin
 482                if No (Current_Source_Dir) then
 483                   Set_First_Expression_In_List
 484                     (Source_Dirs_List, Tree, To => Expression);
 485                else
 486                   Set_Next_Expression_In_List
 487                     (Current_Source_Dir, Tree, To => Expression);
 488                end if;
 489
 490                Current_Source_Dir := Expression;
 491                Set_First_Term (Expression, Tree, To => Term);
 492                Set_Current_Term (Term, Tree, To => Value);
 493                Name_Len := 0;
 494                Add_Str_To_Name_Buffer
 495                  (Source_Directories.Table (Source_Dir_Index).all);
 496                Set_String_Value_Of (Value, Tree, To => Name_Find);
 497             end;
 498          end loop;
 499
 500          --  Add an attribute declaration for Source_Files or Source_List_File
 501          --  with the source list file name that will be created.
 502
 503          declare
 504             Decl_Item  : constant Project_Node_Id :=
 505                            Default_Project_Node
 506                              (Of_Kind => N_Declarative_Item,
 507                               In_Tree => Tree);
 508
 509             Attribute  : constant Project_Node_Id :=
 510                             Default_Project_Node
 511                               (Of_Kind       => N_Attribute_Declaration,
 512                                In_Tree       => Tree,
 513                                And_Expr_Kind => Single);
 514
 515             Expression : constant Project_Node_Id :=
 516                            Default_Project_Node
 517                              (Of_Kind       => N_Expression,
 518                               In_Tree       => Tree,
 519                               And_Expr_Kind => Single);
 520
 521             Term       : constant Project_Node_Id :=
 522                            Default_Project_Node
 523                              (Of_Kind       => N_Term,
 524                               In_Tree       => Tree,
 525                               And_Expr_Kind => Single);
 526
 527             Value      : constant Project_Node_Id :=
 528                            Default_Project_Node
 529                              (Of_Kind       => N_Literal_String,
 530                               In_Tree       => Tree,
 531                               And_Expr_Kind => Single);
 532
 533          begin
 534             Set_Next_Declarative_Item
 535               (Decl_Item, Tree,
 536                To => First_Declarative_Item_Of (Project_Declaration, Tree));
 537             Set_First_Declarative_Item_Of
 538               (Project_Declaration, Tree, To => Decl_Item);
 539             Set_Current_Item_Node (Decl_Item, Tree, To => Attribute);
 540
 541             Set_Name_Of (Attribute, Tree, To => Name_Source_List_File);
 542             Set_Expression_Of (Attribute, Tree, To => Expression);
 543             Set_First_Term (Expression, Tree, To => Term);
 544             Set_Current_Term (Term, Tree, To => Value);
 545             Name_Len := Source_List_Last;
 546             Name_Buffer (1 .. Name_Len) :=
 547               Source_List_Path (1 .. Source_List_Last);
 548             Set_String_Value_Of (Value, Tree, To => Name_Find);
 549
 550             --  If there was no comments for attribute Source_List_File, put
 551             --  those for Source_Files, if they exist.
 552
 553             if Present (Source_List_File_Comments) then
 554                Tree.Project_Nodes.Table (Attribute).Comments :=
 555                  Source_List_File_Comments;
 556             else
 557                Tree.Project_Nodes.Table (Attribute).Comments :=
 558                  Source_Files_Comments;
 559             end if;
 560          end;
 561
 562          --  Put the sources in the source list files and in the naming
 563          --  project.
 564
 565          for Source_Index in 1 .. Sources.Last loop
 566
 567             --  Add the corresponding attribute in the
 568             --  Naming package of the naming project.
 569
 570             declare
 571                Current_Source : constant Source :=
 572                                   Sources.Table (Source_Index);
 573
 574                Decl_Item : constant Project_Node_Id :=
 575                              Default_Project_Node
 576                                (Of_Kind =>
 577                                                 N_Declarative_Item,
 578                                 In_Tree => Tree);
 579
 580                Attribute : constant Project_Node_Id :=
 581                              Default_Project_Node
 582                                (Of_Kind =>
 583                                                 N_Attribute_Declaration,
 584                                 In_Tree => Tree);
 585
 586                Expression : constant Project_Node_Id :=
 587                               Default_Project_Node
 588                                 (Of_Kind       => N_Expression,
 589                                  And_Expr_Kind => Single,
 590                                  In_Tree       => Tree);
 591
 592                Term      : constant Project_Node_Id :=
 593                              Default_Project_Node
 594                                (Of_Kind       => N_Term,
 595                                 And_Expr_Kind => Single,
 596                                 In_Tree       => Tree);
 597
 598                Value     : constant Project_Node_Id :=
 599                              Default_Project_Node
 600                                (Of_Kind       => N_Literal_String,
 601                                 And_Expr_Kind => Single,
 602                                 In_Tree       => Tree);
 603
 604             begin
 605                --  Add source file name to the source list file
 606
 607                Get_Name_String (Current_Source.File_Name);
 608                Add_Char_To_Name_Buffer (ASCII.LF);
 609                if Write (Source_List_FD,
 610                          Name_Buffer (1)'Address,
 611                          Name_Len) /= Name_Len
 612                then
 613                   Prj.Com.Fail ("disk full");
 614                end if;
 615
 616                --  For an Ada source, add entry in package Naming
 617
 618                if Current_Source.Unit_Name /= No_Name then
 619                   Set_Next_Declarative_Item
 620                     (Decl_Item,
 621                      To      => First_Declarative_Item_Of
 622                        (Naming_Package, Tree),
 623                      In_Tree => Tree);
 624                   Set_First_Declarative_Item_Of
 625                     (Naming_Package,
 626                      To      => Decl_Item,
 627                      In_Tree => Tree);
 628                   Set_Current_Item_Node
 629                     (Decl_Item,
 630                      To      => Attribute,
 631                      In_Tree => Tree);
 632
 633                   --  Is it a spec or a body?
 634
 635                   if Current_Source.Spec then
 636                      Set_Name_Of
 637                        (Attribute, Tree,
 638                         To => Name_Spec);
 639                   else
 640                      Set_Name_Of
 641                        (Attribute, Tree,
 642                         To => Name_Body);
 643                   end if;
 644
 645                   --  Get the name of the unit
 646
 647                   Get_Name_String (Current_Source.Unit_Name);
 648                   To_Lower (Name_Buffer (1 .. Name_Len));
 649                   Set_Associative_Array_Index_Of
 650                     (Attribute, Tree, To => Name_Find);
 651
 652                   Set_Expression_Of
 653                     (Attribute, Tree, To => Expression);
 654                   Set_First_Term
 655                     (Expression, Tree, To => Term);
 656                   Set_Current_Term
 657                     (Term, Tree, To => Value);
 658
 659                   --  And set the name of the file
 660
 661                   Set_String_Value_Of
 662                     (Value, Tree, To => Current_Source.File_Name);
 663                   Set_Source_Index_Of
 664                     (Value, Tree, To => Current_Source.Index);
 665                end if;
 666             end;
 667          end loop;
 668
 669          --  Close the source list file
 670
 671          Close (Source_List_FD);
 672
 673          --  Output the project file
 674
 675          Prj.PP.Pretty_Print
 676            (Project_Node, Tree,
 677             W_Char                 => Write_A_Char'Access,
 678             W_Eol                  => Write_Eol'Access,
 679             W_Str                  => Write_A_String'Access,
 680             Backward_Compatibility => False);
 681          Close (Output_FD);
 682
 683          --  Delete the naming project file if it already exists
 684
 685          Delete_File
 686            (Project_Naming_File_Name (1 .. Project_Naming_Last),
 687             Success => Discard);
 688
 689          --  Create a new one
 690
 691          if Opt.Verbose_Mode then
 692             Output.Write_Str ("Creating new naming project file """);
 693             Output.Write_Str (Project_Naming_File_Name
 694                               (1 .. Project_Naming_Last));
 695             Output.Write_Line ("""");
 696          end if;
 697
 698          Output_FD := Create_New_File
 699            (Project_Naming_File_Name (1 .. Project_Naming_Last),
 700             Fmode => Text);
 701
 702          --  Fails if naming project file cannot be created
 703
 704          if Output_FD = Invalid_FD then
 705             Prj.Com.Fail
 706               ("cannot create new """
 707                & Project_Naming_File_Name (1 .. Project_Naming_Last)
 708                & """");
 709          end if;
 710
 711          --  Output the naming project file
 712
 713          Prj.PP.Pretty_Print
 714            (Project_Naming_Node, Tree,
 715             W_Char                 => Write_A_Char'Access,
 716             W_Eol                  => Write_Eol'Access,
 717             W_Str                  => Write_A_String'Access,
 718             Backward_Compatibility => False);
 719          Close (Output_FD);
 720
 721       else
 722          --  For each Ada source, write a pragma Source_File_Name to the
 723          --  configuration pragmas file.
 724
 725          for Index in 1 .. Sources.Last loop
 726             if Sources.Table (Index).Unit_Name /= No_Name then
 727                Write_A_String ("pragma Source_File_Name");
 728                Write_Eol;
 729                Write_A_String ("  (");
 730                Write_A_String
 731                  (Get_Name_String (Sources.Table (Index).Unit_Name));
 732                Write_A_String (",");
 733                Write_Eol;
 734
 735                if Sources.Table (Index).Spec then
 736                   Write_A_String ("   Spec_File_Name => """);
 737
 738                else
 739                   Write_A_String ("   Body_File_Name => """);
 740                end if;
 741
 742                Write_A_String
 743                  (Get_Name_String (Sources.Table (Index).File_Name));
 744
 745                Write_A_String ("""");
 746
 747                if Sources.Table (Index).Index /= 0 then
 748                   Write_A_String (", Index =>");
 749                   Write_A_String (Sources.Table (Index).Index'Img);
 750                end if;
 751
 752                Write_A_String (");");
 753                Write_Eol;
 754             end if;
 755          end loop;
 756
 757          Close (Output_FD);
 758       end if;
 759    end Finalize;
 760
 761    ----------------
 762    -- Initialize --
 763    ----------------
 764
 765    procedure Initialize
 766      (File_Path         : String;
 767       Project_File      : Boolean;
 768       Preproc_Switches  : Argument_List;
 769       Very_Verbose      : Boolean;
 770       Flags             : Processing_Flags)
 771    is
 772    begin
 773       Makr.Very_Verbose := Initialize.Very_Verbose;
 774       Makr.Project_File := Initialize.Project_File;
 775
 776       --  Do some needed initializations
 777
 778       Csets.Initialize;
 779       Namet.Initialize;
 780       Snames.Initialize;
 781       Prj.Initialize (No_Project_Tree);
 782       Prj.Tree.Initialize (Tree);
 783
 784       Sources.Set_Last (0);
 785       Source_Directories.Set_Last (0);
 786
 787       --  Initialize the compiler switches
 788
 789       Args := new Argument_List (1 .. Preproc_Switches'Length + 6);
 790       Args (1) := new String'("-c");
 791       Args (2) := new String'("-gnats");
 792       Args (3) := new String'("-gnatu");
 793       Args (4 .. 3 + Preproc_Switches'Length) := Preproc_Switches;
 794       Args (4 + Preproc_Switches'Length) := new String'("-x");
 795       Args (5 + Preproc_Switches'Length) := new String'("ada");
 796
 797       --  Get the path and file names
 798
 799       Path_Name := new
 800         String (1 .. File_Path'Length + Project_File_Extension'Length);
 801       Path_Last := File_Path'Length;
 802
 803       if File_Names_Case_Sensitive then
 804          Path_Name (1 .. Path_Last) := File_Path;
 805       else
 806          Path_Name (1 .. Path_Last) := To_Lower (File_Path);
 807       end if;
 808
 809       Path_Name (Path_Last + 1 .. Path_Name'Last) :=
 810         Project_File_Extension;
 811
 812       --  Get the end of directory information, if any
 813
 814       for Index in reverse 1 .. Path_Last loop
 815          if Path_Name (Index) = Directory_Separator then
 816             Directory_Last := Index;
 817             exit;
 818          end if;
 819       end loop;
 820
 821       if Project_File then
 822          if Path_Last < Project_File_Extension'Length + 1
 823            or else Path_Name
 824            (Path_Last - Project_File_Extension'Length + 1 .. Path_Last)
 825            /= Project_File_Extension
 826          then
 827             Path_Last := Path_Name'Last;
 828          end if;
 829
 830          Output_Name := new String'(To_Lower (Path_Name (1 .. Path_Last)));
 831          Output_Name_Last := Output_Name'Last - 4;
 832
 833          --  If there is already a project file with the specified name, parse
 834          --  it to get the components that are not automatically generated.
 835
 836          if Is_Regular_File (Output_Name (1 .. Path_Last)) then
 837             if Opt.Verbose_Mode then
 838                Output.Write_Str ("Parsing already existing project file """);
 839                Output.Write_Str (Output_Name.all);
 840                Output.Write_Line ("""");
 841             end if;
 842
 843             Part.Parse
 844               (In_Tree                => Tree,
 845                Project                => Project_Node,
 846                Project_File_Name      => Output_Name.all,
 847                Always_Errout_Finalize => False,
 848                Store_Comments         => True,
 849                Is_Config_File         => False,
 850                Flags                  => Flags,
 851                Current_Directory      => Get_Current_Dir,
 852                Packages_To_Check      => Packages_To_Check_By_Gnatname);
 853
 854             --  Fail if parsing was not successful
 855
 856             if No (Project_Node) then
 857                Fail ("parsing of existing project file failed");
 858
 859             else
 860                --  If parsing was successful, remove the components that are
 861                --  automatically generated, if any, so that they will be
 862                --  unconditionally added later.
 863
 864                --  Remove the with clause for the naming project file
 865
 866                declare
 867                   With_Clause : Project_Node_Id :=
 868                                   First_With_Clause_Of (Project_Node, Tree);
 869                   Previous    : Project_Node_Id := Empty_Node;
 870
 871                begin
 872                   while Present (With_Clause) loop
 873                      if Prj.Tree.Name_Of (With_Clause, Tree) =
 874                           Project_Naming_Id
 875                      then
 876                         if No (Previous) then
 877                            Set_First_With_Clause_Of
 878                              (Project_Node, Tree,
 879                               To => Next_With_Clause_Of (With_Clause, Tree));
 880                         else
 881                            Set_Next_With_Clause_Of
 882                              (Previous, Tree,
 883                               To => Next_With_Clause_Of (With_Clause, Tree));
 884                         end if;
 885
 886                         exit;
 887                      end if;
 888
 889                      Previous := With_Clause;
 890                      With_Clause := Next_With_Clause_Of (With_Clause, Tree);
 891                   end loop;
 892                end;
 893
 894                --  Remove attribute declarations of Source_Files,
 895                --  Source_List_File, Source_Dirs, and the declaration of
 896                --  package Naming, if they exist, but preserve the comments
 897                --  attached to these nodes.
 898
 899                declare
 900                   Declaration  : Project_Node_Id :=
 901                                    First_Declarative_Item_Of
 902                                      (Project_Declaration_Of
 903                                         (Project_Node, Tree),
 904                                       Tree);
 905                   Previous     : Project_Node_Id := Empty_Node;
 906                   Current_Node : Project_Node_Id := Empty_Node;
 907
 908                   Name         : Name_Id;
 909                   Kind_Of_Node : Project_Node_Kind;
 910                   Comments     : Project_Node_Id;
 911
 912                begin
 913                   while Present (Declaration) loop
 914                      Current_Node := Current_Item_Node (Declaration, Tree);
 915
 916                      Kind_Of_Node := Kind_Of (Current_Node, Tree);
 917
 918                      if Kind_Of_Node = N_Attribute_Declaration or else
 919                        Kind_Of_Node = N_Package_Declaration
 920                      then
 921                         Name := Prj.Tree.Name_Of (Current_Node, Tree);
 922
 923                         if Name = Name_Source_Files     or else
 924                            Name = Name_Source_List_File or else
 925                            Name = Name_Source_Dirs      or else
 926                            Name = Name_Naming
 927                         then
 928                            Comments :=
 929                              Tree.Project_Nodes.Table (Current_Node).Comments;
 930
 931                            if Name = Name_Source_Files then
 932                               Source_Files_Comments := Comments;
 933
 934                            elsif Name = Name_Source_List_File then
 935                               Source_List_File_Comments := Comments;
 936
 937                            elsif Name = Name_Source_Dirs then
 938                               Source_Dirs_Comments := Comments;
 939
 940                            elsif Name = Name_Naming then
 941                               Naming_Package_Comments := Comments;
 942                            end if;
 943
 944                            if No (Previous) then
 945                               Set_First_Declarative_Item_Of
 946                                 (Project_Declaration_Of (Project_Node, Tree),
 947                                  Tree,
 948                                  To => Next_Declarative_Item
 949                                          (Declaration, Tree));
 950
 951                            else
 952                               Set_Next_Declarative_Item
 953                                 (Previous, Tree,
 954                                  To => Next_Declarative_Item
 955                                          (Declaration, Tree));
 956                            end if;
 957
 958                         else
 959                            Previous := Declaration;
 960                         end if;
 961                      end if;
 962
 963                      Declaration := Next_Declarative_Item (Declaration, Tree);
 964                   end loop;
 965                end;
 966             end if;
 967          end if;
 968
 969          if Directory_Last /= 0 then
 970             Output_Name (1 .. Output_Name_Last - Directory_Last) :=
 971               Output_Name (Directory_Last + 1 .. Output_Name_Last);
 972             Output_Name_Last := Output_Name_Last - Directory_Last;
 973          end if;
 974
 975          --  Get the project name id
 976
 977          Name_Len := Output_Name_Last;
 978          Name_Buffer (1 .. Name_Len) := Output_Name (1 .. Name_Len);
 979          Output_Name_Id := Name_Find;
 980
 981          --  Create the project naming file name
 982
 983          Project_Naming_Last := Output_Name_Last;
 984          Project_Naming_File_Name :=
 985            new String'(Output_Name (1 .. Output_Name_Last) &
 986                        Naming_File_Suffix &
 987                        Project_File_Extension);
 988          Project_Naming_Last :=
 989            Project_Naming_Last + Naming_File_Suffix'Length;
 990
 991          --  Get the project naming id
 992
 993          Name_Len := Project_Naming_Last;
 994          Name_Buffer (1 .. Name_Len) :=
 995            Project_Naming_File_Name (1 .. Name_Len);
 996          Project_Naming_Id := Name_Find;
 997
 998          Project_Naming_Last :=
 999            Project_Naming_Last + Project_File_Extension'Length;
1000
1001          --  Create the source list file name
1002
1003          Source_List_Last := Output_Name_Last;
1004          Source_List_Path :=
1005            new String'(Output_Name (1 .. Output_Name_Last) &
1006                        Source_List_File_Suffix);
1007          Source_List_Last :=
1008            Output_Name_Last + Source_List_File_Suffix'Length;
1009
1010          --  Add the project file extension to the project name
1011
1012          Output_Name
1013            (Output_Name_Last + 1 ..
1014               Output_Name_Last + Project_File_Extension'Length) :=
1015            Project_File_Extension;
1016          Output_Name_Last := Output_Name_Last + Project_File_Extension'Length;
1017
1018       end if;
1019
1020       --  Change the current directory to the directory of the project file,
1021       --  if any directory information is specified.
1022
1023       if Directory_Last /= 0 then
1024          begin
1025             Change_Dir (Path_Name (1 .. Directory_Last));
1026          exception
1027             when Directory_Error =>
1028                Prj.Com.Fail
1029                  ("unknown directory """
1030                   & Path_Name (1 .. Directory_Last)
1031                   & """");
1032          end;
1033       end if;
1034    end Initialize;
1035
1036    -------------
1037    -- Process --
1038    -------------
1039
1040    procedure Process
1041      (Directories       : Argument_List;
1042       Name_Patterns     : Regexp_List;
1043       Excluded_Patterns : Regexp_List;
1044       Foreign_Patterns  : Regexp_List)
1045   is
1046       procedure Process_Directory (Dir_Name : String; Recursively : Boolean);
1047       --  Look for Ada and foreign sources in a directory, according to the
1048       --  patterns. When Recursively is True, after looking for sources in
1049       --  Dir_Name, look also in its subdirectories, if any.
1050
1051       -----------------------
1052       -- Process_Directory --
1053       -----------------------
1054
1055       procedure Process_Directory (Dir_Name : String; Recursively : Boolean) is
1056          Matched : Matched_Type := False;
1057          Str     : String (1 .. 2_000);
1058          Canon   : String (1 .. 2_000);
1059          Last    : Natural;
1060          Dir     : Dir_Type;
1061          Do_Process : Boolean := True;
1062
1063          Temp_File_Name         : String_Access := null;
1064          Save_Last_Source_Index : Natural := 0;
1065          File_Name_Id           : Name_Id := No_Name;
1066
1067          Current_Source : Source;
1068
1069       begin
1070          --  Avoid processing the same directory more than once
1071
1072          for Index in 1 .. Processed_Directories.Last loop
1073             if Processed_Directories.Table (Index).all = Dir_Name then
1074                Do_Process := False;
1075                exit;
1076             end if;
1077          end loop;
1078
1079          if Do_Process then
1080             if Opt.Verbose_Mode then
1081                Output.Write_Str ("Processing directory """);
1082                Output.Write_Str (Dir_Name);
1083                Output.Write_Line ("""");
1084             end if;
1085
1086             Processed_Directories. Increment_Last;
1087             Processed_Directories.Table (Processed_Directories.Last) :=
1088               new String'(Dir_Name);
1089
1090             --  Get the source file names from the directory. Fails if the
1091             --  directory does not exist.
1092
1093             begin
1094                Open (Dir, Dir_Name);
1095             exception
1096                when Directory_Error =>
1097                   Prj.Com.Fail ("cannot open directory """ & Dir_Name & """");
1098             end;
1099
1100             --  Process each regular file in the directory
1101
1102             File_Loop : loop
1103                Read (Dir, Str, Last);
1104                exit File_Loop when Last = 0;
1105
1106                --  Copy the file name and put it in canonical case to match
1107                --  against the patterns that have themselves already been put
1108                --  in canonical case.
1109
1110                Canon (1 .. Last) := Str (1 .. Last);
1111                Canonical_Case_File_Name (Canon (1 .. Last));
1112
1113                if Is_Regular_File
1114                  (Dir_Name & Directory_Separator & Str (1 .. Last))
1115                then
1116                   Matched := True;
1117
1118                   Name_Len := Last;
1119                   Name_Buffer (1 .. Name_Len) := Str (1 .. Last);
1120                   File_Name_Id := Name_Find;
1121
1122                   --  First, check if the file name matches at least one of
1123                   --  the excluded expressions;
1124
1125                   for Index in Excluded_Patterns'Range loop
1126                      if
1127                        Match (Canon (1 .. Last), Excluded_Patterns (Index))
1128                      then
1129                         Matched := Excluded;
1130                         exit;
1131                      end if;
1132                   end loop;
1133
1134                   --  If it does not match any of the excluded expressions,
1135                   --  check if the file name matches at least one of the
1136                   --  regular expressions.
1137
1138                   if Matched = True then
1139                      Matched := False;
1140
1141                      for Index in Name_Patterns'Range loop
1142                         if
1143                           Match
1144                             (Canon (1 .. Last), Name_Patterns (Index))
1145                         then
1146                            Matched := True;
1147                            exit;
1148                         end if;
1149                      end loop;
1150                   end if;
1151
1152                   if Very_Verbose
1153                     or else (Matched = True and then Opt.Verbose_Mode)
1154                   then
1155                      Output.Write_Str ("   Checking """);
1156                      Output.Write_Str (Str (1 .. Last));
1157                      Output.Write_Line (""": ");
1158                   end if;
1159
1160                   --  If the file name matches one of the regular expressions,
1161                   --  parse it to get its unit name.
1162
1163                   if Matched = True then
1164                      declare
1165                         FD : File_Descriptor;
1166                         Success : Boolean;
1167                         Saved_Output : File_Descriptor;
1168                         Saved_Error  : File_Descriptor;
1169
1170                      begin
1171                         --  If we don't have the path of the compiler yet,
1172                         --  get it now. The compiler name may have a prefix,
1173                         --  so we get the potentially prefixed name.
1174
1175                         if Gcc_Path = null then
1176                            declare
1177                               Prefix_Gcc : String_Access :=
1178                                              Program_Name (Gcc, "gnatname");
1179                            begin
1180                               Gcc_Path :=
1181                                 Locate_Exec_On_Path (Prefix_Gcc.all);
1182                               Free (Prefix_Gcc);
1183                            end;
1184
1185                            if Gcc_Path = null then
1186                               Prj.Com.Fail ("could not locate " & Gcc);
1187                            end if;
1188                         end if;
1189
1190                         --  If we don't have yet the file name of the
1191                         --  temporary file, get it now.
1192
1193                         if Temp_File_Name = null then
1194                            Create_Temp_File (FD, Temp_File_Name);
1195
1196                            if FD = Invalid_FD then
1197                               Prj.Com.Fail
1198                                 ("could not create temporary file");
1199                            end if;
1200
1201                            Close (FD);
1202                            Delete_File (Temp_File_Name.all, Success);
1203                         end if;
1204
1205                         Args (Args'Last) := new String'
1206                           (Dir_Name &
1207                            Directory_Separator &
1208                            Str (1 .. Last));
1209
1210                         --  Create the temporary file
1211
1212                         FD := Create_Output_Text_File
1213                           (Name => Temp_File_Name.all);
1214
1215                         if FD = Invalid_FD then
1216                            Prj.Com.Fail
1217                              ("could not create temporary file");
1218                         end if;
1219
1220                         --  Save the standard output and error
1221
1222                         Saved_Output := Dup (Standout);
1223                         Saved_Error  := Dup (Standerr);
1224
1225                         --  Set standard output and error to the temporary file
1226
1227                         Dup2 (FD, Standout);
1228                         Dup2 (FD, Standerr);
1229
1230                         --  And spawn the compiler
1231
1232                         Spawn (Gcc_Path.all, Args.all, Success);
1233
1234                         --  Restore the standard output and error
1235
1236                         Dup2 (Saved_Output, Standout);
1237                         Dup2 (Saved_Error, Standerr);
1238
1239                         --  Close the temporary file
1240
1241                         Close (FD);
1242
1243                         --  And close the saved standard output and error to
1244                         --  avoid too many file descriptors.
1245
1246                         Close (Saved_Output);
1247                         Close (Saved_Error);
1248
1249                         --  Now that standard output is restored, check if
1250                         --  the compiler ran correctly.
1251
1252                         --  Read the lines of the temporary file:
1253                         --  they should contain the kind and name of the unit.
1254
1255                         declare
1256                            File      : Text_File;
1257                            Text_Line : String (1 .. 1_000);
1258                            Text_Last : Natural;
1259
1260                         begin
1261                            Open (File, Temp_File_Name.all);
1262
1263                            if not Is_Valid (File) then
1264                               Prj.Com.Fail
1265                                 ("could not read temporary file");
1266                            end if;
1267
1268                            Save_Last_Source_Index := Sources.Last;
1269
1270                            if End_Of_File (File) then
1271                               if Opt.Verbose_Mode then
1272                                  if not Success then
1273                                     Output.Write_Str ("      (process died) ");
1274                                  end if;
1275                               end if;
1276
1277                            else
1278                               Line_Loop : while not End_Of_File (File) loop
1279                                  Get_Line (File, Text_Line, Text_Last);
1280
1281                                  --  Find the first closing parenthesis
1282
1283                                  Char_Loop : for J in 1 .. Text_Last loop
1284                                     if Text_Line (J) = ')' then
1285                                        if J >= 13 and then
1286                                          Text_Line (1 .. 4) = "Unit"
1287                                        then
1288                                           --  Add entry to Sources table
1289
1290                                           Name_Len := J - 12;
1291                                           Name_Buffer (1 .. Name_Len) :=
1292                                             Text_Line (6 .. J - 7);
1293                                           Current_Source :=
1294                                             (Unit_Name  => Name_Find,
1295                                              File_Name  => File_Name_Id,
1296                                              Index => 0,
1297                                              Spec  => Text_Line (J - 5 .. J) =
1298                                                         "(spec)");
1299
1300                                           Sources.Append (Current_Source);
1301                                        end if;
1302
1303                                        exit Char_Loop;
1304                                     end if;
1305                                  end loop Char_Loop;
1306                               end loop Line_Loop;
1307                            end if;
1308
1309                            if Save_Last_Source_Index = Sources.Last then
1310                               if Opt.Verbose_Mode then
1311                                  Output.Write_Line ("      not a unit");
1312                               end if;
1313
1314                            else
1315                               if Sources.Last >
1316                                    Save_Last_Source_Index + 1
1317                               then
1318                                  for Index in Save_Last_Source_Index + 1 ..
1319                                                 Sources.Last
1320                                  loop
1321                                     Sources.Table (Index).Index :=
1322                                       Int (Index - Save_Last_Source_Index);
1323                                  end loop;
1324                               end if;
1325
1326                               for Index in Save_Last_Source_Index + 1 ..
1327                                              Sources.Last
1328                               loop
1329                                  Current_Source := Sources.Table (Index);
1330
1331                                  if Opt.Verbose_Mode then
1332                                     if Current_Source.Spec then
1333                                        Output.Write_Str ("      spec of ");
1334
1335                                     else
1336                                        Output.Write_Str ("      body of ");
1337                                     end if;
1338
1339                                     Output.Write_Line
1340                                       (Get_Name_String
1341                                          (Current_Source.Unit_Name));
1342                                  end if;
1343                               end loop;
1344                            end if;
1345
1346                            Close (File);
1347
1348                            Delete_File (Temp_File_Name.all, Success);
1349                         end;
1350                      end;
1351
1352                   --  File name matches none of the regular expressions
1353
1354                   else
1355                      --  If file is not excluded, see if this is foreign source
1356
1357                      if Matched /= Excluded then
1358                         for Index in Foreign_Patterns'Range loop
1359                            if Match (Canon (1 .. Last),
1360                                      Foreign_Patterns (Index))
1361                            then
1362                               Matched := True;
1363                               exit;
1364                            end if;
1365                         end loop;
1366                      end if;
1367
1368                      if Very_Verbose then
1369                         case Matched is
1370                            when False =>
1371                               Output.Write_Line ("no match");
1372
1373                            when Excluded =>
1374                               Output.Write_Line ("excluded");
1375
1376                            when True =>
1377                               Output.Write_Line ("foreign source");
1378                         end case;
1379                      end if;
1380
1381                      if Matched = True then
1382
1383                         --  Add source file name without unit name
1384
1385                         Name_Len := 0;
1386                         Add_Str_To_Name_Buffer (Canon (1 .. Last));
1387                         Sources.Append
1388                           ((File_Name => Name_Find,
1389                             Unit_Name => No_Name,
1390                             Index     => 0,
1391                             Spec      => False));
1392                      end if;
1393                   end if;
1394                end if;
1395             end loop File_Loop;
1396
1397             Close (Dir);
1398          end if;
1399
1400          --  If Recursively is True, call itself for each subdirectory.
1401          --  We do that, even when this directory has already been processed,
1402          --  because all of its subdirectories may not have been processed.
1403
1404          if Recursively then
1405             Open (Dir, Dir_Name);
1406
1407             loop
1408                Read (Dir, Str, Last);
1409                exit when Last = 0;
1410
1411                --  Do not call itself for "." or ".."
1412
1413                if Is_Directory
1414                  (Dir_Name & Directory_Separator & Str (1 .. Last))
1415                  and then Str (1 .. Last) /= "."
1416                  and then Str (1 .. Last) /= ".."
1417                then
1418                   Process_Directory
1419                     (Dir_Name & Directory_Separator & Str (1 .. Last),
1420                      Recursively => True);
1421                end if;
1422             end loop;
1423
1424             Close (Dir);
1425          end if;
1426       end Process_Directory;
1427
1428    --  Start of processing for Process
1429
1430    begin
1431       Processed_Directories.Set_Last (0);
1432
1433       --  Process each directory
1434
1435       for Index in Directories'Range  loop
1436
1437          declare
1438             Dir_Name    : constant String := Directories (Index).all;
1439             Last        : Natural := Dir_Name'Last;
1440             Recursively : Boolean := False;
1441             Found       : Boolean;
1442             Canonical   : String (1 .. Dir_Name'Length) := Dir_Name;
1443
1444          begin
1445             Canonical_Case_File_Name (Canonical);
1446
1447             Found := False;
1448             for J in 1 .. Source_Directories.Last loop
1449                if Source_Directories.Table (J).all = Canonical then
1450                   Found := True;
1451                   exit;
1452                end if;
1453             end loop;
1454
1455             if not Found then
1456                Source_Directories.Append (new String'(Canonical));
1457             end if;
1458
1459             if Dir_Name'Length >= 4
1460               and then (Dir_Name (Last - 2 .. Last) = "/**")
1461             then
1462                Last := Last - 3;
1463                Recursively := True;
1464             end if;
1465
1466             Process_Directory (Dir_Name (Dir_Name'First .. Last), Recursively);
1467          end;
1468
1469       end loop;
1470    end Process;
1471
1472    ----------------
1473    -- Write_Char --
1474    ----------------
1475    procedure Write_A_Char (C : Character) is
1476    begin
1477       Write_A_String ((1 => C));
1478    end Write_A_Char;
1479
1480    ---------------
1481    -- Write_Eol --
1482    ---------------
1483
1484    procedure Write_Eol is
1485    begin
1486       Write_A_String ((1 => ASCII.LF));
1487    end Write_Eol;
1488
1489    --------------------
1490    -- Write_A_String --
1491    --------------------
1492
1493    procedure Write_A_String (S : String) is
1494       Str : String (1 .. S'Length);
1495
1496    begin
1497       if S'Length > 0 then
1498          Str := S;
1499
1500          if Write (Output_FD, Str (1)'Address, Str'Length) /= Str'Length then
1501             Prj.Com.Fail ("disk full");
1502          end if;
1503       end if;
1504    end Write_A_String;
1505
1506 end Prj.Makr;