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-2008, 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
 389                --  -f
 390
 391                elsif Arg'Length >= 2 and then Arg (1 .. 2) = "-f" then
 392                   if Arg'Length = 2 then
 393                      Foreign_Pattern_Expected := True;
 394
 395                      if Next_Arg = Argument_Count then
 396                         Fail ("foreign pattern missing");
 397                      end if;
 398
 399                   else
 400                      Patterns.Append
 401                        (Arguments.Table (Arguments.Last).Foreign_Patterns,
 402                         new String'(Arg (3 .. Arg'Last)));
 403                      Check_Regular_Expression (Arg (3 .. Arg'Last));
 404                   end if;
 405
 406                --  -gnatep or -gnateD
 407
 408                elsif Arg'Length > 7 and then
 409                  (Arg  (1 .. 7) = "-gnatep" or else Arg (1 .. 7) = "-gnateD")
 410                then
 411                   Preprocessor_Switches.Append (new String'(Arg));
 412
 413                --  -h
 414
 415                elsif Arg = "-h" then
 416                   Usage_Needed := True;
 417
 418                --  -p
 419
 420                elsif Arg'Length >= 2 and then Arg (1 .. 2) = "-P" then
 421                   if File_Set then
 422                      Fail ("only one -c or -P switch may be specified");
 423                   end if;
 424
 425                   if Arg'Length = 2 then
 426                      if Next_Arg = Argument_Count then
 427                         Fail ("project file name missing");
 428
 429                      else
 430                         Project_File_Name_Expected := True;
 431                      end if;
 432
 433                   else
 434                      File_Set       := True;
 435                      File_Path      := new String'(Arg (3 .. Arg'Last));
 436                   end if;
 437
 438                   Create_Project := True;
 439
 440                --  -v
 441
 442                elsif Arg = "-v" then
 443                   if Opt.Verbose_Mode then
 444                      Very_Verbose := True;
 445                   else
 446                      Opt.Verbose_Mode := True;
 447                   end if;
 448
 449                --  -x
 450
 451                elsif Arg'Length >= 2 and then Arg (1 .. 2) = "-x" then
 452                   if Arg'Length = 2 then
 453                      Excluded_Pattern_Expected := True;
 454
 455                      if Next_Arg = Argument_Count then
 456                         Fail ("excluded pattern missing");
 457                      end if;
 458
 459                   else
 460                      Patterns.Append
 461                        (Arguments.Table (Arguments.Last).Excluded_Patterns,
 462                         new String'(Arg (3 .. Arg'Last)));
 463                      Check_Regular_Expression (Arg (3 .. Arg'Last));
 464                   end if;
 465
 466                --  Junk switch starting with minus
 467
 468                elsif Arg (1) = '-' then
 469                   Fail ("wrong switch: " & Arg);
 470
 471                --  Not a recognized switch, assume file name
 472
 473                else
 474                   Canonical_Case_File_Name (Arg);
 475                   Patterns.Append
 476                     (Arguments.Table (Arguments.Last).Name_Patterns,
 477                      new String'(Arg));
 478                   Check_Regular_Expression (Arg);
 479                end if;
 480             end if;
 481          end;
 482       end loop;
 483    end Scan_Args;
 484
 485    -----------
 486    -- Usage --
 487    -----------
 488
 489    procedure Usage is
 490    begin
 491       if not Usage_Output then
 492          Usage_Needed := False;
 493          Usage_Output := True;
 494          Write_Str ("Usage: ");
 495          Osint.Write_Program_Name;
 496          Write_Line (" [switches] naming-pattern [naming-patterns]");
 497          Write_Line ("   {--and [switches] naming-pattern [naming-patterns]}");
 498          Write_Eol;
 499          Write_Line ("switches:");
 500
 501          Write_Line ("  --subdirs=dir real obj/lib/exec dirs are subdirs");
 502          Write_Eol;
 503
 504          Write_Line ("  --and        use different patterns");
 505          Write_Eol;
 506
 507          Write_Line ("  -cfile       create configuration pragmas file");
 508          Write_Line ("  -ddir        use dir as one of the source " &
 509                      "directories");
 510          Write_Line ("  -Dfile       get source directories from file");
 511          Write_Line ("  -eL          follow symbolic links when processing " &
 512                      "project files");
 513          Write_Line ("  -fpat        foreign pattern");
 514          Write_Line ("  -gnateDsym=v preprocess with symbol definition");
 515          Write_Line ("  -gnatep=data preprocess files with data file");
 516          Write_Line ("  -h           output this help message");
 517          Write_Line ("  -Pproj       update or create project file proj");
 518          Write_Line ("  -v           verbose output");
 519          Write_Line ("  -v -v        very verbose output");
 520          Write_Line ("  -xpat        exclude pattern pat");
 521       end if;
 522    end Usage;
 523
 524 --  Start of processing for Gnatname
 525
 526 begin
 527    Prj.Set_Mode (Prj.Ada_Only);
 528
 529    --  Add the directory where gnatname is invoked in front of the
 530    --  path, if gnatname is invoked with directory information.
 531    --  Only do this if the platform is not VMS, where the notion of path
 532    --  does not really exist.
 533
 534    if not Hostparm.OpenVMS then
 535       declare
 536          Command : constant String := Command_Name;
 537
 538       begin
 539          for Index in reverse Command'Range loop
 540             if Command (Index) = Directory_Separator then
 541                declare
 542                   Absolute_Dir : constant String :=
 543                                    Normalize_Pathname
 544                                      (Command (Command'First .. Index));
 545
 546                   PATH         : constant String :=
 547                                    Absolute_Dir &
 548                                    Path_Separator &
 549                                    Getenv ("PATH").all;
 550
 551                begin
 552                   Setenv ("PATH", PATH);
 553                end;
 554
 555                exit;
 556             end if;
 557          end loop;
 558       end;
 559    end if;
 560
 561    --  Initialize tables
 562
 563    Arguments.Set_Last (0);
 564    Arguments.Increment_Last;
 565    Patterns.Init (Arguments.Table (1).Directories);
 566    Patterns.Set_Last (Arguments.Table (1).Directories, 0);
 567    Patterns.Init (Arguments.Table (1).Name_Patterns);
 568    Patterns.Set_Last (Arguments.Table (1).Name_Patterns, 0);
 569    Patterns.Init (Arguments.Table (1).Excluded_Patterns);
 570    Patterns.Set_Last (Arguments.Table (1).Excluded_Patterns, 0);
 571    Patterns.Init (Arguments.Table (1).Foreign_Patterns);
 572    Patterns.Set_Last (Arguments.Table (1).Foreign_Patterns, 0);
 573
 574    Preprocessor_Switches.Set_Last (0);
 575
 576    --  Get the arguments
 577
 578    Scan_Args;
 579
 580    if Opt.Verbose_Mode then
 581       Output_Version;
 582    end if;
 583
 584    if Usage_Needed then
 585       Usage;
 586    end if;
 587
 588    --  If no Ada or foreign pattern was specified, print the usage and return
 589
 590    if Patterns.Last (Arguments.Table (Arguments.Last).Name_Patterns) = 0
 591       and then
 592       Patterns.Last (Arguments.Table (Arguments.Last).Foreign_Patterns) = 0
 593    then
 594       Usage;
 595       return;
 596    end if;
 597
 598    --  If no source directory was specified, use the current directory as the
 599    --  unique directory. Note that if a file was specified with directory
 600    --  information, the current directory is the directory of the specified
 601    --  file.
 602
 603    if Patterns.Last
 604      (Arguments.Table (Arguments.Last).Directories) = 0
 605    then
 606       Patterns.Append
 607         (Arguments.Table (Arguments.Last).Directories, new String'("."));
 608    end if;
 609
 610    --  Initialize
 611
 612    declare
 613       Prep_Switches : Argument_List
 614                         (1 .. Integer (Preprocessor_Switches.Last));
 615
 616    begin
 617       for Index in Prep_Switches'Range loop
 618          Prep_Switches (Index) := Preprocessor_Switches.Table (Index);
 619       end loop;
 620
 621       Prj.Makr.Initialize
 622         (File_Path         => File_Path.all,
 623          Project_File      => Create_Project,
 624          Preproc_Switches  => Prep_Switches,
 625          Very_Verbose      => Very_Verbose);
 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;