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