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