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-2006, 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,  51  Franklin  Street,  Fifth  Floor, --
  20 -- Boston, MA 02110-1301, 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;  use 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      => 100,
  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      => 100,
  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      => 100,
  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      => 100,
  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        => 10,
 106       Table_Increment      => 100,
 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-" &
 176             Current_Year &
 177             ", Free Software Foundation, Inc.");
 178       end if;
 179    end Output_Version;
 180
 181    ---------------
 182    -- Scan_Args --
 183    ---------------
 184
 185    procedure Scan_Args is
 186    begin
 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    --  Add the directory where gnatname is invoked in front of the
 303    --  path, if gnatname is invoked with directory information.
 304    --  Only do this if the platform is not VMS, where the notion of path
 305    --  does not really exist.
 306
 307    if not Hostparm.OpenVMS then
 308       declare
 309          Command : constant String := Command_Name;
 310
 311       begin
 312          for Index in reverse Command'Range loop
 313             if Command (Index) = Directory_Separator then
 314                declare
 315                   Absolute_Dir : constant String :=
 316                                    Normalize_Pathname
 317                                      (Command (Command'First .. Index));
 318
 319                   PATH         : constant String :=
 320                                    Absolute_Dir &
 321                   Path_Separator &
 322                   Getenv ("PATH").all;
 323
 324                begin
 325                   Setenv ("PATH", PATH);
 326                end;
 327
 328                exit;
 329             end if;
 330          end loop;
 331       end;
 332    end if;
 333
 334    --  Initialize tables
 335
 336    Excluded_Patterns.Set_Last (0);
 337    Foreign_Patterns.Set_Last (0);
 338    Patterns.Set_Last (0);
 339    Source_Directories.Set_Last (0);
 340    Preprocessor_Switches.Set_Last (0);
 341
 342    --  Get the arguments
 343
 344    Scan_Args;
 345
 346    if Opt.Verbose_Mode then
 347       Output_Version;
 348    end if;
 349
 350    if Usage_Needed then
 351       Usage;
 352    end if;
 353
 354    --  If no pattern was specified, print the usage and return
 355
 356    if Patterns.Last = 0 and Foreign_Patterns.Last = 0 then
 357       Usage;
 358       return;
 359    end if;
 360
 361    --  If no source directory was specified, use the current directory as the
 362    --  unique directory. Note that if a file was specified with directory
 363    --  information, the current directory is the directory of the specified
 364    --  file.
 365
 366    if Source_Directories.Last = 0 then
 367       Source_Directories.Increment_Last;
 368       Source_Directories.Table (Source_Directories.Last) := new String'(".");
 369    end if;
 370
 371    declare
 372       Directories   : Argument_List (1 .. Integer (Source_Directories.Last));
 373       Name_Patterns : Argument_List (1 .. Integer (Patterns.Last));
 374       Excl_Patterns : Argument_List (1 .. Integer (Excluded_Patterns.Last));
 375       Frgn_Patterns : Argument_List (1 .. Integer (Foreign_Patterns.Last));
 376       Prep_Switches : Argument_List
 377                         (1 .. Integer (Preprocessor_Switches.Last));
 378
 379    begin
 380       --  Build the Directories and Name_Patterns arguments
 381
 382       for Index in Directories'Range loop
 383          Directories (Index) := Source_Directories.Table (Index);
 384       end loop;
 385
 386       for Index in Name_Patterns'Range loop
 387          Name_Patterns (Index) := Patterns.Table (Index);
 388       end loop;
 389
 390       for Index in Excl_Patterns'Range loop
 391          Excl_Patterns (Index) := Excluded_Patterns.Table (Index);
 392       end loop;
 393
 394       for Index in Frgn_Patterns'Range loop
 395          Frgn_Patterns (Index) := Foreign_Patterns.Table (Index);
 396       end loop;
 397
 398       for Index in Prep_Switches'Range loop
 399          Prep_Switches (Index) := Preprocessor_Switches.Table (Index);
 400       end loop;
 401
 402       --  Call Prj.Makr.Make where the real work is done
 403
 404       Prj.Makr.Make
 405         (File_Path         => File_Path.all,
 406          Project_File      => Create_Project,
 407          Directories       => Directories,
 408          Name_Patterns     => Name_Patterns,
 409          Excluded_Patterns => Excl_Patterns,
 410          Foreign_Patterns  => Frgn_Patterns,
 411          Preproc_Switches  => Prep_Switches,
 412          Very_Verbose      => Very_Verbose);
 413    end;
 414
 415    if Opt.Verbose_Mode then
 416       Write_Eol;
 417    end if;
 418 end Gnatname;