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