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