gcc/ada/gnatfind.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --                             G N A T F I N D                              --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --          Copyright (C) 1998-2018, 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 3,  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 COPYING3.  If not, go to --
  19 -- http://www.gnu.org/licenses for a complete copy of the license.          --
  20 --                                                                          --
  21 -- GNAT was originally developed  by the GNAT team at  New York University. --
  22 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  23 --                                                                          --
  24 ------------------------------------------------------------------------------
  25
  26 with Opt;
  27 with Osint;    use Osint;
  28 with Switch;   use Switch;
  29 with Types;    use Types;
  30 with Xr_Tabls;
  31 with Xref_Lib; use Xref_Lib;
  32
  33 with Ada.Command_Line;  use Ada.Command_Line;
  34 with Ada.Strings.Fixed; use Ada.Strings.Fixed;
  35 with Ada.Text_IO;       use Ada.Text_IO;
  36
  37 with GNAT.Command_Line; use GNAT.Command_Line;
  38
  39 with System.Strings;    use System.Strings;
  40
  41 --------------
  42 -- Gnatfind --
  43 --------------
  44
  45 procedure Gnatfind is
  46    Output_Ref      : Boolean := False;
  47    Pattern         : Xref_Lib.Search_Pattern;
  48    Local_Symbols   : Boolean := True;
  49    Prj_File        : File_Name_String;
  50    Prj_File_Length : Natural := 0;
  51    Nb_File         : Natural := 0;
  52    Usage_Error     : exception;
  53    Full_Path_Name  : Boolean := False;
  54    Have_Entity     : Boolean := False;
  55    Wide_Search     : Boolean := True;
  56    Glob_Mode       : Boolean := True;
  57    Der_Info        : Boolean := False;
  58    Type_Tree       : Boolean := False;
  59    Read_Only       : Boolean := False;
  60    Source_Lines    : Boolean := False;
  61
  62    Has_File_In_Entity : Boolean := False;
  63    --  Will be true if a file name was specified in the entity
  64
  65    RTS_Specified : String_Access := null;
  66    --  Used to detect multiple use of --RTS= switch
  67
  68    EXT_Specified : String_Access := null;
  69    --  Used to detect multiple use of --ext= switch
  70
  71    procedure Parse_Cmd_Line;
  72    --  Parse every switch on the command line
  73
  74    procedure Usage;
  75    --  Display the usage
  76
  77    procedure Write_Usage;
  78    pragma No_Return (Write_Usage);
  79    --  Print a small help page for program usage and exit program
  80
  81    --------------------
  82    -- Parse_Cmd_Line --
  83    --------------------
  84
  85    procedure Parse_Cmd_Line is
  86
  87       procedure Check_Version_And_Help is new Check_Version_And_Help_G (Usage);
  88
  89       --  Start of processing for Parse_Cmd_Line
  90
  91    begin
  92       --  First check for --version or --help
  93
  94       Check_Version_And_Help ("GNATFIND", "1998");
  95
  96       --  Now scan the other switches
  97
  98       GNAT.Command_Line.Initialize_Option_Scan;
  99
 100       loop
 101          case
 102            GNAT.Command_Line.Getopt
 103              ("a aI: aO: d e f g h I: nostdinc nostdlib p: r s t -RTS= -ext=")
 104          is
 105             when ASCII.NUL =>
 106                exit;
 107
 108             when 'a'    =>
 109                if GNAT.Command_Line.Full_Switch = "a" then
 110                   Read_Only := True;
 111                elsif GNAT.Command_Line.Full_Switch = "aI" then
 112                   Osint.Add_Src_Search_Dir (GNAT.Command_Line.Parameter);
 113                else
 114                   Osint.Add_Lib_Search_Dir (GNAT.Command_Line.Parameter);
 115                end if;
 116
 117             when 'd'    =>
 118                Der_Info := True;
 119
 120             when 'e'    =>
 121                Glob_Mode := False;
 122
 123             when 'f'    =>
 124                Full_Path_Name := True;
 125
 126             when 'g'    =>
 127                Local_Symbols := False;
 128
 129             when 'h'    =>
 130                Write_Usage;
 131
 132             when 'I'    =>
 133                Osint.Add_Src_Search_Dir (GNAT.Command_Line.Parameter);
 134                Osint.Add_Lib_Search_Dir (GNAT.Command_Line.Parameter);
 135
 136             when 'n'    =>
 137                if GNAT.Command_Line.Full_Switch = "nostdinc" then
 138                   Opt.No_Stdinc := True;
 139                elsif GNAT.Command_Line.Full_Switch = "nostdlib" then
 140                   Opt.No_Stdlib := True;
 141                end if;
 142
 143             when 'p'    =>
 144                declare
 145                   S : constant String := GNAT.Command_Line.Parameter;
 146                begin
 147                   Prj_File_Length := S'Length;
 148                   Prj_File (1 .. Prj_File_Length) := S;
 149                end;
 150
 151             when 'r'    =>
 152                Output_Ref := True;
 153
 154             when 's' =>
 155                Source_Lines := True;
 156
 157             when 't' =>
 158                Type_Tree := True;
 159
 160             --  Only switch starting with -- recognized is --RTS
 161
 162             when '-' =>
 163                if GNAT.Command_Line.Full_Switch = "-RTS" then
 164
 165                   --  Check that it is the first time we see this switch
 166
 167                   if RTS_Specified = null then
 168                      RTS_Specified := new String'(GNAT.Command_Line.Parameter);
 169                   elsif RTS_Specified.all /= GNAT.Command_Line.Parameter then
 170                      Osint.Fail ("--RTS cannot be specified multiple times");
 171                   end if;
 172
 173                   Opt.No_Stdinc := True;
 174                   Opt.RTS_Switch := True;
 175
 176                   declare
 177                      Src_Path_Name : constant String_Ptr :=
 178                                        Get_RTS_Search_Dir
 179                                          (GNAT.Command_Line.Parameter,
 180                                           Include);
 181                      Lib_Path_Name : constant String_Ptr :=
 182                                        Get_RTS_Search_Dir
 183                                          (GNAT.Command_Line.Parameter,
 184                                           Objects);
 185
 186                   begin
 187                      if Src_Path_Name /= null
 188                        and then Lib_Path_Name /= null
 189                      then
 190                         Add_Search_Dirs (Src_Path_Name, Include);
 191                         Add_Search_Dirs (Lib_Path_Name, Objects);
 192
 193                      elsif Src_Path_Name = null
 194                        and then Lib_Path_Name = null
 195                      then
 196                         Osint.Fail ("RTS path not valid: missing " &
 197                                       "adainclude and adalib directories");
 198
 199                      elsif Src_Path_Name = null then
 200                         Osint.Fail ("RTS path not valid: missing " &
 201                                       "adainclude directory");
 202
 203                      elsif Lib_Path_Name = null then
 204                         Osint.Fail ("RTS path not valid: missing " &
 205                                       "adalib directory");
 206                      end if;
 207                   end;
 208
 209                --  Process -ext switch
 210
 211                elsif GNAT.Command_Line.Full_Switch = "-ext" then
 212
 213                   --  Check that it is the first time we see this switch
 214
 215                   if EXT_Specified = null then
 216                      EXT_Specified := new String'(GNAT.Command_Line.Parameter);
 217                   elsif EXT_Specified.all /= GNAT.Command_Line.Parameter then
 218                      Osint.Fail ("--ext cannot be specified multiple times");
 219                   end if;
 220
 221                   if
 222                     EXT_Specified'Length = Osint.ALI_Default_Suffix'Length
 223                   then
 224                      Osint.ALI_Suffix := EXT_Specified.all'Access;
 225                   else
 226                      Osint.Fail ("--ext argument must have 3 characters");
 227                   end if;
 228
 229                end if;
 230
 231             when others =>
 232                Try_Help;
 233                raise Usage_Error;
 234          end case;
 235       end loop;
 236
 237       --  Get the other arguments
 238
 239       loop
 240          declare
 241             S : constant String := GNAT.Command_Line.Get_Argument;
 242
 243          begin
 244             exit when S'Length = 0;
 245
 246             --  First argument is the pattern
 247
 248             if not Have_Entity then
 249                Add_Entity (Pattern, S, Glob_Mode);
 250                Have_Entity := True;
 251
 252                if not Has_File_In_Entity
 253                  and then Index (S, ":") /= 0
 254                then
 255                   Has_File_In_Entity := True;
 256                end if;
 257
 258             --  Next arguments are the files to search
 259
 260             else
 261                Add_Xref_File (S);
 262                Wide_Search := False;
 263                Nb_File := Nb_File + 1;
 264             end if;
 265          end;
 266       end loop;
 267
 268    exception
 269       when GNAT.Command_Line.Invalid_Switch =>
 270          Ada.Text_IO.Put_Line ("Invalid switch : "
 271                                & GNAT.Command_Line.Full_Switch);
 272          Try_Help;
 273          raise Usage_Error;
 274
 275       when GNAT.Command_Line.Invalid_Parameter =>
 276          Ada.Text_IO.Put_Line ("Parameter missing for : "
 277                                & GNAT.Command_Line.Full_Switch);
 278          Try_Help;
 279          raise Usage_Error;
 280
 281       when Xref_Lib.Invalid_Argument =>
 282          Ada.Text_IO.Put_Line ("Invalid line or column in the pattern");
 283          Try_Help;
 284          raise Usage_Error;
 285    end Parse_Cmd_Line;
 286
 287    -----------
 288    -- Usage --
 289    -----------
 290
 291    procedure Usage is
 292    begin
 293       Put_Line ("Usage: gnatfind pattern[:sourcefile[:line[:column]]] "
 294                 & "[file1 file2 ...]");
 295       New_Line;
 296       Put_Line ("  pattern     Name of the entity to look for (can have "
 297                 & "wildcards)");
 298       Put_Line ("  sourcefile  Only find entities referenced from this "
 299                 & "file");
 300       Put_Line ("  line        Only find entities referenced from this line "
 301                 & "of file");
 302       Put_Line ("  column      Only find entities referenced from this columns"
 303                 & " of file");
 304       Put_Line ("  file ...    Set of Ada source files to search for "
 305                 & "references. This parameters are optional");
 306       New_Line;
 307       Put_Line ("gnatfind switches:");
 308       Display_Usage_Version_And_Help;
 309       Put_Line ("   -a        Consider all files, even when the ali file is "
 310                 & "readonly");
 311       Put_Line ("   -aIdir    Specify source files search path");
 312       Put_Line ("   -aOdir    Specify library/object files search path");
 313       Put_Line ("   -d        Output derived type information");
 314       Put_Line ("   -e        Use the full regular expression set for "
 315                 & "pattern");
 316       Put_Line ("   -f        Output full path name");
 317       Put_Line ("   -g        Output information only for global symbols");
 318       Put_Line ("   -Idir     Like -aIdir -aOdir");
 319       Put_Line ("   -nostdinc Don't look for sources in the system default"
 320                 & " directory");
 321       Put_Line ("   -nostdlib Don't look for library files in the system"
 322                 & " default directory");
 323       Put_Line ("   --ext=xxx Specify alternate ali file extension");
 324       Put_Line ("   --RTS=dir specify the default source and object search"
 325                 & " path");
 326       Put_Line ("   -p file   Use file as the configuration file");
 327       Put_Line ("   -r        Find all references (default to find declaration"
 328                 & " only)");
 329       Put_Line ("   -s        Print source line");
 330       Put_Line ("   -t        Print type hierarchy");
 331    end Usage;
 332
 333    -----------------
 334    -- Write_Usage --
 335    -----------------
 336
 337    procedure Write_Usage is
 338    begin
 339       Display_Version ("GNATFIND", "1998");
 340       New_Line;
 341
 342       Usage;
 343
 344       raise Usage_Error;
 345    end Write_Usage;
 346
 347 --  Start of processing for Gnatfind
 348
 349 begin
 350    Parse_Cmd_Line;
 351
 352    if not Have_Entity then
 353       if Argument_Count = 0 then
 354          Write_Usage;
 355       else
 356          Try_Help;
 357          raise Usage_Error;
 358       end if;
 359    end if;
 360
 361    --  Special case to speed things up: if the user has a command line of the
 362    --  form 'gnatfind entity:file', i.e. has specified a file and only wants
 363    --  the bodies and specs, then we can restrict the search to the .ali file
 364    --  associated with 'file'.
 365
 366    if Has_File_In_Entity
 367      and then not Output_Ref
 368    then
 369       Wide_Search := False;
 370    end if;
 371
 372    --  Find the project file
 373
 374    if Prj_File_Length = 0 then
 375       Xr_Tabls.Create_Project_File (Default_Project_File ("."));
 376    else
 377       Xr_Tabls.Create_Project_File (Prj_File (1 .. Prj_File_Length));
 378    end if;
 379
 380    --  Fill up the table
 381
 382    if Type_Tree and then Nb_File > 1 then
 383       Ada.Text_IO.Put_Line ("Error: for type hierarchy output you must "
 384                             & "specify only one file.");
 385       Ada.Text_IO.New_Line;
 386       Try_Help;
 387       raise Usage_Error;
 388    end if;
 389
 390    Search (Pattern, Local_Symbols, Wide_Search, Read_Only,
 391            Der_Info, Type_Tree);
 392
 393    if Source_Lines then
 394       Xr_Tabls.Grep_Source_Files;
 395    end if;
 396
 397    Print_Gnatfind (Output_Ref, Full_Path_Name);
 398
 399 exception
 400    when Usage_Error =>
 401       null;
 402 end Gnatfind;