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