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 --                            $Revision$
  10 --                                                                          --
  11 --           Copyright (C) 2001-2002 Free Software Foundation, Inc.         --
  12 --                                                                          --
  13 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  14 -- terms of the  GNU General Public License as published  by the Free Soft- --
  15 -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
  16 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  17 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  18 -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  19 -- for  more details.  You should have  received  a copy of the GNU General --
  20 -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
  21 -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
  22 -- MA 02111-1307, USA.                                                      --
  23 --                                                                          --
  24 -- GNAT was originally developed  by the GNAT team at  New York University. --
  25 -- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
  26 --                                                                          --
  27 ------------------------------------------------------------------------------
  28
  29 with Gnatvsn;
  30 with Opt;
  31 with Osint;    use Osint;
  32 with Output;   use Output;
  33 with Prj.Makr;
  34 with Table;
  35
  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 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.Patterns");
  80    --  Table to accumulate the name patterns.
  81
  82    package Source_Directories 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.Source_Directories");
  89    --  Table to accumulate the source directories specified directly with -d
  90    --  or indirectly with -D.
  91
  92    procedure Output_Version;
  93    --  Print name and version
  94
  95    procedure Usage;
  96    --  Print usage
  97
  98    procedure Scan_Args;
  99    --  Scan the command line arguments
 100
 101    procedure Add_Source_Directory (S : String);
 102    --  Add S in the Source_Directories table
 103
 104    procedure Get_Directories (From_File : String);
 105    --  Read a source directory text file
 106
 107    --------------------------
 108    -- Add_Source_Directory --
 109    --------------------------
 110
 111    procedure Add_Source_Directory (S : String) is
 112    begin
 113       Source_Directories.Increment_Last;
 114       Source_Directories.Table (Source_Directories.Last) := new String'(S);
 115    end Add_Source_Directory;
 116
 117    ---------------------
 118    -- Get_Directories --
 119    ---------------------
 120
 121    procedure Get_Directories (From_File : String) is
 122       File : Ada.Text_IO.File_Type;
 123       Line : String (1 .. 2_000);
 124       Last : Natural;
 125
 126    begin
 127       Open (File, In_File, From_File);
 128
 129       while not End_Of_File (File) loop
 130          Get_Line (File, Line, Last);
 131
 132          if Last /= 0 then
 133             Add_Source_Directory (Line (1 .. Last));
 134          end if;
 135       end loop;
 136
 137       Close (File);
 138
 139    exception
 140       when Name_Error =>
 141          Fail ("cannot open source directory """ & From_File & '"');
 142    end Get_Directories;
 143
 144    --------------------
 145    -- Output_Version --
 146    --------------------
 147
 148    procedure Output_Version is
 149    begin
 150       if not Version_Output then
 151          Version_Output := True;
 152          Output.Write_Eol;
 153          Output.Write_Str ("GNATNAME ");
 154          Output.Write_Str (Gnatvsn.Gnat_Version_String);
 155          Output.Write_Line
 156            (" Copyright 2001-2002 Free Software Foundation, Inc.");
 157       end if;
 158    end Output_Version;
 159
 160    ---------------
 161    -- Scan_Args --
 162    ---------------
 163
 164    procedure Scan_Args is
 165    begin
 166       Initialize_Option_Scan;
 167
 168       --  Scan options first
 169
 170       loop
 171          case Getopt ("c: d: D: h P: v x:") is
 172             when ASCII.NUL =>
 173                exit;
 174
 175             when 'c' =>
 176                if File_Set then
 177                   Fail ("only one -P or -c switch may be specified");
 178                end if;
 179
 180                File_Set := True;
 181                File_Path := new String'(Parameter);
 182                Create_Project := False;
 183
 184             when 'd' =>
 185                Add_Source_Directory (Parameter);
 186
 187             when 'D' =>
 188                Get_Directories (Parameter);
 189
 190             when 'h' =>
 191                Usage_Needed := True;
 192
 193             when 'P' =>
 194                if File_Set then
 195                   Fail ("only one -c or -P switch may be specified");
 196                end if;
 197
 198                File_Set       := True;
 199                File_Path      := new String'(Parameter);
 200                Create_Project := True;
 201
 202             when 'v' =>
 203                if Opt.Verbose_Mode then
 204                   Very_Verbose := True;
 205
 206                else
 207                   Opt.Verbose_Mode := True;
 208                end if;
 209
 210             when 'x' =>
 211                Excluded_Patterns.Increment_Last;
 212                Excluded_Patterns.Table (Excluded_Patterns.Last) :=
 213                  new String'(Parameter);
 214
 215             when others =>
 216                null;
 217          end case;
 218       end loop;
 219
 220       --  Now, get the name patterns, if any
 221
 222       loop
 223          declare
 224             S : constant String := Get_Argument (Do_Expansion => False);
 225
 226          begin
 227             exit when S = "";
 228             Patterns.Increment_Last;
 229             Patterns.Table (Patterns.Last) := new String'(S);
 230          end;
 231       end loop;
 232
 233    exception
 234       when Invalid_Switch =>
 235          Fail ("invalid switch " & Full_Switch);
 236
 237    end Scan_Args;
 238
 239    -----------
 240    -- Usage --
 241    -----------
 242
 243    procedure Usage is
 244    begin
 245       if not Usage_Output then
 246          Usage_Needed := False;
 247          Usage_Output := True;
 248          Write_Str ("Usage: ");
 249          Osint.Write_Program_Name;
 250          Write_Line (" [switches] naming-pattern [naming-patterns]");
 251          Write_Eol;
 252          Write_Line ("switches:");
 253
 254          Write_Line ("  -cfile    create configuration pragmas file");
 255          Write_Line ("  -ddir     use dir as one of the source directories");
 256          Write_Line ("  -Dfile    get source directories from file");
 257          Write_Line ("  -h        output this help message");
 258          Write_Line ("  -Pproj    update or create project file proj");
 259          Write_Line ("  -v        verbose output");
 260          Write_Line ("  -v -v     very verbose output");
 261          Write_Line ("  -xpat     exclude pattern pat");
 262       end if;
 263    end Usage;
 264
 265 --  Start of processing for Gnatname
 266
 267 begin
 268    --  Initialize tables
 269
 270    Excluded_Patterns.Set_Last (0);
 271    Patterns.Set_Last (0);
 272    Source_Directories.Set_Last (0);
 273
 274    --  Get the arguments
 275
 276    Scan_Args;
 277
 278    if Opt.Verbose_Mode then
 279       Output_Version;
 280    end if;
 281
 282    if Usage_Needed then
 283       Usage;
 284    end if;
 285
 286    --  If no pattern was specified, print the usage and return
 287
 288    if Patterns.Last = 0 then
 289       Usage;
 290       return;
 291    end if;
 292
 293    --  If no source directory was specified, use the current directory as the
 294    --  unique directory. Note that if a file was specified with directory
 295    --  information, the current directory is the directory of the specified
 296    --  file.
 297
 298    if Source_Directories.Last = 0 then
 299       Source_Directories.Increment_Last;
 300       Source_Directories.Table (Source_Directories.Last) := new String'(".");
 301    end if;
 302
 303    declare
 304       Directories   : Argument_List (1 .. Integer (Source_Directories.Last));
 305       Name_Patterns : Argument_List (1 .. Integer (Patterns.Last));
 306       Excl_Patterns : Argument_List (1 .. Integer (Excluded_Patterns.Last));
 307
 308    begin
 309       --  Build the Directories and Name_Patterns arguments
 310
 311       for Index in Directories'Range loop
 312          Directories (Index) := Source_Directories.Table (Index);
 313       end loop;
 314
 315       for Index in Name_Patterns'Range loop
 316          Name_Patterns (Index) := Patterns.Table (Index);
 317       end loop;
 318
 319       for Index in Excl_Patterns'Range loop
 320          Excl_Patterns (Index) := Excluded_Patterns.Table (Index);
 321       end loop;
 322
 323       --  Call Prj.Makr.Make where the real work is done
 324
 325       Prj.Makr.Make
 326         (File_Path         => File_Path.all,
 327          Project_File      => Create_Project,
 328          Directories       => Directories,
 329          Name_Patterns     => Name_Patterns,
 330          Excluded_Patterns => Excl_Patterns,
 331          Very_Verbose      => Very_Verbose);
 332    end;
 333
 334    if Opt.Verbose_Mode then
 335       Write_Eol;
 336    end if;
 337 end Gnatname;