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