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