1------------------------------------------------------------------------------
2--                                                                          --
3--                         GNAT COMPILER COMPONENTS                         --
4--                                                                          --
5--                             G N A T X R E F                              --
6--                                                                          --
7--                                 B o d y                                  --
8--                                                                          --
9--          Copyright (C) 1998-2021, 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 Types;    use Types;
29with Switch;   use Switch;
30with Xr_Tabls;
31with Xref_Lib; use Xref_Lib;
32
33with Ada.Command_Line;  use Ada.Command_Line;
34with 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
41procedure Gnatxref is
42   Search_Unused   : Boolean := False;
43   Local_Symbols   : Boolean := True;
44   Prj_File        : File_Name_String;
45   Prj_File_Length : Natural := 0;
46   Usage_Error     : exception;
47   Full_Path_Name  : Boolean := False;
48   Vi_Mode         : Boolean := False;
49   Read_Only       : Boolean := False;
50   Have_File       : Boolean := False;
51   Der_Info        : Boolean := False;
52
53   RTS_Specified : String_Access := null;
54   --  Used to detect multiple use of --RTS= switch
55
56   EXT_Specified : String_Access := null;
57   --  Used to detect multiple use of --ext= switch
58
59   procedure Parse_Cmd_Line;
60   --  Parse every switch on the command line
61
62   procedure Usage;
63   --  Display the usage
64
65   procedure Write_Usage;
66   pragma No_Return (Write_Usage);
67   --  Print a small help page for program usage
68
69   --------------------
70   -- Parse_Cmd_Line --
71   --------------------
72
73   procedure Parse_Cmd_Line is
74
75      procedure Check_Version_And_Help is new Check_Version_And_Help_G (Usage);
76
77      --  Start of processing for Parse_Cmd_Line
78
79   begin
80      --  First check for --version or --help
81
82      Check_Version_And_Help ("GNATXREF", "1998");
83
84      loop
85         case
86           GNAT.Command_Line.Getopt
87             ("a aI: aO: d f g h I: nostdinc nostdlib p: u v -RTS= -ext=")
88         is
89            when ASCII.NUL =>
90               exit;
91
92            when 'a' =>
93               if GNAT.Command_Line.Full_Switch = "a" then
94                  Read_Only := True;
95
96               elsif GNAT.Command_Line.Full_Switch = "aI" then
97                  Osint.Add_Src_Search_Dir (GNAT.Command_Line.Parameter);
98
99               else
100                  Osint.Add_Lib_Search_Dir (GNAT.Command_Line.Parameter);
101               end if;
102
103            when 'd' =>
104               Der_Info := True;
105
106            when 'f' =>
107               Full_Path_Name := True;
108
109            when 'g' =>
110               Local_Symbols := False;
111
112            when 'h' =>
113               Write_Usage;
114
115            when 'I' =>
116               Osint.Add_Src_Search_Dir (GNAT.Command_Line.Parameter);
117               Osint.Add_Lib_Search_Dir (GNAT.Command_Line.Parameter);
118
119            when 'n' =>
120               if GNAT.Command_Line.Full_Switch = "nostdinc" then
121                  Opt.No_Stdinc := True;
122               elsif GNAT.Command_Line.Full_Switch = "nostdlib" then
123                  Opt.No_Stdlib := True;
124               end if;
125
126            when 'p' =>
127               declare
128                  S : constant String := GNAT.Command_Line.Parameter;
129               begin
130                  Prj_File_Length := S'Length;
131                  Prj_File (1 .. Prj_File_Length) := S;
132               end;
133
134            when 'u' =>
135               Search_Unused := True;
136               Vi_Mode := False;
137
138            when 'v' =>
139               Vi_Mode := True;
140               Search_Unused := False;
141
142            --  The only switch starting with -- recognized is --RTS
143
144            when '-' =>
145
146               --  Check that it is the first time we see this switch
147
148               if Full_Switch = "-RTS" then
149                  if RTS_Specified = null then
150                     RTS_Specified := new String'(GNAT.Command_Line.Parameter);
151
152                  elsif RTS_Specified.all /= GNAT.Command_Line.Parameter then
153                     Osint.Fail ("--RTS cannot be specified multiple times");
154                  end if;
155
156                  Opt.No_Stdinc  := True;
157                  Opt.RTS_Switch := True;
158
159                  declare
160                     Src_Path_Name : constant String_Ptr :=
161                                       Get_RTS_Search_Dir
162                                         (GNAT.Command_Line.Parameter,
163                                          Include);
164
165                     Lib_Path_Name : constant String_Ptr :=
166                                       Get_RTS_Search_Dir
167                                         (GNAT.Command_Line.Parameter,
168                                          Objects);
169
170                  begin
171                     if Src_Path_Name /= null
172                       and then Lib_Path_Name /= null
173                     then
174                        Add_Search_Dirs (Src_Path_Name, Include);
175                        Add_Search_Dirs (Lib_Path_Name, Objects);
176
177                     elsif Src_Path_Name = null
178                       and then Lib_Path_Name = null
179                     then
180                        Osint.Fail
181                          ("RTS path not valid: missing adainclude and "
182                           & "adalib directories");
183
184                     elsif Src_Path_Name = null then
185                        Osint.Fail
186                          ("RTS path not valid: missing adainclude directory");
187
188                     elsif Lib_Path_Name = null then
189                        Osint.Fail
190                          ("RTS path not valid: missing adalib directory");
191                     end if;
192                  end;
193
194               elsif GNAT.Command_Line.Full_Switch = "-ext" then
195
196                  --  Check that it is the first time we see this switch
197
198                  if EXT_Specified = null then
199                     EXT_Specified := new String'(GNAT.Command_Line.Parameter);
200
201                  elsif EXT_Specified.all /= GNAT.Command_Line.Parameter then
202                     Osint.Fail ("--ext cannot be specified multiple times");
203                  end if;
204
205                  if EXT_Specified'Length = Osint.ALI_Default_Suffix'Length
206                  then
207                     Osint.ALI_Suffix := EXT_Specified.all'Access;
208                  else
209                     Osint.Fail ("--ext argument must have 3 characters");
210                  end if;
211               end if;
212
213            when others =>
214               Try_Help;
215               raise Usage_Error;
216         end case;
217      end loop;
218
219      --  Get the other arguments
220
221      loop
222         declare
223            S : constant String := GNAT.Command_Line.Get_Argument;
224
225         begin
226            exit when S'Length = 0;
227
228            if Ada.Strings.Fixed.Index (S, ":") /= 0 then
229               Ada.Text_IO.Put_Line
230                 ("Only file names are allowed on the command line");
231               Try_Help;
232               raise Usage_Error;
233            end if;
234
235            Add_Xref_File (S);
236            Have_File := True;
237         end;
238      end loop;
239
240   exception
241      when GNAT.Command_Line.Invalid_Switch =>
242         Ada.Text_IO.Put_Line ("Invalid switch : "
243                               & GNAT.Command_Line.Full_Switch);
244         Try_Help;
245         raise Usage_Error;
246
247      when GNAT.Command_Line.Invalid_Parameter =>
248         Ada.Text_IO.Put_Line ("Parameter missing for : "
249                               & GNAT.Command_Line.Full_Switch);
250         Try_Help;
251         raise Usage_Error;
252   end Parse_Cmd_Line;
253
254   -----------
255   -- Usage --
256   -----------
257
258   procedure Usage is
259   begin
260      Put_Line ("Usage: gnatxref [switches] file1 file2 ...");
261      New_Line;
262      Put_Line ("  file ... list of source files to xref, " &
263                "including with'ed units");
264      New_Line;
265      Put_Line ("gnatxref switches:");
266      Display_Usage_Version_And_Help;
267      Put_Line ("   -a        Consider all files, even when the ali file is"
268                & " readonly");
269      Put_Line ("   -aIdir    Specify source files search path");
270      Put_Line ("   -aOdir    Specify library/object files search path");
271      Put_Line ("   -d        Output derived type information");
272      Put_Line ("   -f        Output full path name");
273      Put_Line ("   -g        Output information only for global symbols");
274      Put_Line ("   -Idir     Like -aIdir -aOdir");
275      Put_Line ("   -nostdinc Don't look for sources in the system default"
276                & " directory");
277      Put_Line ("   -nostdlib Don't look for library files in the system"
278                & " default directory");
279      Put_Line ("   --ext=xxx Specify alternate ali file extension");
280      Put_Line ("   --RTS=dir specify the default source and object search"
281                & " path");
282      Put_Line ("   -p file   Use file as the configuration file");
283      Put_Line ("   -u        List unused entities");
284      Put_Line ("   -v        Print a 'tags' file for vi");
285      New_Line;
286
287   end Usage;
288
289   -----------------
290   -- Write_Usage --
291   -----------------
292
293   procedure Write_Usage is
294   begin
295      Display_Version ("GNATXREF", "1998");
296      New_Line;
297      Usage;
298      raise Usage_Error;
299   end Write_Usage;
300
301begin
302   Put_Line
303     ("WARNING: gnatxref is obsolete and will be removed in the next release");
304   Put_Line
305     ("Consider using Libadalang or GNAT Studio python scripting instead");
306
307   Parse_Cmd_Line;
308
309   if not Have_File then
310      if Argument_Count = 0 then
311         Write_Usage;
312      else
313         Try_Help;
314         raise Usage_Error;
315      end if;
316   end if;
317
318   Xr_Tabls.Set_Default_Match (True);
319
320   --  Find the project file
321
322   if Prj_File_Length = 0 then
323      Xr_Tabls.Create_Project_File
324        (Default_Project_File (Osint.To_Host_Dir_Spec (".", False).all));
325   else
326      Xr_Tabls.Create_Project_File (Prj_File (1 .. Prj_File_Length));
327   end if;
328
329   --  Fill up the table
330
331   Search_Xref (Local_Symbols, Read_Only, Der_Info);
332
333   if Search_Unused then
334      Print_Unused (Full_Path_Name);
335   elsif Vi_Mode then
336      Print_Vi (Full_Path_Name);
337   else
338      Print_Xref (Full_Path_Name);
339   end if;
340
341exception
342   when Usage_Error =>
343      null;
344end Gnatxref;
345