Mercurial > hg > CbC > CbC_gcc
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; |