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-2005 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_Line (Gnatvsn.Gnat_Version_String);
 174          Output.Write_Line
 175            ("Copyright 2001-2005 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                else
 235                   Opt.Verbose_Mode := True;
 236                end if;
 237
 238             when 'x' =>
 239                Excluded_Patterns.Increment_Last;
 240                Excluded_Patterns.Table (Excluded_Patterns.Last) :=
 241                  new String'(Parameter);
 242
 243             when others =>
 244                null;
 245          end case;
 246       end loop;
 247
 248       --  Now, get the name patterns, if any
 249
 250       loop
 251          declare
 252             S : String := Get_Argument (Do_Expansion => False);
 253
 254          begin
 255             exit when S = "";
 256             Canonical_Case_File_Name (S);
 257             Patterns.Increment_Last;
 258             Patterns.Table (Patterns.Last) := new String'(S);
 259          end;
 260       end loop;
 261
 262    exception
 263       when Invalid_Switch =>
 264          Fail ("invalid switch " & Full_Switch);
 265    end Scan_Args;
 266
 267    -----------
 268    -- Usage --
 269    -----------
 270
 271    procedure Usage is
 272    begin
 273       if not Usage_Output then
 274          Usage_Needed := False;
 275          Usage_Output := True;
 276          Write_Str ("Usage: ");
 277          Osint.Write_Program_Name;
 278          Write_Line (" [switches] naming-pattern [naming-patterns]");
 279          Write_Eol;
 280          Write_Line ("switches:");
 281
 282          Write_Line ("  -cfile       create configuration pragmas file");
 283          Write_Line ("  -ddir        use dir as one of the source " &
 284                      "directories");
 285          Write_Line ("  -Dfile       get source directories from file");
 286          Write_Line ("  -fpat        foreign pattern");
 287          Write_Line ("  -gnateDsym=v preprocess with symbol definition");
 288          Write_Line ("  -gnatep=data preprocess files with data file");
 289          Write_Line ("  -h           output this help message");
 290          Write_Line ("  -Pproj       update or create project file proj");
 291          Write_Line ("  -v           verbose output");
 292          Write_Line ("  -v -v        very verbose output");
 293          Write_Line ("  -xpat        exclude pattern pat");
 294       end if;
 295    end Usage;
 296
 297 --  Start of processing for Gnatname
 298
 299 begin
 300    --  Add the directory where gnatname is invoked in front of the
 301    --  path, if gnatname is invoked with directory information.
 302    --  Only do this if the platform is not VMS, where the notion of path
 303    --  does not really exist.
 304
 305    if not Hostparm.OpenVMS then
 306       declare
 307          Command : constant String := Command_Name;
 308
 309       begin
 310          for Index in reverse Command'Range loop
 311             if Command (Index) = Directory_Separator then
 312                declare
 313                   Absolute_Dir : constant String :=
 314                                    Normalize_Pathname
 315                                      (Command (Command'First .. Index));
 316
 317                   PATH         : constant String :=
 318                                    Absolute_Dir &
 319                   Path_Separator &
 320                   Getenv ("PATH").all;
 321
 322                begin
 323                   Setenv ("PATH", PATH);
 324                end;
 325
 326                exit;
 327             end if;
 328          end loop;
 329       end;
 330    end if;
 331
 332    --  Initialize tables
 333
 334    Excluded_Patterns.Set_Last (0);
 335    Foreign_Patterns.Set_Last (0);
 336    Patterns.Set_Last (0);
 337    Source_Directories.Set_Last (0);
 338    Preprocessor_Switches.Set_Last (0);
 339
 340    --  Get the arguments
 341
 342    Scan_Args;
 343
 344    if Opt.Verbose_Mode then
 345       Output_Version;
 346    end if;
 347
 348    if Usage_Needed then
 349       Usage;
 350    end if;
 351
 352    --  If no pattern was specified, print the usage and return
 353
 354    if Patterns.Last = 0 and Foreign_Patterns.Last = 0 then
 355       Usage;
 356       return;
 357    end if;
 358
 359    --  If no source directory was specified, use the current directory as the
 360    --  unique directory. Note that if a file was specified with directory
 361    --  information, the current directory is the directory of the specified
 362    --  file.
 363
 364    if Source_Directories.Last = 0 then
 365       Source_Directories.Increment_Last;
 366       Source_Directories.Table (Source_Directories.Last) := new String'(".");
 367    end if;
 368
 369    declare
 370       Directories   : Argument_List (1 .. Integer (Source_Directories.Last));
 371       Name_Patterns : Argument_List (1 .. Integer (Patterns.Last));
 372       Excl_Patterns : Argument_List (1 .. Integer (Excluded_Patterns.Last));
 373       Frgn_Patterns : Argument_List (1 .. Integer (Foreign_Patterns.Last));
 374       Prep_Switches : Argument_List
 375                         (1 .. Integer (Preprocessor_Switches.Last));
 376
 377    begin
 378       --  Build the Directories and Name_Patterns arguments
 379
 380       for Index in Directories'Range loop
 381          Directories (Index) := Source_Directories.Table (Index);
 382       end loop;
 383
 384       for Index in Name_Patterns'Range loop
 385          Name_Patterns (Index) := Patterns.Table (Index);
 386       end loop;
 387
 388       for Index in Excl_Patterns'Range loop
 389          Excl_Patterns (Index) := Excluded_Patterns.Table (Index);
 390       end loop;
 391
 392       for Index in Frgn_Patterns'Range loop
 393          Frgn_Patterns (Index) := Foreign_Patterns.Table (Index);
 394       end loop;
 395
 396       for Index in Prep_Switches'Range loop
 397          Prep_Switches (Index) := Preprocessor_Switches.Table (Index);
 398       end loop;
 399
 400       --  Call Prj.Makr.Make where the real work is done
 401
 402       Prj.Makr.Make
 403         (File_Path         => File_Path.all,
 404          Project_File      => Create_Project,
 405          Directories       => Directories,
 406          Name_Patterns     => Name_Patterns,
 407          Excluded_Patterns => Excl_Patterns,
 408          Foreign_Patterns  => Frgn_Patterns,
 409          Preproc_Switches  => Prep_Switches,
 410          Very_Verbose      => Very_Verbose);
 411    end;
 412
 413    if Opt.Verbose_Mode then
 414       Write_Eol;
 415    end if;
 416 end Gnatname;