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