gcc/ada/gnatname.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --                             G N A T N A M E                              --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --          Copyright (C) 2001-2009, 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 3,  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 COPYING3.  If not, go to --
  19 -- http://www.gnu.org/licenses for a complete copy of the license.          --
  20 --                                                                          --
  21 -- GNAT was originally developed  by the GNAT team at  New York University. --
  22 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  23 --                                                                          --
  24 ------------------------------------------------------------------------------
  25
  26 with Ada.Command_Line;  use Ada.Command_Line;
  27 with Ada.Text_IO;       use Ada.Text_IO;
  28
  29 with GNAT.Dynamic_Tables;
  30 with GNAT.OS_Lib;       use GNAT.OS_Lib;
  31
  32 with Hostparm;
  33 with Opt;
  34 with Osint;    use Osint;
  35 with Output;   use Output;
  36 with Prj;      use Prj;
  37 with Prj.Makr;
  38 with Switch;   use Switch;
  39 with Table;
  40
  41 with System.Regexp; use System.Regexp;
  42
  43 procedure Gnatname is
  44
  45    Subdirs_Switch : constant String := "--subdirs=";
  46
  47    Usage_Output : Boolean := False;
  48    --  Set to True when usage is output, to avoid multiple output
  49
  50    Usage_Needed : Boolean := False;
  51    --  Set to True by -h switch
  52
  53    Version_Output : Boolean := False;
  54    --  Set to True when version is output, to avoid multiple output
  55
  56    Very_Verbose : Boolean := False;
  57    --  Set to True with -v -v
  58
  59    Create_Project : Boolean := False;
  60    --  Set to True with a -P switch
  61
  62    File_Path : String_Access := new String'("gnat.adc");
  63    --  Path name of the file specified by -c or -P switch
  64
  65    File_Set : Boolean := False;
  66    --  Set to True by -c or -P switch.
  67    --  Used to detect multiple -c/-P switches.
  68
  69    package Patterns is new GNAT.Dynamic_Tables
  70      (Table_Component_Type => String_Access,
  71       Table_Index_Type     => Natural,
  72       Table_Low_Bound      => 0,
  73       Table_Initial        => 10,
  74       Table_Increment      => 100);
  75    --  Table to accumulate the patterns
  76
  77    type Argument_Data is record
  78       Directories       : Patterns.Instance;
  79       Name_Patterns     : Patterns.Instance;
  80       Excluded_Patterns : Patterns.Instance;
  81       Foreign_Patterns  : Patterns.Instance;
  82    end record;
  83
  84    package Arguments is new Table.Table
  85      (Table_Component_Type => Argument_Data,
  86       Table_Index_Type     => Natural,
  87       Table_Low_Bound      => 0,
  88       Table_Initial        => 10,
  89       Table_Increment      => 100,
  90       Table_Name           => "Gnatname.Arguments");
  91    --  Table to accumulate the foreign patterns
  92
  93    package Preprocessor_Switches is new Table.Table
  94      (Table_Component_Type => String_Access,
  95       Table_Index_Type     => Natural,
  96       Table_Low_Bound      => 0,
  97       Table_Initial        => 10,
  98       Table_Increment      => 100,
  99       Table_Name           => "Gnatname.Preprocessor_Switches");
 100    --  Table to store the preprocessor switches to be used in the call
 101    --  to the compiler.
 102
 103    procedure Output_Version;
 104    --  Print name and version
 105
 106    procedure Usage;
 107    --  Print usage
 108
 109    procedure Scan_Args;
 110    --  Scan the command line arguments
 111
 112    procedure Add_Source_Directory (S : String);
 113    --  Add S in the Source_Directories table
 114
 115    procedure Get_Directories (From_File : String);
 116    --  Read a source directory text file
 117
 118    --------------------------
 119    -- Add_Source_Directory --
 120    --------------------------
 121
 122    procedure Add_Source_Directory (S : String) is
 123    begin
 124       Patterns.Append
 125         (Arguments.Table (Arguments.Last).Directories, new String'(S));
 126    end Add_Source_Directory;
 127
 128    ---------------------
 129    -- Get_Directories --
 130    ---------------------
 131
 132    procedure Get_Directories (From_File : String) is
 133       File : Ada.Text_IO.File_Type;
 134       Line : String (1 .. 2_000);
 135       Last : Natural;
 136
 137    begin
 138       Open (File, In_File, From_File);
 139
 140       while not End_Of_File (File) loop
 141          Get_Line (File, Line, Last);
 142
 143          if Last /= 0 then
 144             Add_Source_Directory (Line (1 .. Last));
 145          end if;
 146       end loop;
 147
 148       Close (File);
 149
 150    exception
 151       when Name_Error =>
 152          Fail ("cannot open source directory file """ & From_File & '"');
 153    end Get_Directories;
 154
 155    --------------------
 156    -- Output_Version --
 157    --------------------
 158
 159    procedure Output_Version is
 160    begin
 161       if not Version_Output then
 162          Version_Output := True;
 163          Output.Write_Eol;
 164          Display_Version ("GNATNAME", "2001");
 165       end if;
 166    end Output_Version;
 167
 168    ---------------
 169    -- Scan_Args --
 170    ---------------
 171
 172    procedure Scan_Args is
 173
 174       procedure Check_Version_And_Help is new Check_Version_And_Help_G (Usage);
 175
 176       Project_File_Name_Expected : Boolean;
 177
 178       Pragmas_File_Expected : Boolean;
 179
 180       Directory_Expected : Boolean;
 181
 182       Dir_File_Name_Expected : Boolean;
 183
 184       Foreign_Pattern_Expected : Boolean;
 185
 186       Excluded_Pattern_Expected : Boolean;
 187
 188       procedure Check_Regular_Expression (S : String);
 189       --  Compile string S into a Regexp, fail if any error
 190
 191       -----------------------------
 192       -- Check_Regular_Expression--
 193       -----------------------------
 194
 195       procedure Check_Regular_Expression (S : String) is
 196          Dummy : Regexp;
 197          pragma Warnings (Off, Dummy);
 198       begin
 199          Dummy := Compile (S, Glob => True);
 200       exception
 201          when Error_In_Regexp =>
 202             Fail ("invalid regular expression """ & S & """");
 203       end Check_Regular_Expression;
 204
 205    --  Start of processing for Scan_Args
 206
 207    begin
 208       --  First check for --version or --help
 209
 210       Check_Version_And_Help ("GNATNAME", "2001");
 211
 212       --  Now scan the other switches
 213
 214       Project_File_Name_Expected := False;
 215       Pragmas_File_Expected      := False;
 216       Directory_Expected         := False;
 217       Dir_File_Name_Expected     := False;
 218       Foreign_Pattern_Expected   := False;
 219       Excluded_Pattern_Expected  := False;
 220
 221       for Next_Arg in 1 .. Argument_Count loop
 222          declare
 223             Next_Argv : constant String := Argument (Next_Arg);
 224             Arg       : String (1 .. Next_Argv'Length) := Next_Argv;
 225
 226          begin
 227             if Arg'Length > 0 then
 228
 229                --  -P xxx
 230
 231                if Project_File_Name_Expected then
 232                   if Arg (1) = '-' then
 233                      Fail ("project file name missing");
 234
 235                   else
 236                      File_Set       := True;
 237                      File_Path      := new String'(Arg);
 238                      Project_File_Name_Expected := False;
 239                   end if;
 240
 241                --  -c file
 242
 243                elsif Pragmas_File_Expected then
 244                   File_Set := True;
 245                   File_Path := new String'(Arg);
 246                   Create_Project := False;
 247                   Pragmas_File_Expected := False;
 248
 249                --  -d xxx
 250
 251                elsif Directory_Expected then
 252                   Add_Source_Directory (Arg);
 253                   Directory_Expected := False;
 254
 255                --  -D xxx
 256
 257                elsif Dir_File_Name_Expected then
 258                   Get_Directories (Arg);
 259                   Dir_File_Name_Expected := False;
 260
 261                --  -f xxx
 262
 263                elsif Foreign_Pattern_Expected then
 264                   Patterns.Append
 265                     (Arguments.Table (Arguments.Last).Foreign_Patterns,
 266                      new String'(Arg));
 267                   Check_Regular_Expression (Arg);
 268                   Foreign_Pattern_Expected := False;
 269
 270                --  -x xxx
 271
 272                elsif Excluded_Pattern_Expected then
 273                   Patterns.Append
 274                     (Arguments.Table (Arguments.Last).Excluded_Patterns,
 275                      new String'(Arg));
 276                   Check_Regular_Expression (Arg);
 277                   Excluded_Pattern_Expected := False;
 278
 279                --  There must be at least one Ada pattern or one foreign
 280                --  pattern for the previous section.
 281
 282                --  --and
 283
 284                elsif Arg = "--and" then
 285
 286                   if Patterns.Last
 287                     (Arguments.Table (Arguments.Last).Name_Patterns) = 0
 288                     and then
 289                       Patterns.Last
 290                         (Arguments.Table (Arguments.Last).Foreign_Patterns) = 0
 291                   then
 292                      Usage;
 293                      return;
 294                   end if;
 295
 296                   --  If no directory were specified for the previous section,
 297                   --  then the directory is the project directory.
 298
 299                   if Patterns.Last
 300                     (Arguments.Table (Arguments.Last).Directories) = 0
 301                   then
 302                      Patterns.Append
 303                        (Arguments.Table (Arguments.Last).Directories,
 304                         new String'("."));
 305                   end if;
 306
 307                   --  Add and initialize another component to Arguments table
 308
 309                   Arguments.Increment_Last;
 310
 311                   Patterns.Init
 312                     (Arguments.Table (Arguments.Last).Directories);
 313                   Patterns.Set_Last
 314                     (Arguments.Table (Arguments.Last).Directories, 0);
 315                   Patterns.Init
 316                     (Arguments.Table (Arguments.Last).Name_Patterns);
 317                   Patterns.Set_Last
 318                     (Arguments.Table (Arguments.Last).Name_Patterns, 0);
 319                   Patterns.Init
 320                     (Arguments.Table (Arguments.Last).Excluded_Patterns);
 321                   Patterns.Set_Last
 322                     (Arguments.Table (Arguments.Last).Excluded_Patterns, 0);
 323                   Patterns.Init
 324                     (Arguments.Table (Arguments.Last).Foreign_Patterns);
 325                   Patterns.Set_Last
 326                     (Arguments.Table (Arguments.Last).Foreign_Patterns, 0);
 327
 328                --  Subdirectory switch
 329
 330                elsif Arg'Length > Subdirs_Switch'Length
 331                  and then Arg (1 .. Subdirs_Switch'Length) = Subdirs_Switch
 332                then
 333                   Subdirs :=
 334                     new String'(Arg (Subdirs_Switch'Length + 1 .. Arg'Last));
 335
 336                --  -c
 337
 338                elsif Arg'Length >= 2 and then Arg (1 .. 2) = "-c" then
 339                   if File_Set then
 340                      Fail ("only one -P or -c switch may be specified");
 341                   end if;
 342
 343                   if Arg'Length = 2 then
 344                      Pragmas_File_Expected := True;
 345
 346                      if Next_Arg = Argument_Count then
 347                         Fail ("configuration pragmas file name missing");
 348                      end if;
 349
 350                   else
 351                      File_Set := True;
 352                      File_Path := new String'(Arg (3 .. Arg'Last));
 353                      Create_Project := False;
 354                   end if;
 355
 356                --  -d
 357
 358                elsif Arg'Length >= 2 and then Arg (1 .. 2) = "-d" then
 359                   if Arg'Length = 2 then
 360                      Directory_Expected := True;
 361
 362                      if Next_Arg = Argument_Count then
 363                         Fail ("directory name missing");
 364                      end if;
 365
 366                   else
 367                      Add_Source_Directory (Arg (3 .. Arg'Last));
 368                   end if;
 369
 370                --  -D
 371
 372                elsif Arg'Length >= 2 and then Arg (1 .. 2) = "-D" then
 373                   if Arg'Length = 2 then
 374                      Dir_File_Name_Expected := True;
 375
 376                      if Next_Arg = Argument_Count then
 377                         Fail ("directory list file name missing");
 378                      end if;
 379
 380                   else
 381                      Get_Directories (Arg (3 .. Arg'Last));
 382                   end if;
 383
 384                --  -eL
 385
 386                elsif Arg = "-eL" then
 387                   Opt.Follow_Links_For_Files := True;
 388                   Opt.Follow_Links_For_Dirs  := True;
 389
 390                --  -f
 391
 392                elsif Arg'Length >= 2 and then Arg (1 .. 2) = "-f" then
 393                   if Arg'Length = 2 then
 394                      Foreign_Pattern_Expected := True;
 395
 396                      if Next_Arg = Argument_Count then
 397                         Fail ("foreign pattern missing");
 398                      end if;
 399
 400                   else
 401                      Patterns.Append
 402                        (Arguments.Table (Arguments.Last).Foreign_Patterns,
 403                         new String'(Arg (3 .. Arg'Last)));
 404                      Check_Regular_Expression (Arg (3 .. Arg'Last));
 405                   end if;
 406
 407                --  -gnatep or -gnateD
 408
 409                elsif Arg'Length > 7 and then
 410                  (Arg  (1 .. 7) = "-gnatep" or else Arg (1 .. 7) = "-gnateD")
 411                then
 412                   Preprocessor_Switches.Append (new String'(Arg));
 413
 414                --  -h
 415
 416                elsif Arg = "-h" then
 417                   Usage_Needed := True;
 418
 419                --  -p
 420
 421                elsif Arg'Length >= 2 and then Arg (1 .. 2) = "-P" then
 422                   if File_Set then
 423                      Fail ("only one -c or -P switch may be specified");
 424                   end if;
 425
 426                   if Arg'Length = 2 then
 427                      if Next_Arg = Argument_Count then
 428                         Fail ("project file name missing");
 429
 430                      else
 431                         Project_File_Name_Expected := True;
 432                      end if;
 433
 434                   else
 435                      File_Set       := True;
 436                      File_Path      := new String'(Arg (3 .. Arg'Last));
 437                   end if;
 438
 439                   Create_Project := True;
 440
 441                --  -v
 442
 443                elsif Arg = "-v" then
 444                   if Opt.Verbose_Mode then
 445                      Very_Verbose := True;
 446                   else
 447                      Opt.Verbose_Mode := True;
 448                   end if;
 449
 450                --  -x
 451
 452                elsif Arg'Length >= 2 and then Arg (1 .. 2) = "-x" then
 453                   if Arg'Length = 2 then
 454                      Excluded_Pattern_Expected := True;
 455
 456                      if Next_Arg = Argument_Count then
 457                         Fail ("excluded pattern missing");
 458                      end if;
 459
 460                   else
 461                      Patterns.Append
 462                        (Arguments.Table (Arguments.Last).Excluded_Patterns,
 463                         new String'(Arg (3 .. Arg'Last)));
 464                      Check_Regular_Expression (Arg (3 .. Arg'Last));
 465                   end if;
 466
 467                --  Junk switch starting with minus
 468
 469                elsif Arg (1) = '-' then
 470                   Fail ("wrong switch: " & Arg);
 471
 472                --  Not a recognized switch, assume file name
 473
 474                else
 475                   Canonical_Case_File_Name (Arg);
 476                   Patterns.Append
 477                     (Arguments.Table (Arguments.Last).Name_Patterns,
 478                      new String'(Arg));
 479                   Check_Regular_Expression (Arg);
 480                end if;
 481             end if;
 482          end;
 483       end loop;
 484    end Scan_Args;
 485
 486    -----------
 487    -- Usage --
 488    -----------
 489
 490    procedure Usage is
 491    begin
 492       if not Usage_Output then
 493          Usage_Needed := False;
 494          Usage_Output := True;
 495          Write_Str ("Usage: ");
 496          Osint.Write_Program_Name;
 497          Write_Line (" [switches] naming-pattern [naming-patterns]");
 498          Write_Line ("   {--and [switches] naming-pattern [naming-patterns]}");
 499          Write_Eol;
 500          Write_Line ("switches:");
 501
 502          Write_Line ("  --subdirs=dir real obj/lib/exec dirs are subdirs");
 503          Write_Eol;
 504
 505          Write_Line ("  --and        use different patterns");
 506          Write_Eol;
 507
 508          Write_Line ("  -cfile       create configuration pragmas file");
 509          Write_Line ("  -ddir        use dir as one of the source " &
 510                      "directories");
 511          Write_Line ("  -Dfile       get source directories from file");
 512          Write_Line ("  -eL          follow symbolic links when processing " &
 513                      "project files");
 514          Write_Line ("  -fpat        foreign pattern");
 515          Write_Line ("  -gnateDsym=v preprocess with symbol definition");
 516          Write_Line ("  -gnatep=data preprocess files with data file");
 517          Write_Line ("  -h           output this help message");
 518          Write_Line ("  -Pproj       update or create project file proj");
 519          Write_Line ("  -v           verbose output");
 520          Write_Line ("  -v -v        very verbose output");
 521          Write_Line ("  -xpat        exclude pattern pat");
 522       end if;
 523    end Usage;
 524
 525 --  Start of processing for Gnatname
 526
 527 begin
 528    --  Add the directory where gnatname is invoked in front of the
 529    --  path, if gnatname is invoked with directory information.
 530    --  Only do this if the platform is not VMS, where the notion of path
 531    --  does not really exist.
 532
 533    if not Hostparm.OpenVMS then
 534       declare
 535          Command : constant String := Command_Name;
 536
 537       begin
 538          for Index in reverse Command'Range loop
 539             if Command (Index) = Directory_Separator then
 540                declare
 541                   Absolute_Dir : constant String :=
 542                                    Normalize_Pathname
 543                                      (Command (Command'First .. Index));
 544
 545                   PATH         : constant String :=
 546                                    Absolute_Dir &
 547                                    Path_Separator &
 548                                    Getenv ("PATH").all;
 549
 550                begin
 551                   Setenv ("PATH", PATH);
 552                end;
 553
 554                exit;
 555             end if;
 556          end loop;
 557       end;
 558    end if;
 559
 560    --  Initialize tables
 561
 562    Arguments.Set_Last (0);
 563    Arguments.Increment_Last;
 564    Patterns.Init (Arguments.Table (1).Directories);
 565    Patterns.Set_Last (Arguments.Table (1).Directories, 0);
 566    Patterns.Init (Arguments.Table (1).Name_Patterns);
 567    Patterns.Set_Last (Arguments.Table (1).Name_Patterns, 0);
 568    Patterns.Init (Arguments.Table (1).Excluded_Patterns);
 569    Patterns.Set_Last (Arguments.Table (1).Excluded_Patterns, 0);
 570    Patterns.Init (Arguments.Table (1).Foreign_Patterns);
 571    Patterns.Set_Last (Arguments.Table (1).Foreign_Patterns, 0);
 572
 573    Preprocessor_Switches.Set_Last (0);
 574
 575    --  Get the arguments
 576
 577    Scan_Args;
 578
 579    if Opt.Verbose_Mode then
 580       Output_Version;
 581    end if;
 582
 583    if Usage_Needed then
 584       Usage;
 585    end if;
 586
 587    --  If no Ada or foreign pattern was specified, print the usage and return
 588
 589    if Patterns.Last (Arguments.Table (Arguments.Last).Name_Patterns) = 0
 590       and then
 591       Patterns.Last (Arguments.Table (Arguments.Last).Foreign_Patterns) = 0
 592    then
 593       Usage;
 594       return;
 595    end if;
 596
 597    --  If no source directory was specified, use the current directory as the
 598    --  unique directory. Note that if a file was specified with directory
 599    --  information, the current directory is the directory of the specified
 600    --  file.
 601
 602    if Patterns.Last
 603      (Arguments.Table (Arguments.Last).Directories) = 0
 604    then
 605       Patterns.Append
 606         (Arguments.Table (Arguments.Last).Directories, new String'("."));
 607    end if;
 608
 609    --  Initialize
 610
 611    declare
 612       Prep_Switches : Argument_List
 613                         (1 .. Integer (Preprocessor_Switches.Last));
 614
 615    begin
 616       for Index in Prep_Switches'Range loop
 617          Prep_Switches (Index) := Preprocessor_Switches.Table (Index);
 618       end loop;
 619
 620       Prj.Makr.Initialize
 621         (File_Path         => File_Path.all,
 622          Project_File      => Create_Project,
 623          Preproc_Switches  => Prep_Switches,
 624          Very_Verbose      => Very_Verbose,
 625          Flags             => Gnatmake_Flags);
 626    end;
 627
 628    --  Process each section successively
 629
 630    for J in 1 .. Arguments.Last loop
 631       declare
 632          Directories   : Argument_List
 633            (1 .. Integer
 634                    (Patterns.Last (Arguments.Table (J).Directories)));
 635          Name_Patterns : Prj.Makr.Regexp_List
 636            (1 .. Integer
 637                    (Patterns.Last (Arguments.Table (J).Name_Patterns)));
 638          Excl_Patterns : Prj.Makr.Regexp_List
 639            (1 .. Integer
 640                    (Patterns.Last (Arguments.Table (J).Excluded_Patterns)));
 641          Frgn_Patterns : Prj.Makr.Regexp_List
 642            (1 .. Integer
 643                    (Patterns.Last (Arguments.Table (J).Foreign_Patterns)));
 644
 645       begin
 646          --  Build the Directories and Patterns arguments
 647
 648          for Index in Directories'Range loop
 649             Directories (Index) :=
 650               Arguments.Table (J).Directories.Table (Index);
 651          end loop;
 652
 653          for Index in Name_Patterns'Range loop
 654             Name_Patterns (Index) :=
 655               Compile
 656                 (Arguments.Table (J).Name_Patterns.Table (Index).all,
 657                  Glob => True);
 658          end loop;
 659
 660          for Index in Excl_Patterns'Range loop
 661             Excl_Patterns (Index) :=
 662               Compile
 663                 (Arguments.Table (J).Excluded_Patterns.Table (Index).all,
 664                  Glob => True);
 665          end loop;
 666
 667          for Index in Frgn_Patterns'Range loop
 668             Frgn_Patterns (Index) :=
 669               Compile
 670                 (Arguments.Table (J).Foreign_Patterns.Table (Index).all,
 671                  Glob => True);
 672          end loop;
 673
 674          --  Call Prj.Makr.Process where the real work is done
 675
 676          Prj.Makr.Process
 677            (Directories       => Directories,
 678             Name_Patterns     => Name_Patterns,
 679             Excluded_Patterns => Excl_Patterns,
 680             Foreign_Patterns  => Frgn_Patterns);
 681       end;
 682    end loop;
 683
 684    --  Finalize
 685
 686    Prj.Makr.Finalize;
 687
 688    if Opt.Verbose_Mode then
 689       Write_Eol;
 690    end if;
 691 end Gnatname;