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