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