|
111
|
1 ------------------------------------------------------------------------------
|
|
|
2 -- --
|
|
|
3 -- GNAT COMPILER COMPONENTS --
|
|
|
4 -- --
|
|
|
5 -- G N A T C M D --
|
|
|
6 -- --
|
|
|
7 -- B o d y --
|
|
|
8 -- --
|
|
|
9 -- Copyright (C) 1996-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 Gnatvsn;
|
|
|
27 with Namet; use Namet;
|
|
|
28 with Opt; use Opt;
|
|
|
29 with Osint; use Osint;
|
|
|
30 with Output; use Output;
|
|
|
31 with Switch; use Switch;
|
|
|
32 with Table;
|
|
|
33
|
|
|
34 with Ada.Characters.Handling; use Ada.Characters.Handling;
|
|
|
35 with Ada.Command_Line; use Ada.Command_Line;
|
|
|
36 with Ada.Text_IO; use Ada.Text_IO;
|
|
|
37
|
|
|
38 with GNAT.OS_Lib; use GNAT.OS_Lib;
|
|
|
39
|
|
|
40 procedure GNATCmd is
|
|
|
41 Gprbuild : constant String := "gprbuild";
|
|
|
42 Gprclean : constant String := "gprclean";
|
|
|
43 Gprname : constant String := "gprname";
|
|
|
44 Gprls : constant String := "gprls";
|
|
|
45
|
|
|
46 Error_Exit : exception;
|
|
|
47 -- Raise this exception if error detected
|
|
|
48
|
|
|
49 type Command_Type is
|
|
|
50 (Bind,
|
|
|
51 Chop,
|
|
|
52 Clean,
|
|
|
53 Compile,
|
|
|
54 Check,
|
|
|
55 Elim,
|
|
|
56 Find,
|
|
|
57 Krunch,
|
|
|
58 Link,
|
|
|
59 List,
|
|
|
60 Make,
|
|
|
61 Metric,
|
|
|
62 Name,
|
|
|
63 Preprocess,
|
|
|
64 Pretty,
|
|
|
65 Stack,
|
|
|
66 Stub,
|
|
|
67 Test,
|
|
|
68 Xref,
|
|
|
69 Undefined);
|
|
|
70
|
|
|
71 subtype Real_Command_Type is Command_Type range Bind .. Xref;
|
|
|
72 -- All real command types (excludes only Undefined).
|
|
|
73
|
|
|
74 type Alternate_Command is (Comp, Ls, Kr, Pp, Prep);
|
|
|
75 -- Alternate command label
|
|
|
76
|
|
|
77 Corresponding_To : constant array (Alternate_Command) of Command_Type :=
|
|
|
78 (Comp => Compile,
|
|
|
79 Ls => List,
|
|
|
80 Kr => Krunch,
|
|
|
81 Prep => Preprocess,
|
|
|
82 Pp => Pretty);
|
|
|
83 -- Mapping of alternate commands to commands
|
|
|
84
|
|
|
85 package First_Switches is new Table.Table
|
|
|
86 (Table_Component_Type => String_Access,
|
|
|
87 Table_Index_Type => Integer,
|
|
|
88 Table_Low_Bound => 1,
|
|
|
89 Table_Initial => 20,
|
|
|
90 Table_Increment => 100,
|
|
|
91 Table_Name => "Gnatcmd.First_Switches");
|
|
|
92 -- A table to keep the switches from the project file
|
|
|
93
|
|
|
94 package Last_Switches is new Table.Table
|
|
|
95 (Table_Component_Type => String_Access,
|
|
|
96 Table_Index_Type => Integer,
|
|
|
97 Table_Low_Bound => 1,
|
|
|
98 Table_Initial => 20,
|
|
|
99 Table_Increment => 100,
|
|
|
100 Table_Name => "Gnatcmd.Last_Switches");
|
|
|
101
|
|
|
102 ----------------------------------
|
|
|
103 -- Declarations for GNATCMD use --
|
|
|
104 ----------------------------------
|
|
|
105
|
|
|
106 The_Command : Command_Type;
|
|
|
107 -- The command specified in the invocation of the GNAT driver
|
|
|
108
|
|
|
109 Command_Arg : Positive := 1;
|
|
|
110 -- The index of the command in the arguments of the GNAT driver
|
|
|
111
|
|
|
112 My_Exit_Status : Exit_Status := Success;
|
|
|
113 -- The exit status of the spawned tool
|
|
|
114
|
|
|
115 type Command_Entry is record
|
|
|
116 Cname : String_Access;
|
|
|
117 -- Command name for GNAT xxx command
|
|
|
118
|
|
|
119 Unixcmd : String_Access;
|
|
|
120 -- Corresponding Unix command
|
|
|
121
|
|
|
122 Unixsws : Argument_List_Access;
|
|
|
123 -- List of switches to be used with the Unix command
|
|
|
124 end record;
|
|
|
125
|
|
|
126 Command_List : constant array (Real_Command_Type) of Command_Entry :=
|
|
|
127 (Bind =>
|
|
|
128 (Cname => new String'("BIND"),
|
|
|
129 Unixcmd => new String'("gnatbind"),
|
|
|
130 Unixsws => null),
|
|
|
131
|
|
|
132 Chop =>
|
|
|
133 (Cname => new String'("CHOP"),
|
|
|
134 Unixcmd => new String'("gnatchop"),
|
|
|
135 Unixsws => null),
|
|
|
136
|
|
|
137 Clean =>
|
|
|
138 (Cname => new String'("CLEAN"),
|
|
|
139 Unixcmd => new String'("gnatclean"),
|
|
|
140 Unixsws => null),
|
|
|
141
|
|
|
142 Compile =>
|
|
|
143 (Cname => new String'("COMPILE"),
|
|
|
144 Unixcmd => new String'("gnatmake"),
|
|
|
145 Unixsws => new Argument_List'(1 => new String'("-f"),
|
|
|
146 2 => new String'("-u"),
|
|
|
147 3 => new String'("-c"))),
|
|
|
148
|
|
|
149 Check =>
|
|
|
150 (Cname => new String'("CHECK"),
|
|
|
151 Unixcmd => new String'("gnatcheck"),
|
|
|
152 Unixsws => null),
|
|
|
153
|
|
|
154 Elim =>
|
|
|
155 (Cname => new String'("ELIM"),
|
|
|
156 Unixcmd => new String'("gnatelim"),
|
|
|
157 Unixsws => null),
|
|
|
158
|
|
|
159 Find =>
|
|
|
160 (Cname => new String'("FIND"),
|
|
|
161 Unixcmd => new String'("gnatfind"),
|
|
|
162 Unixsws => null),
|
|
|
163
|
|
|
164 Krunch =>
|
|
|
165 (Cname => new String'("KRUNCH"),
|
|
|
166 Unixcmd => new String'("gnatkr"),
|
|
|
167 Unixsws => null),
|
|
|
168
|
|
|
169 Link =>
|
|
|
170 (Cname => new String'("LINK"),
|
|
|
171 Unixcmd => new String'("gnatlink"),
|
|
|
172 Unixsws => null),
|
|
|
173
|
|
|
174 List =>
|
|
|
175 (Cname => new String'("LIST"),
|
|
|
176 Unixcmd => new String'("gnatls"),
|
|
|
177 Unixsws => null),
|
|
|
178
|
|
|
179 Make =>
|
|
|
180 (Cname => new String'("MAKE"),
|
|
|
181 Unixcmd => new String'("gnatmake"),
|
|
|
182 Unixsws => null),
|
|
|
183
|
|
|
184 Metric =>
|
|
|
185 (Cname => new String'("METRIC"),
|
|
|
186 Unixcmd => new String'("gnatmetric"),
|
|
|
187 Unixsws => null),
|
|
|
188
|
|
|
189 Name =>
|
|
|
190 (Cname => new String'("NAME"),
|
|
|
191 Unixcmd => new String'("gnatname"),
|
|
|
192 Unixsws => null),
|
|
|
193
|
|
|
194 Preprocess =>
|
|
|
195 (Cname => new String'("PREPROCESS"),
|
|
|
196 Unixcmd => new String'("gnatprep"),
|
|
|
197 Unixsws => null),
|
|
|
198
|
|
|
199 Pretty =>
|
|
|
200 (Cname => new String'("PRETTY"),
|
|
|
201 Unixcmd => new String'("gnatpp"),
|
|
|
202 Unixsws => null),
|
|
|
203
|
|
|
204 Stack =>
|
|
|
205 (Cname => new String'("STACK"),
|
|
|
206 Unixcmd => new String'("gnatstack"),
|
|
|
207 Unixsws => null),
|
|
|
208
|
|
|
209 Stub =>
|
|
|
210 (Cname => new String'("STUB"),
|
|
|
211 Unixcmd => new String'("gnatstub"),
|
|
|
212 Unixsws => null),
|
|
|
213
|
|
|
214 Test =>
|
|
|
215 (Cname => new String'("TEST"),
|
|
|
216 Unixcmd => new String'("gnattest"),
|
|
|
217 Unixsws => null),
|
|
|
218
|
|
|
219 Xref =>
|
|
|
220 (Cname => new String'("XREF"),
|
|
|
221 Unixcmd => new String'("gnatxref"),
|
|
|
222 Unixsws => null)
|
|
|
223 );
|
|
|
224
|
|
|
225 -----------------------
|
|
|
226 -- Local Subprograms --
|
|
|
227 -----------------------
|
|
|
228
|
|
|
229 procedure Output_Version;
|
|
|
230 -- Output the version of this program
|
|
|
231
|
|
|
232 procedure Usage;
|
|
|
233 -- Display usage
|
|
|
234
|
|
|
235 --------------------
|
|
|
236 -- Output_Version --
|
|
|
237 --------------------
|
|
|
238
|
|
|
239 procedure Output_Version is
|
|
|
240 begin
|
|
|
241 Put ("GNAT ");
|
|
|
242 Put_Line (Gnatvsn.Gnat_Version_String);
|
|
|
243 Put_Line ("Copyright 1996-" & Gnatvsn.Current_Year
|
|
|
244 & ", Free Software Foundation, Inc.");
|
|
|
245 end Output_Version;
|
|
|
246
|
|
|
247 -----------
|
|
|
248 -- Usage --
|
|
|
249 -----------
|
|
|
250
|
|
|
251 procedure Usage is
|
|
|
252 begin
|
|
|
253 Output_Version;
|
|
|
254 New_Line;
|
|
|
255 Put_Line ("List of available commands");
|
|
|
256 New_Line;
|
|
|
257
|
|
|
258 for C in Command_List'Range loop
|
|
|
259 Put ("gnat ");
|
|
|
260 Put (To_Lower (Command_List (C).Cname.all));
|
|
|
261 Set_Col (25);
|
|
|
262 Put (Program_Name (Command_List (C).Unixcmd.all, "gnat").all);
|
|
|
263
|
|
|
264 declare
|
|
|
265 Sws : Argument_List_Access renames Command_List (C).Unixsws;
|
|
|
266 begin
|
|
|
267 if Sws /= null then
|
|
|
268 for J in Sws'Range loop
|
|
|
269 Put (' ');
|
|
|
270 Put (Sws (J).all);
|
|
|
271 end loop;
|
|
|
272 end if;
|
|
|
273 end;
|
|
|
274
|
|
|
275 New_Line;
|
|
|
276 end loop;
|
|
|
277
|
|
|
278 New_Line;
|
|
|
279 end Usage;
|
|
|
280
|
|
|
281 procedure Check_Version_And_Help is new Check_Version_And_Help_G (Usage);
|
|
|
282
|
|
|
283 -- Start of processing for GNATCmd
|
|
|
284
|
|
|
285 begin
|
|
|
286 -- All output from GNATCmd is debugging or error output: send to stderr
|
|
|
287
|
|
|
288 Set_Standard_Error;
|
|
|
289
|
|
|
290 -- Initializations
|
|
|
291
|
|
|
292 Last_Switches.Init;
|
|
|
293 Last_Switches.Set_Last (0);
|
|
|
294
|
|
|
295 First_Switches.Init;
|
|
|
296 First_Switches.Set_Last (0);
|
|
|
297
|
|
|
298 -- Put the command line in environment variable GNAT_DRIVER_COMMAND_LINE,
|
|
|
299 -- so that the spawned tool may know the way the GNAT driver was invoked.
|
|
|
300
|
|
|
301 Name_Len := 0;
|
|
|
302 Add_Str_To_Name_Buffer (Command_Name);
|
|
|
303
|
|
|
304 for J in 1 .. Argument_Count loop
|
|
|
305 Add_Char_To_Name_Buffer (' ');
|
|
|
306 Add_Str_To_Name_Buffer (Argument (J));
|
|
|
307 end loop;
|
|
|
308
|
|
|
309 Setenv ("GNAT_DRIVER_COMMAND_LINE", Name_Buffer (1 .. Name_Len));
|
|
|
310
|
|
|
311 -- Add the directory where the GNAT driver is invoked in front of the path,
|
|
|
312 -- if the GNAT driver is invoked with directory information.
|
|
|
313
|
|
|
314 declare
|
|
|
315 Command : constant String := Command_Name;
|
|
|
316
|
|
|
317 begin
|
|
|
318 for Index in reverse Command'Range loop
|
|
|
319 if Command (Index) = Directory_Separator then
|
|
|
320 declare
|
|
|
321 Absolute_Dir : constant String :=
|
|
|
322 Normalize_Pathname (Command (Command'First .. Index));
|
|
|
323 PATH : constant String :=
|
|
|
324 Absolute_Dir & Path_Separator & Getenv ("PATH").all;
|
|
|
325 begin
|
|
|
326 Setenv ("PATH", PATH);
|
|
|
327 end;
|
|
|
328
|
|
|
329 exit;
|
|
|
330 end if;
|
|
|
331 end loop;
|
|
|
332 end;
|
|
|
333
|
|
|
334 -- Scan the command line
|
|
|
335
|
|
|
336 -- First, scan to detect --version and/or --help
|
|
|
337
|
|
|
338 Check_Version_And_Help ("GNAT", "1996");
|
|
|
339
|
|
|
340 begin
|
|
|
341 loop
|
|
|
342 if Command_Arg <= Argument_Count
|
|
|
343 and then Argument (Command_Arg) = "-v"
|
|
|
344 then
|
|
|
345 Verbose_Mode := True;
|
|
|
346 Command_Arg := Command_Arg + 1;
|
|
|
347
|
|
|
348 elsif Command_Arg <= Argument_Count
|
|
|
349 and then Argument (Command_Arg) = "-dn"
|
|
|
350 then
|
|
|
351 Keep_Temporary_Files := True;
|
|
|
352 Command_Arg := Command_Arg + 1;
|
|
|
353
|
|
|
354 else
|
|
|
355 exit;
|
|
|
356 end if;
|
|
|
357 end loop;
|
|
|
358
|
|
|
359 -- If there is no command, just output the usage
|
|
|
360
|
|
|
361 if Command_Arg > Argument_Count then
|
|
|
362 Usage;
|
|
|
363 return;
|
|
|
364 end if;
|
|
|
365
|
|
|
366 The_Command := Real_Command_Type'Value (Argument (Command_Arg));
|
|
|
367
|
|
|
368 exception
|
|
|
369 when Constraint_Error =>
|
|
|
370
|
|
|
371 -- Check if it is an alternate command
|
|
|
372
|
|
|
373 declare
|
|
|
374 Alternate : Alternate_Command;
|
|
|
375
|
|
|
376 begin
|
|
|
377 Alternate := Alternate_Command'Value (Argument (Command_Arg));
|
|
|
378 The_Command := Corresponding_To (Alternate);
|
|
|
379
|
|
|
380 exception
|
|
|
381 when Constraint_Error =>
|
|
|
382 Usage;
|
|
|
383 Fail ("unknown command: " & Argument (Command_Arg));
|
|
|
384 end;
|
|
|
385 end;
|
|
|
386
|
|
|
387 -- Get the arguments from the command line and from the eventual
|
|
|
388 -- argument file(s) specified on the command line.
|
|
|
389
|
|
|
390 for Arg in Command_Arg + 1 .. Argument_Count loop
|
|
|
391 declare
|
|
|
392 The_Arg : constant String := Argument (Arg);
|
|
|
393
|
|
|
394 begin
|
|
|
395 -- Check if an argument file is specified
|
|
|
396
|
|
|
397 if The_Arg'Length > 0 and then The_Arg (The_Arg'First) = '@' then
|
|
|
398 declare
|
|
|
399 Arg_File : Ada.Text_IO.File_Type;
|
|
|
400 Line : String (1 .. 256);
|
|
|
401 Last : Natural;
|
|
|
402
|
|
|
403 begin
|
|
|
404 -- Open the file and fail if the file cannot be found
|
|
|
405
|
|
|
406 begin
|
|
|
407 Open (Arg_File, In_File,
|
|
|
408 The_Arg (The_Arg'First + 1 .. The_Arg'Last));
|
|
|
409
|
|
|
410 exception
|
|
|
411 when others =>
|
|
|
412 Put (Standard_Error, "Cannot open argument file """);
|
|
|
413 Put (Standard_Error,
|
|
|
414 The_Arg (The_Arg'First + 1 .. The_Arg'Last));
|
|
|
415 Put_Line (Standard_Error, """");
|
|
|
416 raise Error_Exit;
|
|
|
417 end;
|
|
|
418
|
|
|
419 -- Read line by line and put the content of each non-
|
|
|
420 -- empty line in the Last_Switches table.
|
|
|
421
|
|
|
422 while not End_Of_File (Arg_File) loop
|
|
|
423 Get_Line (Arg_File, Line, Last);
|
|
|
424
|
|
|
425 if Last /= 0 then
|
|
|
426 Last_Switches.Increment_Last;
|
|
|
427 Last_Switches.Table (Last_Switches.Last) :=
|
|
|
428 new String'(Line (1 .. Last));
|
|
|
429 end if;
|
|
|
430 end loop;
|
|
|
431
|
|
|
432 Close (Arg_File);
|
|
|
433 end;
|
|
|
434
|
|
|
435 elsif The_Arg'Length > 0 then
|
|
|
436 -- It is not an argument file; just put the argument in
|
|
|
437 -- the Last_Switches table.
|
|
|
438
|
|
|
439 Last_Switches.Increment_Last;
|
|
|
440 Last_Switches.Table (Last_Switches.Last) := new String'(The_Arg);
|
|
|
441 end if;
|
|
|
442 end;
|
|
|
443 end loop;
|
|
|
444
|
|
|
445 declare
|
|
|
446 Program : String_Access;
|
|
|
447 Exec_Path : String_Access;
|
|
|
448 Get_Target : Boolean := False;
|
|
|
449
|
|
|
450 begin
|
|
|
451 if The_Command = Stack then
|
|
|
452
|
|
|
453 -- Never call gnatstack with a prefix
|
|
|
454
|
|
|
455 Program := new String'(Command_List (The_Command).Unixcmd.all);
|
|
|
456
|
|
|
457 else
|
|
|
458 Program :=
|
|
|
459 Program_Name (Command_List (The_Command).Unixcmd.all, "gnat");
|
|
|
460
|
|
|
461 -- If we want to invoke gnatmake/gnatclean with -P, then check if
|
|
|
462 -- gprbuild/gprclean is available; if it is, use gprbuild/gprclean
|
|
|
463 -- instead of gnatmake/gnatclean.
|
|
|
464 -- Ditto for gnatname -> gprname and gnatls -> gprls.
|
|
|
465
|
|
|
466 if The_Command = Make
|
|
|
467 or else The_Command = Compile
|
|
|
468 or else The_Command = Bind
|
|
|
469 or else The_Command = Link
|
|
|
470 or else The_Command = Clean
|
|
|
471 or else The_Command = Name
|
|
|
472 or else The_Command = List
|
|
|
473 then
|
|
|
474 declare
|
|
|
475 Switch : String_Access;
|
|
|
476 Call_GPR_Tool : Boolean := False;
|
|
|
477 begin
|
|
|
478 for J in 1 .. Last_Switches.Last loop
|
|
|
479 Switch := Last_Switches.Table (J);
|
|
|
480
|
|
|
481 if Switch'Length >= 2
|
|
|
482 and then Switch (Switch'First .. Switch'First + 1) = "-P"
|
|
|
483 then
|
|
|
484 Call_GPR_Tool := True;
|
|
|
485 exit;
|
|
|
486 end if;
|
|
|
487 end loop;
|
|
|
488
|
|
|
489 if Call_GPR_Tool then
|
|
|
490 case The_Command is
|
|
|
491 when Bind
|
|
|
492 | Compile
|
|
|
493 | Link
|
|
|
494 | Make
|
|
|
495 =>
|
|
|
496 if Locate_Exec_On_Path (Gprbuild) /= null then
|
|
|
497 Program := new String'(Gprbuild);
|
|
|
498 Get_Target := True;
|
|
|
499
|
|
|
500 if The_Command = Bind then
|
|
|
501 First_Switches.Append (new String'("-b"));
|
|
|
502 elsif The_Command = Link then
|
|
|
503 First_Switches.Append (new String'("-l"));
|
|
|
504 end if;
|
|
|
505
|
|
|
506 elsif The_Command = Bind then
|
|
|
507 Fail
|
|
|
508 ("'gnat bind -P' is no longer supported;" &
|
|
|
509 " use 'gprbuild -b' instead.");
|
|
|
510
|
|
|
511 elsif The_Command = Link then
|
|
|
512 Fail
|
|
|
513 ("'gnat Link -P' is no longer supported;" &
|
|
|
514 " use 'gprbuild -l' instead.");
|
|
|
515 end if;
|
|
|
516
|
|
|
517 when Clean =>
|
|
|
518 if Locate_Exec_On_Path (Gprclean) /= null then
|
|
|
519 Program := new String'(Gprclean);
|
|
|
520 Get_Target := True;
|
|
|
521 end if;
|
|
|
522
|
|
|
523 when Name =>
|
|
|
524 if Locate_Exec_On_Path (Gprname) /= null then
|
|
|
525 Program := new String'(Gprname);
|
|
|
526 Get_Target := True;
|
|
|
527 end if;
|
|
|
528
|
|
|
529 when List =>
|
|
|
530 if Locate_Exec_On_Path (Gprls) /= null then
|
|
|
531 Program := new String'(Gprls);
|
|
|
532 Get_Target := True;
|
|
|
533 end if;
|
|
|
534
|
|
|
535 when others =>
|
|
|
536 null;
|
|
|
537 end case;
|
|
|
538
|
|
|
539 if Get_Target then
|
|
|
540 Find_Program_Name;
|
|
|
541
|
|
|
542 if Name_Len > 5 then
|
|
|
543 First_Switches.Append
|
|
|
544 (new String'
|
|
|
545 ("--target=" & Name_Buffer (1 .. Name_Len - 5)));
|
|
|
546 end if;
|
|
|
547 end if;
|
|
|
548 end if;
|
|
|
549 end;
|
|
|
550 end if;
|
|
|
551 end if;
|
|
|
552
|
|
|
553 -- Locate the executable for the command
|
|
|
554
|
|
|
555 Exec_Path := Locate_Exec_On_Path (Program.all);
|
|
|
556
|
|
|
557 if Exec_Path = null then
|
|
|
558 Put_Line (Standard_Error, "could not locate " & Program.all);
|
|
|
559 raise Error_Exit;
|
|
|
560 end if;
|
|
|
561
|
|
|
562 -- If there are switches for the executable, put them as first switches
|
|
|
563
|
|
|
564 if Command_List (The_Command).Unixsws /= null then
|
|
|
565 for J in Command_List (The_Command).Unixsws'Range loop
|
|
|
566 First_Switches.Increment_Last;
|
|
|
567 First_Switches.Table (First_Switches.Last) :=
|
|
|
568 Command_List (The_Command).Unixsws (J);
|
|
|
569 end loop;
|
|
|
570 end if;
|
|
|
571
|
|
|
572 -- For FIND and XREF, look for switch -P. If it is specified, then
|
|
|
573 -- report an error indicating that the command is no longer supporting
|
|
|
574 -- project files.
|
|
|
575
|
|
|
576 if The_Command = Find or else The_Command = Xref then
|
|
|
577 declare
|
|
|
578 Argv : String_Access;
|
|
|
579 begin
|
|
|
580 for Arg_Num in 1 .. Last_Switches.Last loop
|
|
|
581 Argv := Last_Switches.Table (Arg_Num);
|
|
|
582
|
|
|
583 if Argv'Length >= 2 and then
|
|
|
584 Argv (Argv'First .. Argv'First + 1) = "-P"
|
|
|
585 then
|
|
|
586 if The_Command = Find then
|
|
|
587 Fail ("'gnat find -P' is no longer supported;");
|
|
|
588 else
|
|
|
589 Fail ("'gnat xref -P' is no longer supported;");
|
|
|
590 end if;
|
|
|
591 end if;
|
|
|
592 end loop;
|
|
|
593 end;
|
|
|
594 end if;
|
|
|
595
|
|
|
596 -- Gather all the arguments and invoke the executable
|
|
|
597
|
|
|
598 declare
|
|
|
599 The_Args : Argument_List
|
|
|
600 (1 .. First_Switches.Last + Last_Switches.Last);
|
|
|
601 Arg_Num : Natural := 0;
|
|
|
602
|
|
|
603 begin
|
|
|
604 for J in 1 .. First_Switches.Last loop
|
|
|
605 Arg_Num := Arg_Num + 1;
|
|
|
606 The_Args (Arg_Num) := First_Switches.Table (J);
|
|
|
607 end loop;
|
|
|
608
|
|
|
609 for J in 1 .. Last_Switches.Last loop
|
|
|
610 Arg_Num := Arg_Num + 1;
|
|
|
611 The_Args (Arg_Num) := Last_Switches.Table (J);
|
|
|
612 end loop;
|
|
|
613
|
|
|
614 if Verbose_Mode then
|
|
|
615 Put (Exec_Path.all);
|
|
|
616
|
|
|
617 for Arg in The_Args'Range loop
|
|
|
618 Put (" " & The_Args (Arg).all);
|
|
|
619 end loop;
|
|
|
620
|
|
|
621 New_Line;
|
|
|
622 end if;
|
|
|
623
|
|
|
624 My_Exit_Status := Exit_Status (Spawn (Exec_Path.all, The_Args));
|
|
|
625
|
|
|
626 Set_Exit_Status (My_Exit_Status);
|
|
|
627 end;
|
|
|
628 end;
|
|
|
629
|
|
|
630 exception
|
|
|
631 when Error_Exit =>
|
|
|
632 Set_Exit_Status (Failure);
|
|
|
633 end GNATCmd;
|
