|
111
|
1 ------------------------------------------------------------------------------
|
|
|
2 -- --
|
|
|
3 -- GNAT COMPILER COMPONENTS --
|
|
|
4 -- --
|
|
|
5 -- S W I T C H - C --
|
|
|
6 -- --
|
|
|
7 -- B o d y --
|
|
|
8 -- --
|
|
145
|
9 -- Copyright (C) 2001-2019, 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 -- This package is for switch processing and should not depend on higher level
|
|
|
27 -- packages such as those for the scanner, parser, etc. Doing so may cause
|
|
|
28 -- circularities, especially for back ends using Adabkend.
|
|
|
29
|
|
|
30 with Debug; use Debug;
|
|
|
31 with Errout; use Errout;
|
|
|
32 with Lib; use Lib;
|
|
|
33 with Osint; use Osint;
|
|
|
34 with Opt; use Opt;
|
|
|
35 with Stylesw; use Stylesw;
|
|
|
36 with Targparm; use Targparm;
|
|
|
37 with Ttypes; use Ttypes;
|
|
|
38 with Validsw; use Validsw;
|
|
|
39 with Warnsw; use Warnsw;
|
|
|
40
|
|
|
41 with Ada.Unchecked_Deallocation;
|
|
|
42
|
|
|
43 with System.WCh_Con; use System.WCh_Con;
|
|
|
44 with System.OS_Lib;
|
|
|
45
|
|
|
46 package body Switch.C is
|
|
|
47
|
|
|
48 RTS_Specified : String_Access := null;
|
|
|
49 -- Used to detect multiple use of --RTS= flag
|
|
|
50
|
|
|
51 procedure Add_Symbol_Definition (Def : String);
|
|
|
52 -- Add a symbol definition from the command line
|
|
|
53
|
|
|
54 procedure Free is
|
|
|
55 new Ada.Unchecked_Deallocation (String_List, String_List_Access);
|
|
|
56 -- Avoid using System.Strings.Free, which also frees the designated strings
|
|
|
57
|
|
|
58 function Get_Overflow_Mode (C : Character) return Overflow_Mode_Type;
|
|
|
59 -- Given a digit in the range 0 .. 3, returns the corresponding value of
|
|
|
60 -- Overflow_Mode_Type. Raises Program_Error if C is outside this range.
|
|
|
61
|
|
|
62 function Switch_Subsequently_Cancelled
|
|
|
63 (C : String;
|
|
|
64 Args : String_List;
|
|
|
65 Arg_Rank : Positive) return Boolean;
|
|
|
66 -- This function is called from Scan_Front_End_Switches. It determines if
|
|
|
67 -- the switch currently being scanned is followed by a switch of the form
|
|
|
68 -- "-gnat-" & C, where C is the argument. If so, then True is returned,
|
|
|
69 -- and Scan_Front_End_Switches will cancel the effect of the switch. If
|
|
|
70 -- no such switch is found, False is returned.
|
|
|
71
|
|
|
72 ---------------------------
|
|
|
73 -- Add_Symbol_Definition --
|
|
|
74 ---------------------------
|
|
|
75
|
|
|
76 procedure Add_Symbol_Definition (Def : String) is
|
|
|
77 begin
|
|
|
78 -- If Preprocessor_Symbol_Defs is not large enough, double its size
|
|
|
79
|
|
|
80 if Preprocessing_Symbol_Last = Preprocessing_Symbol_Defs'Last then
|
|
|
81 declare
|
|
|
82 New_Symbol_Definitions : constant String_List_Access :=
|
|
|
83 new String_List (1 .. 2 * Preprocessing_Symbol_Last);
|
|
|
84 begin
|
|
|
85 New_Symbol_Definitions (Preprocessing_Symbol_Defs'Range) :=
|
|
|
86 Preprocessing_Symbol_Defs.all;
|
|
|
87 Free (Preprocessing_Symbol_Defs);
|
|
|
88 Preprocessing_Symbol_Defs := New_Symbol_Definitions;
|
|
|
89 end;
|
|
|
90 end if;
|
|
|
91
|
|
|
92 Preprocessing_Symbol_Last := Preprocessing_Symbol_Last + 1;
|
|
|
93 Preprocessing_Symbol_Defs (Preprocessing_Symbol_Last) :=
|
|
|
94 new String'(Def);
|
|
|
95 end Add_Symbol_Definition;
|
|
|
96
|
|
|
97 -----------------------
|
|
|
98 -- Get_Overflow_Mode --
|
|
|
99 -----------------------
|
|
|
100
|
|
|
101 function Get_Overflow_Mode (C : Character) return Overflow_Mode_Type is
|
|
|
102 begin
|
|
|
103 case C is
|
|
|
104 when '1' =>
|
|
|
105 return Strict;
|
|
|
106
|
|
|
107 when '2' =>
|
|
|
108 return Minimized;
|
|
|
109
|
|
|
110 -- Eliminated allowed only if Long_Long_Integer is 64 bits (since
|
|
|
111 -- the current implementation of System.Bignums assumes this).
|
|
|
112
|
|
|
113 when '3' =>
|
|
|
114 if Standard_Long_Long_Integer_Size /= 64 then
|
|
|
115 Bad_Switch ("-gnato3 not implemented for this configuration");
|
|
|
116 else
|
|
|
117 return Eliminated;
|
|
|
118 end if;
|
|
|
119
|
|
|
120 when others =>
|
|
|
121 raise Program_Error;
|
|
|
122 end case;
|
|
|
123 end Get_Overflow_Mode;
|
|
|
124
|
|
|
125 -----------------------------
|
|
|
126 -- Scan_Front_End_Switches --
|
|
|
127 -----------------------------
|
|
|
128
|
|
|
129 procedure Scan_Front_End_Switches
|
|
|
130 (Switch_Chars : String;
|
|
|
131 Args : String_List;
|
|
|
132 Arg_Rank : Positive)
|
|
|
133 is
|
|
131
|
134 Max : constant Natural := Switch_Chars'Last;
|
|
|
135 C : Character := ' ';
|
|
|
136 Ptr : Natural;
|
|
|
137
|
|
|
138 Dot : Boolean;
|
|
|
139 -- This flag is set upon encountering a dot in a debug switch
|
|
|
140
|
|
|
141 First_Char : Positive;
|
|
|
142 -- Marks start of switch to be stored
|
|
|
143
|
|
|
144 First_Ptr : Positive;
|
|
|
145 -- Save position of first character after -gnatd (for checking that
|
|
|
146 -- debug flags that must come first are first, in particular -gnatd.b).
|
|
|
147
|
|
111
|
148 First_Switch : Boolean := True;
|
|
|
149 -- False for all but first switch
|
|
|
150
|
|
|
151 Store_Switch : Boolean;
|
|
|
152 -- For -gnatxx switches, the normal processing, signalled by this flag
|
|
|
153 -- being set to True, is to store the switch on exit from the case
|
|
|
154 -- statement, the switch stored is -gnat followed by the characters
|
|
|
155 -- from First_Char to Ptr-1. For cases like -gnaty, where the switch
|
|
|
156 -- is stored in separate pieces, this flag is set to False, and the
|
|
|
157 -- appropriate calls to Store_Compilation_Switch are made from within
|
|
|
158 -- the case branch.
|
|
|
159
|
|
131
|
160 Underscore : Boolean;
|
|
|
161 -- This flag is set upon encountering an underscode in a debug switch
|
|
111
|
162
|
|
|
163 begin
|
|
|
164 Ptr := Switch_Chars'First;
|
|
|
165
|
|
|
166 -- Skip past the initial character (must be the switch character)
|
|
|
167
|
|
|
168 if Ptr = Max then
|
|
|
169 Bad_Switch (C);
|
|
|
170 else
|
|
|
171 Ptr := Ptr + 1;
|
|
|
172 end if;
|
|
|
173
|
|
|
174 -- Handle switches that do not start with -gnat
|
|
|
175
|
|
|
176 if Ptr + 3 > Max or else Switch_Chars (Ptr .. Ptr + 3) /= "gnat" then
|
|
|
177
|
|
|
178 -- There are two front-end switches that do not start with -gnat:
|
|
|
179 -- -I, --RTS
|
|
|
180
|
|
|
181 if Switch_Chars (Ptr) = 'I' then
|
|
|
182
|
|
|
183 -- Set flag Search_Directory_Present if switch is "-I" only:
|
|
|
184 -- the directory will be the next argument.
|
|
|
185
|
|
|
186 if Ptr = Max then
|
|
|
187 Search_Directory_Present := True;
|
|
|
188 return;
|
|
|
189 end if;
|
|
|
190
|
|
|
191 Ptr := Ptr + 1;
|
|
|
192
|
|
|
193 -- Find out whether this is a -I- or regular -Ixxx switch
|
|
|
194
|
|
|
195 -- Note: -I switches are not recorded in the ALI file, since the
|
|
|
196 -- meaning of the program depends on the source files compiled,
|
|
|
197 -- not where they came from.
|
|
|
198
|
|
|
199 if Ptr = Max and then Switch_Chars (Ptr) = '-' then
|
|
|
200 Look_In_Primary_Dir := False;
|
|
|
201 else
|
|
|
202 Add_Src_Search_Dir (Switch_Chars (Ptr .. Max));
|
|
|
203 end if;
|
|
|
204
|
|
|
205 -- Processing of the --RTS switch. --RTS may have been modified by
|
|
|
206 -- gcc into -fRTS (for GCC targets).
|
|
|
207
|
|
|
208 elsif Ptr + 3 <= Max
|
|
|
209 and then (Switch_Chars (Ptr .. Ptr + 3) = "fRTS"
|
|
|
210 or else
|
|
|
211 Switch_Chars (Ptr .. Ptr + 3) = "-RTS")
|
|
|
212 then
|
|
|
213 Ptr := Ptr + 1;
|
|
|
214
|
|
|
215 if Ptr + 4 > Max
|
|
|
216 or else Switch_Chars (Ptr + 3) /= '='
|
|
|
217 then
|
|
|
218 Osint.Fail ("missing path for --RTS");
|
|
|
219
|
|
|
220 else
|
|
|
221 declare
|
|
|
222 Runtime_Dir : String_Access;
|
|
|
223 begin
|
|
|
224 if System.OS_Lib.Is_Absolute_Path
|
|
|
225 (Switch_Chars (Ptr + 4 .. Max))
|
|
|
226 then
|
|
|
227 Runtime_Dir :=
|
|
|
228 new String'(System.OS_Lib.Normalize_Pathname
|
|
|
229 (Switch_Chars (Ptr + 4 .. Max)));
|
|
|
230 else
|
|
|
231 Runtime_Dir :=
|
|
|
232 new String'(Switch_Chars (Ptr + 4 .. Max));
|
|
|
233 end if;
|
|
|
234
|
|
|
235 -- Valid --RTS switch
|
|
|
236
|
|
|
237 Opt.No_Stdinc := True;
|
|
|
238 Opt.RTS_Switch := True;
|
|
|
239
|
|
|
240 RTS_Src_Path_Name :=
|
|
|
241 Get_RTS_Search_Dir (Runtime_Dir.all, Include);
|
|
|
242
|
|
|
243 RTS_Lib_Path_Name :=
|
|
|
244 Get_RTS_Search_Dir (Runtime_Dir.all, Objects);
|
|
|
245
|
|
|
246 if RTS_Specified /= null then
|
|
|
247 if RTS_Src_Path_Name = null
|
|
|
248 or else RTS_Lib_Path_Name = null
|
|
|
249 or else
|
|
|
250 System.OS_Lib.Normalize_Pathname
|
|
|
251 (RTS_Specified.all) /=
|
|
|
252 System.OS_Lib.Normalize_Pathname
|
|
|
253 (RTS_Lib_Path_Name.all)
|
|
|
254 then
|
|
|
255 Osint.Fail
|
|
|
256 ("--RTS cannot be specified multiple times");
|
|
|
257 end if;
|
|
|
258
|
|
|
259 elsif RTS_Src_Path_Name /= null
|
|
|
260 and then RTS_Lib_Path_Name /= null
|
|
|
261 then
|
|
|
262 -- Store the -fRTS switch (Note: Store_Compilation_Switch
|
|
|
263 -- changes -fRTS back into --RTS for the actual output).
|
|
|
264
|
|
|
265 Store_Compilation_Switch (Switch_Chars);
|
|
|
266 RTS_Specified := new String'(RTS_Lib_Path_Name.all);
|
|
|
267
|
|
|
268 elsif RTS_Src_Path_Name = null
|
|
|
269 and then RTS_Lib_Path_Name = null
|
|
|
270 then
|
|
|
271 Osint.Fail ("RTS path not valid: missing "
|
|
|
272 & "adainclude and adalib directories");
|
|
|
273
|
|
|
274 elsif RTS_Src_Path_Name = null then
|
|
|
275 Osint.Fail ("RTS path not valid: missing "
|
|
|
276 & "adainclude directory");
|
|
|
277
|
|
|
278 elsif RTS_Lib_Path_Name = null then
|
|
|
279 Osint.Fail ("RTS path not valid: missing "
|
|
|
280 & "adalib directory");
|
|
|
281 end if;
|
|
|
282 end;
|
|
|
283 end if;
|
|
|
284
|
|
|
285 -- There are no other switches not starting with -gnat
|
|
|
286
|
|
|
287 else
|
|
|
288 Bad_Switch (Switch_Chars);
|
|
|
289 end if;
|
|
|
290
|
|
|
291 -- Case of switch starting with -gnat
|
|
|
292
|
|
|
293 else
|
|
|
294 Ptr := Ptr + 4;
|
|
|
295
|
|
|
296 -- Loop to scan through switches given in switch string
|
|
|
297
|
|
|
298 while Ptr <= Max loop
|
|
|
299 First_Char := Ptr;
|
|
|
300 Store_Switch := True;
|
|
|
301
|
|
|
302 C := Switch_Chars (Ptr);
|
|
|
303
|
|
|
304 case C is
|
|
|
305
|
|
|
306 -- -gnata (assertions enabled)
|
|
|
307
|
|
|
308 when 'a' =>
|
|
|
309 Ptr := Ptr + 1;
|
|
|
310 Assertions_Enabled := True;
|
|
|
311
|
|
|
312 -- -gnatA (disregard gnat.adc)
|
|
|
313
|
|
|
314 when 'A' =>
|
|
|
315 Ptr := Ptr + 1;
|
|
|
316 Config_File := False;
|
|
|
317
|
|
|
318 -- -gnatb (brief messages to stderr)
|
|
|
319
|
|
|
320 when 'b' =>
|
|
|
321 Ptr := Ptr + 1;
|
|
|
322 Brief_Output := True;
|
|
|
323
|
|
|
324 -- -gnatB (assume no invalid values)
|
|
|
325
|
|
|
326 when 'B' =>
|
|
|
327 Ptr := Ptr + 1;
|
|
|
328 Assume_No_Invalid_Values := True;
|
|
|
329
|
|
|
330 -- -gnatc (check syntax and semantics only)
|
|
|
331
|
|
|
332 when 'c' =>
|
|
|
333 if not First_Switch then
|
|
|
334 Osint.Fail
|
|
|
335 ("-gnatc must be first if combined with other switches");
|
|
|
336 end if;
|
|
|
337
|
|
|
338 Ptr := Ptr + 1;
|
|
|
339 Operating_Mode := Check_Semantics;
|
|
|
340
|
|
|
341 -- -gnatC (Generate CodePeer information)
|
|
|
342
|
|
|
343 when 'C' =>
|
|
|
344 Ptr := Ptr + 1;
|
|
131
|
345 CodePeer_Mode := True;
|
|
111
|
346
|
|
|
347 -- -gnatd (compiler debug options)
|
|
|
348
|
|
|
349 when 'd' =>
|
|
131
|
350 Dot := False;
|
|
111
|
351 Store_Switch := False;
|
|
131
|
352 Underscore := False;
|
|
|
353
|
|
111
|
354 First_Ptr := Ptr + 1;
|
|
|
355
|
|
|
356 -- Note: for the debug switch, the remaining characters in this
|
|
|
357 -- switch field must all be debug flags, since all valid switch
|
|
|
358 -- characters are also valid debug characters.
|
|
|
359
|
|
|
360 -- Loop to scan out debug flags
|
|
|
361
|
|
|
362 while Ptr < Max loop
|
|
|
363 Ptr := Ptr + 1;
|
|
|
364 C := Switch_Chars (Ptr);
|
|
|
365 exit when C = ASCII.NUL or else C = '/' or else C = '-';
|
|
|
366
|
|
|
367 if C in '1' .. '9' or else
|
|
|
368 C in 'a' .. 'z' or else
|
|
|
369 C in 'A' .. 'Z'
|
|
|
370 then
|
|
|
371 -- Case of dotted flag
|
|
|
372
|
|
|
373 if Dot then
|
|
|
374 Set_Dotted_Debug_Flag (C);
|
|
|
375 Store_Compilation_Switch ("-gnatd." & C);
|
|
|
376
|
|
|
377 -- Special check, -gnatd.b must come first
|
|
|
378
|
|
|
379 if C = 'b'
|
|
|
380 and then (Ptr /= First_Ptr + 1
|
|
|
381 or else not First_Switch)
|
|
|
382 then
|
|
|
383 Osint.Fail
|
|
131
|
384 ("-gnatd.b must be first if combined with other "
|
|
|
385 & "switches");
|
|
111
|
386 end if;
|
|
|
387
|
|
131
|
388 -- Case of an underscored flag
|
|
|
389
|
|
|
390 elsif Underscore then
|
|
|
391 Set_Underscored_Debug_Flag (C);
|
|
|
392 Store_Compilation_Switch ("-gnatd_" & C);
|
|
|
393
|
|
|
394 -- Normal flag
|
|
111
|
395
|
|
|
396 else
|
|
|
397 Set_Debug_Flag (C);
|
|
|
398 Store_Compilation_Switch ("-gnatd" & C);
|
|
|
399 end if;
|
|
|
400
|
|
|
401 elsif C = '.' then
|
|
|
402 Dot := True;
|
|
|
403
|
|
131
|
404 elsif C = '_' then
|
|
|
405 Underscore := True;
|
|
|
406
|
|
111
|
407 elsif Dot then
|
|
|
408 Bad_Switch ("-gnatd." & Switch_Chars (Ptr .. Max));
|
|
131
|
409
|
|
|
410 elsif Underscore then
|
|
|
411 Bad_Switch ("-gnatd_" & Switch_Chars (Ptr .. Max));
|
|
|
412
|
|
111
|
413 else
|
|
|
414 Bad_Switch ("-gnatd" & Switch_Chars (Ptr .. Max));
|
|
|
415 end if;
|
|
|
416 end loop;
|
|
|
417
|
|
|
418 return;
|
|
|
419
|
|
|
420 -- -gnatD (debug expanded code)
|
|
|
421
|
|
|
422 when 'D' =>
|
|
|
423 Ptr := Ptr + 1;
|
|
|
424
|
|
|
425 -- Not allowed if previous -gnatR given
|
|
|
426
|
|
|
427 -- The reason for this prohibition is that the rewriting of
|
|
|
428 -- Sloc values causes strange malfunctions in the tests of
|
|
|
429 -- whether units belong to the main source. This is really a
|
|
|
430 -- bug, but too hard to fix for a marginal capability ???
|
|
|
431
|
|
|
432 -- The proper fix is to completely redo -gnatD processing so
|
|
|
433 -- that the tree is not messed with, and instead a separate
|
|
|
434 -- table is built on the side for debug information generation.
|
|
|
435
|
|
|
436 if List_Representation_Info /= 0 then
|
|
|
437 Osint.Fail
|
|
|
438 ("-gnatD not permitted since -gnatR given previously");
|
|
|
439 end if;
|
|
|
440
|
|
|
441 -- Scan optional integer line limit value
|
|
|
442
|
|
|
443 if Nat_Present (Switch_Chars, Max, Ptr) then
|
|
|
444 Scan_Nat (Switch_Chars, Max, Ptr, Sprint_Line_Limit, 'D');
|
|
|
445 Sprint_Line_Limit := Nat'Max (Sprint_Line_Limit, 40);
|
|
|
446 end if;
|
|
|
447
|
|
|
448 -- Note: -gnatD also sets -gnatx (to turn off cross-reference
|
|
|
449 -- generation in the ali file) since otherwise this generation
|
|
|
450 -- gets confused by the "wrong" Sloc values put in the tree.
|
|
|
451
|
|
|
452 Debug_Generated_Code := True;
|
|
|
453 Xref_Active := False;
|
|
|
454 Set_Debug_Flag ('g');
|
|
|
455
|
|
|
456 -- -gnate? (extended switches)
|
|
|
457
|
|
|
458 when 'e' =>
|
|
|
459 Ptr := Ptr + 1;
|
|
|
460
|
|
|
461 -- The -gnate? switches are all double character switches
|
|
|
462 -- so we must always have a character after the e.
|
|
|
463
|
|
|
464 if Ptr > Max then
|
|
|
465 Bad_Switch ("-gnate");
|
|
|
466 end if;
|
|
|
467
|
|
|
468 case Switch_Chars (Ptr) is
|
|
|
469
|
|
|
470 -- -gnatea (initial delimiter of explicit switches)
|
|
|
471
|
|
|
472 -- This is an internal switch
|
|
|
473
|
|
|
474 -- All switches that come before -gnatea have been added by
|
|
|
475 -- the GCC driver and are not stored in the ALI file.
|
|
|
476 -- See also -gnatez below.
|
|
|
477
|
|
|
478 when 'a' =>
|
|
|
479 Store_Switch := False;
|
|
|
480 Enable_Switch_Storing;
|
|
|
481 Ptr := Ptr + 1;
|
|
|
482
|
|
|
483 -- -gnateA (aliasing checks on parameters)
|
|
|
484
|
|
|
485 when 'A' =>
|
|
|
486 Ptr := Ptr + 1;
|
|
|
487 Check_Aliasing_Of_Parameters := True;
|
|
|
488
|
|
|
489 -- -gnatec (configuration pragmas)
|
|
|
490
|
|
|
491 when 'c' =>
|
|
|
492 Store_Switch := False;
|
|
|
493 Ptr := Ptr + 1;
|
|
|
494
|
|
|
495 -- There may be an equal sign between -gnatec and
|
|
|
496 -- the path name of the config file.
|
|
|
497
|
|
|
498 if Ptr <= Max and then Switch_Chars (Ptr) = '=' then
|
|
|
499 Ptr := Ptr + 1;
|
|
|
500 end if;
|
|
|
501
|
|
|
502 if Ptr > Max then
|
|
|
503 Bad_Switch ("-gnatec");
|
|
|
504 end if;
|
|
|
505
|
|
|
506 declare
|
|
|
507 Config_File_Name : constant String_Access :=
|
|
|
508 new String'
|
|
|
509 (Switch_Chars (Ptr .. Max));
|
|
|
510
|
|
|
511 begin
|
|
|
512 if Config_File_Names = null then
|
|
|
513 Config_File_Names :=
|
|
|
514 new String_List'(1 => Config_File_Name);
|
|
|
515
|
|
|
516 else
|
|
|
517 declare
|
|
|
518 New_Names : constant String_List_Access :=
|
|
|
519 new String_List
|
|
|
520 (1 ..
|
|
|
521 Config_File_Names'Length + 1);
|
|
|
522
|
|
|
523 begin
|
|
|
524 for Index in Config_File_Names'Range loop
|
|
|
525 New_Names (Index) :=
|
|
|
526 Config_File_Names (Index);
|
|
|
527 Config_File_Names (Index) := null;
|
|
|
528 end loop;
|
|
|
529
|
|
|
530 New_Names (New_Names'Last) := Config_File_Name;
|
|
|
531 Free (Config_File_Names);
|
|
|
532 Config_File_Names := New_Names;
|
|
|
533 end;
|
|
|
534 end if;
|
|
|
535 end;
|
|
|
536
|
|
|
537 return;
|
|
|
538
|
|
|
539 -- -gnateC switch (generate CodePeer messages)
|
|
|
540
|
|
|
541 when 'C' =>
|
|
|
542 Ptr := Ptr + 1;
|
|
|
543
|
|
|
544 if not Generate_CodePeer_Messages then
|
|
|
545 Generate_CodePeer_Messages := True;
|
|
|
546 CodePeer_Mode := True;
|
|
|
547 Warning_Mode := Normal;
|
|
|
548 Warning_Doc_Switch := True; -- -gnatw.d
|
|
|
549
|
|
|
550 -- Enable warnings potentially useful for non GNAT
|
|
|
551 -- users.
|
|
|
552
|
|
|
553 Constant_Condition_Warnings := True; -- -gnatwc
|
|
|
554 Warn_On_Assertion_Failure := True; -- -gnatw.a
|
|
|
555 Warn_On_Assumed_Low_Bound := True; -- -gnatww
|
|
|
556 Warn_On_Bad_Fixed_Value := True; -- -gnatwb
|
|
|
557 Warn_On_Biased_Representation := True; -- -gnatw.b
|
|
|
558 Warn_On_Export_Import := True; -- -gnatwx
|
|
|
559 Warn_On_No_Value_Assigned := True; -- -gnatwv
|
|
|
560 Warn_On_Object_Renames_Function := True; -- -gnatw.r
|
|
|
561 Warn_On_Overlap := True; -- -gnatw.i
|
|
|
562 Warn_On_Parameter_Order := True; -- -gnatw.p
|
|
|
563 Warn_On_Questionable_Missing_Parens := True; -- -gnatwq
|
|
|
564 Warn_On_Redundant_Constructs := True; -- -gnatwr
|
|
|
565 Warn_On_Suspicious_Modulus_Value := True; -- -gnatw.m
|
|
|
566 end if;
|
|
|
567
|
|
|
568 -- -gnated switch (disable atomic synchronization)
|
|
|
569
|
|
|
570 when 'd' =>
|
|
|
571 Suppress_Options.Suppress (Atomic_Synchronization) :=
|
|
|
572 True;
|
|
|
573
|
|
|
574 -- -gnateD switch (preprocessing symbol definition)
|
|
|
575
|
|
|
576 when 'D' =>
|
|
|
577 Store_Switch := False;
|
|
|
578 Ptr := Ptr + 1;
|
|
|
579
|
|
|
580 if Ptr > Max then
|
|
|
581 Bad_Switch ("-gnateD");
|
|
|
582 end if;
|
|
|
583
|
|
|
584 Add_Symbol_Definition (Switch_Chars (Ptr .. Max));
|
|
|
585
|
|
|
586 -- Store the switch
|
|
|
587
|
|
|
588 Store_Compilation_Switch
|
|
|
589 ("-gnateD" & Switch_Chars (Ptr .. Max));
|
|
|
590 Ptr := Max + 1;
|
|
|
591
|
|
|
592 -- -gnateE (extra exception information)
|
|
|
593
|
|
|
594 when 'E' =>
|
|
|
595 Exception_Extra_Info := True;
|
|
|
596 Ptr := Ptr + 1;
|
|
|
597
|
|
|
598 -- -gnatef (full source path for brief error messages)
|
|
|
599
|
|
|
600 when 'f' =>
|
|
|
601 Store_Switch := False;
|
|
|
602 Ptr := Ptr + 1;
|
|
|
603 Full_Path_Name_For_Brief_Errors := True;
|
|
|
604
|
|
|
605 -- -gnateF (Check_Float_Overflow)
|
|
|
606
|
|
|
607 when 'F' =>
|
|
|
608 Ptr := Ptr + 1;
|
|
|
609 Check_Float_Overflow := not Machine_Overflows_On_Target;
|
|
|
610
|
|
|
611 -- -gnateg (generate C code)
|
|
|
612
|
|
|
613 when 'g' =>
|
|
|
614 -- Special check, -gnateg must occur after -gnatc
|
|
|
615
|
|
|
616 if Operating_Mode /= Check_Semantics then
|
|
|
617 Osint.Fail
|
|
|
618 ("gnateg requires previous occurrence of -gnatc");
|
|
|
619 end if;
|
|
|
620
|
|
|
621 Generate_C_Code := True;
|
|
|
622 Ptr := Ptr + 1;
|
|
|
623
|
|
|
624 -- -gnateG (save preprocessor output)
|
|
|
625
|
|
|
626 when 'G' =>
|
|
|
627 Generate_Processed_File := True;
|
|
|
628 Ptr := Ptr + 1;
|
|
|
629
|
|
|
630 -- -gnatei (max number of instantiations)
|
|
|
631
|
|
|
632 when 'i' =>
|
|
|
633 Ptr := Ptr + 1;
|
|
|
634 Scan_Pos
|
|
|
635 (Switch_Chars, Max, Ptr, Maximum_Instantiations, C);
|
|
|
636
|
|
|
637 -- -gnateI (index of unit in multi-unit source)
|
|
|
638
|
|
|
639 when 'I' =>
|
|
|
640 Ptr := Ptr + 1;
|
|
|
641 Scan_Pos (Switch_Chars, Max, Ptr, Multiple_Unit_Index, C);
|
|
|
642
|
|
|
643 -- -gnatel
|
|
|
644
|
|
|
645 when 'l' =>
|
|
|
646 Ptr := Ptr + 1;
|
|
|
647 Elab_Info_Messages := True;
|
|
|
648
|
|
|
649 -- -gnateL
|
|
|
650
|
|
|
651 when 'L' =>
|
|
|
652 Ptr := Ptr + 1;
|
|
|
653 Elab_Info_Messages := False;
|
|
|
654
|
|
|
655 -- -gnatem (mapping file)
|
|
|
656
|
|
|
657 when 'm' =>
|
|
|
658 Store_Switch := False;
|
|
|
659 Ptr := Ptr + 1;
|
|
|
660
|
|
|
661 -- There may be an equal sign between -gnatem and
|
|
|
662 -- the path name of the mapping file.
|
|
|
663
|
|
|
664 if Ptr <= Max and then Switch_Chars (Ptr) = '=' then
|
|
|
665 Ptr := Ptr + 1;
|
|
|
666 end if;
|
|
|
667
|
|
|
668 if Ptr > Max then
|
|
|
669 Bad_Switch ("-gnatem");
|
|
|
670 end if;
|
|
|
671
|
|
|
672 Mapping_File_Name :=
|
|
|
673 new String'(Switch_Chars (Ptr .. Max));
|
|
|
674 return;
|
|
|
675
|
|
|
676 -- -gnateO= (object path file)
|
|
|
677
|
|
|
678 -- This is an internal switch
|
|
|
679
|
|
|
680 when 'O' =>
|
|
|
681 Store_Switch := False;
|
|
|
682 Ptr := Ptr + 1;
|
|
|
683
|
|
|
684 -- Check for '='
|
|
|
685
|
|
|
686 if Ptr >= Max or else Switch_Chars (Ptr) /= '=' then
|
|
|
687 Bad_Switch ("-gnateO");
|
|
|
688 else
|
|
|
689 Object_Path_File_Name :=
|
|
|
690 new String'(Switch_Chars (Ptr + 1 .. Max));
|
|
|
691 end if;
|
|
|
692
|
|
|
693 return;
|
|
|
694
|
|
|
695 -- -gnatep (preprocessing data file)
|
|
|
696
|
|
|
697 when 'p' =>
|
|
|
698 Store_Switch := False;
|
|
|
699 Ptr := Ptr + 1;
|
|
|
700
|
|
|
701 -- There may be an equal sign between -gnatep and
|
|
|
702 -- the path name of the mapping file.
|
|
|
703
|
|
|
704 if Ptr <= Max and then Switch_Chars (Ptr) = '=' then
|
|
|
705 Ptr := Ptr + 1;
|
|
|
706 end if;
|
|
|
707
|
|
|
708 if Ptr > Max then
|
|
|
709 Bad_Switch ("-gnatep");
|
|
|
710 end if;
|
|
|
711
|
|
|
712 Preprocessing_Data_File :=
|
|
|
713 new String'(Switch_Chars (Ptr .. Max));
|
|
|
714
|
|
|
715 -- Store the switch, normalizing to -gnatep=
|
|
|
716
|
|
|
717 Store_Compilation_Switch
|
|
|
718 ("-gnatep=" & Preprocessing_Data_File.all);
|
|
|
719
|
|
|
720 Ptr := Max + 1;
|
|
|
721
|
|
|
722 -- -gnateP (Treat pragma Pure/Preelaborate errs as warnings)
|
|
|
723
|
|
|
724 when 'P' =>
|
|
|
725 Treat_Categorization_Errors_As_Warnings := True;
|
|
|
726
|
|
|
727 -- -gnates=file (specify extra file switches for gnat2why)
|
|
|
728
|
|
|
729 -- This is an internal switch
|
|
|
730
|
|
|
731 when 's' =>
|
|
|
732 if not First_Switch then
|
|
|
733 Osint.Fail
|
|
|
734 ("-gnates must not be combined with other switches");
|
|
|
735 end if;
|
|
|
736
|
|
|
737 -- Check for '='
|
|
|
738
|
|
|
739 Ptr := Ptr + 1;
|
|
|
740
|
|
|
741 if Ptr >= Max or else Switch_Chars (Ptr) /= '=' then
|
|
|
742 Bad_Switch ("-gnates");
|
|
|
743 else
|
|
|
744 SPARK_Switches_File_Name :=
|
|
|
745 new String'(Switch_Chars (Ptr + 1 .. Max));
|
|
|
746 end if;
|
|
|
747
|
|
|
748 return;
|
|
|
749
|
|
|
750 -- -gnateS (generate SCO information)
|
|
|
751
|
|
|
752 -- Include Source Coverage Obligation information in ALI
|
|
|
753 -- files for use by source coverage analysis tools
|
|
|
754 -- (gnatcov) (equivalent to -fdump-scos, provided for
|
|
|
755 -- backwards compatibility).
|
|
|
756
|
|
|
757 when 'S' =>
|
|
|
758 Generate_SCO := True;
|
|
|
759 Generate_SCO_Instance_Table := True;
|
|
|
760 Ptr := Ptr + 1;
|
|
|
761
|
|
|
762 -- -gnatet (write target dependent information)
|
|
|
763
|
|
|
764 when 't' =>
|
|
|
765 if not First_Switch then
|
|
|
766 Osint.Fail
|
|
|
767 ("-gnatet must not be combined with other switches");
|
|
|
768 end if;
|
|
|
769
|
|
|
770 -- Check for '='
|
|
|
771
|
|
|
772 Ptr := Ptr + 1;
|
|
|
773
|
|
|
774 if Ptr >= Max or else Switch_Chars (Ptr) /= '=' then
|
|
|
775 Bad_Switch ("-gnatet");
|
|
|
776 else
|
|
|
777 Target_Dependent_Info_Write_Name :=
|
|
|
778 new String'(Switch_Chars (Ptr + 1 .. Max));
|
|
|
779 end if;
|
|
|
780
|
|
|
781 return;
|
|
|
782
|
|
|
783 -- -gnateT (read target dependent information)
|
|
|
784
|
|
|
785 when 'T' =>
|
|
|
786 if not First_Switch then
|
|
|
787 Osint.Fail
|
|
|
788 ("-gnateT must not be combined with other switches");
|
|
|
789 end if;
|
|
|
790
|
|
|
791 -- Check for '='
|
|
|
792
|
|
|
793 Ptr := Ptr + 1;
|
|
|
794
|
|
|
795 if Ptr >= Max or else Switch_Chars (Ptr) /= '=' then
|
|
|
796 Bad_Switch ("-gnateT");
|
|
|
797 else
|
|
|
798 -- This parameter was stored by Set_Targ earlier
|
|
|
799
|
|
|
800 pragma Assert
|
|
|
801 (Target_Dependent_Info_Read_Name.all =
|
|
|
802 Switch_Chars (Ptr + 1 .. Max));
|
|
|
803 null;
|
|
|
804 end if;
|
|
|
805
|
|
|
806 return;
|
|
|
807
|
|
|
808 -- -gnateu (unrecognized y,V,w switches)
|
|
|
809
|
|
|
810 when 'u' =>
|
|
|
811 Ptr := Ptr + 1;
|
|
|
812 Ignore_Unrecognized_VWY_Switches := True;
|
|
|
813
|
|
|
814 -- -gnateV (validity checks on parameters)
|
|
|
815
|
|
|
816 when 'V' =>
|
|
|
817 Ptr := Ptr + 1;
|
|
|
818 Check_Validity_Of_Parameters := True;
|
|
|
819
|
|
|
820 -- -gnateY (ignore Style_Checks pragmas)
|
|
|
821
|
|
|
822 when 'Y' =>
|
|
|
823 Ignore_Style_Checks_Pragmas := True;
|
|
|
824 Ptr := Ptr + 1;
|
|
|
825
|
|
|
826 -- -gnatez (final delimiter of explicit switches)
|
|
|
827
|
|
|
828 -- This is an internal switch
|
|
|
829
|
|
|
830 -- All switches that come after -gnatez have been added by
|
|
|
831 -- the GCC driver and are not stored in the ALI file. See
|
|
|
832 -- also -gnatea above.
|
|
|
833
|
|
|
834 when 'z' =>
|
|
|
835 Store_Switch := False;
|
|
|
836 Disable_Switch_Storing;
|
|
|
837 Ptr := Ptr + 1;
|
|
|
838
|
|
|
839 -- All other -gnate? switches are unassigned
|
|
|
840
|
|
|
841 when others =>
|
|
|
842 Bad_Switch ("-gnate" & Switch_Chars (Ptr .. Max));
|
|
|
843 end case;
|
|
|
844
|
|
|
845 -- -gnatE (dynamic elaboration checks)
|
|
|
846
|
|
|
847 when 'E' =>
|
|
|
848 Ptr := Ptr + 1;
|
|
|
849 Dynamic_Elaboration_Checks := True;
|
|
|
850
|
|
|
851 -- -gnatf (full error messages)
|
|
|
852
|
|
|
853 when 'f' =>
|
|
|
854 Ptr := Ptr + 1;
|
|
|
855 All_Errors_Mode := True;
|
|
|
856
|
|
|
857 -- -gnatF (overflow of predefined float types)
|
|
|
858
|
|
|
859 when 'F' =>
|
|
|
860 Ptr := Ptr + 1;
|
|
|
861 External_Name_Exp_Casing := Uppercase;
|
|
|
862 External_Name_Imp_Casing := Uppercase;
|
|
|
863
|
|
|
864 -- -gnatg (GNAT implementation mode)
|
|
|
865
|
|
|
866 when 'g' =>
|
|
|
867 Ptr := Ptr + 1;
|
|
|
868 GNAT_Mode := True;
|
|
|
869 GNAT_Mode_Config := True;
|
|
|
870 Identifier_Character_Set := 'n';
|
|
|
871 System_Extend_Unit := Empty;
|
|
|
872 Warning_Mode := Treat_As_Error;
|
|
|
873 Style_Check_Main := True;
|
|
|
874 Ada_Version := Ada_2012;
|
|
|
875 Ada_Version_Explicit := Ada_2012;
|
|
|
876 Ada_Version_Pragma := Empty;
|
|
|
877
|
|
|
878 -- Set default warnings and style checks for -gnatg
|
|
|
879
|
|
|
880 Set_GNAT_Mode_Warnings;
|
|
|
881 Set_GNAT_Style_Check_Options;
|
|
|
882
|
|
|
883 -- -gnatG (output generated code)
|
|
|
884
|
|
|
885 when 'G' =>
|
|
|
886 Ptr := Ptr + 1;
|
|
|
887 Print_Generated_Code := True;
|
|
|
888
|
|
|
889 -- Scan optional integer line limit value
|
|
|
890
|
|
|
891 if Nat_Present (Switch_Chars, Max, Ptr) then
|
|
|
892 Scan_Nat (Switch_Chars, Max, Ptr, Sprint_Line_Limit, 'G');
|
|
|
893 Sprint_Line_Limit := Nat'Max (Sprint_Line_Limit, 40);
|
|
|
894 end if;
|
|
|
895
|
|
|
896 -- -gnath (help information)
|
|
|
897
|
|
|
898 when 'h' =>
|
|
|
899 Ptr := Ptr + 1;
|
|
|
900 Usage_Requested := True;
|
|
|
901
|
|
131
|
902 -- -gnatH (legacy static elaboration checking mode enabled)
|
|
|
903
|
|
|
904 when 'H' =>
|
|
|
905 Ptr := Ptr + 1;
|
|
|
906 Legacy_Elaboration_Checks := True;
|
|
|
907
|
|
111
|
908 -- -gnati (character set)
|
|
|
909
|
|
|
910 when 'i' =>
|
|
|
911 if Ptr = Max then
|
|
|
912 Bad_Switch ("-gnati");
|
|
|
913 end if;
|
|
|
914
|
|
|
915 Ptr := Ptr + 1;
|
|
|
916 C := Switch_Chars (Ptr);
|
|
|
917
|
|
|
918 if C in '1' .. '5'
|
|
|
919 or else C = '8'
|
|
|
920 or else C = '9'
|
|
|
921 or else C = 'p'
|
|
|
922 or else C = 'f'
|
|
|
923 or else C = 'n'
|
|
|
924 or else C = 'w'
|
|
|
925 then
|
|
|
926 Identifier_Character_Set := C;
|
|
|
927 Ptr := Ptr + 1;
|
|
|
928
|
|
|
929 else
|
|
|
930 Bad_Switch ("-gnati" & Switch_Chars (Ptr .. Max));
|
|
|
931 end if;
|
|
|
932
|
|
|
933 -- -gnatI (ignore representation clauses)
|
|
|
934
|
|
|
935 when 'I' =>
|
|
|
936 Ptr := Ptr + 1;
|
|
|
937 Ignore_Rep_Clauses := True;
|
|
|
938
|
|
|
939 -- -gnatj (messages in limited length lines)
|
|
|
940
|
|
|
941 when 'j' =>
|
|
|
942 Ptr := Ptr + 1;
|
|
|
943 Scan_Nat (Switch_Chars, Max, Ptr, Error_Msg_Line_Length, C);
|
|
|
944
|
|
131
|
945 -- -gnatJ (relaxed elaboration checking mode enabled)
|
|
|
946
|
|
|
947 when 'J' =>
|
|
|
948 Ptr := Ptr + 1;
|
|
|
949 Relaxed_Elaboration_Checks := True;
|
|
|
950
|
|
|
951 -- Common relaxations for both ABE mechanisms
|
|
|
952 --
|
|
|
953 -- -gnatd.G (ignore calls through generic formal parameters
|
|
|
954 -- for elaboration)
|
|
|
955 -- -gnatd.U (ignore indirect calls for static elaboration)
|
|
|
956 -- -gnatd.y (disable implicit pragma Elaborate_All on task
|
|
|
957 -- bodies)
|
|
|
958
|
|
|
959 Debug_Flag_Dot_GG := True;
|
|
|
960 Debug_Flag_Dot_UU := True;
|
|
|
961 Debug_Flag_Dot_Y := True;
|
|
|
962
|
|
|
963 -- Relaxatons to the legacy ABE mechanism
|
|
|
964
|
|
|
965 if Legacy_Elaboration_Checks then
|
|
|
966 null;
|
|
|
967
|
|
|
968 -- Relaxations to the default ABE mechanism
|
|
|
969 --
|
|
|
970 -- -gnatd_a (stop elaboration checks on accept or select
|
|
|
971 -- statement)
|
|
|
972 -- -gnatd_e (ignore entry calls and requeue statements for
|
|
|
973 -- elaboration)
|
|
|
974 -- -gnatd_i (ignore activations and calls to instances for
|
|
|
975 -- elaboration)
|
|
|
976 -- -gnatd_p (ignore assertion pragmas for elaboration)
|
|
|
977 -- -gnatd_s (stop elaboration checks on synchronous
|
|
|
978 -- suspension)
|
|
|
979 -- -gnatdL (ignore external calls from instances for
|
|
|
980 -- elaboration)
|
|
|
981
|
|
|
982 else
|
|
|
983 Debug_Flag_Underscore_A := True;
|
|
|
984 Debug_Flag_Underscore_E := True;
|
|
|
985 Debug_Flag_Underscore_I := True;
|
|
|
986 Debug_Flag_Underscore_P := True;
|
|
|
987 Debug_Flag_Underscore_S := True;
|
|
|
988 Debug_Flag_LL := True;
|
|
|
989 end if;
|
|
|
990
|
|
111
|
991 -- -gnatk (limit file name length)
|
|
|
992
|
|
|
993 when 'k' =>
|
|
|
994 Ptr := Ptr + 1;
|
|
|
995 Scan_Pos
|
|
|
996 (Switch_Chars, Max, Ptr, Maximum_File_Name_Length, C);
|
|
|
997
|
|
|
998 -- -gnatl (output full source)
|
|
|
999
|
|
|
1000 when 'l' =>
|
|
|
1001 Ptr := Ptr + 1;
|
|
|
1002 Full_List := True;
|
|
|
1003
|
|
|
1004 -- There may be an equal sign between -gnatl and a file name
|
|
|
1005
|
|
|
1006 if Ptr <= Max and then Switch_Chars (Ptr) = '=' then
|
|
|
1007 if Ptr = Max then
|
|
|
1008 Osint.Fail ("file name for -gnatl= is null");
|
|
|
1009 else
|
|
|
1010 Opt.Full_List_File_Name :=
|
|
|
1011 new String'(Switch_Chars (Ptr + 1 .. Max));
|
|
|
1012 Ptr := Max + 1;
|
|
|
1013 end if;
|
|
|
1014 end if;
|
|
|
1015
|
|
|
1016 -- -gnatL (corresponding source text)
|
|
|
1017
|
|
|
1018 when 'L' =>
|
|
|
1019 Ptr := Ptr + 1;
|
|
|
1020 Dump_Source_Text := True;
|
|
|
1021
|
|
|
1022 -- -gnatm (max number or errors/warnings)
|
|
|
1023
|
|
|
1024 when 'm' =>
|
|
|
1025 Ptr := Ptr + 1;
|
|
|
1026 Scan_Nat (Switch_Chars, Max, Ptr, Maximum_Messages, C);
|
|
|
1027
|
|
|
1028 -- -gnatn (enable pragma Inline)
|
|
|
1029
|
|
|
1030 when 'n' =>
|
|
|
1031 Ptr := Ptr + 1;
|
|
|
1032 Inline_Active := True;
|
|
|
1033
|
|
|
1034 -- There may be a digit (1 or 2) appended to the switch
|
|
|
1035
|
|
|
1036 if Ptr <= Max then
|
|
|
1037 C := Switch_Chars (Ptr);
|
|
|
1038
|
|
|
1039 if C in '1' .. '2' then
|
|
|
1040 Ptr := Ptr + 1;
|
|
|
1041 Inline_Level := Character'Pos (C) - Character'Pos ('0');
|
|
|
1042 end if;
|
|
|
1043 end if;
|
|
|
1044
|
|
|
1045 -- -gnatN (obsolescent)
|
|
|
1046
|
|
|
1047 when 'N' =>
|
|
|
1048 Ptr := Ptr + 1;
|
|
|
1049 Inline_Active := True;
|
|
|
1050 Front_End_Inlining := True;
|
|
|
1051
|
|
|
1052 -- -gnato (overflow checks)
|
|
|
1053
|
|
|
1054 when 'o' =>
|
|
|
1055 Ptr := Ptr + 1;
|
|
|
1056
|
|
|
1057 -- Case of -gnato0 (overflow checking turned off)
|
|
|
1058
|
|
|
1059 if Ptr <= Max and then Switch_Chars (Ptr) = '0' then
|
|
|
1060 Ptr := Ptr + 1;
|
|
|
1061 Suppress_Options.Suppress (Overflow_Check) := True;
|
|
|
1062
|
|
|
1063 -- We set strict mode in case overflow checking is turned
|
|
|
1064 -- on locally (also records that we had a -gnato switch).
|
|
|
1065
|
|
|
1066 Suppress_Options.Overflow_Mode_General := Strict;
|
|
|
1067 Suppress_Options.Overflow_Mode_Assertions := Strict;
|
|
|
1068
|
|
|
1069 -- All cases other than -gnato0 (overflow checking turned on)
|
|
|
1070
|
|
|
1071 else
|
|
|
1072 Suppress_Options.Suppress (Overflow_Check) := False;
|
|
|
1073
|
|
|
1074 -- Case of no digits after the -gnato
|
|
|
1075
|
|
|
1076 if Ptr > Max
|
|
|
1077 or else Switch_Chars (Ptr) not in '1' .. '3'
|
|
|
1078 then
|
|
|
1079 Suppress_Options.Overflow_Mode_General := Strict;
|
|
|
1080 Suppress_Options.Overflow_Mode_Assertions := Strict;
|
|
|
1081
|
|
|
1082 -- At least one digit after the -gnato
|
|
|
1083
|
|
|
1084 else
|
|
|
1085 -- Handle first digit after -gnato
|
|
|
1086
|
|
|
1087 Suppress_Options.Overflow_Mode_General :=
|
|
|
1088 Get_Overflow_Mode (Switch_Chars (Ptr));
|
|
|
1089 Ptr := Ptr + 1;
|
|
|
1090
|
|
|
1091 -- Only one digit after -gnato, set assertions mode to be
|
|
|
1092 -- the same as general mode.
|
|
|
1093
|
|
|
1094 if Ptr > Max
|
|
|
1095 or else Switch_Chars (Ptr) not in '1' .. '3'
|
|
|
1096 then
|
|
|
1097 Suppress_Options.Overflow_Mode_Assertions :=
|
|
|
1098 Suppress_Options.Overflow_Mode_General;
|
|
|
1099
|
|
|
1100 -- Process second digit after -gnato
|
|
|
1101
|
|
|
1102 else
|
|
|
1103 Suppress_Options.Overflow_Mode_Assertions :=
|
|
|
1104 Get_Overflow_Mode (Switch_Chars (Ptr));
|
|
|
1105 Ptr := Ptr + 1;
|
|
|
1106 end if;
|
|
|
1107 end if;
|
|
|
1108 end if;
|
|
|
1109
|
|
|
1110 -- -gnatO (specify name of the object file)
|
|
|
1111
|
|
|
1112 -- This is an internal switch
|
|
|
1113
|
|
|
1114 when 'O' =>
|
|
|
1115 Store_Switch := False;
|
|
|
1116 Ptr := Ptr + 1;
|
|
|
1117 Output_File_Name_Present := True;
|
|
|
1118
|
|
|
1119 -- -gnatp (suppress all checks)
|
|
|
1120
|
|
|
1121 when 'p' =>
|
|
|
1122 Ptr := Ptr + 1;
|
|
|
1123
|
|
|
1124 -- Skip processing if cancelled by subsequent -gnat-p
|
|
|
1125
|
|
|
1126 if Switch_Subsequently_Cancelled ("p", Args, Arg_Rank) then
|
|
|
1127 Store_Switch := False;
|
|
|
1128
|
|
|
1129 else
|
|
|
1130 -- Set all specific options as well as All_Checks in the
|
|
|
1131 -- Suppress_Options array, excluding Elaboration_Check,
|
|
|
1132 -- since this is treated specially because we do not want
|
|
|
1133 -- -gnatp to disable static elaboration processing. Also
|
|
|
1134 -- exclude Atomic_Synchronization, since this is not a real
|
|
|
1135 -- check.
|
|
|
1136
|
|
|
1137 for J in Suppress_Options.Suppress'Range loop
|
|
|
1138 if J /= Elaboration_Check
|
|
|
1139 and then
|
|
|
1140 J /= Atomic_Synchronization
|
|
|
1141 then
|
|
|
1142 Suppress_Options.Suppress (J) := True;
|
|
|
1143 end if;
|
|
|
1144 end loop;
|
|
|
1145
|
|
|
1146 Validity_Checks_On := False;
|
|
|
1147 Opt.Suppress_Checks := True;
|
|
|
1148
|
|
|
1149 -- Set overflow mode checking to strict in case it gets
|
|
|
1150 -- turned on locally (also signals that overflow checking
|
|
|
1151 -- has been specifically turned off).
|
|
|
1152
|
|
|
1153 Suppress_Options.Overflow_Mode_General := Strict;
|
|
|
1154 Suppress_Options.Overflow_Mode_Assertions := Strict;
|
|
|
1155 end if;
|
|
|
1156
|
|
|
1157 -- -gnatP (periodic poll)
|
|
|
1158
|
|
|
1159 when 'P' =>
|
|
|
1160 Ptr := Ptr + 1;
|
|
|
1161 Polling_Required := True;
|
|
|
1162
|
|
|
1163 -- -gnatq (don't quit)
|
|
|
1164
|
|
|
1165 when 'q' =>
|
|
|
1166 Ptr := Ptr + 1;
|
|
|
1167 Try_Semantics := True;
|
|
|
1168
|
|
|
1169 -- -gnatQ (always write ALI file)
|
|
|
1170
|
|
|
1171 when 'Q' =>
|
|
|
1172 Ptr := Ptr + 1;
|
|
|
1173 Force_ALI_Tree_File := True;
|
|
|
1174 Try_Semantics := True;
|
|
|
1175
|
|
|
1176 -- -gnatr (restrictions as warnings)
|
|
|
1177
|
|
|
1178 when 'r' =>
|
|
|
1179 Ptr := Ptr + 1;
|
|
|
1180 Treat_Restrictions_As_Warnings := True;
|
|
|
1181
|
|
|
1182 -- -gnatR (list rep. info)
|
|
|
1183
|
|
|
1184 when 'R' =>
|
|
|
1185
|
|
|
1186 -- Not allowed if previous -gnatD given. See more extensive
|
|
|
1187 -- comments in the 'D' section for the inverse test.
|
|
|
1188
|
|
|
1189 if Debug_Generated_Code then
|
|
|
1190 Osint.Fail
|
|
|
1191 ("-gnatR not permitted since -gnatD given previously");
|
|
|
1192 end if;
|
|
|
1193
|
|
|
1194 -- Set to annotate rep info, and set default -gnatR mode
|
|
|
1195
|
|
|
1196 Back_Annotate_Rep_Info := True;
|
|
|
1197 List_Representation_Info := 1;
|
|
|
1198
|
|
|
1199 -- Scan possible parameter
|
|
|
1200
|
|
|
1201 Ptr := Ptr + 1;
|
|
|
1202 while Ptr <= Max loop
|
|
|
1203 C := Switch_Chars (Ptr);
|
|
|
1204
|
|
|
1205 case C is
|
|
|
1206
|
|
145
|
1207 when '0' .. '4' =>
|
|
111
|
1208 List_Representation_Info :=
|
|
|
1209 Character'Pos (C) - Character'Pos ('0');
|
|
|
1210
|
|
|
1211 when 's' =>
|
|
|
1212 List_Representation_Info_To_File := True;
|
|
|
1213
|
|
131
|
1214 when 'j' =>
|
|
|
1215 List_Representation_Info_To_JSON := True;
|
|
|
1216
|
|
111
|
1217 when 'm' =>
|
|
|
1218 List_Representation_Info_Mechanisms := True;
|
|
|
1219
|
|
|
1220 when 'e' =>
|
|
|
1221 List_Representation_Info_Extended := True;
|
|
|
1222
|
|
|
1223 when others =>
|
|
|
1224 Bad_Switch ("-gnatR" & Switch_Chars (Ptr .. Max));
|
|
|
1225 end case;
|
|
|
1226
|
|
|
1227 Ptr := Ptr + 1;
|
|
|
1228 end loop;
|
|
|
1229
|
|
131
|
1230 if List_Representation_Info_To_JSON
|
|
|
1231 and then List_Representation_Info_Extended
|
|
|
1232 then
|
|
|
1233 Osint.Fail ("-gnatRe is incompatible with -gnatRj");
|
|
|
1234 end if;
|
|
|
1235
|
|
111
|
1236 -- -gnats (syntax check only)
|
|
|
1237
|
|
|
1238 when 's' =>
|
|
|
1239 if not First_Switch then
|
|
|
1240 Osint.Fail
|
|
|
1241 ("-gnats must be first if combined with other switches");
|
|
|
1242 end if;
|
|
|
1243
|
|
|
1244 Ptr := Ptr + 1;
|
|
|
1245 Operating_Mode := Check_Syntax;
|
|
|
1246
|
|
|
1247 -- -gnatS (print package Standard)
|
|
|
1248
|
|
|
1249 when 'S' =>
|
|
|
1250 Print_Standard := True;
|
|
|
1251 Ptr := Ptr + 1;
|
|
|
1252
|
|
|
1253 -- -gnatt (output tree)
|
|
|
1254
|
|
|
1255 when 't' =>
|
|
|
1256 Ptr := Ptr + 1;
|
|
|
1257 Tree_Output := True;
|
|
|
1258 Back_Annotate_Rep_Info := True;
|
|
|
1259
|
|
|
1260 -- -gnatT (change start of internal table sizes)
|
|
|
1261
|
|
|
1262 when 'T' =>
|
|
|
1263 Ptr := Ptr + 1;
|
|
|
1264 Scan_Pos (Switch_Chars, Max, Ptr, Table_Factor, C);
|
|
|
1265
|
|
|
1266 -- -gnatu (list units for compilation)
|
|
|
1267
|
|
|
1268 when 'u' =>
|
|
|
1269 Ptr := Ptr + 1;
|
|
|
1270 List_Units := True;
|
|
|
1271
|
|
|
1272 -- -gnatU (unique tags)
|
|
|
1273
|
|
|
1274 when 'U' =>
|
|
|
1275 Ptr := Ptr + 1;
|
|
|
1276 Unique_Error_Tag := True;
|
|
|
1277
|
|
|
1278 -- -gnatv (verbose mode)
|
|
|
1279
|
|
|
1280 when 'v' =>
|
|
|
1281 Ptr := Ptr + 1;
|
|
|
1282 Verbose_Mode := True;
|
|
|
1283
|
|
|
1284 -- -gnatV (validity checks)
|
|
|
1285
|
|
|
1286 when 'V' =>
|
|
|
1287 Store_Switch := False;
|
|
|
1288 Ptr := Ptr + 1;
|
|
|
1289
|
|
|
1290 if Ptr > Max then
|
|
|
1291 Bad_Switch ("-gnatV");
|
|
|
1292
|
|
|
1293 else
|
|
|
1294 declare
|
|
|
1295 OK : Boolean;
|
|
|
1296
|
|
|
1297 begin
|
|
|
1298 Set_Validity_Check_Options
|
|
|
1299 (Switch_Chars (Ptr .. Max), OK, Ptr);
|
|
|
1300
|
|
|
1301 if not OK then
|
|
|
1302 Bad_Switch ("-gnatV" & Switch_Chars (Ptr .. Max));
|
|
|
1303 end if;
|
|
|
1304
|
|
|
1305 for Index in First_Char + 1 .. Max loop
|
|
|
1306 Store_Compilation_Switch
|
|
|
1307 ("-gnatV" & Switch_Chars (Index));
|
|
|
1308 end loop;
|
|
|
1309 end;
|
|
|
1310 end if;
|
|
|
1311
|
|
|
1312 Ptr := Max + 1;
|
|
|
1313
|
|
|
1314 -- -gnatw (warning modes)
|
|
|
1315
|
|
|
1316 when 'w' =>
|
|
|
1317 Store_Switch := False;
|
|
|
1318 Ptr := Ptr + 1;
|
|
|
1319
|
|
|
1320 if Ptr > Max then
|
|
|
1321 Bad_Switch ("-gnatw");
|
|
|
1322 end if;
|
|
|
1323
|
|
|
1324 while Ptr <= Max loop
|
|
|
1325 C := Switch_Chars (Ptr);
|
|
|
1326
|
|
|
1327 -- Case of dot switch
|
|
|
1328
|
|
|
1329 if C = '.' and then Ptr < Max then
|
|
|
1330 Ptr := Ptr + 1;
|
|
|
1331 C := Switch_Chars (Ptr);
|
|
|
1332
|
|
|
1333 if Set_Dot_Warning_Switch (C) then
|
|
|
1334 Store_Compilation_Switch ("-gnatw." & C);
|
|
|
1335 else
|
|
|
1336 Bad_Switch ("-gnatw." & Switch_Chars (Ptr .. Max));
|
|
|
1337 end if;
|
|
|
1338
|
|
|
1339 -- Case of underscore switch
|
|
|
1340
|
|
|
1341 elsif C = '_' and then Ptr < Max then
|
|
|
1342 Ptr := Ptr + 1;
|
|
|
1343 C := Switch_Chars (Ptr);
|
|
|
1344
|
|
|
1345 if Set_Underscore_Warning_Switch (C) then
|
|
|
1346 Store_Compilation_Switch ("-gnatw_" & C);
|
|
|
1347 else
|
|
|
1348 Bad_Switch ("-gnatw_" & Switch_Chars (Ptr .. Max));
|
|
|
1349 end if;
|
|
|
1350
|
|
131
|
1351 -- Normal case
|
|
111
|
1352
|
|
|
1353 else
|
|
|
1354 if Set_Warning_Switch (C) then
|
|
|
1355 Store_Compilation_Switch ("-gnatw" & C);
|
|
|
1356 else
|
|
|
1357 Bad_Switch ("-gnatw" & Switch_Chars (Ptr .. Max));
|
|
|
1358 end if;
|
|
|
1359 end if;
|
|
|
1360
|
|
|
1361 Ptr := Ptr + 1;
|
|
|
1362 end loop;
|
|
|
1363
|
|
|
1364 return;
|
|
|
1365
|
|
|
1366 -- -gnatW (wide character encoding method)
|
|
|
1367
|
|
|
1368 when 'W' =>
|
|
|
1369 Ptr := Ptr + 1;
|
|
|
1370
|
|
|
1371 if Ptr > Max then
|
|
|
1372 Bad_Switch ("-gnatW");
|
|
|
1373 end if;
|
|
|
1374
|
|
|
1375 begin
|
|
|
1376 Wide_Character_Encoding_Method :=
|
|
|
1377 Get_WC_Encoding_Method (Switch_Chars (Ptr));
|
|
|
1378 exception
|
|
|
1379 when Constraint_Error =>
|
|
|
1380 Bad_Switch ("-gnatW" & Switch_Chars (Ptr .. Max));
|
|
|
1381 end;
|
|
|
1382
|
|
|
1383 Wide_Character_Encoding_Method_Specified := True;
|
|
|
1384
|
|
|
1385 Upper_Half_Encoding :=
|
|
|
1386 Wide_Character_Encoding_Method in
|
|
|
1387 WC_Upper_Half_Encoding_Method;
|
|
|
1388
|
|
|
1389 Ptr := Ptr + 1;
|
|
|
1390
|
|
|
1391 -- -gnatx (suppress cross-ref information)
|
|
|
1392
|
|
|
1393 when 'x' =>
|
|
|
1394 Ptr := Ptr + 1;
|
|
|
1395 Xref_Active := False;
|
|
|
1396
|
|
|
1397 -- -gnatX (language extensions)
|
|
|
1398
|
|
|
1399 when 'X' =>
|
|
|
1400 Ptr := Ptr + 1;
|
|
|
1401 Extensions_Allowed := True;
|
|
|
1402 Ada_Version := Ada_Version_Type'Last;
|
|
|
1403 Ada_Version_Explicit := Ada_Version_Type'Last;
|
|
|
1404 Ada_Version_Pragma := Empty;
|
|
|
1405
|
|
|
1406 -- -gnaty (style checks)
|
|
|
1407
|
|
|
1408 when 'y' =>
|
|
|
1409 Ptr := Ptr + 1;
|
|
|
1410 Style_Check_Main := True;
|
|
|
1411
|
|
|
1412 if Ptr > Max then
|
|
|
1413 Set_Default_Style_Check_Options;
|
|
|
1414
|
|
|
1415 else
|
|
|
1416 Store_Switch := False;
|
|
|
1417
|
|
|
1418 declare
|
|
|
1419 OK : Boolean;
|
|
|
1420
|
|
|
1421 begin
|
|
|
1422 Set_Style_Check_Options
|
|
|
1423 (Switch_Chars (Ptr .. Max), OK, Ptr);
|
|
|
1424
|
|
|
1425 if not OK then
|
|
|
1426 Osint.Fail
|
|
|
1427 ("bad -gnaty switch (" &
|
|
|
1428 Style_Msg_Buf (1 .. Style_Msg_Len) & ')');
|
|
|
1429 end if;
|
|
|
1430
|
|
|
1431 Ptr := First_Char + 1;
|
|
|
1432 while Ptr <= Max loop
|
|
|
1433 if Switch_Chars (Ptr) = 'M' then
|
|
|
1434 First_Char := Ptr;
|
|
|
1435 loop
|
|
|
1436 Ptr := Ptr + 1;
|
|
|
1437 exit when Ptr > Max
|
|
|
1438 or else Switch_Chars (Ptr) not in '0' .. '9';
|
|
|
1439 end loop;
|
|
|
1440
|
|
|
1441 Store_Compilation_Switch
|
|
|
1442 ("-gnaty" & Switch_Chars (First_Char .. Ptr - 1));
|
|
|
1443
|
|
|
1444 else
|
|
|
1445 Store_Compilation_Switch
|
|
|
1446 ("-gnaty" & Switch_Chars (Ptr));
|
|
|
1447 Ptr := Ptr + 1;
|
|
|
1448 end if;
|
|
|
1449 end loop;
|
|
|
1450 end;
|
|
|
1451 end if;
|
|
|
1452
|
|
|
1453 -- -gnatz (stub generation)
|
|
|
1454
|
|
|
1455 when 'z' =>
|
|
|
1456
|
|
|
1457 -- -gnatz must be the first and only switch in Switch_Chars,
|
|
|
1458 -- and is a two-letter switch.
|
|
|
1459
|
|
|
1460 if Ptr /= Switch_Chars'First + 5
|
|
|
1461 or else (Max - Ptr + 1) > 2
|
|
|
1462 then
|
|
|
1463 Osint.Fail
|
|
|
1464 ("-gnatz* may not be combined with other switches");
|
|
|
1465 end if;
|
|
|
1466
|
|
|
1467 if Ptr = Max then
|
|
|
1468 Bad_Switch ("-gnatz");
|
|
|
1469 end if;
|
|
|
1470
|
|
|
1471 Ptr := Ptr + 1;
|
|
|
1472
|
|
|
1473 -- Only one occurrence of -gnat* is permitted
|
|
|
1474
|
|
|
1475 if Distribution_Stub_Mode = No_Stubs then
|
|
|
1476 case Switch_Chars (Ptr) is
|
|
|
1477 when 'r' =>
|
|
|
1478 Distribution_Stub_Mode := Generate_Receiver_Stub_Body;
|
|
|
1479
|
|
|
1480 when 'c' =>
|
|
|
1481 Distribution_Stub_Mode := Generate_Caller_Stub_Body;
|
|
|
1482
|
|
|
1483 when others =>
|
|
|
1484 Bad_Switch ("-gnatz" & Switch_Chars (Ptr .. Max));
|
|
|
1485 end case;
|
|
|
1486
|
|
|
1487 Ptr := Ptr + 1;
|
|
|
1488
|
|
|
1489 else
|
|
|
1490 Osint.Fail ("only one -gnatz* switch allowed");
|
|
|
1491 end if;
|
|
|
1492
|
|
|
1493 -- -gnatZ (obsolescent)
|
|
|
1494
|
|
|
1495 when 'Z' =>
|
|
|
1496 Ptr := Ptr + 1;
|
|
|
1497 Osint.Fail
|
|
|
1498 ("-gnatZ is no longer supported: consider using --RTS=zcx");
|
|
|
1499
|
|
|
1500 -- Note on language version switches: whenever a new language
|
|
|
1501 -- version switch is added, Switch.M.Normalize_Compiler_Switches
|
|
|
1502 -- must be updated.
|
|
|
1503
|
|
|
1504 -- -gnat83
|
|
|
1505
|
|
|
1506 when '8' =>
|
|
|
1507 if Ptr = Max then
|
|
|
1508 Bad_Switch ("-gnat8");
|
|
|
1509 end if;
|
|
|
1510
|
|
|
1511 Ptr := Ptr + 1;
|
|
|
1512
|
|
|
1513 if Switch_Chars (Ptr) /= '3' or else Latest_Ada_Only then
|
|
|
1514 Bad_Switch ("-gnat8" & Switch_Chars (Ptr .. Max));
|
|
|
1515 else
|
|
|
1516 Ptr := Ptr + 1;
|
|
|
1517 Ada_Version := Ada_83;
|
|
|
1518 Ada_Version_Explicit := Ada_83;
|
|
|
1519 Ada_Version_Pragma := Empty;
|
|
|
1520 end if;
|
|
|
1521
|
|
|
1522 -- -gnat95
|
|
|
1523
|
|
|
1524 when '9' =>
|
|
|
1525 if Ptr = Max then
|
|
|
1526 Bad_Switch ("-gnat9");
|
|
|
1527 end if;
|
|
|
1528
|
|
|
1529 Ptr := Ptr + 1;
|
|
|
1530
|
|
|
1531 if Switch_Chars (Ptr) /= '5' or else Latest_Ada_Only then
|
|
|
1532 Bad_Switch ("-gnat9" & Switch_Chars (Ptr .. Max));
|
|
|
1533 else
|
|
|
1534 Ptr := Ptr + 1;
|
|
|
1535 Ada_Version := Ada_95;
|
|
|
1536 Ada_Version_Explicit := Ada_95;
|
|
|
1537 Ada_Version_Pragma := Empty;
|
|
|
1538 end if;
|
|
|
1539
|
|
|
1540 -- -gnat05
|
|
|
1541
|
|
|
1542 when '0' =>
|
|
|
1543 if Ptr = Max then
|
|
|
1544 Bad_Switch ("-gnat0");
|
|
|
1545 end if;
|
|
|
1546
|
|
|
1547 Ptr := Ptr + 1;
|
|
|
1548
|
|
|
1549 if Switch_Chars (Ptr) /= '5' or else Latest_Ada_Only then
|
|
|
1550 Bad_Switch ("-gnat0" & Switch_Chars (Ptr .. Max));
|
|
|
1551 else
|
|
|
1552 Ptr := Ptr + 1;
|
|
|
1553 Ada_Version := Ada_2005;
|
|
|
1554 Ada_Version_Explicit := Ada_2005;
|
|
|
1555 Ada_Version_Pragma := Empty;
|
|
|
1556 end if;
|
|
|
1557
|
|
|
1558 -- -gnat12
|
|
|
1559
|
|
|
1560 when '1' =>
|
|
|
1561 if Ptr = Max then
|
|
|
1562 Bad_Switch ("-gnat1");
|
|
|
1563 end if;
|
|
|
1564
|
|
|
1565 Ptr := Ptr + 1;
|
|
|
1566
|
|
|
1567 if Switch_Chars (Ptr) /= '2' then
|
|
|
1568 Bad_Switch ("-gnat1" & Switch_Chars (Ptr .. Max));
|
|
|
1569 else
|
|
|
1570 Ptr := Ptr + 1;
|
|
|
1571 Ada_Version := Ada_2012;
|
|
|
1572 Ada_Version_Explicit := Ada_2012;
|
|
|
1573 Ada_Version_Pragma := Empty;
|
|
|
1574 end if;
|
|
|
1575
|
|
|
1576 -- -gnat2005 and -gnat2012
|
|
|
1577
|
|
|
1578 when '2' =>
|
|
|
1579 if Ptr > Max - 3 then
|
|
|
1580 Bad_Switch ("-gnat" & Switch_Chars (Ptr .. Max));
|
|
|
1581
|
|
|
1582 elsif Switch_Chars (Ptr .. Ptr + 3) = "2005"
|
|
|
1583 and then not Latest_Ada_Only
|
|
|
1584 then
|
|
|
1585 Ada_Version := Ada_2005;
|
|
|
1586
|
|
|
1587 elsif Switch_Chars (Ptr .. Ptr + 3) = "2012" then
|
|
|
1588 Ada_Version := Ada_2012;
|
|
|
1589
|
|
|
1590 elsif Switch_Chars (Ptr .. Ptr + 3) = "2020" then
|
|
|
1591 Ada_Version := Ada_2020;
|
|
|
1592
|
|
|
1593 else
|
|
|
1594 Bad_Switch ("-gnat" & Switch_Chars (Ptr .. Ptr + 3));
|
|
|
1595 end if;
|
|
|
1596
|
|
|
1597 Ada_Version_Explicit := Ada_Version;
|
|
|
1598 Ada_Version_Pragma := Empty;
|
|
|
1599 Ptr := Ptr + 4;
|
|
|
1600
|
|
|
1601 -- Switch cancellation, currently only -gnat-p is allowed.
|
|
|
1602 -- All we do here is the error checking, since the actual
|
|
|
1603 -- processing for switch cancellation is done by calls to
|
|
|
1604 -- Switch_Subsequently_Cancelled at the appropriate point.
|
|
|
1605
|
|
|
1606 when '-' =>
|
|
|
1607
|
|
|
1608 -- Simple ignore -gnat-p
|
|
|
1609
|
|
|
1610 if Switch_Chars = "-gnat-p" then
|
|
|
1611 return;
|
|
|
1612
|
|
|
1613 -- Any other occurrence of minus is ignored. This is for
|
|
|
1614 -- maximum compatibility with previous version which ignored
|
|
|
1615 -- all occurrences of minus.
|
|
|
1616
|
|
|
1617 else
|
|
|
1618 Store_Switch := False;
|
|
|
1619 Ptr := Ptr + 1;
|
|
|
1620 end if;
|
|
|
1621
|
|
|
1622 -- We ignore '/' in switches, this is historical, still needed???
|
|
|
1623
|
|
|
1624 when '/' =>
|
|
|
1625 Store_Switch := False;
|
|
|
1626
|
|
|
1627 -- Anything else is an error (illegal switch character)
|
|
|
1628
|
|
|
1629 when others =>
|
|
|
1630 Bad_Switch ("-gnat" & Switch_Chars (Ptr .. Max));
|
|
|
1631 end case;
|
|
|
1632
|
|
|
1633 if Store_Switch then
|
|
|
1634 Store_Compilation_Switch
|
|
|
1635 ("-gnat" & Switch_Chars (First_Char .. Ptr - 1));
|
|
|
1636 end if;
|
|
|
1637
|
|
|
1638 First_Switch := False;
|
|
|
1639 end loop;
|
|
|
1640 end if;
|
|
|
1641 end Scan_Front_End_Switches;
|
|
|
1642
|
|
|
1643 -----------------------------------
|
|
|
1644 -- Switch_Subsequently_Cancelled --
|
|
|
1645 -----------------------------------
|
|
|
1646
|
|
|
1647 function Switch_Subsequently_Cancelled
|
|
|
1648 (C : String;
|
|
|
1649 Args : String_List;
|
|
|
1650 Arg_Rank : Positive) return Boolean
|
|
|
1651 is
|
|
|
1652 begin
|
|
|
1653 -- Loop through arguments following the current one
|
|
|
1654
|
|
|
1655 for Arg in Arg_Rank + 1 .. Args'Last loop
|
|
|
1656 if Args (Arg).all = "-gnat-" & C then
|
|
|
1657 return True;
|
|
|
1658 end if;
|
|
|
1659 end loop;
|
|
|
1660
|
|
|
1661 -- No match found, not cancelled
|
|
|
1662
|
|
|
1663 return False;
|
|
|
1664 end Switch_Subsequently_Cancelled;
|
|
|
1665
|
|
|
1666 end Switch.C;
|
