Mercurial > hg > CbC > CbC_gcc
comparison gcc/ada/gnatfind.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 F I N D -- | |
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 Switch; use Switch; | |
29 with Types; use Types; | |
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; use 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 -------------- | |
42 -- Gnatfind -- | |
43 -------------- | |
44 | |
45 procedure 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 configuration 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 | |
348 begin | |
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 | |
398 exception | |
399 when Usage_Error => | |
400 null; | |
401 end Gnatfind; |