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