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    begin
 181       --  First check for --version or --help
 182
 183       Check_Version_And_Help ("GNATNAME", "2001", Usage'Unrestricted_Access);
 184
 185       --  Now scan the other switches
 186
 187       Initialize_Option_Scan;
 188
 189       --  Scan options first
 190
 191       loop
 192          case Getopt ("c: d: gnatep=! gnatep! gnateD! D: h P: v x: f:") is
 193             when ASCII.NUL =>
 194                exit;
 195
 196             when 'c' =>
 197                if File_Set then
 198                   Fail ("only one -P or -c switch may be specified");
 199                end if;
 200
 201                File_Set := True;
 202                File_Path := new String'(Parameter);
 203                Create_Project := False;
 204
 205             when 'd' =>
 206                Add_Source_Directory (Parameter);
 207
 208             when 'D' =>
 209                Get_Directories (Parameter);
 210
 211             when 'f' =>
 212                Foreign_Patterns.Increment_Last;
 213                Foreign_Patterns.Table (Foreign_Patterns.Last) :=
 214                  new String'(Parameter);
 215
 216             when 'g' =>
 217                Preprocessor_Switches.Increment_Last;
 218                Preprocessor_Switches.Table (Preprocessor_Switches.Last) :=
 219                  new String'('-' & Full_Switch & Parameter);
 220
 221             when 'h' =>
 222                Usage_Needed := True;
 223
 224             when 'P' =>
 225                if File_Set then
 226                   Fail ("only one -c or -P switch may be specified");
 227                end if;
 228
 229                File_Set       := True;
 230                File_Path      := new String'(Parameter);
 231                Create_Project := True;
 232
 233             when 'v' =>
 234                if Opt.Verbose_Mode then
 235                   Very_Verbose := True;
 236                else
 237                   Opt.Verbose_Mode := True;
 238                end if;
 239
 240             when 'x' =>
 241                Excluded_Patterns.Increment_Last;
 242                Excluded_Patterns.Table (Excluded_Patterns.Last) :=
 243                  new String'(Parameter);
 244
 245             when others =>
 246                null;
 247          end case;
 248       end loop;
 249
 250       --  Now, get the name patterns, if any
 251
 252       loop
 253          declare
 254             S : String := Get_Argument (Do_Expansion => False);
 255
 256          begin
 257             exit when S = "";
 258             Canonical_Case_File_Name (S);
 259             Patterns.Increment_Last;
 260             Patterns.Table (Patterns.Last) := new String'(S);
 261          end;
 262       end loop;
 263
 264    exception
 265       when Invalid_Switch =>
 266          Fail ("invalid switch " & Full_Switch);
 267    end Scan_Args;
 268
 269    -----------
 270    -- Usage --
 271    -----------
 272
 273    procedure Usage is
 274    begin
 275       if not Usage_Output then
 276          Usage_Needed := False;
 277          Usage_Output := True;
 278          Write_Str ("Usage: ");
 279          Osint.Write_Program_Name;
 280          Write_Line (" [switches] naming-pattern [naming-patterns]");
 281          Write_Eol;
 282          Write_Line ("switches:");
 283
 284          Write_Line ("  -cfile       create configuration pragmas file");
 285          Write_Line ("  -ddir        use dir as one of the source " &
 286                      "directories");
 287          Write_Line ("  -Dfile       get source directories from file");
 288          Write_Line ("  -fpat        foreign pattern");
 289          Write_Line ("  -gnateDsym=v preprocess with symbol definition");
 290          Write_Line ("  -gnatep=data preprocess files with data file");
 291          Write_Line ("  -h           output this help message");
 292          Write_Line ("  -Pproj       update or create project file proj");
 293          Write_Line ("  -v           verbose output");
 294          Write_Line ("  -v -v        very verbose output");
 295          Write_Line ("  -xpat        exclude pattern pat");
 296       end if;
 297    end Usage;
 298
 299 --  Start of processing for Gnatname
 300
 301 begin
 302    Prj.Set_Mode (Prj.Ada_Only);
 303
 304    --  Add the directory where gnatname is invoked in front of the
 305    --  path, if gnatname is invoked with directory information.
 306    --  Only do this if the platform is not VMS, where the notion of path
 307    --  does not really exist.
 308
 309    if not Hostparm.OpenVMS then
 310       declare
 311          Command : constant String := Command_Name;
 312
 313       begin
 314          for Index in reverse Command'Range loop
 315             if Command (Index) = Directory_Separator then
 316                declare
 317                   Absolute_Dir : constant String :=
 318                                    Normalize_Pathname
 319                                      (Command (Command'First .. Index));
 320
 321                   PATH         : constant String :=
 322                                    Absolute_Dir &
 323                   Path_Separator &
 324                   Getenv ("PATH").all;
 325
 326                begin
 327                   Setenv ("PATH", PATH);
 328                end;
 329
 330                exit;
 331             end if;
 332          end loop;
 333       end;
 334    end if;
 335
 336    --  Initialize tables
 337
 338    Excluded_Patterns.Set_Last (0);
 339    Foreign_Patterns.Set_Last (0);
 340    Patterns.Set_Last (0);
 341    Source_Directories.Set_Last (0);
 342    Preprocessor_Switches.Set_Last (0);
 343
 344    --  Get the arguments
 345
 346    Scan_Args;
 347
 348    if Opt.Verbose_Mode then
 349       Output_Version;
 350    end if;
 351
 352    if Usage_Needed then
 353       Usage;
 354    end if;
 355
 356    --  If no pattern was specified, print the usage and return
 357
 358    if Patterns.Last = 0 and Foreign_Patterns.Last = 0 then
 359       Usage;
 360       return;
 361    end if;
 362
 363    --  If no source directory was specified, use the current directory as the
 364    --  unique directory. Note that if a file was specified with directory
 365    --  information, the current directory is the directory of the specified
 366    --  file.
 367
 368    if Source_Directories.Last = 0 then
 369       Source_Directories.Increment_Last;
 370       Source_Directories.Table (Source_Directories.Last) := new String'(".");
 371    end if;
 372
 373    declare
 374       Directories   : Argument_List (1 .. Integer (Source_Directories.Last));
 375       Name_Patterns : Argument_List (1 .. Integer (Patterns.Last));
 376       Excl_Patterns : Argument_List (1 .. Integer (Excluded_Patterns.Last));
 377       Frgn_Patterns : Argument_List (1 .. Integer (Foreign_Patterns.Last));
 378       Prep_Switches : Argument_List
 379                         (1 .. Integer (Preprocessor_Switches.Last));
 380
 381    begin
 382       --  Build the Directories and Name_Patterns arguments
 383
 384       for Index in Directories'Range loop
 385          Directories (Index) := Source_Directories.Table (Index);
 386       end loop;
 387
 388       for Index in Name_Patterns'Range loop
 389          Name_Patterns (Index) := Patterns.Table (Index);
 390       end loop;
 391
 392       for Index in Excl_Patterns'Range loop
 393          Excl_Patterns (Index) := Excluded_Patterns.Table (Index);
 394       end loop;
 395
 396       for Index in Frgn_Patterns'Range loop
 397          Frgn_Patterns (Index) := Foreign_Patterns.Table (Index);
 398       end loop;
 399
 400       for Index in Prep_Switches'Range loop
 401          Prep_Switches (Index) := Preprocessor_Switches.Table (Index);
 402       end loop;
 403
 404       --  Call Prj.Makr.Make where the real work is done
 405
 406       Prj.Makr.Make
 407         (File_Path         => File_Path.all,
 408          Project_File      => Create_Project,
 409          Directories       => Directories,
 410          Name_Patterns     => Name_Patterns,
 411          Excluded_Patterns => Excl_Patterns,
 412          Foreign_Patterns  => Frgn_Patterns,
 413          Preproc_Switches  => Prep_Switches,
 414          Very_Verbose      => Very_Verbose);
 415    end;
 416
 417    if Opt.Verbose_Mode then
 418       Write_Eol;
 419    end if;
 420 end Gnatname;