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