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-2012, 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                   declare
 310                      New_Arguments : Argument_Data;
 311                      pragma Warnings (Off, New_Arguments);
 312                      --  Declaring this defaulted initialized object ensures
 313                      --  that the new allocated component of table Arguments
 314                      --  is correctly initialized.
 315
 316                      --  This is VERY ugly, Table should never be used with
 317                      --  data requiring default initialization. We should
 318                      --  find a way to avoid violating this rule ???
 319
 320                   begin
 321                      Arguments.Append (New_Arguments);
 322                   end;
 323
 324                   Patterns.Init
 325                     (Arguments.Table (Arguments.Last).Directories);
 326                   Patterns.Set_Last
 327                     (Arguments.Table (Arguments.Last).Directories, 0);
 328                   Patterns.Init
 329                     (Arguments.Table (Arguments.Last).Name_Patterns);
 330                   Patterns.Set_Last
 331                     (Arguments.Table (Arguments.Last).Name_Patterns, 0);
 332                   Patterns.Init
 333                     (Arguments.Table (Arguments.Last).Excluded_Patterns);
 334                   Patterns.Set_Last
 335                     (Arguments.Table (Arguments.Last).Excluded_Patterns, 0);
 336                   Patterns.Init
 337                     (Arguments.Table (Arguments.Last).Foreign_Patterns);
 338                   Patterns.Set_Last
 339                     (Arguments.Table (Arguments.Last).Foreign_Patterns, 0);
 340
 341                --  Subdirectory switch
 342
 343                elsif Arg'Length > Subdirs_Switch'Length
 344                  and then Arg (1 .. Subdirs_Switch'Length) = Subdirs_Switch
 345                then
 346                   Subdirs :=
 347                     new String'(Arg (Subdirs_Switch'Length + 1 .. Arg'Last));
 348
 349                --  -c
 350
 351                elsif Arg'Length >= 2 and then Arg (1 .. 2) = "-c" then
 352                   if File_Set then
 353                      Fail ("only one -P or -c switch may be specified");
 354                   end if;
 355
 356                   if Arg'Length = 2 then
 357                      Pragmas_File_Expected := True;
 358
 359                      if Next_Arg = Argument_Count then
 360                         Fail ("configuration pragmas file name missing");
 361                      end if;
 362
 363                   else
 364                      File_Set := True;
 365                      File_Path := new String'(Arg (3 .. Arg'Last));
 366                      Create_Project := False;
 367                   end if;
 368
 369                --  -d
 370
 371                elsif Arg'Length >= 2 and then Arg (1 .. 2) = "-d" then
 372                   if Arg'Length = 2 then
 373                      Directory_Expected := True;
 374
 375                      if Next_Arg = Argument_Count then
 376                         Fail ("directory name missing");
 377                      end if;
 378
 379                   else
 380                      Add_Source_Directory (Arg (3 .. Arg'Last));
 381                   end if;
 382
 383                --  -D
 384
 385                elsif Arg'Length >= 2 and then Arg (1 .. 2) = "-D" then
 386                   if Arg'Length = 2 then
 387                      Dir_File_Name_Expected := True;
 388
 389                      if Next_Arg = Argument_Count then
 390                         Fail ("directory list file name missing");
 391                      end if;
 392
 393                   else
 394                      Get_Directories (Arg (3 .. Arg'Last));
 395                   end if;
 396
 397                --  -eL
 398
 399                elsif Arg = "-eL" then
 400                   Opt.Follow_Links_For_Files := True;
 401                   Opt.Follow_Links_For_Dirs  := True;
 402
 403                --  -f
 404
 405                elsif Arg'Length >= 2 and then Arg (1 .. 2) = "-f" then
 406                   if Arg'Length = 2 then
 407                      Foreign_Pattern_Expected := True;
 408
 409                      if Next_Arg = Argument_Count then
 410                         Fail ("foreign pattern missing");
 411                      end if;
 412
 413                   else
 414                      Patterns.Append
 415                        (Arguments.Table (Arguments.Last).Foreign_Patterns,
 416                         new String'(Arg (3 .. Arg'Last)));
 417                      Check_Regular_Expression (Arg (3 .. Arg'Last));
 418                   end if;
 419
 420                --  -gnatep or -gnateD
 421
 422                elsif Arg'Length > 7 and then
 423                  (Arg  (1 .. 7) = "-gnatep" or else Arg (1 .. 7) = "-gnateD")
 424                then
 425                   Preprocessor_Switches.Append (new String'(Arg));
 426
 427                --  -h
 428
 429                elsif Arg = "-h" then
 430                   Usage_Needed := True;
 431
 432                --  -p
 433
 434                elsif Arg'Length >= 2 and then Arg (1 .. 2) = "-P" then
 435                   if File_Set then
 436                      Fail ("only one -c or -P switch may be specified");
 437                   end if;
 438
 439                   if Arg'Length = 2 then
 440                      if Next_Arg = Argument_Count then
 441                         Fail ("project file name missing");
 442
 443                      else
 444                         Project_File_Name_Expected := True;
 445                      end if;
 446
 447                   else
 448                      File_Set       := True;
 449                      File_Path      := new String'(Arg (3 .. Arg'Last));
 450                   end if;
 451
 452                   Create_Project := True;
 453
 454                --  -v
 455
 456                elsif Arg = "-v" then
 457                   if Opt.Verbose_Mode then
 458                      Very_Verbose := True;
 459                   else
 460                      Opt.Verbose_Mode := True;
 461                   end if;
 462
 463                --  -x
 464
 465                elsif Arg'Length >= 2 and then Arg (1 .. 2) = "-x" then
 466                   if Arg'Length = 2 then
 467                      Excluded_Pattern_Expected := True;
 468
 469                      if Next_Arg = Argument_Count then
 470                         Fail ("excluded pattern missing");
 471                      end if;
 472
 473                   else
 474                      Patterns.Append
 475                        (Arguments.Table (Arguments.Last).Excluded_Patterns,
 476                         new String'(Arg (3 .. Arg'Last)));
 477                      Check_Regular_Expression (Arg (3 .. Arg'Last));
 478                   end if;
 479
 480                --  Junk switch starting with minus
 481
 482                elsif Arg (1) = '-' then
 483                   Fail ("wrong switch: " & Arg);
 484
 485                --  Not a recognized switch, assume file name
 486
 487                else
 488                   Canonical_Case_File_Name (Arg);
 489                   Patterns.Append
 490                     (Arguments.Table (Arguments.Last).Name_Patterns,
 491                      new String'(Arg));
 492                   Check_Regular_Expression (Arg);
 493                end if;
 494             end if;
 495          end;
 496       end loop;
 497    end Scan_Args;
 498
 499    -----------
 500    -- Usage --
 501    -----------
 502
 503    procedure Usage is
 504    begin
 505       if not Usage_Output then
 506          Usage_Needed := False;
 507          Usage_Output := True;
 508          Write_Str ("Usage: ");
 509          Osint.Write_Program_Name;
 510          Write_Line (" [switches] naming-pattern [naming-patterns]");
 511          Write_Line ("   {--and [switches] naming-pattern [naming-patterns]}");
 512          Write_Eol;
 513          Write_Line ("switches:");
 514
 515          Display_Usage_Version_And_Help;
 516
 517          Write_Line ("  --subdirs=dir real obj/lib/exec dirs are subdirs");
 518          Write_Eol;
 519
 520          Write_Line ("  --and        use different patterns");
 521          Write_Eol;
 522
 523          Write_Line ("  -cfile       create configuration pragmas file");
 524          Write_Line ("  -ddir        use dir as one of the source " &
 525                      "directories");
 526          Write_Line ("  -Dfile       get source directories from file");
 527          Write_Line ("  -eL          follow symbolic links when processing " &
 528                      "project files");
 529          Write_Line ("  -fpat        foreign pattern");
 530          Write_Line ("  -gnateDsym=v preprocess with symbol definition");
 531          Write_Line ("  -gnatep=data preprocess files with data file");
 532          Write_Line ("  -h           output this help message");
 533          Write_Line ("  -Pproj       update or create project file proj");
 534          Write_Line ("  -v           verbose output");
 535          Write_Line ("  -v -v        very verbose output");
 536          Write_Line ("  -xpat        exclude pattern pat");
 537       end if;
 538    end Usage;
 539
 540 --  Start of processing for Gnatname
 541
 542 begin
 543    --  Add the directory where gnatname is invoked in front of the
 544    --  path, if gnatname is invoked with directory information.
 545    --  Only do this if the platform is not VMS, where the notion of path
 546    --  does not really exist.
 547
 548    if not Hostparm.OpenVMS then
 549       declare
 550          Command : constant String := Command_Name;
 551
 552       begin
 553          for Index in reverse Command'Range loop
 554             if Command (Index) = Directory_Separator then
 555                declare
 556                   Absolute_Dir : constant String :=
 557                                    Normalize_Pathname
 558                                      (Command (Command'First .. Index));
 559
 560                   PATH         : constant String :=
 561                                    Absolute_Dir &
 562                                    Path_Separator &
 563                                    Getenv ("PATH").all;
 564
 565                begin
 566                   Setenv ("PATH", PATH);
 567                end;
 568
 569                exit;
 570             end if;
 571          end loop;
 572       end;
 573    end if;
 574
 575    --  Initialize tables
 576
 577    Arguments.Set_Last (0);
 578    declare
 579       New_Arguments : Argument_Data;
 580       pragma Warnings (Off, New_Arguments);
 581       --  Declaring this defaulted initialized object ensures
 582       --  that the new allocated component of table Arguments
 583       --  is correctly initialized.
 584    begin
 585       Arguments.Append (New_Arguments);
 586    end;
 587    Patterns.Init (Arguments.Table (1).Directories);
 588    Patterns.Set_Last (Arguments.Table (1).Directories, 0);
 589    Patterns.Init (Arguments.Table (1).Name_Patterns);
 590    Patterns.Set_Last (Arguments.Table (1).Name_Patterns, 0);
 591    Patterns.Init (Arguments.Table (1).Excluded_Patterns);
 592    Patterns.Set_Last (Arguments.Table (1).Excluded_Patterns, 0);
 593    Patterns.Init (Arguments.Table (1).Foreign_Patterns);
 594    Patterns.Set_Last (Arguments.Table (1).Foreign_Patterns, 0);
 595
 596    Preprocessor_Switches.Set_Last (0);
 597
 598    --  Get the arguments
 599
 600    Scan_Args;
 601
 602    if Opt.Verbose_Mode then
 603       Output_Version;
 604    end if;
 605
 606    if Usage_Needed then
 607       Usage;
 608    end if;
 609
 610    --  If no Ada or foreign pattern was specified, print the usage and return
 611
 612    if Patterns.Last (Arguments.Table (Arguments.Last).Name_Patterns) = 0
 613       and then
 614       Patterns.Last (Arguments.Table (Arguments.Last).Foreign_Patterns) = 0
 615    then
 616       Usage;
 617       return;
 618    end if;
 619
 620    --  If no source directory was specified, use the current directory as the
 621    --  unique directory. Note that if a file was specified with directory
 622    --  information, the current directory is the directory of the specified
 623    --  file.
 624
 625    if Patterns.Last
 626      (Arguments.Table (Arguments.Last).Directories) = 0
 627    then
 628       Patterns.Append
 629         (Arguments.Table (Arguments.Last).Directories, new String'("."));
 630    end if;
 631
 632    --  Initialize
 633
 634    declare
 635       Prep_Switches : Argument_List
 636                         (1 .. Integer (Preprocessor_Switches.Last));
 637
 638    begin
 639       for Index in Prep_Switches'Range loop
 640          Prep_Switches (Index) := Preprocessor_Switches.Table (Index);
 641       end loop;
 642
 643       Prj.Makr.Initialize
 644         (File_Path         => File_Path.all,
 645          Project_File      => Create_Project,
 646          Preproc_Switches  => Prep_Switches,
 647          Very_Verbose      => Very_Verbose,
 648          Flags             => Gnatmake_Flags);
 649    end;
 650
 651    --  Process each section successively
 652
 653    for J in 1 .. Arguments.Last loop
 654       declare
 655          Directories   : Argument_List
 656            (1 .. Integer
 657                    (Patterns.Last (Arguments.Table (J).Directories)));
 658          Name_Patterns : Prj.Makr.Regexp_List
 659            (1 .. Integer
 660                    (Patterns.Last (Arguments.Table (J).Name_Patterns)));
 661          Excl_Patterns : Prj.Makr.Regexp_List
 662            (1 .. Integer
 663                    (Patterns.Last (Arguments.Table (J).Excluded_Patterns)));
 664          Frgn_Patterns : Prj.Makr.Regexp_List
 665            (1 .. Integer
 666                    (Patterns.Last (Arguments.Table (J).Foreign_Patterns)));
 667
 668       begin
 669          --  Build the Directories and Patterns arguments
 670
 671          for Index in Directories'Range loop
 672             Directories (Index) :=
 673               Arguments.Table (J).Directories.Table (Index);
 674          end loop;
 675
 676          for Index in Name_Patterns'Range loop
 677             Name_Patterns (Index) :=
 678               Compile
 679                 (Arguments.Table (J).Name_Patterns.Table (Index).all,
 680                  Glob => True);
 681          end loop;
 682
 683          for Index in Excl_Patterns'Range loop
 684             Excl_Patterns (Index) :=
 685               Compile
 686                 (Arguments.Table (J).Excluded_Patterns.Table (Index).all,
 687                  Glob => True);
 688          end loop;
 689
 690          for Index in Frgn_Patterns'Range loop
 691             Frgn_Patterns (Index) :=
 692               Compile
 693                 (Arguments.Table (J).Foreign_Patterns.Table (Index).all,
 694                  Glob => True);
 695          end loop;
 696
 697          --  Call Prj.Makr.Process where the real work is done
 698
 699          Prj.Makr.Process
 700            (Directories       => Directories,
 701             Name_Patterns     => Name_Patterns,
 702             Excluded_Patterns => Excl_Patterns,
 703             Foreign_Patterns  => Frgn_Patterns);
 704       end;
 705    end loop;
 706
 707    --  Finalize
 708
 709    Prj.Makr.Finalize;
 710
 711    if Opt.Verbose_Mode then
 712       Write_Eol;
 713    end if;
 714 end Gnatname;