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