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-2007, 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 Hostparm;
  27 with Opt;
  28 with Osint;    use Osint;
  29 with Output;   use Output;
  30 with Prj.Makr;
  31 with Switch;   use Switch;
  32 with Table;
  33
  34 with Ada.Command_Line;  use Ada.Command_Line;
  35 with Ada.Text_IO;       use Ada.Text_IO;
  36 with GNAT.Command_Line; use GNAT.Command_Line;
  37 with GNAT.OS_Lib;       use GNAT.OS_Lib;
  38
  39 procedure Gnatname is
  40
  41    Usage_Output : Boolean := False;
  42    --  Set to True when usage is output, to avoid multiple output
  43
  44    Usage_Needed : Boolean := False;
  45    --  Set to True by -h switch
  46
  47    Version_Output : Boolean := False;
  48    --  Set to True when version is output, to avoid multiple output
  49
  50    Very_Verbose : Boolean := False;
  51    --  Set to True with -v -v
  52
  53    Create_Project : Boolean := False;
  54    --  Set to True with a -P switch
  55
  56    File_Path : String_Access := new String'("gnat.adc");
  57    --  Path name of the file specified by -c or -P switch
  58
  59    File_Set : Boolean := False;
  60    --  Set to True by -c or -P switch.
  61    --  Used to detect multiple -c/-P switches.
  62
  63    package Excluded_Patterns is new Table.Table
  64      (Table_Component_Type => String_Access,
  65       Table_Index_Type     => Natural,
  66       Table_Low_Bound      => 0,
  67       Table_Initial        => 10,
  68       Table_Increment      => 100,
  69       Table_Name           => "Gnatname.Excluded_Patterns");
  70    --  Table to accumulate the negative patterns
  71
  72    package Foreign_Patterns is new Table.Table
  73      (Table_Component_Type => String_Access,
  74       Table_Index_Type     => Natural,
  75       Table_Low_Bound      => 0,
  76       Table_Initial        => 10,
  77       Table_Increment      => 100,
  78       Table_Name           => "Gnatname.Foreign_Patterns");
  79    --  Table to accumulate the foreign patterns
  80
  81    package Patterns is new Table.Table
  82      (Table_Component_Type => String_Access,
  83       Table_Index_Type     => Natural,
  84       Table_Low_Bound      => 0,
  85       Table_Initial        => 10,
  86       Table_Increment      => 100,
  87       Table_Name           => "Gnatname.Patterns");
  88    --  Table to accumulate the name patterns
  89
  90    package Source_Directories is new Table.Table
  91      (Table_Component_Type => String_Access,
  92       Table_Index_Type     => Natural,
  93       Table_Low_Bound      => 0,
  94       Table_Initial        => 10,
  95       Table_Increment      => 100,
  96       Table_Name           => "Gnatname.Source_Directories");
  97    --  Table to accumulate the source directories specified directly with -d
  98    --  or indirectly with -D.
  99
 100    package Preprocessor_Switches is new Table.Table
 101      (Table_Component_Type => String_Access,
 102       Table_Index_Type     => Natural,
 103       Table_Low_Bound      => 0,
 104       Table_Initial        => 10,
 105       Table_Increment      => 100,
 106       Table_Name           => "Gnatname.Preprocessor_Switches");
 107    --  Table to store the preprocessor switches to be used in the call
 108    --  to the compiler.
 109
 110    procedure Output_Version;
 111    --  Print name and version
 112
 113    procedure Usage;
 114    --  Print usage
 115
 116    procedure Scan_Args;
 117    --  Scan the command line arguments
 118
 119    procedure Add_Source_Directory (S : String);
 120    --  Add S in the Source_Directories table
 121
 122    procedure Get_Directories (From_File : String);
 123    --  Read a source directory text file
 124
 125    --------------------------
 126    -- Add_Source_Directory --
 127    --------------------------
 128
 129    procedure Add_Source_Directory (S : String) is
 130    begin
 131       Source_Directories.Increment_Last;
 132       Source_Directories.Table (Source_Directories.Last) := new String'(S);
 133    end Add_Source_Directory;
 134
 135    ---------------------
 136    -- Get_Directories --
 137    ---------------------
 138
 139    procedure Get_Directories (From_File : String) is
 140       File : Ada.Text_IO.File_Type;
 141       Line : String (1 .. 2_000);
 142       Last : Natural;
 143
 144    begin
 145       Open (File, In_File, From_File);
 146
 147       while not End_Of_File (File) loop
 148          Get_Line (File, Line, Last);
 149
 150          if Last /= 0 then
 151             Add_Source_Directory (Line (1 .. Last));
 152          end if;
 153       end loop;
 154
 155       Close (File);
 156
 157    exception
 158       when Name_Error =>
 159          Fail ("cannot open source directory """ & From_File & '"');
 160    end Get_Directories;
 161
 162    --------------------
 163    -- Output_Version --
 164    --------------------
 165
 166    procedure Output_Version is
 167    begin
 168       if not Version_Output then
 169          Version_Output := True;
 170          Output.Write_Eol;
 171          Display_Version ("GNATNAME", "2001");
 172       end if;
 173    end Output_Version;
 174
 175    ---------------
 176    -- Scan_Args --
 177    ---------------
 178
 179    procedure Scan_Args is
 180
 181       procedure Check_Version_And_Help is new Check_Version_And_Help_G (Usage);
 182
 183       --  Start of processing for Scan_Args
 184
 185    begin
 186       --  First check for --version or --help
 187
 188       Check_Version_And_Help ("GNATNAME", "2001");
 189
 190       --  Now scan the other switches
 191
 192       Initialize_Option_Scan;
 193
 194       --  Scan options first
 195
 196       loop
 197          case Getopt ("c: d: gnatep=! gnatep! gnateD! D: h P: v x: f:") is
 198             when ASCII.NUL =>
 199                exit;
 200
 201             when 'c' =>
 202                if File_Set then
 203                   Fail ("only one -P or -c switch may be specified");
 204                end if;
 205
 206                File_Set := True;
 207                File_Path := new String'(Parameter);
 208                Create_Project := False;
 209
 210             when 'd' =>
 211                Add_Source_Directory (Parameter);
 212
 213             when 'D' =>
 214                Get_Directories (Parameter);
 215
 216             when 'f' =>
 217                Foreign_Patterns.Increment_Last;
 218                Foreign_Patterns.Table (Foreign_Patterns.Last) :=
 219                  new String'(Parameter);
 220
 221             when 'g' =>
 222                Preprocessor_Switches.Increment_Last;
 223                Preprocessor_Switches.Table (Preprocessor_Switches.Last) :=
 224                  new String'('-' & Full_Switch & Parameter);
 225
 226             when 'h' =>
 227                Usage_Needed := True;
 228
 229             when 'P' =>
 230                if File_Set then
 231                   Fail ("only one -c or -P switch may be specified");
 232                end if;
 233
 234                File_Set       := True;
 235                File_Path      := new String'(Parameter);
 236                Create_Project := True;
 237
 238             when 'v' =>
 239                if Opt.Verbose_Mode then
 240                   Very_Verbose := True;
 241                else
 242                   Opt.Verbose_Mode := True;
 243                end if;
 244
 245             when 'x' =>
 246                Excluded_Patterns.Increment_Last;
 247                Excluded_Patterns.Table (Excluded_Patterns.Last) :=
 248                  new String'(Parameter);
 249
 250             when others =>
 251                null;
 252          end case;
 253       end loop;
 254
 255       --  Now, get the name patterns, if any
 256
 257       loop
 258          declare
 259             S : String := Get_Argument (Do_Expansion => False);
 260
 261          begin
 262             exit when S = "";
 263             Canonical_Case_File_Name (S);
 264             Patterns.Increment_Last;
 265             Patterns.Table (Patterns.Last) := new String'(S);
 266          end;
 267       end loop;
 268
 269    exception
 270       when Invalid_Switch =>
 271          Fail ("invalid switch " & Full_Switch);
 272    end Scan_Args;
 273
 274    -----------
 275    -- Usage --
 276    -----------
 277
 278    procedure Usage is
 279    begin
 280       if not Usage_Output then
 281          Usage_Needed := False;
 282          Usage_Output := True;
 283          Write_Str ("Usage: ");
 284          Osint.Write_Program_Name;
 285          Write_Line (" [switches] naming-pattern [naming-patterns]");
 286          Write_Eol;
 287          Write_Line ("switches:");
 288
 289          Write_Line ("  -cfile       create configuration pragmas file");
 290          Write_Line ("  -ddir        use dir as one of the source " &
 291                      "directories");
 292          Write_Line ("  -Dfile       get source directories from file");
 293          Write_Line ("  -fpat        foreign pattern");
 294          Write_Line ("  -gnateDsym=v preprocess with symbol definition");
 295          Write_Line ("  -gnatep=data preprocess files with data file");
 296          Write_Line ("  -h           output this help message");
 297          Write_Line ("  -Pproj       update or create project file proj");
 298          Write_Line ("  -v           verbose output");
 299          Write_Line ("  -v -v        very verbose output");
 300          Write_Line ("  -xpat        exclude pattern pat");
 301       end if;
 302    end Usage;
 303
 304 --  Start of processing for Gnatname
 305
 306 begin
 307    Prj.Set_Mode (Prj.Ada_Only);
 308
 309    --  Add the directory where gnatname is invoked in front of the
 310    --  path, if gnatname is invoked with directory information.
 311    --  Only do this if the platform is not VMS, where the notion of path
 312    --  does not really exist.
 313
 314    if not Hostparm.OpenVMS then
 315       declare
 316          Command : constant String := Command_Name;
 317
 318       begin
 319          for Index in reverse Command'Range loop
 320             if Command (Index) = Directory_Separator then
 321                declare
 322                   Absolute_Dir : constant String :=
 323                                    Normalize_Pathname
 324                                      (Command (Command'First .. Index));
 325
 326                   PATH         : constant String :=
 327                                    Absolute_Dir &
 328                   Path_Separator &
 329                   Getenv ("PATH").all;
 330
 331                begin
 332                   Setenv ("PATH", PATH);
 333                end;
 334
 335                exit;
 336             end if;
 337          end loop;
 338       end;
 339    end if;
 340
 341    --  Initialize tables
 342
 343    Excluded_Patterns.Set_Last (0);
 344    Foreign_Patterns.Set_Last (0);
 345    Patterns.Set_Last (0);
 346    Source_Directories.Set_Last (0);
 347    Preprocessor_Switches.Set_Last (0);
 348
 349    --  Get the arguments
 350
 351    Scan_Args;
 352
 353    if Opt.Verbose_Mode then
 354       Output_Version;
 355    end if;
 356
 357    if Usage_Needed then
 358       Usage;
 359    end if;
 360
 361    --  If no pattern was specified, print the usage and return
 362
 363    if Patterns.Last = 0 and Foreign_Patterns.Last = 0 then
 364       Usage;
 365       return;
 366    end if;
 367
 368    --  If no source directory was specified, use the current directory as the
 369    --  unique directory. Note that if a file was specified with directory
 370    --  information, the current directory is the directory of the specified
 371    --  file.
 372
 373    if Source_Directories.Last = 0 then
 374       Source_Directories.Increment_Last;
 375       Source_Directories.Table (Source_Directories.Last) := new String'(".");
 376    end if;
 377
 378    declare
 379       Directories   : Argument_List (1 .. Integer (Source_Directories.Last));
 380       Name_Patterns : Argument_List (1 .. Integer (Patterns.Last));
 381       Excl_Patterns : Argument_List (1 .. Integer (Excluded_Patterns.Last));
 382       Frgn_Patterns : Argument_List (1 .. Integer (Foreign_Patterns.Last));
 383       Prep_Switches : Argument_List
 384                         (1 .. Integer (Preprocessor_Switches.Last));
 385
 386    begin
 387       --  Build the Directories and Name_Patterns arguments
 388
 389       for Index in Directories'Range loop
 390          Directories (Index) := Source_Directories.Table (Index);
 391       end loop;
 392
 393       for Index in Name_Patterns'Range loop
 394          Name_Patterns (Index) := Patterns.Table (Index);
 395       end loop;
 396
 397       for Index in Excl_Patterns'Range loop
 398          Excl_Patterns (Index) := Excluded_Patterns.Table (Index);
 399       end loop;
 400
 401       for Index in Frgn_Patterns'Range loop
 402          Frgn_Patterns (Index) := Foreign_Patterns.Table (Index);
 403       end loop;
 404
 405       for Index in Prep_Switches'Range loop
 406          Prep_Switches (Index) := Preprocessor_Switches.Table (Index);
 407       end loop;
 408
 409       --  Call Prj.Makr.Make where the real work is done
 410
 411       Prj.Makr.Make
 412         (File_Path         => File_Path.all,
 413          Project_File      => Create_Project,
 414          Directories       => Directories,
 415          Name_Patterns     => Name_Patterns,
 416          Excluded_Patterns => Excl_Patterns,
 417          Foreign_Patterns  => Frgn_Patterns,
 418          Preproc_Switches  => Prep_Switches,
 419          Very_Verbose      => Very_Verbose);
 420    end;
 421
 422    if Opt.Verbose_Mode then
 423       Write_Eol;
 424    end if;
 425 end Gnatname;