|
111
|
1 ------------------------------------------------------------------------------
|
|
|
2 -- --
|
|
|
3 -- GNAT COMPILER COMPONENTS --
|
|
|
4 -- --
|
|
|
5 -- C L E A N --
|
|
|
6 -- --
|
|
|
7 -- B o d y --
|
|
|
8 -- --
|
|
131
|
9 -- Copyright (C) 2003-2018, Free Software Foundation, Inc. --
|
|
111
|
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 ALI; use ALI;
|
|
|
27 with Make_Util; use Make_Util;
|
|
|
28 with Namet; use Namet;
|
|
|
29 with Opt; use Opt;
|
|
|
30 with Osint; use Osint;
|
|
|
31 with Osint.M; use Osint.M;
|
|
|
32 with Switch; use Switch;
|
|
|
33 with Table;
|
|
|
34 with Targparm;
|
|
|
35 with Types; use Types;
|
|
|
36
|
|
|
37 with Ada.Command_Line; use Ada.Command_Line;
|
|
|
38
|
|
|
39 with GNAT.Command_Line; use GNAT.Command_Line;
|
|
|
40 with GNAT.Directory_Operations; use GNAT.Directory_Operations;
|
|
|
41 with GNAT.IO; use GNAT.IO;
|
|
|
42 with GNAT.OS_Lib; use GNAT.OS_Lib;
|
|
|
43
|
|
|
44 package body Clean is
|
|
|
45
|
|
|
46 -- Suffixes of various files
|
|
|
47
|
|
|
48 Assembly_Suffix : constant String := ".s";
|
|
|
49 Tree_Suffix : constant String := ".adt";
|
|
|
50 Object_Suffix : constant String := Get_Target_Object_Suffix.all;
|
|
|
51 Debug_Suffix : constant String := ".dg";
|
|
|
52 Repinfo_Suffix : constant String := ".rep";
|
|
|
53 -- Suffix of representation info files
|
|
|
54
|
|
|
55 B_Start : constant String := "b~";
|
|
|
56 -- Prefix of binder generated file, and number of actual characters used
|
|
|
57
|
|
|
58 Object_Directory_Path : String_Access := null;
|
|
|
59 -- The path name of the object directory, set with switch -D
|
|
|
60
|
|
|
61 Force_Deletions : Boolean := False;
|
|
|
62 -- Set to True by switch -f. When True, attempts to delete non writable
|
|
|
63 -- files will be done.
|
|
|
64
|
|
|
65 Do_Nothing : Boolean := False;
|
|
|
66 -- Set to True when switch -n is specified. When True, no file is deleted.
|
|
|
67 -- gnatclean only lists the files that would have been deleted if the
|
|
|
68 -- switch -n had not been specified.
|
|
|
69
|
|
|
70 File_Deleted : Boolean := False;
|
|
|
71 -- Set to True if at least one file has been deleted
|
|
|
72
|
|
|
73 Copyright_Displayed : Boolean := False;
|
|
|
74 Usage_Displayed : Boolean := False;
|
|
|
75
|
|
|
76 Project_File_Name : String_Access := null;
|
|
|
77
|
|
|
78 package Sources is new Table.Table
|
|
|
79 (Table_Component_Type => File_Name_Type,
|
|
|
80 Table_Index_Type => Natural,
|
|
|
81 Table_Low_Bound => 0,
|
|
|
82 Table_Initial => 10,
|
|
|
83 Table_Increment => 100,
|
|
|
84 Table_Name => "Clean.Processed_Projects");
|
|
|
85 -- Table to store all the source files of a library unit: spec, body and
|
|
|
86 -- subunits, to detect .dg files and delete them.
|
|
|
87
|
|
|
88 -----------------------------
|
|
|
89 -- Other local subprograms --
|
|
|
90 -----------------------------
|
|
|
91
|
|
|
92 function Assembly_File_Name (Source : File_Name_Type) return String;
|
|
|
93 -- Returns the assembly file name corresponding to Source
|
|
|
94
|
|
|
95 procedure Clean_Executables;
|
|
|
96 -- Do the cleaning work when no project file is specified
|
|
|
97
|
|
|
98 function Debug_File_Name (Source : File_Name_Type) return String;
|
|
|
99 -- Name of the expanded source file corresponding to Source
|
|
|
100
|
|
|
101 procedure Delete (In_Directory : String; File : String);
|
|
|
102 -- Delete one file, or list the file name if switch -n is specified
|
|
|
103
|
|
|
104 procedure Delete_Binder_Generated_Files
|
|
|
105 (Dir : String;
|
|
|
106 Source : File_Name_Type);
|
|
|
107 -- Delete the binder generated file in directory Dir for Source, if they
|
|
|
108 -- exist: for Unix these are b~<source>.ads, b~<source>.adb,
|
|
|
109 -- b~<source>.ali and b~<source>.o.
|
|
|
110
|
|
|
111 procedure Display_Copyright;
|
|
|
112 -- Display the Copyright notice. If called several times, display the
|
|
|
113 -- Copyright notice only the first time.
|
|
|
114
|
|
|
115 procedure Initialize;
|
|
|
116 -- Call the necessary package initializations
|
|
|
117
|
|
|
118 function Object_File_Name (Source : File_Name_Type) return String;
|
|
|
119 -- Returns the object file name corresponding to Source
|
|
|
120
|
|
|
121 procedure Parse_Cmd_Line;
|
|
|
122 -- Parse the command line
|
|
|
123
|
|
|
124 function Repinfo_File_Name (Source : File_Name_Type) return String;
|
|
|
125 -- Returns the repinfo file name corresponding to Source
|
|
|
126
|
|
|
127 function Tree_File_Name (Source : File_Name_Type) return String;
|
|
|
128 -- Returns the tree file name corresponding to Source
|
|
|
129
|
|
|
130 procedure Usage;
|
|
|
131 -- Display the usage. If called several times, the usage is displayed only
|
|
|
132 -- the first time.
|
|
|
133
|
|
|
134 ------------------------
|
|
|
135 -- Assembly_File_Name --
|
|
|
136 ------------------------
|
|
|
137
|
|
|
138 function Assembly_File_Name (Source : File_Name_Type) return String is
|
|
|
139 Src : constant String := Get_Name_String (Source);
|
|
|
140
|
|
|
141 begin
|
|
|
142 -- If the source name has an extension, then replace it with
|
|
|
143 -- the assembly suffix.
|
|
|
144
|
|
|
145 for Index in reverse Src'First + 1 .. Src'Last loop
|
|
|
146 if Src (Index) = '.' then
|
|
|
147 return Src (Src'First .. Index - 1) & Assembly_Suffix;
|
|
|
148 end if;
|
|
|
149 end loop;
|
|
|
150
|
|
|
151 -- If there is no dot, or if it is the first character, just add the
|
|
|
152 -- assembly suffix.
|
|
|
153
|
|
|
154 return Src & Assembly_Suffix;
|
|
|
155 end Assembly_File_Name;
|
|
|
156
|
|
|
157 -----------------------
|
|
|
158 -- Clean_Executables --
|
|
|
159 -----------------------
|
|
|
160
|
|
|
161 procedure Clean_Executables is
|
|
|
162 Main_Source_File : File_Name_Type;
|
|
|
163 -- Current main source
|
|
|
164
|
|
|
165 Main_Lib_File : File_Name_Type;
|
|
|
166 -- ALI file of the current main
|
|
|
167
|
|
|
168 Lib_File : File_Name_Type;
|
|
|
169 -- Current ALI file
|
|
|
170
|
|
|
171 Full_Lib_File : File_Name_Type;
|
|
|
172 -- Full name of the current ALI file
|
|
|
173
|
|
|
174 Text : Text_Buffer_Ptr;
|
|
|
175 The_ALI : ALI_Id;
|
|
|
176 Found : Boolean;
|
|
|
177 Source : Queue.Source_Info;
|
|
|
178
|
|
|
179 begin
|
|
|
180 Queue.Initialize;
|
|
|
181
|
|
|
182 -- It does not really matter if there is or not an object file
|
|
|
183 -- corresponding to an ALI file: if there is one, it will be deleted.
|
|
|
184
|
|
|
185 Opt.Check_Object_Consistency := False;
|
|
|
186
|
|
|
187 -- Proceed each executable one by one. Each source is marked as it is
|
|
|
188 -- processed, so common sources between executables will not be
|
|
|
189 -- processed several times.
|
|
|
190
|
|
|
191 for N_File in 1 .. Osint.Number_Of_Files loop
|
|
|
192 Main_Source_File := Next_Main_Source;
|
|
|
193 Main_Lib_File :=
|
|
|
194 Osint.Lib_File_Name (Main_Source_File, Current_File_Index);
|
|
|
195
|
|
|
196 if Main_Lib_File /= No_File then
|
|
|
197 Queue.Insert
|
|
|
198 ((File => Main_Lib_File,
|
|
|
199 Unit => No_Unit_Name,
|
|
|
200 Index => 0));
|
|
|
201 end if;
|
|
|
202
|
|
|
203 while not Queue.Is_Empty loop
|
|
|
204 Sources.Set_Last (0);
|
|
|
205 Queue.Extract (Found, Source);
|
|
|
206 pragma Assert (Found);
|
|
|
207 pragma Assert (Source.File /= No_File);
|
|
|
208 Lib_File := Source.File;
|
|
|
209 Full_Lib_File := Osint.Full_Lib_File_Name (Lib_File);
|
|
|
210
|
|
|
211 -- If we have existing ALI file that is not read-only, process it
|
|
|
212
|
|
|
213 if Full_Lib_File /= No_File
|
|
|
214 and then not Is_Readonly_Library (Full_Lib_File)
|
|
|
215 then
|
|
|
216 Text := Read_Library_Info (Lib_File);
|
|
|
217
|
|
|
218 if Text /= null then
|
|
|
219 The_ALI :=
|
|
|
220 Scan_ALI (Lib_File, Text, Ignore_ED => False, Err => True);
|
|
|
221 Free (Text);
|
|
|
222
|
|
|
223 -- If no error was produced while loading this ALI file,
|
|
|
224 -- insert into the queue all the unmarked withed sources.
|
|
|
225
|
|
|
226 if The_ALI /= No_ALI_Id then
|
|
|
227 for J in ALIs.Table (The_ALI).First_Unit ..
|
|
|
228 ALIs.Table (The_ALI).Last_Unit
|
|
|
229 loop
|
|
|
230 Sources.Increment_Last;
|
|
|
231 Sources.Table (Sources.Last) :=
|
|
|
232 ALI.Units.Table (J).Sfile;
|
|
|
233
|
|
|
234 for K in ALI.Units.Table (J).First_With ..
|
|
|
235 ALI.Units.Table (J).Last_With
|
|
|
236 loop
|
|
|
237 if Withs.Table (K).Afile /= No_File then
|
|
|
238 Queue.Insert
|
|
|
239 ((File => Withs.Table (K).Afile,
|
|
|
240 Unit => No_Unit_Name,
|
|
|
241 Index => 0));
|
|
|
242 end if;
|
|
|
243 end loop;
|
|
|
244 end loop;
|
|
|
245
|
|
|
246 -- Look for subunits and put them in the Sources table
|
|
|
247
|
|
|
248 for J in ALIs.Table (The_ALI).First_Sdep ..
|
|
|
249 ALIs.Table (The_ALI).Last_Sdep
|
|
|
250 loop
|
|
|
251 if Sdep.Table (J).Subunit_Name /= No_Name then
|
|
|
252 Sources.Increment_Last;
|
|
|
253 Sources.Table (Sources.Last) :=
|
|
|
254 Sdep.Table (J).Sfile;
|
|
|
255 end if;
|
|
|
256 end loop;
|
|
|
257 end if;
|
|
|
258 end if;
|
|
|
259
|
|
|
260 -- Now delete all existing files corresponding to this ALI file
|
|
|
261
|
|
|
262 declare
|
|
|
263 Obj_Dir : constant String :=
|
|
|
264 Dir_Name (Get_Name_String (Full_Lib_File));
|
|
|
265 Obj : constant String := Object_File_Name (Lib_File);
|
|
|
266 Adt : constant String := Tree_File_Name (Lib_File);
|
|
|
267 Asm : constant String := Assembly_File_Name (Lib_File);
|
|
|
268
|
|
|
269 begin
|
|
|
270 Delete (Obj_Dir, Get_Name_String (Lib_File));
|
|
|
271
|
|
|
272 if Is_Regular_File (Obj_Dir & Dir_Separator & Obj) then
|
|
|
273 Delete (Obj_Dir, Obj);
|
|
|
274 end if;
|
|
|
275
|
|
|
276 if Is_Regular_File (Obj_Dir & Dir_Separator & Adt) then
|
|
|
277 Delete (Obj_Dir, Adt);
|
|
|
278 end if;
|
|
|
279
|
|
|
280 if Is_Regular_File (Obj_Dir & Dir_Separator & Asm) then
|
|
|
281 Delete (Obj_Dir, Asm);
|
|
|
282 end if;
|
|
|
283
|
|
|
284 -- Delete expanded source files (.dg) and/or repinfo files
|
|
|
285 -- (.rep) if any
|
|
|
286
|
|
|
287 for J in 1 .. Sources.Last loop
|
|
|
288 declare
|
|
|
289 Deb : constant String :=
|
|
|
290 Debug_File_Name (Sources.Table (J));
|
|
|
291 Rep : constant String :=
|
|
|
292 Repinfo_File_Name (Sources.Table (J));
|
|
|
293
|
|
|
294 begin
|
|
|
295 if Is_Regular_File (Obj_Dir & Dir_Separator & Deb) then
|
|
|
296 Delete (Obj_Dir, Deb);
|
|
|
297 end if;
|
|
|
298
|
|
|
299 if Is_Regular_File (Obj_Dir & Dir_Separator & Rep) then
|
|
|
300 Delete (Obj_Dir, Rep);
|
|
|
301 end if;
|
|
|
302 end;
|
|
|
303 end loop;
|
|
|
304 end;
|
|
|
305 end if;
|
|
|
306 end loop;
|
|
|
307
|
|
|
308 -- Delete the executable, if it exists, and the binder generated
|
|
|
309 -- files, if any.
|
|
|
310
|
|
|
311 if not Compile_Only then
|
|
|
312 declare
|
|
|
313 Source : constant File_Name_Type :=
|
|
|
314 Strip_Suffix (Main_Lib_File);
|
|
|
315 Executable : constant String :=
|
|
|
316 Get_Name_String (Executable_Name (Source));
|
|
|
317 begin
|
|
|
318 if Is_Regular_File (Executable) then
|
|
|
319 Delete ("", Executable);
|
|
|
320 end if;
|
|
|
321
|
|
|
322 Delete_Binder_Generated_Files (Get_Current_Dir, Source);
|
|
|
323 end;
|
|
|
324 end if;
|
|
|
325 end loop;
|
|
|
326 end Clean_Executables;
|
|
|
327
|
|
|
328 ---------------------
|
|
|
329 -- Debug_File_Name --
|
|
|
330 ---------------------
|
|
|
331
|
|
|
332 function Debug_File_Name (Source : File_Name_Type) return String is
|
|
|
333 begin
|
|
|
334 return Get_Name_String (Source) & Debug_Suffix;
|
|
|
335 end Debug_File_Name;
|
|
|
336
|
|
|
337 ------------
|
|
|
338 -- Delete --
|
|
|
339 ------------
|
|
|
340
|
|
|
341 procedure Delete (In_Directory : String; File : String) is
|
|
|
342 Full_Name : String (1 .. In_Directory'Length + File'Length + 1);
|
|
|
343 Last : Natural := 0;
|
|
|
344 Success : Boolean;
|
|
|
345
|
|
|
346 begin
|
|
|
347 -- Indicate that at least one file is deleted or is to be deleted
|
|
|
348
|
|
|
349 File_Deleted := True;
|
|
|
350
|
|
|
351 -- Build the path name of the file to delete
|
|
|
352
|
|
|
353 Last := In_Directory'Length;
|
|
|
354 Full_Name (1 .. Last) := In_Directory;
|
|
|
355
|
|
|
356 if Last > 0 and then Full_Name (Last) /= Directory_Separator then
|
|
|
357 Last := Last + 1;
|
|
|
358 Full_Name (Last) := Directory_Separator;
|
|
|
359 end if;
|
|
|
360
|
|
|
361 Full_Name (Last + 1 .. Last + File'Length) := File;
|
|
|
362 Last := Last + File'Length;
|
|
|
363
|
|
|
364 -- If switch -n was used, simply output the path name
|
|
|
365
|
|
|
366 if Do_Nothing then
|
|
|
367 Put_Line (Full_Name (1 .. Last));
|
|
|
368
|
|
|
369 -- Otherwise, delete the file if it is writable
|
|
|
370
|
|
|
371 else
|
|
|
372 if Force_Deletions
|
|
|
373 or else Is_Writable_File (Full_Name (1 .. Last))
|
|
|
374 or else Is_Symbolic_Link (Full_Name (1 .. Last))
|
|
|
375 then
|
|
|
376 Delete_File (Full_Name (1 .. Last), Success);
|
|
|
377
|
|
|
378 -- Here if no deletion required
|
|
|
379
|
|
|
380 else
|
|
|
381 Success := False;
|
|
|
382 end if;
|
|
|
383
|
|
|
384 if Verbose_Mode or else not Quiet_Output then
|
|
|
385 if not Success then
|
|
|
386 Put ("Warning: """);
|
|
|
387 Put (Full_Name (1 .. Last));
|
|
|
388 Put_Line (""" could not be deleted");
|
|
|
389
|
|
|
390 else
|
|
|
391 Put ("""");
|
|
|
392 Put (Full_Name (1 .. Last));
|
|
|
393 Put_Line (""" has been deleted");
|
|
|
394 end if;
|
|
|
395 end if;
|
|
|
396 end if;
|
|
|
397 end Delete;
|
|
|
398
|
|
|
399 -----------------------------------
|
|
|
400 -- Delete_Binder_Generated_Files --
|
|
|
401 -----------------------------------
|
|
|
402
|
|
|
403 procedure Delete_Binder_Generated_Files
|
|
|
404 (Dir : String;
|
|
|
405 Source : File_Name_Type)
|
|
|
406 is
|
|
|
407 Source_Name : constant String := Get_Name_String (Source);
|
|
|
408 Current : constant String := Get_Current_Dir;
|
|
|
409 Last : constant Positive := B_Start'Length + Source_Name'Length;
|
|
|
410 File_Name : String (1 .. Last + 4);
|
|
|
411
|
|
|
412 begin
|
|
|
413 Change_Dir (Dir);
|
|
|
414
|
|
|
415 -- Build the file name (before the extension)
|
|
|
416
|
|
|
417 File_Name (1 .. B_Start'Length) := B_Start;
|
|
|
418 File_Name (B_Start'Length + 1 .. Last) := Source_Name;
|
|
|
419
|
|
|
420 -- Spec
|
|
|
421
|
|
|
422 File_Name (Last + 1 .. Last + 4) := ".ads";
|
|
|
423
|
|
|
424 if Is_Regular_File (File_Name (1 .. Last + 4)) then
|
|
|
425 Delete (Dir, File_Name (1 .. Last + 4));
|
|
|
426 end if;
|
|
|
427
|
|
|
428 -- Body
|
|
|
429
|
|
|
430 File_Name (Last + 1 .. Last + 4) := ".adb";
|
|
|
431
|
|
|
432 if Is_Regular_File (File_Name (1 .. Last + 4)) then
|
|
|
433 Delete (Dir, File_Name (1 .. Last + 4));
|
|
|
434 end if;
|
|
|
435
|
|
|
436 -- ALI file
|
|
|
437
|
|
|
438 File_Name (Last + 1 .. Last + 4) := ".ali";
|
|
|
439
|
|
|
440 if Is_Regular_File (File_Name (1 .. Last + 4)) then
|
|
|
441 Delete (Dir, File_Name (1 .. Last + 4));
|
|
|
442 end if;
|
|
|
443
|
|
|
444 -- Object file
|
|
|
445
|
|
|
446 File_Name (Last + 1 .. Last + Object_Suffix'Length) := Object_Suffix;
|
|
|
447
|
|
|
448 if Is_Regular_File (File_Name (1 .. Last + Object_Suffix'Length)) then
|
|
|
449 Delete (Dir, File_Name (1 .. Last + Object_Suffix'Length));
|
|
|
450 end if;
|
|
|
451
|
|
|
452 -- Change back to previous directory
|
|
|
453
|
|
|
454 Change_Dir (Current);
|
|
|
455 end Delete_Binder_Generated_Files;
|
|
|
456
|
|
|
457 -----------------------
|
|
|
458 -- Display_Copyright --
|
|
|
459 -----------------------
|
|
|
460
|
|
|
461 procedure Display_Copyright is
|
|
|
462 begin
|
|
|
463 if not Copyright_Displayed then
|
|
|
464 Copyright_Displayed := True;
|
|
|
465 Display_Version ("GNATCLEAN", "2003");
|
|
|
466 end if;
|
|
|
467 end Display_Copyright;
|
|
|
468
|
|
|
469 ---------------
|
|
|
470 -- Gnatclean --
|
|
|
471 ---------------
|
|
|
472
|
|
|
473 procedure Gnatclean is
|
|
|
474 begin
|
|
|
475 -- Do the necessary initializations
|
|
|
476
|
|
|
477 Clean.Initialize;
|
|
|
478
|
|
|
479 -- Parse the command line, getting the switches and the executable names
|
|
|
480
|
|
|
481 Parse_Cmd_Line;
|
|
|
482
|
|
|
483 if Verbose_Mode then
|
|
|
484 Display_Copyright;
|
|
|
485 end if;
|
|
|
486
|
|
|
487 Osint.Add_Default_Search_Dirs;
|
|
|
488 Targparm.Get_Target_Parameters;
|
|
|
489
|
|
|
490 if Osint.Number_Of_Files = 0 then
|
|
|
491 if Argument_Count = 0 then
|
|
|
492 Usage;
|
|
|
493 else
|
|
|
494 Try_Help;
|
|
|
495 end if;
|
|
|
496
|
|
|
497 return;
|
|
|
498 end if;
|
|
|
499
|
|
|
500 if Verbose_Mode then
|
|
|
501 New_Line;
|
|
|
502 end if;
|
|
|
503
|
|
|
504 if Project_File_Name /= null then
|
|
|
505 declare
|
|
|
506 Gprclean_Path : constant String_Access :=
|
|
|
507 Locate_Exec_On_Path ("gprclean");
|
|
|
508 Arg_Len : Natural := Argument_Count;
|
|
|
509 Pos : Natural := 0;
|
|
|
510 Target : String_Access := null;
|
|
|
511 Success : Boolean := False;
|
|
|
512 begin
|
|
|
513 if Gprclean_Path = null then
|
|
|
514 Fail_Program
|
|
|
515 ("project files are no longer supported by gnatclean;" &
|
|
|
516 " use gprclean instead");
|
|
|
517 end if;
|
|
|
518
|
|
|
519 Find_Program_Name;
|
|
|
520
|
|
|
521 if Name_Len > 10
|
|
|
522 and then Name_Buffer (Name_Len - 8 .. Name_Len) = "gnatclean"
|
|
|
523 then
|
|
|
524 Target := new String'(Name_Buffer (1 .. Name_Len - 9));
|
|
|
525 Arg_Len := Arg_Len + 1;
|
|
|
526 end if;
|
|
|
527
|
|
|
528 declare
|
|
|
529 Args : Argument_List (1 .. Arg_Len);
|
|
|
530 begin
|
|
|
531 if Target /= null then
|
|
|
532 Args (1) := new String'("--target=" & Target.all);
|
|
|
533 Pos := 1;
|
|
|
534 end if;
|
|
|
535
|
|
|
536 for J in 1 .. Argument_Count loop
|
|
|
537 Pos := Pos + 1;
|
|
|
538 Args (Pos) := new String'(Argument (J));
|
|
|
539 end loop;
|
|
|
540
|
|
|
541 Spawn (Gprclean_Path.all, Args, Success);
|
|
|
542
|
|
|
543 if Success then
|
|
|
544 Exit_Program (E_Success);
|
|
|
545 else
|
|
|
546 Exit_Program (E_Errors);
|
|
|
547 end if;
|
|
|
548 end;
|
|
|
549 end;
|
|
|
550 end if;
|
|
|
551
|
|
|
552 Clean_Executables;
|
|
|
553
|
|
|
554 -- In verbose mode, if Delete has not been called, indicate that no file
|
|
|
555 -- needs to be deleted.
|
|
|
556
|
|
|
557 if Verbose_Mode and (not File_Deleted) then
|
|
|
558 New_Line;
|
|
|
559
|
|
|
560 if Do_Nothing then
|
|
|
561 Put_Line ("No file needs to be deleted");
|
|
|
562 else
|
|
|
563 Put_Line ("No file has been deleted");
|
|
|
564 end if;
|
|
|
565 end if;
|
|
|
566 end Gnatclean;
|
|
|
567
|
|
|
568 ----------------
|
|
|
569 -- Initialize --
|
|
|
570 ----------------
|
|
|
571
|
|
|
572 procedure Initialize is
|
|
|
573 begin
|
|
|
574 -- Reset global variables
|
|
|
575
|
|
|
576 Free (Object_Directory_Path);
|
|
|
577 Do_Nothing := False;
|
|
|
578 File_Deleted := False;
|
|
|
579 Copyright_Displayed := False;
|
|
|
580 Usage_Displayed := False;
|
|
|
581 end Initialize;
|
|
|
582
|
|
|
583 ----------------------
|
|
|
584 -- Object_File_Name --
|
|
|
585 ----------------------
|
|
|
586
|
|
|
587 function Object_File_Name (Source : File_Name_Type) return String is
|
|
|
588 Src : constant String := Get_Name_String (Source);
|
|
|
589
|
|
|
590 begin
|
|
|
591 -- If the source name has an extension, then replace it with
|
|
|
592 -- the Object suffix.
|
|
|
593
|
|
|
594 for Index in reverse Src'First + 1 .. Src'Last loop
|
|
|
595 if Src (Index) = '.' then
|
|
|
596 return Src (Src'First .. Index - 1) & Object_Suffix;
|
|
|
597 end if;
|
|
|
598 end loop;
|
|
|
599
|
|
|
600 -- If there is no dot, or if it is the first character, just add the
|
|
|
601 -- ALI suffix.
|
|
|
602
|
|
|
603 return Src & Object_Suffix;
|
|
|
604 end Object_File_Name;
|
|
|
605
|
|
|
606 --------------------
|
|
|
607 -- Parse_Cmd_Line --
|
|
|
608 --------------------
|
|
|
609
|
|
|
610 procedure Parse_Cmd_Line is
|
|
|
611 Last : constant Natural := Argument_Count;
|
|
|
612 Index : Positive;
|
|
|
613 Source_Index : Int := 0;
|
|
|
614
|
|
|
615 procedure Check_Version_And_Help is new Check_Version_And_Help_G (Usage);
|
|
|
616
|
|
|
617 begin
|
|
|
618 -- First, check for --version and --help
|
|
|
619
|
|
|
620 Check_Version_And_Help ("GNATCLEAN", "2003");
|
|
|
621
|
|
|
622 -- First, check for switch -P and, if found and gprclean is available,
|
|
|
623 -- silently invoke gprclean, with switch --target if not on a native
|
|
|
624 -- platform.
|
|
|
625
|
|
|
626 declare
|
|
|
627 Arg_Len : Positive := Argument_Count;
|
|
|
628 Call_Gprclean : Boolean := False;
|
|
|
629 Gprclean : String_Access := null;
|
|
|
630 Pos : Natural := 0;
|
|
|
631 Success : Boolean;
|
|
|
632 Target : String_Access := null;
|
|
|
633
|
|
|
634 begin
|
|
|
635 Find_Program_Name;
|
|
|
636
|
|
|
637 if Name_Len >= 9
|
|
|
638 and then Name_Buffer (Name_Len - 8 .. Name_Len) = "gnatclean"
|
|
|
639 then
|
|
|
640 if Name_Len > 9 then
|
|
|
641 Target := new String'(Name_Buffer (1 .. Name_Len - 10));
|
|
|
642 Arg_Len := Arg_Len + 1;
|
|
|
643 end if;
|
|
|
644
|
|
|
645 for J in 1 .. Argument_Count loop
|
|
|
646 declare
|
|
|
647 Arg : constant String := Argument (J);
|
|
|
648 begin
|
|
|
649 if Arg'Length >= 2
|
|
|
650 and then Arg (Arg'First .. Arg'First + 1) = "-P"
|
|
|
651 then
|
|
|
652 Call_Gprclean := True;
|
|
|
653 exit;
|
|
|
654 end if;
|
|
|
655 end;
|
|
|
656 end loop;
|
|
|
657
|
|
|
658 if Call_Gprclean then
|
|
|
659 Gprclean := Locate_Exec_On_Path (Exec_Name => "gprclean");
|
|
|
660
|
|
|
661 if Gprclean /= null then
|
|
|
662 declare
|
|
|
663 Args : Argument_List (1 .. Arg_Len);
|
|
|
664 begin
|
|
|
665 if Target /= null then
|
|
|
666 Args (1) := new String'("--target=" & Target.all);
|
|
|
667 Pos := 1;
|
|
|
668 end if;
|
|
|
669
|
|
|
670 for J in 1 .. Argument_Count loop
|
|
|
671 Pos := Pos + 1;
|
|
|
672 Args (Pos) := new String'(Argument (J));
|
|
|
673 end loop;
|
|
|
674
|
|
|
675 Spawn (Gprclean.all, Args, Success);
|
|
|
676
|
|
|
677 Free (Gprclean);
|
|
|
678
|
|
|
679 if Success then
|
|
|
680 Exit_Program (E_Success);
|
|
|
681
|
|
|
682 else
|
|
|
683 Exit_Program (E_Fatal);
|
|
|
684 end if;
|
|
|
685 end;
|
|
|
686 end if;
|
|
|
687 end if;
|
|
|
688 end if;
|
|
|
689 end;
|
|
|
690
|
|
|
691 Index := 1;
|
|
|
692 while Index <= Last loop
|
|
|
693 declare
|
|
|
694 Arg : constant String := Argument (Index);
|
|
|
695
|
|
|
696 procedure Bad_Argument;
|
|
131
|
697 pragma No_Return (Bad_Argument);
|
|
111
|
698 -- Signal bad argument
|
|
|
699
|
|
|
700 ------------------
|
|
|
701 -- Bad_Argument --
|
|
|
702 ------------------
|
|
|
703
|
|
|
704 procedure Bad_Argument is
|
|
|
705 begin
|
|
|
706 Fail ("invalid argument """ & Arg & """");
|
|
|
707 end Bad_Argument;
|
|
|
708
|
|
|
709 begin
|
|
|
710 if Arg'Length /= 0 then
|
|
|
711 if Arg (1) = '-' then
|
|
|
712 if Arg'Length = 1 then
|
|
|
713 Bad_Argument;
|
|
|
714 end if;
|
|
|
715
|
|
|
716 case Arg (2) is
|
|
|
717 when '-' =>
|
|
|
718 if Arg'Length > Subdirs_Option'Length
|
|
|
719 and then
|
|
|
720 Arg (1 .. Subdirs_Option'Length) = Subdirs_Option
|
|
|
721 then
|
|
|
722 null;
|
|
|
723 -- Subdirs are only used in gprclean
|
|
|
724
|
|
|
725 elsif Arg = Make_Util.Unchecked_Shared_Lib_Imports then
|
|
|
726 Opt.Unchecked_Shared_Lib_Imports := True;
|
|
|
727
|
|
|
728 else
|
|
|
729 Bad_Argument;
|
|
|
730 end if;
|
|
|
731
|
|
|
732 when 'a' =>
|
|
|
733 if Arg'Length < 4 then
|
|
|
734 Bad_Argument;
|
|
|
735 end if;
|
|
|
736
|
|
|
737 if Arg (3) = 'O' then
|
|
|
738 Add_Lib_Search_Dir (Arg (4 .. Arg'Last));
|
|
|
739
|
|
|
740 elsif Arg (3) = 'P' then
|
|
|
741 null;
|
|
|
742 -- This is only for gprclean
|
|
|
743
|
|
|
744 else
|
|
|
745 Bad_Argument;
|
|
|
746 end if;
|
|
|
747
|
|
|
748 when 'c' =>
|
|
|
749 Compile_Only := True;
|
|
|
750
|
|
|
751 when 'D' =>
|
|
|
752 if Object_Directory_Path /= null then
|
|
|
753 Fail ("duplicate -D switch");
|
|
|
754
|
|
|
755 elsif Project_File_Name /= null then
|
|
|
756 Fail ("-P and -D cannot be used simultaneously");
|
|
|
757 end if;
|
|
|
758
|
|
|
759 if Arg'Length > 2 then
|
|
|
760 declare
|
|
|
761 Dir : constant String := Arg (3 .. Arg'Last);
|
|
|
762 begin
|
|
|
763 if not Is_Directory (Dir) then
|
|
|
764 Fail (Dir & " is not a directory");
|
|
|
765 else
|
|
|
766 Add_Lib_Search_Dir (Dir);
|
|
|
767 end if;
|
|
|
768 end;
|
|
|
769
|
|
|
770 else
|
|
|
771 if Index = Last then
|
|
|
772 Fail ("no directory specified after -D");
|
|
|
773 end if;
|
|
|
774
|
|
|
775 Index := Index + 1;
|
|
|
776
|
|
|
777 declare
|
|
|
778 Dir : constant String := Argument (Index);
|
|
|
779 begin
|
|
|
780 if not Is_Directory (Dir) then
|
|
|
781 Fail (Dir & " is not a directory");
|
|
|
782 else
|
|
|
783 Add_Lib_Search_Dir (Dir);
|
|
|
784 end if;
|
|
|
785 end;
|
|
|
786 end if;
|
|
|
787
|
|
|
788 when 'e' =>
|
|
|
789 if Arg = "-eL" then
|
|
|
790 Follow_Links_For_Files := True;
|
|
|
791 Follow_Links_For_Dirs := True;
|
|
|
792
|
|
|
793 else
|
|
|
794 Bad_Argument;
|
|
|
795 end if;
|
|
|
796
|
|
|
797 when 'f' =>
|
|
|
798 Force_Deletions := True;
|
|
|
799 Directories_Must_Exist_In_Projects := False;
|
|
|
800
|
|
|
801 when 'F' =>
|
|
|
802 Full_Path_Name_For_Brief_Errors := True;
|
|
|
803
|
|
|
804 when 'h' =>
|
|
|
805 Usage;
|
|
|
806
|
|
|
807 when 'i' =>
|
|
|
808 if Arg'Length = 2 then
|
|
|
809 Bad_Argument;
|
|
|
810 end if;
|
|
|
811
|
|
|
812 Source_Index := 0;
|
|
|
813
|
|
|
814 for J in 3 .. Arg'Last loop
|
|
|
815 if Arg (J) not in '0' .. '9' then
|
|
|
816 Bad_Argument;
|
|
|
817 end if;
|
|
|
818
|
|
|
819 Source_Index :=
|
|
|
820 (20 * Source_Index) +
|
|
|
821 (Character'Pos (Arg (J)) - Character'Pos ('0'));
|
|
|
822 end loop;
|
|
|
823
|
|
|
824 when 'I' =>
|
|
|
825 if Arg = "-I-" then
|
|
|
826 Opt.Look_In_Primary_Dir := False;
|
|
|
827
|
|
|
828 else
|
|
|
829 if Arg'Length = 2 then
|
|
|
830 Bad_Argument;
|
|
|
831 end if;
|
|
|
832
|
|
|
833 Add_Lib_Search_Dir (Arg (3 .. Arg'Last));
|
|
|
834 end if;
|
|
|
835
|
|
|
836 when 'n' =>
|
|
|
837 Do_Nothing := True;
|
|
|
838
|
|
|
839 when 'P' =>
|
|
|
840 if Project_File_Name /= null then
|
|
|
841 Fail ("multiple -P switches");
|
|
|
842
|
|
|
843 elsif Object_Directory_Path /= null then
|
|
|
844 Fail ("-D and -P cannot be used simultaneously");
|
|
|
845
|
|
|
846 end if;
|
|
|
847
|
|
|
848 if Arg'Length > 2 then
|
|
|
849 declare
|
|
|
850 Prj : constant String := Arg (3 .. Arg'Last);
|
|
|
851 begin
|
|
|
852 if Prj'Length > 1
|
|
|
853 and then Prj (Prj'First) = '='
|
|
|
854 then
|
|
|
855 Project_File_Name :=
|
|
|
856 new String'
|
|
|
857 (Prj (Prj'First + 1 .. Prj'Last));
|
|
|
858 else
|
|
|
859 Project_File_Name := new String'(Prj);
|
|
|
860 end if;
|
|
|
861 end;
|
|
|
862
|
|
|
863 else
|
|
|
864 if Index = Last then
|
|
|
865 Fail ("no project specified after -P");
|
|
|
866 end if;
|
|
|
867
|
|
|
868 Index := Index + 1;
|
|
|
869 Project_File_Name := new String'(Argument (Index));
|
|
|
870 end if;
|
|
|
871
|
|
|
872 when 'q' =>
|
|
|
873 Quiet_Output := True;
|
|
|
874
|
|
|
875 when 'r' =>
|
|
|
876 null;
|
|
|
877 -- This is only for gprclean
|
|
|
878
|
|
|
879 when 'v' =>
|
|
|
880 if Arg = "-v" then
|
|
|
881 Verbose_Mode := True;
|
|
|
882
|
|
|
883 elsif Arg = "-vP0"
|
|
|
884 or else Arg = "-vP1"
|
|
|
885 or else Arg = "-vP2"
|
|
|
886 then
|
|
|
887 null;
|
|
|
888 -- This is only for gprclean
|
|
|
889
|
|
|
890 else
|
|
|
891 Bad_Argument;
|
|
|
892 end if;
|
|
|
893
|
|
|
894 when 'X' =>
|
|
|
895 if Arg'Length = 2 then
|
|
|
896 Bad_Argument;
|
|
|
897 end if;
|
|
|
898
|
|
|
899 when others =>
|
|
|
900 Bad_Argument;
|
|
|
901 end case;
|
|
|
902
|
|
|
903 else
|
|
|
904 Add_File (Arg, Source_Index);
|
|
|
905 end if;
|
|
|
906 end if;
|
|
|
907 end;
|
|
|
908
|
|
|
909 Index := Index + 1;
|
|
|
910 end loop;
|
|
|
911 end Parse_Cmd_Line;
|
|
|
912
|
|
|
913 -----------------------
|
|
|
914 -- Repinfo_File_Name --
|
|
|
915 -----------------------
|
|
|
916
|
|
|
917 function Repinfo_File_Name (Source : File_Name_Type) return String is
|
|
|
918 begin
|
|
|
919 return Get_Name_String (Source) & Repinfo_Suffix;
|
|
|
920 end Repinfo_File_Name;
|
|
|
921
|
|
|
922 --------------------
|
|
|
923 -- Tree_File_Name --
|
|
|
924 --------------------
|
|
|
925
|
|
|
926 function Tree_File_Name (Source : File_Name_Type) return String is
|
|
|
927 Src : constant String := Get_Name_String (Source);
|
|
|
928
|
|
|
929 begin
|
|
|
930 -- If source name has an extension, then replace it with the tree suffix
|
|
|
931
|
|
|
932 for Index in reverse Src'First + 1 .. Src'Last loop
|
|
|
933 if Src (Index) = '.' then
|
|
|
934 return Src (Src'First .. Index - 1) & Tree_Suffix;
|
|
|
935 end if;
|
|
|
936 end loop;
|
|
|
937
|
|
|
938 -- If there is no dot, or if it is the first character, just add the
|
|
|
939 -- tree suffix.
|
|
|
940
|
|
|
941 return Src & Tree_Suffix;
|
|
|
942 end Tree_File_Name;
|
|
|
943
|
|
|
944 -----------
|
|
|
945 -- Usage --
|
|
|
946 -----------
|
|
|
947
|
|
|
948 procedure Usage is
|
|
|
949 begin
|
|
|
950 if not Usage_Displayed then
|
|
|
951 Usage_Displayed := True;
|
|
|
952 Display_Copyright;
|
|
|
953 Put_Line ("Usage: gnatclean [switches] {[-innn] name}");
|
|
|
954 New_Line;
|
|
|
955
|
|
|
956 Display_Usage_Version_And_Help;
|
|
|
957
|
|
|
958 Put_Line (" names is one or more file names from which " &
|
|
|
959 "the .adb or .ads suffix may be omitted");
|
|
|
960 Put_Line (" names may be omitted if -P<project> is specified");
|
|
|
961 New_Line;
|
|
|
962
|
|
|
963 Put_Line (" --subdirs=dir real obj/lib/exec dirs are subdirs");
|
|
|
964 Put_Line (" " & Make_Util.Unchecked_Shared_Lib_Imports);
|
|
|
965 Put_Line (" Allow shared libraries to import static libraries");
|
|
|
966 New_Line;
|
|
|
967
|
|
|
968 Put_Line (" -c Only delete compiler generated files");
|
|
|
969 Put_Line (" -D dir Specify dir as the object library");
|
|
|
970 Put_Line (" -eL Follow symbolic links when processing " &
|
|
|
971 "project files");
|
|
|
972 Put_Line (" -f Force deletions of unwritable files");
|
|
|
973 Put_Line (" -F Full project path name " &
|
|
|
974 "in brief error messages");
|
|
|
975 Put_Line (" -h Display this message");
|
|
|
976 Put_Line (" -innn Index of unit in source for following names");
|
|
|
977 Put_Line (" -n Nothing to do: only list files to delete");
|
|
|
978 Put_Line (" -Pproj Use GNAT Project File proj");
|
|
|
979 Put_Line (" -q Be quiet/terse");
|
|
|
980 Put_Line (" -r Clean all projects recursively");
|
|
|
981 Put_Line (" -v Verbose mode");
|
|
|
982 Put_Line (" -vPx Specify verbosity when parsing " &
|
|
|
983 "GNAT Project Files");
|
|
|
984 Put_Line (" -Xnm=val Specify an external reference " &
|
|
|
985 "for GNAT Project Files");
|
|
|
986 New_Line;
|
|
|
987
|
|
|
988 Put_Line (" -aPdir Add directory dir to project search path");
|
|
|
989 New_Line;
|
|
|
990
|
|
|
991 Put_Line (" -aOdir Specify ALI/object files search path");
|
|
|
992 Put_Line (" -Idir Like -aOdir");
|
|
|
993 Put_Line (" -I- Don't look for source/library files " &
|
|
|
994 "in the default directory");
|
|
|
995 New_Line;
|
|
|
996 end if;
|
|
|
997 end Usage;
|
|
|
998
|
|
|
999 end Clean;
|
