|
111
|
1 ------------------------------------------------------------------------------
|
|
|
2 -- --
|
|
|
3 -- GNAT COMPILER COMPONENTS --
|
|
|
4 -- --
|
|
|
5 -- G N A T N A M E --
|
|
|
6 -- --
|
|
|
7 -- B o d y --
|
|
|
8 -- --
|
|
131
|
9 -- Copyright (C) 2001-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 Ada.Characters.Handling; use Ada.Characters.Handling;
|
|
|
27 with Ada.Command_Line; use Ada.Command_Line;
|
|
|
28 with Ada.Text_IO; use Ada.Text_IO;
|
|
|
29
|
|
|
30 with GNAT.Command_Line; use GNAT.Command_Line;
|
|
|
31 with GNAT.Directory_Operations; use GNAT.Directory_Operations;
|
|
|
32 with GNAT.Dynamic_Tables;
|
|
|
33 with GNAT.OS_Lib; use GNAT.OS_Lib;
|
|
|
34
|
|
|
35 with Make_Util; use Make_Util;
|
|
|
36 with Namet; use Namet;
|
|
|
37 with Opt;
|
|
|
38 with Osint; use Osint;
|
|
|
39 with Output;
|
|
|
40 with Switch; use Switch;
|
|
|
41 with Table;
|
|
|
42 with Tempdir;
|
|
|
43 with Types; use Types;
|
|
|
44
|
|
|
45 with System.CRTL;
|
|
|
46 with System.Regexp; use System.Regexp;
|
|
|
47
|
|
|
48 procedure Gnatname is
|
|
|
49
|
|
|
50 pragma Warnings (Off);
|
|
|
51 type Matched_Type is (True, False, Excluded);
|
|
|
52 pragma Warnings (On);
|
|
|
53
|
|
|
54 Create_Project : Boolean := False;
|
|
|
55
|
|
|
56 Subdirs_Switch : constant String := "--subdirs=";
|
|
|
57
|
|
|
58 Usage_Output : Boolean := False;
|
|
|
59 -- Set to True when usage is output, to avoid multiple output
|
|
|
60
|
|
|
61 Usage_Needed : Boolean := False;
|
|
|
62 -- Set to True by -h switch
|
|
|
63
|
|
|
64 Version_Output : Boolean := False;
|
|
|
65 -- Set to True when version is output, to avoid multiple output
|
|
|
66
|
|
|
67 Very_Verbose : Boolean := False;
|
|
|
68 -- Set to True with -v -v
|
|
|
69
|
|
|
70 File_Path : String_Access := new String'("gnat.adc");
|
|
|
71 -- Path name of the file specified by -c or -P switch
|
|
|
72
|
|
|
73 File_Set : Boolean := False;
|
|
|
74 -- Set to True by -c or -P switch.
|
|
|
75 -- Used to detect multiple -c/-P switches.
|
|
|
76
|
|
|
77 Args : Argument_List_Access;
|
|
|
78 -- The list of arguments for calls to the compiler to get the unit names
|
|
|
79 -- and kinds (spec or body) in the Ada sources.
|
|
|
80
|
|
|
81 Path_Name : String_Access;
|
|
|
82
|
|
|
83 Path_Last : Natural;
|
|
|
84
|
|
|
85 Directory_Last : Natural := 0;
|
|
|
86
|
|
|
87 function Dup (Fd : File_Descriptor) return File_Descriptor;
|
|
|
88
|
|
|
89 procedure Dup2 (Old_Fd, New_Fd : File_Descriptor);
|
|
|
90
|
|
|
91 Gcc : constant String := "gcc";
|
|
|
92 Gcc_Path : String_Access := null;
|
|
|
93
|
|
|
94 package Patterns is new GNAT.Dynamic_Tables
|
|
|
95 (Table_Component_Type => String_Access,
|
|
|
96 Table_Index_Type => Natural,
|
|
|
97 Table_Low_Bound => 0,
|
|
|
98 Table_Initial => 10,
|
|
|
99 Table_Increment => 100);
|
|
|
100 -- Table to accumulate the patterns
|
|
|
101
|
|
|
102 type Argument_Data is record
|
|
|
103 Directories : Patterns.Instance;
|
|
|
104 Name_Patterns : Patterns.Instance;
|
|
|
105 Excluded_Patterns : Patterns.Instance;
|
|
|
106 Foreign_Patterns : Patterns.Instance;
|
|
|
107 end record;
|
|
|
108
|
|
|
109 package Arguments is new Table.Table
|
|
|
110 (Table_Component_Type => Argument_Data,
|
|
|
111 Table_Index_Type => Natural,
|
|
|
112 Table_Low_Bound => 0,
|
|
|
113 Table_Initial => 10,
|
|
|
114 Table_Increment => 100,
|
|
|
115 Table_Name => "Gnatname.Arguments");
|
|
|
116 -- Table to accumulate directories and patterns
|
|
|
117
|
|
|
118 package Preprocessor_Switches is new Table.Table
|
|
|
119 (Table_Component_Type => String_Access,
|
|
|
120 Table_Index_Type => Natural,
|
|
|
121 Table_Low_Bound => 0,
|
|
|
122 Table_Initial => 10,
|
|
|
123 Table_Increment => 100,
|
|
|
124 Table_Name => "Gnatname.Preprocessor_Switches");
|
|
|
125 -- Table to store the preprocessor switches to be used in the call
|
|
|
126 -- to the compiler.
|
|
|
127
|
|
|
128 type Source is record
|
|
|
129 File_Name : Name_Id;
|
|
|
130 Unit_Name : Name_Id;
|
|
|
131 Index : Int := 0;
|
|
|
132 Spec : Boolean;
|
|
|
133 end record;
|
|
|
134
|
|
|
135 package Processed_Directories is new Table.Table
|
|
|
136 (Table_Component_Type => String_Access,
|
|
|
137 Table_Index_Type => Natural,
|
|
|
138 Table_Low_Bound => 0,
|
|
|
139 Table_Initial => 10,
|
|
|
140 Table_Increment => 100,
|
|
|
141 Table_Name => "Prj.Makr.Processed_Directories");
|
|
|
142 -- The list of already processed directories for each section, to avoid
|
|
|
143 -- processing several times the same directory in the same section.
|
|
|
144
|
|
|
145 package Sources is new Table.Table
|
|
|
146 (Table_Component_Type => Source,
|
|
|
147 Table_Index_Type => Natural,
|
|
|
148 Table_Low_Bound => 0,
|
|
|
149 Table_Initial => 10,
|
|
|
150 Table_Increment => 100,
|
|
|
151 Table_Name => "Gnatname.Sources");
|
|
|
152 -- The list of Ada sources found, with their unit name and kind, to be put
|
|
|
153 -- in the pragmas Source_File_Name in the configuration pragmas file.
|
|
|
154
|
|
|
155 procedure Output_Version;
|
|
|
156 -- Print name and version
|
|
|
157
|
|
|
158 procedure Usage;
|
|
|
159 -- Print usage
|
|
|
160
|
|
|
161 procedure Scan_Args;
|
|
|
162 -- Scan the command line arguments
|
|
|
163
|
|
|
164 procedure Add_Source_Directory (S : String);
|
|
|
165 -- Add S in the Source_Directories table
|
|
|
166
|
|
|
167 procedure Get_Directories (From_File : String);
|
|
|
168 -- Read a source directory text file
|
|
|
169
|
|
|
170 procedure Write_Eol;
|
|
|
171 -- Output an empty line
|
|
|
172
|
|
|
173 procedure Write_A_String (S : String);
|
|
|
174 -- Write a String to Output_FD
|
|
|
175
|
|
|
176 procedure Initialize
|
|
|
177 (File_Path : String;
|
|
|
178 Preproc_Switches : Argument_List);
|
|
|
179 -- Start the creation of a configuration pragmas file
|
|
|
180 --
|
|
|
181 -- File_Path is the name of the configuration pragmas file to create
|
|
|
182 --
|
|
|
183 -- Preproc_Switches is a list of switches to be used when invoking the
|
|
|
184 -- compiler to get the name and kind of unit of a source file.
|
|
|
185
|
|
|
186 type Regexp_List is array (Positive range <>) of Regexp;
|
|
|
187
|
|
|
188 procedure Process
|
|
|
189 (Directories : Argument_List;
|
|
|
190 Name_Patterns : Regexp_List;
|
|
|
191 Excluded_Patterns : Regexp_List;
|
|
|
192 Foreign_Patterns : Regexp_List);
|
|
|
193 -- Look for source files in the specified directories, with the specified
|
|
|
194 -- patterns.
|
|
|
195 --
|
|
|
196 -- Directories is the list of source directories where to look for sources.
|
|
|
197 --
|
|
|
198 -- Name_Patterns is a potentially empty list of file name patterns to check
|
|
|
199 -- for Ada Sources.
|
|
|
200 --
|
|
|
201 -- Excluded_Patterns is a potentially empty list of file name patterns that
|
|
|
202 -- should not be checked for Ada or non Ada sources.
|
|
|
203 --
|
|
|
204 -- Foreign_Patterns is a potentially empty list of file name patterns to
|
|
|
205 -- check for non Ada sources.
|
|
|
206 --
|
|
|
207 -- At least one of Name_Patterns and Foreign_Patterns is not empty
|
|
|
208
|
|
|
209 procedure Finalize;
|
|
|
210 -- Write the configuration pragmas file indicated in a call to procedure
|
|
|
211 -- Initialize, after one or several calls to procedure Process.
|
|
|
212
|
|
|
213 --------------------------
|
|
|
214 -- Add_Source_Directory --
|
|
|
215 --------------------------
|
|
|
216
|
|
|
217 procedure Add_Source_Directory (S : String) is
|
|
|
218 begin
|
|
|
219 Patterns.Append
|
|
|
220 (Arguments.Table (Arguments.Last).Directories, new String'(S));
|
|
|
221 end Add_Source_Directory;
|
|
|
222
|
|
|
223 ---------
|
|
|
224 -- Dup --
|
|
|
225 ---------
|
|
|
226
|
|
|
227 function Dup (Fd : File_Descriptor) return File_Descriptor is
|
|
|
228 begin
|
|
|
229 return File_Descriptor (System.CRTL.dup (Integer (Fd)));
|
|
|
230 end Dup;
|
|
|
231
|
|
|
232 ----------
|
|
|
233 -- Dup2 --
|
|
|
234 ----------
|
|
|
235
|
|
|
236 procedure Dup2 (Old_Fd, New_Fd : File_Descriptor) is
|
|
|
237 Fd : Integer;
|
|
|
238 pragma Warnings (Off, Fd);
|
|
|
239 begin
|
|
|
240 Fd := System.CRTL.dup2 (Integer (Old_Fd), Integer (New_Fd));
|
|
|
241 end Dup2;
|
|
|
242
|
|
|
243 ---------------------
|
|
|
244 -- Get_Directories --
|
|
|
245 ---------------------
|
|
|
246
|
|
|
247 procedure Get_Directories (From_File : String) is
|
|
|
248 File : Ada.Text_IO.File_Type;
|
|
|
249 Line : String (1 .. 2_000);
|
|
|
250 Last : Natural;
|
|
|
251
|
|
|
252 begin
|
|
|
253 Open (File, In_File, From_File);
|
|
|
254
|
|
|
255 while not End_Of_File (File) loop
|
|
|
256 Get_Line (File, Line, Last);
|
|
|
257
|
|
|
258 if Last /= 0 then
|
|
|
259 Add_Source_Directory (Line (1 .. Last));
|
|
|
260 end if;
|
|
|
261 end loop;
|
|
|
262
|
|
|
263 Close (File);
|
|
|
264
|
|
|
265 exception
|
|
|
266 when Name_Error =>
|
|
|
267 Fail ("cannot open source directory file """ & From_File & '"');
|
|
|
268 end Get_Directories;
|
|
|
269
|
|
|
270 --------------
|
|
|
271 -- Finalize --
|
|
|
272 --------------
|
|
|
273
|
|
|
274 procedure Finalize is
|
|
|
275 Discard : Boolean;
|
|
|
276 pragma Warnings (Off, Discard);
|
|
|
277
|
|
|
278 begin
|
|
|
279 -- Delete the file if it already exists
|
|
|
280
|
|
|
281 Delete_File
|
|
|
282 (Path_Name (Directory_Last + 1 .. Path_Last),
|
|
|
283 Success => Discard);
|
|
|
284
|
|
|
285 -- Create a new one
|
|
|
286
|
|
|
287 if Opt.Verbose_Mode then
|
|
|
288 Output.Write_Str ("Creating new file """);
|
|
|
289 Output.Write_Str (Path_Name (Directory_Last + 1 .. Path_Last));
|
|
|
290 Output.Write_Line ("""");
|
|
|
291 end if;
|
|
|
292
|
|
|
293 Output_FD := Create_New_File
|
|
|
294 (Path_Name (Directory_Last + 1 .. Path_Last),
|
|
|
295 Fmode => Text);
|
|
|
296
|
|
|
297 -- Fails if file cannot be created
|
|
|
298
|
|
|
299 if Output_FD = Invalid_FD then
|
|
|
300 Fail_Program
|
|
|
301 ("cannot create new """ & Path_Name (1 .. Path_Last) & """");
|
|
|
302 end if;
|
|
|
303
|
|
|
304 -- For each Ada source, write a pragma Source_File_Name to the
|
|
|
305 -- configuration pragmas file.
|
|
|
306
|
|
|
307 for Index in 1 .. Sources.Last loop
|
|
|
308 if Sources.Table (Index).Unit_Name /= No_Name then
|
|
|
309 Write_A_String ("pragma Source_File_Name");
|
|
|
310 Write_Eol;
|
|
|
311 Write_A_String (" (");
|
|
|
312 Write_A_String
|
|
|
313 (Get_Name_String (Sources.Table (Index).Unit_Name));
|
|
|
314 Write_A_String (",");
|
|
|
315 Write_Eol;
|
|
|
316
|
|
|
317 if Sources.Table (Index).Spec then
|
|
|
318 Write_A_String (" Spec_File_Name => """);
|
|
|
319
|
|
|
320 else
|
|
|
321 Write_A_String (" Body_File_Name => """);
|
|
|
322 end if;
|
|
|
323
|
|
|
324 Write_A_String
|
|
|
325 (Get_Name_String (Sources.Table (Index).File_Name));
|
|
|
326
|
|
|
327 Write_A_String ("""");
|
|
|
328
|
|
|
329 if Sources.Table (Index).Index /= 0 then
|
|
|
330 Write_A_String (", Index =>");
|
|
|
331 Write_A_String (Sources.Table (Index).Index'Img);
|
|
|
332 end if;
|
|
|
333
|
|
|
334 Write_A_String (");");
|
|
|
335 Write_Eol;
|
|
|
336 end if;
|
|
|
337 end loop;
|
|
|
338
|
|
|
339 Close (Output_FD);
|
|
|
340 end Finalize;
|
|
|
341
|
|
|
342 ----------------
|
|
|
343 -- Initialize --
|
|
|
344 ----------------
|
|
|
345
|
|
|
346 procedure Initialize
|
|
|
347 (File_Path : String;
|
|
|
348 Preproc_Switches : Argument_List)
|
|
|
349 is
|
|
|
350 begin
|
|
|
351 Sources.Set_Last (0);
|
|
|
352
|
|
|
353 -- Initialize the compiler switches
|
|
|
354
|
|
|
355 Args := new Argument_List (1 .. Preproc_Switches'Length + 6);
|
|
|
356 Args (1) := new String'("-c");
|
|
|
357 Args (2) := new String'("-gnats");
|
|
|
358 Args (3) := new String'("-gnatu");
|
|
|
359 Args (4 .. 3 + Preproc_Switches'Length) := Preproc_Switches;
|
|
|
360 Args (4 + Preproc_Switches'Length) := new String'("-x");
|
|
|
361 Args (5 + Preproc_Switches'Length) := new String'("ada");
|
|
|
362
|
|
|
363 -- Get the path and file names
|
|
|
364
|
|
|
365 Path_Name := new
|
|
|
366 String (1 .. File_Path'Length);
|
|
|
367 Path_Last := File_Path'Length;
|
|
|
368
|
|
|
369 if File_Names_Case_Sensitive then
|
|
|
370 Path_Name (1 .. Path_Last) := File_Path;
|
|
|
371 else
|
|
|
372 Path_Name (1 .. Path_Last) := To_Lower (File_Path);
|
|
|
373 end if;
|
|
|
374
|
|
|
375 -- Get the end of directory information, if any
|
|
|
376
|
|
|
377 for Index in reverse 1 .. Path_Last loop
|
|
|
378 if Path_Name (Index) = Directory_Separator then
|
|
|
379 Directory_Last := Index;
|
|
|
380 exit;
|
|
|
381 end if;
|
|
|
382 end loop;
|
|
|
383
|
|
|
384 -- Change the current directory to the directory of the project file,
|
|
|
385 -- if any directory information is specified.
|
|
|
386
|
|
|
387 if Directory_Last /= 0 then
|
|
|
388 begin
|
|
|
389 Change_Dir (Path_Name (1 .. Directory_Last));
|
|
|
390 exception
|
|
|
391 when Directory_Error =>
|
|
|
392 Fail_Program
|
|
|
393 ("unknown directory """
|
|
|
394 & Path_Name (1 .. Directory_Last)
|
|
|
395 & """");
|
|
|
396 end;
|
|
|
397 end if;
|
|
|
398 end Initialize;
|
|
|
399
|
|
|
400 -------------
|
|
|
401 -- Process --
|
|
|
402 -------------
|
|
|
403
|
|
|
404 procedure Process
|
|
|
405 (Directories : Argument_List;
|
|
|
406 Name_Patterns : Regexp_List;
|
|
|
407 Excluded_Patterns : Regexp_List;
|
|
|
408 Foreign_Patterns : Regexp_List)
|
|
|
409 is
|
|
|
410 procedure Process_Directory (Dir_Name : String);
|
|
|
411 -- Look for Ada and foreign sources in a directory, according to the
|
|
|
412 -- patterns.
|
|
|
413
|
|
|
414 -----------------------
|
|
|
415 -- Process_Directory --
|
|
|
416 -----------------------
|
|
|
417
|
|
|
418 procedure Process_Directory (Dir_Name : String) is
|
|
|
419 Matched : Matched_Type := False;
|
|
|
420 Str : String (1 .. 2_000);
|
|
|
421 Canon : String (1 .. 2_000);
|
|
|
422 Last : Natural;
|
|
|
423 Dir : Dir_Type;
|
|
|
424 Do_Process : Boolean := True;
|
|
|
425
|
|
|
426 Temp_File_Name : String_Access := null;
|
|
|
427 Save_Last_Source_Index : Natural := 0;
|
|
|
428 File_Name_Id : Name_Id := No_Name;
|
|
|
429
|
|
|
430 Current_Source : Source;
|
|
|
431
|
|
|
432 begin
|
|
|
433 -- Avoid processing the same directory more than once
|
|
|
434
|
|
|
435 for Index in 1 .. Processed_Directories.Last loop
|
|
|
436 if Processed_Directories.Table (Index).all = Dir_Name then
|
|
|
437 Do_Process := False;
|
|
|
438 exit;
|
|
|
439 end if;
|
|
|
440 end loop;
|
|
|
441
|
|
|
442 if Do_Process then
|
|
|
443 if Opt.Verbose_Mode then
|
|
|
444 Output.Write_Str ("Processing directory """);
|
|
|
445 Output.Write_Str (Dir_Name);
|
|
|
446 Output.Write_Line ("""");
|
|
|
447 end if;
|
|
|
448
|
|
|
449 Processed_Directories. Increment_Last;
|
|
|
450 Processed_Directories.Table (Processed_Directories.Last) :=
|
|
|
451 new String'(Dir_Name);
|
|
|
452
|
|
|
453 -- Get the source file names from the directory. Fails if the
|
|
|
454 -- directory does not exist.
|
|
|
455
|
|
|
456 begin
|
|
|
457 Open (Dir, Dir_Name);
|
|
|
458 exception
|
|
|
459 when Directory_Error =>
|
|
|
460 Fail_Program ("cannot open directory """ & Dir_Name & """");
|
|
|
461 end;
|
|
|
462
|
|
|
463 -- Process each regular file in the directory
|
|
|
464
|
|
|
465 File_Loop : loop
|
|
|
466 Read (Dir, Str, Last);
|
|
|
467 exit File_Loop when Last = 0;
|
|
|
468
|
|
|
469 -- Copy the file name and put it in canonical case to match
|
|
|
470 -- against the patterns that have themselves already been put
|
|
|
471 -- in canonical case.
|
|
|
472
|
|
|
473 Canon (1 .. Last) := Str (1 .. Last);
|
|
|
474 Canonical_Case_File_Name (Canon (1 .. Last));
|
|
|
475
|
|
|
476 if Is_Regular_File
|
|
|
477 (Dir_Name & Directory_Separator & Str (1 .. Last))
|
|
|
478 then
|
|
|
479 Matched := True;
|
|
|
480
|
|
|
481 Name_Len := Last;
|
|
|
482 Name_Buffer (1 .. Name_Len) := Str (1 .. Last);
|
|
|
483 File_Name_Id := Name_Find;
|
|
|
484
|
|
|
485 -- First, check if the file name matches at least one of
|
|
|
486 -- the excluded expressions;
|
|
|
487
|
|
|
488 for Index in Excluded_Patterns'Range loop
|
|
|
489 if
|
|
|
490 Match (Canon (1 .. Last), Excluded_Patterns (Index))
|
|
|
491 then
|
|
|
492 Matched := Excluded;
|
|
|
493 exit;
|
|
|
494 end if;
|
|
|
495 end loop;
|
|
|
496
|
|
|
497 -- If it does not match any of the excluded expressions,
|
|
|
498 -- check if the file name matches at least one of the
|
|
|
499 -- regular expressions.
|
|
|
500
|
|
|
501 if Matched = True then
|
|
|
502 Matched := False;
|
|
|
503
|
|
|
504 for Index in Name_Patterns'Range loop
|
|
|
505 if
|
|
|
506 Match
|
|
|
507 (Canon (1 .. Last), Name_Patterns (Index))
|
|
|
508 then
|
|
|
509 Matched := True;
|
|
|
510 exit;
|
|
|
511 end if;
|
|
|
512 end loop;
|
|
|
513 end if;
|
|
|
514
|
|
|
515 if Very_Verbose
|
|
|
516 or else (Matched = True and then Opt.Verbose_Mode)
|
|
|
517 then
|
|
|
518 Output.Write_Str (" Checking """);
|
|
|
519 Output.Write_Str (Str (1 .. Last));
|
|
|
520 Output.Write_Line (""": ");
|
|
|
521 end if;
|
|
|
522
|
|
|
523 -- If the file name matches one of the regular expressions,
|
|
|
524 -- parse it to get its unit name.
|
|
|
525
|
|
|
526 if Matched = True then
|
|
|
527 declare
|
|
|
528 FD : File_Descriptor;
|
|
|
529 Success : Boolean;
|
|
|
530 Saved_Output : File_Descriptor;
|
|
|
531 Saved_Error : File_Descriptor;
|
|
|
532 Tmp_File : Path_Name_Type;
|
|
|
533
|
|
|
534 begin
|
|
|
535 -- If we don't have the path of the compiler yet,
|
|
|
536 -- get it now. The compiler name may have a prefix,
|
|
|
537 -- so we get the potentially prefixed name.
|
|
|
538
|
|
|
539 if Gcc_Path = null then
|
|
|
540 declare
|
|
|
541 Prefix_Gcc : String_Access :=
|
|
|
542 Program_Name (Gcc, "gnatname");
|
|
|
543 begin
|
|
|
544 Gcc_Path :=
|
|
|
545 Locate_Exec_On_Path (Prefix_Gcc.all);
|
|
|
546 Free (Prefix_Gcc);
|
|
|
547 end;
|
|
|
548
|
|
|
549 if Gcc_Path = null then
|
|
|
550 Fail_Program ("could not locate " & Gcc);
|
|
|
551 end if;
|
|
|
552 end if;
|
|
|
553
|
|
|
554 -- Create the temporary file
|
|
|
555
|
|
|
556 Tempdir.Create_Temp_File (FD, Tmp_File);
|
|
|
557
|
|
|
558 if FD = Invalid_FD then
|
|
|
559 Fail_Program
|
|
|
560 ("could not create temporary file");
|
|
|
561
|
|
|
562 else
|
|
|
563 Temp_File_Name :=
|
|
|
564 new String'(Get_Name_String (Tmp_File));
|
|
|
565 end if;
|
|
|
566
|
|
|
567 Args (Args'Last) :=
|
|
|
568 new String'
|
|
|
569 (Dir_Name & Directory_Separator & Str (1 .. Last));
|
|
|
570
|
|
|
571 -- Save the standard output and error
|
|
|
572
|
|
|
573 Saved_Output := Dup (Standout);
|
|
|
574 Saved_Error := Dup (Standerr);
|
|
|
575
|
|
|
576 -- Set standard output and error to the temporary file
|
|
|
577
|
|
|
578 Dup2 (FD, Standout);
|
|
|
579 Dup2 (FD, Standerr);
|
|
|
580
|
|
|
581 -- And spawn the compiler
|
|
|
582
|
|
|
583 Spawn (Gcc_Path.all, Args.all, Success);
|
|
|
584
|
|
|
585 -- Restore the standard output and error
|
|
|
586
|
|
|
587 Dup2 (Saved_Output, Standout);
|
|
|
588 Dup2 (Saved_Error, Standerr);
|
|
|
589
|
|
|
590 -- Close the temporary file
|
|
|
591
|
|
|
592 Close (FD);
|
|
|
593
|
|
|
594 -- And close the saved standard output and error to
|
|
|
595 -- avoid too many file descriptors.
|
|
|
596
|
|
|
597 Close (Saved_Output);
|
|
|
598 Close (Saved_Error);
|
|
|
599
|
|
|
600 -- Now that standard output is restored, check if
|
|
|
601 -- the compiler ran correctly.
|
|
|
602
|
|
|
603 -- Read the lines of the temporary file:
|
|
|
604 -- they should contain the kind and name of the unit.
|
|
|
605
|
|
|
606 declare
|
|
|
607 File : Ada.Text_IO.File_Type;
|
|
|
608 Text_Line : String (1 .. 1_000);
|
|
|
609 Text_Last : Natural;
|
|
|
610
|
|
|
611 begin
|
|
|
612 begin
|
|
|
613 Open (File, In_File, Temp_File_Name.all);
|
|
|
614
|
|
|
615 exception
|
|
|
616 when others =>
|
|
|
617 Fail_Program
|
|
|
618 ("could not read temporary file " &
|
|
|
619 Temp_File_Name.all);
|
|
|
620 end;
|
|
|
621
|
|
|
622 Save_Last_Source_Index := Sources.Last;
|
|
|
623
|
|
|
624 if End_Of_File (File) then
|
|
|
625 if Opt.Verbose_Mode then
|
|
|
626 if not Success then
|
|
|
627 Output.Write_Str (" (process died) ");
|
|
|
628 end if;
|
|
|
629 end if;
|
|
|
630
|
|
|
631 else
|
|
|
632 Line_Loop : while not End_Of_File (File) loop
|
|
|
633 Get_Line (File, Text_Line, Text_Last);
|
|
|
634
|
|
|
635 -- Find the first closing parenthesis
|
|
|
636
|
|
|
637 Char_Loop : for J in 1 .. Text_Last loop
|
|
|
638 if Text_Line (J) = ')' then
|
|
|
639 if J >= 13 and then
|
|
|
640 Text_Line (1 .. 4) = "Unit"
|
|
|
641 then
|
|
|
642 -- Add entry to Sources table
|
|
|
643
|
|
|
644 Name_Len := J - 12;
|
|
|
645 Name_Buffer (1 .. Name_Len) :=
|
|
|
646 Text_Line (6 .. J - 7);
|
|
|
647 Current_Source :=
|
|
|
648 (Unit_Name => Name_Find,
|
|
|
649 File_Name => File_Name_Id,
|
|
|
650 Index => 0,
|
|
|
651 Spec => Text_Line (J - 5 .. J) =
|
|
|
652 "(spec)");
|
|
|
653
|
|
|
654 Sources.Append (Current_Source);
|
|
|
655 end if;
|
|
|
656
|
|
|
657 exit Char_Loop;
|
|
|
658 end if;
|
|
|
659 end loop Char_Loop;
|
|
|
660 end loop Line_Loop;
|
|
|
661 end if;
|
|
|
662
|
|
|
663 if Save_Last_Source_Index = Sources.Last then
|
|
|
664 if Opt.Verbose_Mode then
|
|
|
665 Output.Write_Line (" not a unit");
|
|
|
666 end if;
|
|
|
667
|
|
|
668 else
|
|
|
669 if Sources.Last >
|
|
|
670 Save_Last_Source_Index + 1
|
|
|
671 then
|
|
|
672 for Index in Save_Last_Source_Index + 1 ..
|
|
|
673 Sources.Last
|
|
|
674 loop
|
|
|
675 Sources.Table (Index).Index :=
|
|
|
676 Int (Index - Save_Last_Source_Index);
|
|
|
677 end loop;
|
|
|
678 end if;
|
|
|
679
|
|
|
680 for Index in Save_Last_Source_Index + 1 ..
|
|
|
681 Sources.Last
|
|
|
682 loop
|
|
|
683 Current_Source := Sources.Table (Index);
|
|
|
684
|
|
|
685 if Opt.Verbose_Mode then
|
|
|
686 if Current_Source.Spec then
|
|
|
687 Output.Write_Str (" spec of ");
|
|
|
688
|
|
|
689 else
|
|
|
690 Output.Write_Str (" body of ");
|
|
|
691 end if;
|
|
|
692
|
|
|
693 Output.Write_Line
|
|
|
694 (Get_Name_String
|
|
|
695 (Current_Source.Unit_Name));
|
|
|
696 end if;
|
|
|
697 end loop;
|
|
|
698 end if;
|
|
|
699
|
|
|
700 Close (File);
|
|
|
701
|
|
|
702 Delete_File (Temp_File_Name.all, Success);
|
|
|
703 end;
|
|
|
704 end;
|
|
|
705
|
|
|
706 -- File name matches none of the regular expressions
|
|
|
707
|
|
|
708 else
|
|
|
709 -- If file is not excluded, see if this is foreign source
|
|
|
710
|
|
|
711 if Matched /= Excluded then
|
|
|
712 for Index in Foreign_Patterns'Range loop
|
|
|
713 if Match (Canon (1 .. Last),
|
|
|
714 Foreign_Patterns (Index))
|
|
|
715 then
|
|
|
716 Matched := True;
|
|
|
717 exit;
|
|
|
718 end if;
|
|
|
719 end loop;
|
|
|
720 end if;
|
|
|
721
|
|
|
722 if Very_Verbose then
|
|
|
723 case Matched is
|
|
|
724 when False =>
|
|
|
725 Output.Write_Line ("no match");
|
|
|
726
|
|
|
727 when Excluded =>
|
|
|
728 Output.Write_Line ("excluded");
|
|
|
729
|
|
|
730 when True =>
|
|
|
731 Output.Write_Line ("foreign source");
|
|
|
732 end case;
|
|
|
733 end if;
|
|
|
734
|
|
|
735 if Matched = True then
|
|
|
736
|
|
|
737 -- Add source file name without unit name
|
|
|
738
|
|
|
739 Name_Len := 0;
|
|
|
740 Add_Str_To_Name_Buffer (Canon (1 .. Last));
|
|
|
741 Sources.Append
|
|
|
742 ((File_Name => Name_Find,
|
|
|
743 Unit_Name => No_Name,
|
|
|
744 Index => 0,
|
|
|
745 Spec => False));
|
|
|
746 end if;
|
|
|
747 end if;
|
|
|
748 end if;
|
|
|
749 end loop File_Loop;
|
|
|
750
|
|
|
751 Close (Dir);
|
|
|
752 end if;
|
|
|
753
|
|
|
754 end Process_Directory;
|
|
|
755
|
|
|
756 -- Start of processing for Process
|
|
|
757
|
|
|
758 begin
|
|
|
759 Processed_Directories.Set_Last (0);
|
|
|
760
|
|
|
761 -- Process each directory
|
|
|
762
|
|
|
763 for Index in Directories'Range loop
|
|
|
764 Process_Directory (Directories (Index).all);
|
|
|
765 end loop;
|
|
|
766 end Process;
|
|
|
767
|
|
|
768 --------------------
|
|
|
769 -- Output_Version --
|
|
|
770 --------------------
|
|
|
771
|
|
|
772 procedure Output_Version is
|
|
|
773 begin
|
|
|
774 if not Version_Output then
|
|
|
775 Version_Output := True;
|
|
|
776 Output.Write_Eol;
|
|
|
777 Display_Version ("GNATNAME", "2001");
|
|
|
778 end if;
|
|
|
779 end Output_Version;
|
|
|
780
|
|
|
781 ---------------
|
|
|
782 -- Scan_Args --
|
|
|
783 ---------------
|
|
|
784
|
|
|
785 procedure Scan_Args is
|
|
|
786
|
|
|
787 procedure Check_Version_And_Help is new Check_Version_And_Help_G (Usage);
|
|
|
788
|
|
|
789 Project_File_Name_Expected : Boolean;
|
|
|
790
|
|
|
791 Pragmas_File_Expected : Boolean;
|
|
|
792
|
|
|
793 Directory_Expected : Boolean;
|
|
|
794
|
|
|
795 Dir_File_Name_Expected : Boolean;
|
|
|
796
|
|
|
797 Foreign_Pattern_Expected : Boolean;
|
|
|
798
|
|
|
799 Excluded_Pattern_Expected : Boolean;
|
|
|
800
|
|
|
801 procedure Check_Regular_Expression (S : String);
|
|
|
802 -- Compile string S into a Regexp, fail if any error
|
|
|
803
|
|
|
804 -----------------------------
|
|
|
805 -- Check_Regular_Expression--
|
|
|
806 -----------------------------
|
|
|
807
|
|
|
808 procedure Check_Regular_Expression (S : String) is
|
|
|
809 Dummy : Regexp;
|
|
|
810 pragma Warnings (Off, Dummy);
|
|
|
811 begin
|
|
|
812 Dummy := Compile (S, Glob => True);
|
|
|
813 exception
|
|
|
814 when Error_In_Regexp =>
|
|
|
815 Fail ("invalid regular expression """ & S & """");
|
|
|
816 end Check_Regular_Expression;
|
|
|
817
|
|
|
818 -- Start of processing for Scan_Args
|
|
|
819
|
|
|
820 begin
|
|
|
821 -- First check for --version or --help
|
|
|
822
|
|
|
823 Check_Version_And_Help ("GNATNAME", "2001");
|
|
|
824
|
|
|
825 -- Now scan the other switches
|
|
|
826
|
|
|
827 Project_File_Name_Expected := False;
|
|
|
828 Pragmas_File_Expected := False;
|
|
|
829 Directory_Expected := False;
|
|
|
830 Dir_File_Name_Expected := False;
|
|
|
831 Foreign_Pattern_Expected := False;
|
|
|
832 Excluded_Pattern_Expected := False;
|
|
|
833
|
|
|
834 for Next_Arg in 1 .. Argument_Count loop
|
|
|
835 declare
|
|
|
836 Next_Argv : constant String := Argument (Next_Arg);
|
|
|
837 Arg : String (1 .. Next_Argv'Length) := Next_Argv;
|
|
|
838
|
|
|
839 begin
|
|
|
840 if Arg'Length > 0 then
|
|
|
841
|
|
|
842 -- -P xxx
|
|
|
843
|
|
|
844 if Project_File_Name_Expected then
|
|
|
845 if Arg (1) = '-' then
|
|
|
846 Fail ("project file name missing");
|
|
|
847
|
|
|
848 else
|
|
|
849 File_Set := True;
|
|
|
850 File_Path := new String'(Arg);
|
|
|
851 Project_File_Name_Expected := False;
|
|
|
852 end if;
|
|
|
853
|
|
|
854 -- -c file
|
|
|
855
|
|
|
856 elsif Pragmas_File_Expected then
|
|
|
857 File_Set := True;
|
|
|
858 File_Path := new String'(Arg);
|
|
|
859 Pragmas_File_Expected := False;
|
|
|
860
|
|
|
861 -- -d xxx
|
|
|
862
|
|
|
863 elsif Directory_Expected then
|
|
|
864 Add_Source_Directory (Arg);
|
|
|
865 Directory_Expected := False;
|
|
|
866
|
|
|
867 -- -D xxx
|
|
|
868
|
|
|
869 elsif Dir_File_Name_Expected then
|
|
|
870 Get_Directories (Arg);
|
|
|
871 Dir_File_Name_Expected := False;
|
|
|
872
|
|
|
873 -- -f xxx
|
|
|
874
|
|
|
875 elsif Foreign_Pattern_Expected then
|
|
|
876 Patterns.Append
|
|
|
877 (Arguments.Table (Arguments.Last).Foreign_Patterns,
|
|
|
878 new String'(Arg));
|
|
|
879 Check_Regular_Expression (Arg);
|
|
|
880 Foreign_Pattern_Expected := False;
|
|
|
881
|
|
|
882 -- -x xxx
|
|
|
883
|
|
|
884 elsif Excluded_Pattern_Expected then
|
|
|
885 Patterns.Append
|
|
|
886 (Arguments.Table (Arguments.Last).Excluded_Patterns,
|
|
|
887 new String'(Arg));
|
|
|
888 Check_Regular_Expression (Arg);
|
|
|
889 Excluded_Pattern_Expected := False;
|
|
|
890
|
|
|
891 -- There must be at least one Ada pattern or one foreign
|
|
|
892 -- pattern for the previous section.
|
|
|
893
|
|
|
894 -- --and
|
|
|
895
|
|
|
896 elsif Arg = "--and" then
|
|
|
897
|
|
|
898 if Patterns.Last
|
|
|
899 (Arguments.Table (Arguments.Last).Name_Patterns) = 0
|
|
|
900 and then
|
|
|
901 Patterns.Last
|
|
|
902 (Arguments.Table (Arguments.Last).Foreign_Patterns) = 0
|
|
|
903 then
|
|
|
904 Try_Help;
|
|
|
905 return;
|
|
|
906 end if;
|
|
|
907
|
|
|
908 -- If no directory were specified for the previous section,
|
|
|
909 -- then the directory is the project directory.
|
|
|
910
|
|
|
911 if Patterns.Last
|
|
|
912 (Arguments.Table (Arguments.Last).Directories) = 0
|
|
|
913 then
|
|
|
914 Patterns.Append
|
|
|
915 (Arguments.Table (Arguments.Last).Directories,
|
|
|
916 new String'("."));
|
|
|
917 end if;
|
|
|
918
|
|
|
919 -- Add and initialize another component to Arguments table
|
|
|
920
|
|
|
921 declare
|
|
|
922 New_Arguments : Argument_Data;
|
|
|
923 pragma Warnings (Off, New_Arguments);
|
|
|
924 -- Declaring this defaulted initialized object ensures
|
|
|
925 -- that the new allocated component of table Arguments
|
|
|
926 -- is correctly initialized.
|
|
|
927
|
|
|
928 -- This is VERY ugly, Table should never be used with
|
|
|
929 -- data requiring default initialization. We should
|
|
|
930 -- find a way to avoid violating this rule ???
|
|
|
931
|
|
|
932 begin
|
|
|
933 Arguments.Append (New_Arguments);
|
|
|
934 end;
|
|
|
935
|
|
|
936 Patterns.Init
|
|
|
937 (Arguments.Table (Arguments.Last).Directories);
|
|
|
938 Patterns.Set_Last
|
|
|
939 (Arguments.Table (Arguments.Last).Directories, 0);
|
|
|
940 Patterns.Init
|
|
|
941 (Arguments.Table (Arguments.Last).Name_Patterns);
|
|
|
942 Patterns.Set_Last
|
|
|
943 (Arguments.Table (Arguments.Last).Name_Patterns, 0);
|
|
|
944 Patterns.Init
|
|
|
945 (Arguments.Table (Arguments.Last).Excluded_Patterns);
|
|
|
946 Patterns.Set_Last
|
|
|
947 (Arguments.Table (Arguments.Last).Excluded_Patterns, 0);
|
|
|
948 Patterns.Init
|
|
|
949 (Arguments.Table (Arguments.Last).Foreign_Patterns);
|
|
|
950 Patterns.Set_Last
|
|
|
951 (Arguments.Table (Arguments.Last).Foreign_Patterns, 0);
|
|
|
952
|
|
|
953 -- Subdirectory switch
|
|
|
954
|
|
|
955 elsif Arg'Length > Subdirs_Switch'Length
|
|
|
956 and then Arg (1 .. Subdirs_Switch'Length) = Subdirs_Switch
|
|
|
957 then
|
|
|
958 null;
|
|
|
959 -- Subdirs are only used in gprname
|
|
|
960
|
|
|
961 -- --no-backup
|
|
|
962
|
|
|
963 elsif Arg = "--no-backup" then
|
|
|
964 Opt.No_Backup := True;
|
|
|
965
|
|
|
966 -- -c
|
|
|
967
|
|
|
968 elsif Arg'Length >= 2 and then Arg (1 .. 2) = "-c" then
|
|
|
969 if File_Set then
|
|
|
970 Fail ("only one -P or -c switch may be specified");
|
|
|
971 end if;
|
|
|
972
|
|
|
973 if Arg'Length = 2 then
|
|
|
974 Pragmas_File_Expected := True;
|
|
|
975
|
|
|
976 if Next_Arg = Argument_Count then
|
|
|
977 Fail ("configuration pragmas file name missing");
|
|
|
978 end if;
|
|
|
979
|
|
|
980 else
|
|
|
981 File_Set := True;
|
|
|
982 File_Path := new String'(Arg (3 .. Arg'Last));
|
|
|
983 end if;
|
|
|
984
|
|
|
985 -- -d
|
|
|
986
|
|
|
987 elsif Arg'Length >= 2 and then Arg (1 .. 2) = "-d" then
|
|
|
988 if Arg'Length = 2 then
|
|
|
989 Directory_Expected := True;
|
|
|
990
|
|
|
991 if Next_Arg = Argument_Count then
|
|
|
992 Fail ("directory name missing");
|
|
|
993 end if;
|
|
|
994
|
|
|
995 else
|
|
|
996 Add_Source_Directory (Arg (3 .. Arg'Last));
|
|
|
997 end if;
|
|
|
998
|
|
|
999 -- -D
|
|
|
1000
|
|
|
1001 elsif Arg'Length >= 2 and then Arg (1 .. 2) = "-D" then
|
|
|
1002 if Arg'Length = 2 then
|
|
|
1003 Dir_File_Name_Expected := True;
|
|
|
1004
|
|
|
1005 if Next_Arg = Argument_Count then
|
|
|
1006 Fail ("directory list file name missing");
|
|
|
1007 end if;
|
|
|
1008
|
|
|
1009 else
|
|
|
1010 Get_Directories (Arg (3 .. Arg'Last));
|
|
|
1011 end if;
|
|
|
1012
|
|
|
1013 -- -eL
|
|
|
1014
|
|
|
1015 elsif Arg = "-eL" then
|
|
|
1016 Opt.Follow_Links_For_Files := True;
|
|
|
1017 Opt.Follow_Links_For_Dirs := True;
|
|
|
1018
|
|
|
1019 -- -f
|
|
|
1020
|
|
|
1021 elsif Arg'Length >= 2 and then Arg (1 .. 2) = "-f" then
|
|
|
1022 if Arg'Length = 2 then
|
|
|
1023 Foreign_Pattern_Expected := True;
|
|
|
1024
|
|
|
1025 if Next_Arg = Argument_Count then
|
|
|
1026 Fail ("foreign pattern missing");
|
|
|
1027 end if;
|
|
|
1028
|
|
|
1029 else
|
|
|
1030 Patterns.Append
|
|
|
1031 (Arguments.Table (Arguments.Last).Foreign_Patterns,
|
|
|
1032 new String'(Arg (3 .. Arg'Last)));
|
|
|
1033 Check_Regular_Expression (Arg (3 .. Arg'Last));
|
|
|
1034 end if;
|
|
|
1035
|
|
|
1036 -- -gnatep or -gnateD
|
|
|
1037
|
|
|
1038 elsif Arg'Length > 7 and then
|
|
|
1039 (Arg (1 .. 7) = "-gnatep" or else Arg (1 .. 7) = "-gnateD")
|
|
|
1040 then
|
|
|
1041 Preprocessor_Switches.Append (new String'(Arg));
|
|
|
1042
|
|
|
1043 -- -h
|
|
|
1044
|
|
|
1045 elsif Arg = "-h" then
|
|
|
1046 Usage_Needed := True;
|
|
|
1047
|
|
|
1048 -- -P
|
|
|
1049
|
|
|
1050 elsif Arg'Length >= 2 and then Arg (1 .. 2) = "-P" then
|
|
|
1051 if File_Set then
|
|
|
1052 Fail ("only one -c or -P switch may be specified");
|
|
|
1053 end if;
|
|
|
1054
|
|
|
1055 if Arg'Length = 2 then
|
|
|
1056 if Next_Arg = Argument_Count then
|
|
|
1057 Fail ("project file name missing");
|
|
|
1058
|
|
|
1059 else
|
|
|
1060 Project_File_Name_Expected := True;
|
|
|
1061 end if;
|
|
|
1062
|
|
|
1063 else
|
|
|
1064 File_Set := True;
|
|
|
1065 File_Path := new String'(Arg (3 .. Arg'Last));
|
|
|
1066 end if;
|
|
|
1067
|
|
|
1068 Create_Project := True;
|
|
|
1069
|
|
|
1070 -- -v
|
|
|
1071
|
|
|
1072 elsif Arg = "-v" then
|
|
|
1073 if Opt.Verbose_Mode then
|
|
|
1074 Very_Verbose := True;
|
|
|
1075 else
|
|
|
1076 Opt.Verbose_Mode := True;
|
|
|
1077 end if;
|
|
|
1078
|
|
|
1079 -- -x
|
|
|
1080
|
|
|
1081 elsif Arg'Length >= 2 and then Arg (1 .. 2) = "-x" then
|
|
|
1082 if Arg'Length = 2 then
|
|
|
1083 Excluded_Pattern_Expected := True;
|
|
|
1084
|
|
|
1085 if Next_Arg = Argument_Count then
|
|
|
1086 Fail ("excluded pattern missing");
|
|
|
1087 end if;
|
|
|
1088
|
|
|
1089 else
|
|
|
1090 Patterns.Append
|
|
|
1091 (Arguments.Table (Arguments.Last).Excluded_Patterns,
|
|
|
1092 new String'(Arg (3 .. Arg'Last)));
|
|
|
1093 Check_Regular_Expression (Arg (3 .. Arg'Last));
|
|
|
1094 end if;
|
|
|
1095
|
|
|
1096 -- Junk switch starting with minus
|
|
|
1097
|
|
|
1098 elsif Arg (1) = '-' then
|
|
|
1099 Fail ("wrong switch: " & Arg);
|
|
|
1100
|
|
|
1101 -- Not a recognized switch, assume file name
|
|
|
1102
|
|
|
1103 else
|
|
|
1104 Canonical_Case_File_Name (Arg);
|
|
|
1105 Patterns.Append
|
|
|
1106 (Arguments.Table (Arguments.Last).Name_Patterns,
|
|
|
1107 new String'(Arg));
|
|
|
1108 Check_Regular_Expression (Arg);
|
|
|
1109 end if;
|
|
|
1110 end if;
|
|
|
1111 end;
|
|
|
1112 end loop;
|
|
|
1113 end Scan_Args;
|
|
|
1114
|
|
|
1115 -----------
|
|
|
1116 -- Usage --
|
|
|
1117 -----------
|
|
|
1118
|
|
|
1119 procedure Usage is
|
|
|
1120 begin
|
|
|
1121 if not Usage_Output then
|
|
|
1122 Usage_Needed := False;
|
|
|
1123 Usage_Output := True;
|
|
|
1124 Output.Write_Str ("Usage: ");
|
|
|
1125 Osint.Write_Program_Name;
|
|
|
1126 Output.Write_Line (" [switches] naming-pattern [naming-patterns]");
|
|
|
1127 Output.Write_Line
|
|
|
1128 (" {--and [switches] naming-pattern [naming-patterns]}");
|
|
|
1129 Output.Write_Eol;
|
|
|
1130 Output.Write_Line ("switches:");
|
|
|
1131
|
|
|
1132 Display_Usage_Version_And_Help;
|
|
|
1133
|
|
|
1134 Output.Write_Line
|
|
|
1135 (" --subdirs=dir real obj/lib/exec dirs are subdirs");
|
|
|
1136 Output.Write_Line
|
|
|
1137 (" --no-backup do not create backup of project file");
|
|
|
1138 Output.Write_Eol;
|
|
|
1139
|
|
|
1140 Output.Write_Line (" --and use different patterns");
|
|
|
1141 Output.Write_Eol;
|
|
|
1142
|
|
|
1143 Output.Write_Line
|
|
|
1144 (" -cfile create configuration pragmas file");
|
|
|
1145 Output.Write_Line (" -ddir use dir as one of the source " &
|
|
|
1146 "directories");
|
|
|
1147 Output.Write_Line (" -Dfile get source directories from file");
|
|
|
1148 Output.Write_Line
|
|
|
1149 (" -eL follow symbolic links when processing " &
|
|
|
1150 "project files");
|
|
|
1151 Output.Write_Line (" -fpat foreign pattern");
|
|
|
1152 Output.Write_Line
|
|
|
1153 (" -gnateDsym=v preprocess with symbol definition");
|
|
|
1154 Output.Write_Line (" -gnatep=data preprocess files with data file");
|
|
|
1155 Output.Write_Line (" -h output this help message");
|
|
|
1156 Output.Write_Line
|
|
|
1157 (" -Pproj update or create project file proj");
|
|
|
1158 Output.Write_Line (" -v verbose output");
|
|
|
1159 Output.Write_Line (" -v -v very verbose output");
|
|
|
1160 Output.Write_Line (" -xpat exclude pattern pat");
|
|
|
1161 end if;
|
|
|
1162 end Usage;
|
|
|
1163
|
|
|
1164 ---------------
|
|
|
1165 -- Write_Eol --
|
|
|
1166 ---------------
|
|
|
1167
|
|
|
1168 procedure Write_Eol is
|
|
|
1169 begin
|
|
|
1170 Write_A_String ((1 => ASCII.LF));
|
|
|
1171 end Write_Eol;
|
|
|
1172
|
|
|
1173 --------------------
|
|
|
1174 -- Write_A_String --
|
|
|
1175 --------------------
|
|
|
1176
|
|
|
1177 procedure Write_A_String (S : String) is
|
|
|
1178 Str : String (1 .. S'Length);
|
|
|
1179
|
|
|
1180 begin
|
|
|
1181 if S'Length > 0 then
|
|
|
1182 Str := S;
|
|
|
1183
|
|
|
1184 if Write (Output_FD, Str (1)'Address, Str'Length) /= Str'Length then
|
|
|
1185 Fail_Program ("disk full");
|
|
|
1186 end if;
|
|
|
1187 end if;
|
|
|
1188 end Write_A_String;
|
|
|
1189
|
|
|
1190 -- Start of processing for Gnatname
|
|
|
1191
|
|
|
1192 begin
|
|
|
1193 -- Add the directory where gnatname is invoked in front of the
|
|
|
1194 -- path, if gnatname is invoked with directory information.
|
|
|
1195
|
|
|
1196 declare
|
|
|
1197 Command : constant String := Command_Name;
|
|
|
1198
|
|
|
1199 begin
|
|
|
1200 for Index in reverse Command'Range loop
|
|
|
1201 if Command (Index) = Directory_Separator then
|
|
|
1202 declare
|
|
|
1203 Absolute_Dir : constant String :=
|
|
|
1204 Normalize_Pathname
|
|
|
1205 (Command (Command'First .. Index));
|
|
|
1206
|
|
|
1207 PATH : constant String :=
|
|
|
1208 Absolute_Dir &
|
|
|
1209 Path_Separator &
|
|
|
1210 Getenv ("PATH").all;
|
|
|
1211
|
|
|
1212 begin
|
|
|
1213 Setenv ("PATH", PATH);
|
|
|
1214 end;
|
|
|
1215
|
|
|
1216 exit;
|
|
|
1217 end if;
|
|
|
1218 end loop;
|
|
|
1219 end;
|
|
|
1220
|
|
|
1221 -- Initialize tables
|
|
|
1222
|
|
|
1223 Arguments.Set_Last (0);
|
|
|
1224 declare
|
|
|
1225 New_Arguments : Argument_Data;
|
|
|
1226 pragma Warnings (Off, New_Arguments);
|
|
|
1227 -- Declaring this defaulted initialized object ensures that the new
|
|
|
1228 -- allocated component of table Arguments is correctly initialized.
|
|
|
1229 begin
|
|
|
1230 Arguments.Append (New_Arguments);
|
|
|
1231 end;
|
|
|
1232
|
|
|
1233 Patterns.Init (Arguments.Table (1).Directories);
|
|
|
1234 Patterns.Set_Last (Arguments.Table (1).Directories, 0);
|
|
|
1235 Patterns.Init (Arguments.Table (1).Name_Patterns);
|
|
|
1236 Patterns.Set_Last (Arguments.Table (1).Name_Patterns, 0);
|
|
|
1237 Patterns.Init (Arguments.Table (1).Excluded_Patterns);
|
|
|
1238 Patterns.Set_Last (Arguments.Table (1).Excluded_Patterns, 0);
|
|
|
1239 Patterns.Init (Arguments.Table (1).Foreign_Patterns);
|
|
|
1240 Patterns.Set_Last (Arguments.Table (1).Foreign_Patterns, 0);
|
|
|
1241
|
|
|
1242 Preprocessor_Switches.Set_Last (0);
|
|
|
1243
|
|
|
1244 -- Get the arguments
|
|
|
1245
|
|
|
1246 Scan_Args;
|
|
|
1247
|
|
|
1248 if Create_Project then
|
|
|
1249 declare
|
|
|
1250 Gprname_Path : constant String_Access :=
|
|
|
1251 Locate_Exec_On_Path ("gprname");
|
|
|
1252 Arg_Len : Natural := Argument_Count;
|
|
|
1253 Pos : Natural := 0;
|
|
|
1254 Target : String_Access := null;
|
|
|
1255 Success : Boolean := False;
|
|
|
1256 begin
|
|
|
1257 if Gprname_Path = null then
|
|
|
1258 Fail_Program
|
|
|
1259 ("project files are no longer supported by gnatname;" &
|
|
|
1260 " use gprname instead");
|
|
|
1261 end if;
|
|
|
1262
|
|
|
1263 Find_Program_Name;
|
|
|
1264
|
|
|
1265 if Name_Len > 9
|
|
|
1266 and then Name_Buffer (Name_Len - 7 .. Name_Len) = "gnatname"
|
|
|
1267 then
|
|
|
1268 Target := new String'(Name_Buffer (1 .. Name_Len - 9));
|
|
|
1269 Arg_Len := Arg_Len + 1;
|
|
|
1270 end if;
|
|
|
1271
|
|
|
1272 declare
|
|
|
1273 Args : Argument_List (1 .. Arg_Len);
|
|
|
1274 begin
|
|
|
1275 if Target /= null then
|
|
|
1276 Args (1) := new String'("--target=" & Target.all);
|
|
|
1277 Pos := 1;
|
|
|
1278 end if;
|
|
|
1279
|
|
|
1280 for J in 1 .. Argument_Count loop
|
|
|
1281 Pos := Pos + 1;
|
|
|
1282 Args (Pos) := new String'(Argument (J));
|
|
|
1283 end loop;
|
|
|
1284
|
|
|
1285 Spawn (Gprname_Path.all, Args, Success);
|
|
|
1286
|
|
|
1287 if Success then
|
|
|
1288 Exit_Program (E_Success);
|
|
|
1289 else
|
|
|
1290 Exit_Program (E_Errors);
|
|
|
1291 end if;
|
|
|
1292 end;
|
|
|
1293 end;
|
|
|
1294 end if;
|
|
|
1295
|
|
|
1296 if Opt.Verbose_Mode then
|
|
|
1297 Output_Version;
|
|
|
1298 end if;
|
|
|
1299
|
|
|
1300 if Usage_Needed then
|
|
|
1301 Usage;
|
|
|
1302 end if;
|
|
|
1303
|
|
|
1304 -- If no Ada or foreign pattern was specified, print the usage and return
|
|
|
1305
|
|
|
1306 if Patterns.Last (Arguments.Table (Arguments.Last).Name_Patterns) = 0
|
|
|
1307 and then
|
|
|
1308 Patterns.Last (Arguments.Table (Arguments.Last).Foreign_Patterns) = 0
|
|
|
1309 then
|
|
|
1310 if Argument_Count = 0 then
|
|
|
1311 Usage;
|
|
|
1312 elsif not Usage_Output then
|
|
|
1313 Try_Help;
|
|
|
1314 end if;
|
|
|
1315
|
|
|
1316 return;
|
|
|
1317 end if;
|
|
|
1318
|
|
|
1319 -- If no source directory was specified, use the current directory as the
|
|
|
1320 -- unique directory. Note that if a file was specified with directory
|
|
|
1321 -- information, the current directory is the directory of the specified
|
|
|
1322 -- file.
|
|
|
1323
|
|
|
1324 if Patterns.Last (Arguments.Table (Arguments.Last).Directories) = 0 then
|
|
|
1325 Patterns.Append
|
|
|
1326 (Arguments.Table (Arguments.Last).Directories, new String'("."));
|
|
|
1327 end if;
|
|
|
1328
|
|
|
1329 -- Initialize
|
|
|
1330
|
|
|
1331 declare
|
|
|
1332 Prep_Switches : Argument_List
|
|
|
1333 (1 .. Integer (Preprocessor_Switches.Last));
|
|
|
1334
|
|
|
1335 begin
|
|
|
1336 for Index in Prep_Switches'Range loop
|
|
|
1337 Prep_Switches (Index) := Preprocessor_Switches.Table (Index);
|
|
|
1338 end loop;
|
|
|
1339
|
|
|
1340 Initialize
|
|
|
1341 (File_Path => File_Path.all,
|
|
|
1342 Preproc_Switches => Prep_Switches);
|
|
|
1343 end;
|
|
|
1344
|
|
|
1345 -- Process each section successively
|
|
|
1346
|
|
|
1347 for J in 1 .. Arguments.Last loop
|
|
|
1348 declare
|
|
|
1349 Directories : Argument_List
|
|
|
1350 (1 .. Integer
|
|
|
1351 (Patterns.Last (Arguments.Table (J).Directories)));
|
|
|
1352 Name_Patterns : Regexp_List
|
|
|
1353 (1 .. Integer
|
|
|
1354 (Patterns.Last (Arguments.Table (J).Name_Patterns)));
|
|
|
1355 Excl_Patterns : Regexp_List
|
|
|
1356 (1 .. Integer
|
|
|
1357 (Patterns.Last (Arguments.Table (J).Excluded_Patterns)));
|
|
|
1358 Frgn_Patterns : Regexp_List
|
|
|
1359 (1 .. Integer
|
|
|
1360 (Patterns.Last (Arguments.Table (J).Foreign_Patterns)));
|
|
|
1361
|
|
|
1362 begin
|
|
|
1363 -- Build the Directories and Patterns arguments
|
|
|
1364
|
|
|
1365 for Index in Directories'Range loop
|
|
|
1366 Directories (Index) :=
|
|
|
1367 Arguments.Table (J).Directories.Table (Index);
|
|
|
1368 end loop;
|
|
|
1369
|
|
|
1370 for Index in Name_Patterns'Range loop
|
|
|
1371 Name_Patterns (Index) :=
|
|
|
1372 Compile
|
|
|
1373 (Arguments.Table (J).Name_Patterns.Table (Index).all,
|
|
|
1374 Glob => True);
|
|
|
1375 end loop;
|
|
|
1376
|
|
|
1377 for Index in Excl_Patterns'Range loop
|
|
|
1378 Excl_Patterns (Index) :=
|
|
|
1379 Compile
|
|
|
1380 (Arguments.Table (J).Excluded_Patterns.Table (Index).all,
|
|
|
1381 Glob => True);
|
|
|
1382 end loop;
|
|
|
1383
|
|
|
1384 for Index in Frgn_Patterns'Range loop
|
|
|
1385 Frgn_Patterns (Index) :=
|
|
|
1386 Compile
|
|
|
1387 (Arguments.Table (J).Foreign_Patterns.Table (Index).all,
|
|
|
1388 Glob => True);
|
|
|
1389 end loop;
|
|
|
1390
|
|
|
1391 -- Call Prj.Makr.Process where the real work is done
|
|
|
1392
|
|
|
1393 Process
|
|
|
1394 (Directories => Directories,
|
|
|
1395 Name_Patterns => Name_Patterns,
|
|
|
1396 Excluded_Patterns => Excl_Patterns,
|
|
|
1397 Foreign_Patterns => Frgn_Patterns);
|
|
|
1398 end;
|
|
|
1399 end loop;
|
|
|
1400
|
|
|
1401 -- Finalize
|
|
|
1402
|
|
|
1403 Finalize;
|
|
|
1404
|
|
|
1405 if Opt.Verbose_Mode then
|
|
|
1406 Output.Write_Eol;
|
|
|
1407 end if;
|
|
|
1408 end Gnatname;
|
