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