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