comparison gcc/ada/gnatxref.adb @ 111:04ced10e8804

gcc 7
author kono
date Fri, 27 Oct 2017 22:46:09 +0900
parents
children 84e7813d76e9
comparison
equal deleted inserted replaced
68:561a7518be6b 111:04ced10e8804
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-2017, 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 Types; use Types;
29 with Switch; use Switch;
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;
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 procedure 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 configuration 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
300 begin
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
335 exception
336 when Usage_Error =>
337 null;
338 end Gnatxref;