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-2014, 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
26with Opt;
27with Osint;    use Osint;
28with Switch;   use Switch;
29with Types;    use Types;
30with Xr_Tabls; use Xr_Tabls;
31with Xref_Lib; use Xref_Lib;
32
33with Ada.Command_Line;  use Ada.Command_Line;
34with Ada.Strings.Fixed; use Ada.Strings.Fixed;
35with Ada.Text_IO;       use Ada.Text_IO;
36
37with GNAT.Command_Line; use GNAT.Command_Line;
38
39with System.Strings;    use System.Strings;
40
41--------------
42-- Gnatfind --
43--------------
44
45procedure 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 default project 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
348begin
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
398exception
399   when Usage_Error =>
400      null;
401end Gnatfind;
402