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-2002 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.Part;
  34 with Prj.PP;
  35 with Prj.Tree; use Prj.Tree;
  36 with Snames;   use Snames;
  37 with Stringt;  use Stringt;
  38 with Table;    use Table;
  39
  40 with Ada.Characters.Handling;   use Ada.Characters.Handling;
  41 with GNAT.Directory_Operations; use GNAT.Directory_Operations;
  42 with GNAT.Expect;               use GNAT.Expect;
  43 with GNAT.OS_Lib;               use GNAT.OS_Lib;
  44 with GNAT.Regexp;               use GNAT.Regexp;
  45 with GNAT.Regpat;               use GNAT.Regpat;
  46
  47 package body Prj.Makr is
  48
  49    type Matched_Type is (True, False, Excluded);
  50
  51    Naming_File_Suffix      : constant String := "_naming";
  52    Source_List_File_Suffix : constant String := "_source_list.txt";
  53
  54    Output_FD   : File_Descriptor;
  55    --  To save the project file and its naming project file.
  56
  57    procedure Write_Eol;
  58    --  Output an empty line.
  59
  60    procedure Write_A_Char (C : Character);
  61    --  Write one character to Output_FD
  62
  63    procedure Write_A_String (S : String);
  64    --  Write a String to Output_FD
  65
  66    ----------
  67    -- Make --
  68    ----------
  69
  70    procedure Make
  71      (File_Path         : String;
  72       Project_File      : Boolean;
  73       Directories       : Argument_List;
  74       Name_Patterns     : Argument_List;
  75       Excluded_Patterns : Argument_List;
  76       Very_Verbose      : Boolean)
  77    is
  78       Path_Name : String (1 .. File_Path'Length +
  79                                       Project_File_Extension'Length);
  80       Path_Last : Natural := File_Path'Length;
  81
  82       Directory_Last    : Natural := 0;
  83
  84       Output_Name      : String (Path_Name'Range);
  85       Output_Name_Last : Natural;
  86       Output_Name_Id   : Name_Id;
  87
  88       Project_Node        : Project_Node_Id := Empty_Node;
  89       Project_Declaration : Project_Node_Id := Empty_Node;
  90       Source_Dirs_List    : Project_Node_Id := Empty_Node;
  91       Current_Source_Dir  : Project_Node_Id := Empty_Node;
  92
  93       Project_Naming_Node : Project_Node_Id := Empty_Node;
  94       Project_Naming_Decl : Project_Node_Id := Empty_Node;
  95       Naming_Package      : Project_Node_Id := Empty_Node;
  96
  97       Project_Naming_File_Name : String (1 .. Output_Name'Length +
  98                                                 Naming_File_Suffix'Length);
  99
 100       Project_Naming_Last : Natural;
 101       Project_Naming_Id   : Name_Id := No_Name;
 102
 103       Excluded_Expressions : array (Excluded_Patterns'Range) of Regexp;
 104       Regular_Expressions  : array (Name_Patterns'Range) of Regexp;
 105
 106       Source_List_Path : String (1 .. Output_Name'Length +
 107                                         Source_List_File_Suffix'Length);
 108       Source_List_Last : Natural;
 109
 110       Source_List_FD : File_Descriptor;
 111
 112       Str     : String (1 .. 2_000);
 113       Last    : Natural;
 114       Dir     : Dir_Type;
 115
 116       PD      : Process_Descriptor;
 117       Result  : Expect_Match;
 118       Matcher : constant Pattern_Matcher :=
 119                   Compile (Expression => "expected|Unit.*\)|No such");
 120
 121       Args : Argument_List :=
 122         (1 => new String'("-c"),
 123          2 => new String'("-gnats"),
 124          3 => new String'("-gnatu"),
 125          4 => new String'("-x"),
 126          5 => new String'("ada"),
 127          6 => null);
 128
 129       type SFN_Pragma is record
 130         Unit : String_Access;
 131         File : String_Access;
 132         Spec : Boolean;
 133       end record;
 134
 135       package SFN_Pragmas is new Table.Table
 136         (Table_Component_Type => SFN_Pragma,
 137          Table_Index_Type     => Natural,
 138          Table_Low_Bound      => 0,
 139          Table_Initial        => 50,
 140          Table_Increment      => 50,
 141          Table_Name           => "Prj.Makr.SFN_Pragmas");
 142
 143    begin
 144       --  Do some needed initializations
 145
 146       Csets.Initialize;
 147       Namet.Initialize;
 148       Snames.Initialize;
 149       Prj.Initialize;
 150
 151       SFN_Pragmas.Set_Last (0);
 152
 153       --  Get the path and file names
 154
 155       if File_Names_Case_Sensitive then
 156          Path_Name (1 .. Path_Last) := File_Path;
 157       else
 158          Path_Name (1 .. Path_Last) := To_Lower (File_Path);
 159       end if;
 160
 161       Path_Name (Path_Last + 1 .. Path_Name'Last) :=
 162         Project_File_Extension;
 163
 164       --  Get the end of directory information, if any
 165
 166       for Index in reverse 1 .. Path_Last loop
 167          if Path_Name (Index) = Directory_Separator then
 168             Directory_Last := Index;
 169             exit;
 170          end if;
 171       end loop;
 172
 173       if Project_File then
 174          if Path_Last < Project_File_Extension'Length + 1
 175            or else Path_Name
 176                  (Path_Last - Project_File_Extension'Length + 1 .. Path_Last)
 177                     /= Project_File_Extension
 178          then
 179             Path_Last := Path_Name'Last;
 180          end if;
 181
 182          Output_Name (1 .. Path_Last) := To_Lower (Path_Name (1 .. Path_Last));
 183          Output_Name_Last := Path_Last - Project_File_Extension'Length;
 184
 185          if Directory_Last /= 0 then
 186             Output_Name (1 .. Output_Name_Last - Directory_Last) :=
 187               Output_Name (Directory_Last + 1 .. Output_Name_Last);
 188             Output_Name_Last := Output_Name_Last - Directory_Last;
 189          end if;
 190
 191          --  Get the project name id
 192
 193          Name_Len := Output_Name_Last;
 194          Name_Buffer (1 .. Name_Len) := Output_Name (1 .. Name_Len);
 195          Output_Name_Id := Name_Find;
 196
 197          --  Create the project naming file name
 198
 199          Project_Naming_Last := Output_Name_Last;
 200          Project_Naming_File_Name (1 .. Project_Naming_Last) :=
 201            Output_Name (1 .. Project_Naming_Last);
 202          Project_Naming_File_Name
 203            (Project_Naming_Last + 1 ..
 204             Project_Naming_Last + Naming_File_Suffix'Length) :=
 205            Naming_File_Suffix;
 206          Project_Naming_Last :=
 207            Project_Naming_Last + Naming_File_Suffix'Length;
 208
 209          --  Get the project naming id
 210
 211          Name_Len := Project_Naming_Last;
 212          Name_Buffer (1 .. Name_Len) :=
 213            Project_Naming_File_Name (1 .. Name_Len);
 214          Project_Naming_Id := Name_Find;
 215
 216          Project_Naming_File_Name
 217            (Project_Naming_Last + 1 ..
 218             Project_Naming_Last + Project_File_Extension'Length) :=
 219            Project_File_Extension;
 220          Project_Naming_Last :=
 221            Project_Naming_Last + Project_File_Extension'Length;
 222
 223          --  Create the source list file name
 224
 225          Source_List_Last := Output_Name_Last;
 226          Source_List_Path (1 .. Source_List_Last) :=
 227            Output_Name (1 .. Source_List_Last);
 228          Source_List_Path
 229            (Source_List_Last + 1 ..
 230             Source_List_Last + Source_List_File_Suffix'Length) :=
 231            Source_List_File_Suffix;
 232          Source_List_Last := Source_List_Last + Source_List_File_Suffix'Length;
 233
 234          --  Add the project file extension to the project name
 235
 236          Output_Name
 237            (Output_Name_Last + 1 ..
 238             Output_Name_Last + Project_File_Extension'Length) :=
 239            Project_File_Extension;
 240          Output_Name_Last := Output_Name_Last + Project_File_Extension'Length;
 241       end if;
 242
 243       --  Change the current directory to the directory of the project file,
 244       --  if any directory information is specified.
 245
 246       if Directory_Last /= 0 then
 247          begin
 248             Change_Dir (Path_Name (1 .. Directory_Last));
 249          exception
 250             when Directory_Error =>
 251                Fail ("unknown directory """ &
 252                      Path_Name (1 .. Directory_Last) & '"');
 253          end;
 254       end if;
 255
 256       if Project_File then
 257
 258          --  Delete the source list file, if it already exists
 259
 260          declare
 261             Discard : Boolean;
 262
 263          begin
 264             Delete_File
 265               (Source_List_Path (1 .. Source_List_Last),
 266                Success => Discard);
 267          end;
 268
 269          --  And create a new source list file.
 270          --  Fail if file cannot be created.
 271
 272          Source_List_FD := Create_New_File
 273            (Name  => Source_List_Path (1 .. Source_List_Last),
 274             Fmode => Text);
 275
 276          if Source_List_FD = Invalid_FD then
 277             Fail ("cannot create file """ &
 278                   Source_List_Path (1 .. Source_List_Last) & '"');
 279          end if;
 280       end if;
 281
 282       --  Compile the regular expressions. Fails immediately if any of
 283       --  the specified strings is in error.
 284
 285       for Index in Excluded_Expressions'Range loop
 286          begin
 287             Excluded_Expressions (Index) :=
 288               Compile (Pattern => Excluded_Patterns (Index).all, Glob => True);
 289
 290          exception
 291             when Error_In_Regexp =>
 292                Fail ("invalid regular expression """ &
 293                      Excluded_Patterns (Index).all & '"');
 294          end;
 295       end loop;
 296
 297       for Index in Regular_Expressions'Range loop
 298          begin
 299             Regular_Expressions (Index) :=
 300               Compile (Pattern => Name_Patterns (Index).all, Glob => True);
 301
 302          exception
 303             when Error_In_Regexp =>
 304                Fail ("invalid regular expression """ &
 305                      Name_Patterns (Index).all & '"');
 306          end;
 307       end loop;
 308
 309       if Project_File then
 310          if Opt.Verbose_Mode then
 311             Output.Write_Str ("Naming project file name is """);
 312             Output.Write_Str
 313               (Project_Naming_File_Name (1 .. Project_Naming_Last));
 314             Output.Write_Line ("""");
 315          end if;
 316
 317          --  If there is already a project file with the specified name,
 318          --  parse it to get the components that are not automatically
 319          --  generated.
 320
 321          if Is_Regular_File (Output_Name (1 .. Output_Name_Last)) then
 322             if Opt.Verbose_Mode then
 323                Output.Write_Str ("Parsing already existing project file """);
 324                Output.Write_Str (Output_Name (1 .. Output_Name_Last));
 325                Output.Write_Line ("""");
 326             end if;
 327
 328             Part.Parse
 329               (Project           => Project_Node,
 330                Project_File_Name => Output_Name (1 .. Output_Name_Last),
 331                Always_Errout_Finalize => False);
 332
 333             --  If parsing was successful, remove the components that are
 334             --  automatically generated, if any, so that they will be
 335             --  unconditionally added later.
 336
 337             if Project_Node /= Empty_Node then
 338
 339                --  Remove the with clause for the naming project file
 340
 341                declare
 342                   With_Clause : Project_Node_Id :=
 343                     First_With_Clause_Of (Project_Node);
 344                   Previous    : Project_Node_Id := Empty_Node;
 345
 346                begin
 347                   while With_Clause /= Empty_Node loop
 348                      if Tree.Name_Of (With_Clause) = Project_Naming_Id then
 349                         if Previous = Empty_Node then
 350                            Set_First_With_Clause_Of
 351                              (Project_Node,
 352                               To => Next_With_Clause_Of (With_Clause));
 353                         else
 354                            Set_Next_With_Clause_Of
 355                              (Previous,
 356                               To => Next_With_Clause_Of (With_Clause));
 357                         end if;
 358
 359                         exit;
 360                      end if;
 361
 362                      Previous := With_Clause;
 363                      With_Clause := Next_With_Clause_Of (With_Clause);
 364                   end loop;
 365                end;
 366
 367                --  Remove attribute declarations of Source_Files,
 368                --  Source_List_File, Source_Dirs, and the declaration of
 369                --  package Naming, if they exist.
 370
 371                declare
 372                   Declaration  : Project_Node_Id :=
 373                     First_Declarative_Item_Of
 374                     (Project_Declaration_Of (Project_Node));
 375                   Previous     : Project_Node_Id := Empty_Node;
 376                   Current_Node : Project_Node_Id := Empty_Node;
 377
 378                begin
 379                   while Declaration /= Empty_Node loop
 380                      Current_Node := Current_Item_Node (Declaration);
 381
 382                      if (Kind_Of (Current_Node) = N_Attribute_Declaration
 383                            and then
 384                              (Tree.Name_Of (Current_Node) = Name_Source_Files
 385                                 or else Tree.Name_Of (Current_Node) =
 386                                                         Name_Source_List_File
 387                                 or else Tree.Name_Of (Current_Node) =
 388                                                         Name_Source_Dirs))
 389                        or else
 390                          (Kind_Of (Current_Node) = N_Package_Declaration
 391                             and then Tree.Name_Of (Current_Node) = Name_Naming)
 392                      then
 393                         if Previous = Empty_Node then
 394                            Set_First_Declarative_Item_Of
 395                              (Project_Declaration_Of (Project_Node),
 396                               To => Next_Declarative_Item (Declaration));
 397
 398                         else
 399                            Set_Next_Declarative_Item
 400                              (Previous,
 401                               To => Next_Declarative_Item (Declaration));
 402                         end if;
 403
 404                      else
 405                         Previous := Declaration;
 406                      end if;
 407
 408                      Declaration := Next_Declarative_Item (Declaration);
 409                   end loop;
 410                end;
 411             end if;
 412          end if;
 413
 414          --  If there were no already existing project file, or if the parsing
 415          --  was unsuccessful, create an empty project node with the correct
 416          --  name and its project declaration node.
 417
 418          if Project_Node = Empty_Node then
 419             Project_Node := Default_Project_Node (Of_Kind => N_Project);
 420             Set_Name_Of (Project_Node, To => Output_Name_Id);
 421             Set_Project_Declaration_Of
 422               (Project_Node,
 423                To => Default_Project_Node (Of_Kind => N_Project_Declaration));
 424
 425          end if;
 426
 427          --  Create the naming project node, and add an attribute declaration
 428          --  for Source_Files as an empty list, to indicate there are no
 429          --  sources in the naming project.
 430
 431          Project_Naming_Node := Default_Project_Node (Of_Kind => N_Project);
 432          Set_Name_Of (Project_Naming_Node, To => Project_Naming_Id);
 433          Project_Naming_Decl :=
 434            Default_Project_Node (Of_Kind => N_Project_Declaration);
 435          Set_Project_Declaration_Of (Project_Naming_Node, Project_Naming_Decl);
 436          Naming_Package :=
 437            Default_Project_Node (Of_Kind => N_Package_Declaration);
 438          Set_Name_Of (Naming_Package, To => Name_Naming);
 439
 440          declare
 441             Decl_Item : constant Project_Node_Id :=
 442               Default_Project_Node (Of_Kind => N_Declarative_Item);
 443
 444             Attribute : constant Project_Node_Id :=
 445               Default_Project_Node
 446               (Of_Kind => N_Attribute_Declaration,
 447                And_Expr_Kind => List);
 448
 449             Expression : constant Project_Node_Id :=
 450               Default_Project_Node
 451               (Of_Kind => N_Expression,
 452                And_Expr_Kind => List);
 453
 454             Term  : constant Project_Node_Id :=
 455               Default_Project_Node
 456               (Of_Kind => N_Term,
 457                And_Expr_Kind => List);
 458
 459             Empty_List : constant Project_Node_Id :=
 460               Default_Project_Node
 461               (Of_Kind => N_Literal_String_List);
 462
 463          begin
 464             Set_First_Declarative_Item_Of
 465               (Project_Naming_Decl, To => Decl_Item);
 466             Set_Next_Declarative_Item (Decl_Item, Naming_Package);
 467             Set_Current_Item_Node (Decl_Item, To => Attribute);
 468             Set_Name_Of (Attribute, To => Name_Source_Files);
 469             Set_Expression_Of (Attribute, To => Expression);
 470             Set_First_Term (Expression, To => Term);
 471             Set_Current_Term (Term, To => Empty_List);
 472          end;
 473
 474          --  Add a with clause on the naming project in the main project
 475
 476          declare
 477             With_Clause : constant Project_Node_Id :=
 478               Default_Project_Node (Of_Kind => N_With_Clause);
 479
 480          begin
 481             Set_Next_With_Clause_Of
 482               (With_Clause, To => First_With_Clause_Of (Project_Node));
 483             Set_First_With_Clause_Of (Project_Node, To => With_Clause);
 484             Set_Name_Of (With_Clause, To => Project_Naming_Id);
 485             Start_String;
 486             Store_String_Chars
 487               (Project_Naming_File_Name (1 .. Project_Naming_Last));
 488             Set_String_Value_Of (With_Clause, To => End_String);
 489          end;
 490
 491          Project_Declaration := Project_Declaration_Of (Project_Node);
 492
 493          --  Add a renaming declaration for package Naming in the main project
 494
 495          declare
 496             Decl_Item  : constant Project_Node_Id :=
 497               Default_Project_Node (Of_Kind => N_Declarative_Item);
 498
 499             Naming : constant Project_Node_Id :=
 500               Default_Project_Node (Of_Kind => N_Package_Declaration);
 501          begin
 502             Set_Next_Declarative_Item
 503               (Decl_Item,
 504                To => First_Declarative_Item_Of (Project_Declaration));
 505             Set_First_Declarative_Item_Of
 506               (Project_Declaration, To => Decl_Item);
 507             Set_Current_Item_Node (Decl_Item, To => Naming);
 508             Set_Name_Of (Naming, To => Name_Naming);
 509             Set_Project_Of_Renamed_Package_Of
 510               (Naming, To => Project_Naming_Node);
 511          end;
 512
 513          --  Add an attribute declaration for Source_Dirs, initialized as an
 514          --  empty list. Directories will be added as they are read from the
 515          --  directory list file.
 516
 517          declare
 518             Decl_Item  : constant Project_Node_Id :=
 519               Default_Project_Node (Of_Kind => N_Declarative_Item);
 520
 521             Attribute : constant Project_Node_Id :=
 522               Default_Project_Node
 523               (Of_Kind => N_Attribute_Declaration,
 524                And_Expr_Kind => List);
 525
 526             Expression : constant Project_Node_Id :=
 527               Default_Project_Node
 528               (Of_Kind => N_Expression,
 529                And_Expr_Kind => List);
 530
 531             Term  : constant Project_Node_Id :=
 532               Default_Project_Node
 533               (Of_Kind => N_Term, And_Expr_Kind => List);
 534
 535          begin
 536             Set_Next_Declarative_Item
 537               (Decl_Item,
 538                To => First_Declarative_Item_Of (Project_Declaration));
 539             Set_First_Declarative_Item_Of
 540               (Project_Declaration, To => Decl_Item);
 541             Set_Current_Item_Node (Decl_Item, To => Attribute);
 542             Set_Name_Of (Attribute, To => Name_Source_Dirs);
 543             Set_Expression_Of (Attribute, To => Expression);
 544             Set_First_Term (Expression, To => Term);
 545             Source_Dirs_List :=
 546               Default_Project_Node (Of_Kind => N_Literal_String_List,
 547                                     And_Expr_Kind => List);
 548             Set_Current_Term (Term, To => Source_Dirs_List);
 549          end;
 550
 551          --  Add an attribute declaration for Source_List_File with the
 552          --  source list file name that will be created.
 553
 554          declare
 555             Decl_Item  : constant Project_Node_Id :=
 556               Default_Project_Node (Of_Kind => N_Declarative_Item);
 557
 558             Attribute : constant Project_Node_Id :=
 559               Default_Project_Node
 560               (Of_Kind => N_Attribute_Declaration,
 561                And_Expr_Kind => Single);
 562
 563             Expression : constant Project_Node_Id :=
 564               Default_Project_Node
 565               (Of_Kind => N_Expression,
 566                And_Expr_Kind => Single);
 567
 568             Term  : constant Project_Node_Id :=
 569               Default_Project_Node
 570               (Of_Kind => N_Term,
 571                And_Expr_Kind => Single);
 572
 573             Value : constant Project_Node_Id :=
 574               Default_Project_Node
 575               (Of_Kind => N_Literal_String,
 576                And_Expr_Kind => Single);
 577
 578          begin
 579             Set_Next_Declarative_Item
 580               (Decl_Item,
 581                To => First_Declarative_Item_Of (Project_Declaration));
 582             Set_First_Declarative_Item_Of
 583               (Project_Declaration, To => Decl_Item);
 584             Set_Current_Item_Node (Decl_Item, To => Attribute);
 585             Set_Name_Of (Attribute, To => Name_Source_List_File);
 586             Set_Expression_Of (Attribute, To => Expression);
 587             Set_First_Term (Expression, To => Term);
 588             Set_Current_Term (Term, To => Value);
 589             Start_String;
 590             Store_String_Chars (Source_List_Path (1 .. Source_List_Last));
 591             Set_String_Value_Of (Value, To => End_String);
 592          end;
 593       end if;
 594
 595       --  Process each directory
 596
 597       for Index in Directories'Range  loop
 598
 599          declare
 600             Dir_Name : constant String := Directories (Index).all;
 601             Matched  : Matched_Type := False;
 602
 603          begin
 604             if Opt.Verbose_Mode then
 605                Output.Write_Str ("Processing directory """);
 606                Output.Write_Str (Dir_Name);
 607                Output.Write_Line ("""");
 608             end if;
 609
 610             if Project_File then
 611
 612                --  Add the directory in the list for attribute Source_Dirs
 613
 614                declare
 615                   Expression : constant Project_Node_Id :=
 616                     Default_Project_Node
 617                     (Of_Kind => N_Expression,
 618                      And_Expr_Kind => Single);
 619
 620                   Term : constant Project_Node_Id :=
 621                     Default_Project_Node
 622                     (Of_Kind => N_Term,
 623                      And_Expr_Kind => Single);
 624
 625                   Value : constant Project_Node_Id :=
 626                     Default_Project_Node
 627                     (Of_Kind => N_Literal_String,
 628                      And_Expr_Kind => Single);
 629
 630                begin
 631                   if Current_Source_Dir = Empty_Node then
 632                      Set_First_Expression_In_List
 633                        (Source_Dirs_List, To => Expression);
 634                   else
 635                      Set_Next_Expression_In_List
 636                        (Current_Source_Dir, To => Expression);
 637                   end if;
 638
 639                   Current_Source_Dir := Expression;
 640                   Set_First_Term (Expression, To => Term);
 641                   Set_Current_Term (Term, To => Value);
 642                   Start_String;
 643                   Store_String_Chars (S => Dir_Name);
 644                   Set_String_Value_Of (Value, To => End_String);
 645                end;
 646             end if;
 647
 648             --  Get the source file names from the directory.
 649             --  Fails if the directory does not exist.
 650
 651             begin
 652                Open (Dir, Dir_Name);
 653
 654             exception
 655                when Directory_Error =>
 656                   Fail ("cannot open directory """ & Dir_Name & '"');
 657             end;
 658
 659             --  Process each regular file in the directory
 660
 661             loop
 662                Read (Dir, Str, Last);
 663                exit when Last = 0;
 664
 665                if Is_Regular_File
 666                  (Dir_Name & Directory_Separator & Str (1 .. Last))
 667                then
 668                   Matched := True;
 669
 670                   --  First, check if the file name matches at least one of
 671                   --  the excluded expressions;
 672
 673                   for Index in Excluded_Expressions'Range loop
 674                      if
 675                        Match (Str (1 .. Last), Excluded_Expressions (Index))
 676                      then
 677                         Matched := Excluded;
 678                         exit;
 679                      end if;
 680                   end loop;
 681
 682                   --  If it does not match any of the excluded expressions,
 683                   --  check if the file name matches at least one of the
 684                   --  regular expressions.
 685
 686                   if Matched = True then
 687                      Matched := False;
 688                      for Index in Regular_Expressions'Range loop
 689                         if
 690                           Match (Str (1 .. Last), Regular_Expressions (Index))
 691                         then
 692                            Matched := True;
 693                            exit;
 694                         end if;
 695                      end loop;
 696                   end if;
 697
 698                   if Very_Verbose
 699                     or else (Matched = True and then Opt.Verbose_Mode)
 700                   then
 701                      Output.Write_Str ("   Checking """);
 702                      Output.Write_Str (Str (1 .. Last));
 703                      Output.Write_Str (""": ");
 704                   end if;
 705
 706                   --  If the file name matches one of the regular expressions,
 707                   --  parse it to get its unit name.
 708
 709                   if Matched = True then
 710                      Args (6) := new String'
 711                        (Dir_Name &
 712                         Directory_Separator &
 713                         Str (1 .. Last));
 714
 715                      begin
 716                         Non_Blocking_Spawn
 717                           (PD, "gcc", Args, Err_To_Out => True);
 718                         Expect (PD, Result, Matcher);
 719
 720                      exception
 721                         when Process_Died =>
 722                            if Opt.Verbose_Mode then
 723                               Output.Write_Str ("(process died) ");
 724                            end if;
 725
 726                            Result := Expect_Timeout;
 727                      end;
 728
 729                      if Result /= Expect_Timeout then
 730
 731                         --  If we got a unit name, this is a valid source file
 732
 733                         declare
 734                            S : constant String := Expect_Out_Match (PD);
 735
 736                         begin
 737                            if S'Length >= 13
 738                              and then S (S'First .. S'First + 3) = "Unit"
 739                            then
 740                               if Opt.Verbose_Mode then
 741                                  Output.Write_Str
 742                                    (S (S'Last - 4 .. S'Last - 1));
 743                                  Output.Write_Str (" of ");
 744                                  Output.Write_Line
 745                                    (S (S'First + 5 .. S'Last - 7));
 746                               end if;
 747
 748                               if Project_File then
 749
 750                                  --  Add the corresponding attribute in the
 751                                  --  Naming package of the naming project.
 752
 753                                  declare
 754                                     Decl_Item : constant Project_Node_Id :=
 755                                       Default_Project_Node
 756                                       (Of_Kind =>
 757                                          N_Declarative_Item);
 758
 759                                     Attribute : constant Project_Node_Id :=
 760                                       Default_Project_Node
 761                                       (Of_Kind =>
 762                                          N_Attribute_Declaration);
 763
 764                                     Expression : constant Project_Node_Id :=
 765                                       Default_Project_Node
 766                                       (Of_Kind => N_Expression,
 767                                        And_Expr_Kind => Single);
 768
 769                                     Term : constant Project_Node_Id :=
 770                                       Default_Project_Node
 771                                       (Of_Kind => N_Term,
 772                                        And_Expr_Kind => Single);
 773
 774                                     Value : constant Project_Node_Id :=
 775                                       Default_Project_Node
 776                                       (Of_Kind => N_Literal_String,
 777                                        And_Expr_Kind => Single);
 778
 779                                  begin
 780                                     Set_Next_Declarative_Item
 781                                       (Decl_Item,
 782                                        To => First_Declarative_Item_Of
 783                                        (Naming_Package));
 784                                     Set_First_Declarative_Item_Of
 785                                       (Naming_Package, To => Decl_Item);
 786                                     Set_Current_Item_Node
 787                                       (Decl_Item, To => Attribute);
 788
 789                                     if S (S'Last - 5 .. S'Last) = "(spec)" then
 790                                        Set_Name_Of
 791                                          (Attribute, To => Name_Specification);
 792                                     else
 793                                        Set_Name_Of
 794                                          (Attribute,
 795                                           To => Name_Implementation);
 796                                     end if;
 797
 798                                     Start_String;
 799                                     Store_String_Chars
 800                                       (To_Lower
 801                                        (S (S'First + 5 .. S'Last - 7)));
 802                                     Set_Associative_Array_Index_Of
 803                                       (Attribute, To => End_String);
 804
 805                                     Set_Expression_Of
 806                                       (Attribute, To => Expression);
 807                                     Set_First_Term (Expression, To => Term);
 808                                     Set_Current_Term (Term, To => Value);
 809
 810                                     Start_String;
 811                                     Store_String_Chars (Str (1 .. Last));
 812                                     Set_String_Value_Of
 813                                       (Value, To => End_String);
 814                                  end;
 815
 816                                  --  Add source file name to source list file
 817
 818                                  Last := Last + 1;
 819                                  Str (Last) := ASCII.LF;
 820
 821                                  if Write (Source_List_FD,
 822                                            Str (1)'Address,
 823                                            Last) /= Last
 824                                  then
 825                                     Fail ("disk full");
 826                                  end if;
 827                               else
 828                                  --  Add an entry in the SFN_Pragmas table
 829
 830                                  SFN_Pragmas.Increment_Last;
 831                                  SFN_Pragmas.Table (SFN_Pragmas.Last) :=
 832                                    (Unit => new String'
 833                                     (S (S'First + 5 .. S'Last - 7)),
 834                                     File => new String'(Str (1 .. Last)),
 835                                     Spec => S (S'Last - 5 .. S'Last)
 836                                     = "(spec)");
 837                               end if;
 838
 839                            else
 840                               if Opt.Verbose_Mode then
 841                                  Output.Write_Line ("not a unit");
 842                               end if;
 843                            end if;
 844                         end;
 845
 846                      else
 847                         if Opt.Verbose_Mode then
 848                            Output.Write_Line ("not a unit");
 849                         end if;
 850                      end if;
 851
 852                      Close (PD);
 853
 854                   else
 855                      if Very_Verbose then
 856                         if Matched = False then
 857                            Output.Write_Line ("no match");
 858
 859                         else
 860                            Output.Write_Line ("excluded");
 861                         end if;
 862                      end if;
 863                   end if;
 864                end if;
 865             end loop;
 866
 867             Close (Dir);
 868          end;
 869       end loop;
 870
 871       if Project_File then
 872          Close (Source_List_FD);
 873       end if;
 874
 875       declare
 876          Discard : Boolean;
 877
 878       begin
 879          --  Delete the file if it already exists
 880
 881          Delete_File
 882            (Path_Name (Directory_Last + 1 .. Path_Last),
 883             Success => Discard);
 884
 885          --  Create a new one
 886
 887          if Opt.Verbose_Mode then
 888             Output.Write_Str ("Creating new file """);
 889             Output.Write_Str (Path_Name (Directory_Last + 1 .. Path_Last));
 890             Output.Write_Line ("""");
 891          end if;
 892
 893          Output_FD := Create_New_File
 894            (Path_Name (Directory_Last + 1 .. Path_Last),
 895             Fmode => Text);
 896
 897          --  Fails if project file cannot be created
 898
 899          if Output_FD = Invalid_FD then
 900             Fail ("cannot create new """ & Path_Name (1 .. Path_Last) & '"');
 901          end if;
 902
 903          if Project_File then
 904
 905             --  Output the project file
 906
 907             Prj.PP.Pretty_Print
 908               (Project_Node,
 909                W_Char => Write_A_Char'Access,
 910                W_Eol  => Write_Eol'Access,
 911                W_Str  => Write_A_String'Access);
 912             Close (Output_FD);
 913
 914             --  Delete the naming project file if it already exists
 915
 916             Delete_File
 917               (Project_Naming_File_Name (1 .. Project_Naming_Last),
 918                Success => Discard);
 919
 920             --  Create a new one
 921
 922             if Opt.Verbose_Mode then
 923                Output.Write_Str ("Creating new naming project file """);
 924                Output.Write_Str (Project_Naming_File_Name
 925                                  (1 .. Project_Naming_Last));
 926                Output.Write_Line ("""");
 927             end if;
 928
 929             Output_FD := Create_New_File
 930               (Project_Naming_File_Name (1 .. Project_Naming_Last),
 931                Fmode => Text);
 932
 933             --  Fails if naming project file cannot be created
 934
 935             if Output_FD = Invalid_FD then
 936                Fail ("cannot create new """ &
 937                      Project_Naming_File_Name (1 .. Project_Naming_Last) &
 938                      '"');
 939             end if;
 940
 941             --  Output the naming project file
 942
 943             Prj.PP.Pretty_Print
 944               (Project_Naming_Node,
 945                W_Char => Write_A_Char'Access,
 946                W_Eol  => Write_Eol'Access,
 947                W_Str  => Write_A_String'Access);
 948             Close (Output_FD);
 949
 950          else
 951             --  Write to the output file each entry in the SFN_Pragmas table
 952             --  as an pragma Source_File_Name.
 953
 954             for Index in 1 .. SFN_Pragmas.Last loop
 955                Write_A_String ("pragma Source_File_Name");
 956                Write_Eol;
 957                Write_A_String ("  (");
 958                Write_A_String (SFN_Pragmas.Table (Index).Unit.all);
 959                Write_A_String (",");
 960                Write_Eol;
 961
 962                if SFN_Pragmas.Table (Index).Spec then
 963                   Write_A_String ("   Spec_File_Name => """);
 964
 965                else
 966                   Write_A_String ("   Body_File_Name => """);
 967                end if;
 968
 969                Write_A_String (SFN_Pragmas.Table (Index).File.all);
 970                Write_A_String (""");");
 971                Write_Eol;
 972             end loop;
 973
 974             Close (Output_FD);
 975          end if;
 976       end;
 977
 978    end Make;
 979
 980    ----------------
 981    -- Write_Char --
 982    ----------------
 983    procedure Write_A_Char (C : Character) is
 984    begin
 985       Write_A_String ((1 => C));
 986    end Write_A_Char;
 987
 988    ---------------
 989    -- Write_Eol --
 990    ---------------
 991
 992    procedure Write_Eol is
 993    begin
 994       Write_A_String ((1 => ASCII.LF));
 995    end Write_Eol;
 996
 997    --------------------
 998    -- Write_A_String --
 999    --------------------
1000
1001    procedure Write_A_String (S : String) is
1002       Str : String (1 .. S'Length);
1003
1004    begin
1005       if S'Length > 0 then
1006          Str := S;
1007
1008          if Write (Output_FD, Str (1)'Address, Str'Length) /= Str'Length then
1009             Fail ("disk full");
1010          end if;
1011       end if;
1012    end Write_A_String;
1013
1014 end Prj.Makr;