projects / gcc.git / blob
? search:
summary | shortlog | log | commit | commitdiff | tree
history | raw | HEAD
Daily bump.
[gcc.git] / gcc / ada / switch-c.adb
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT COMPILER COMPONENTS --
4 -- --
5 -- S W I T C H - C --
6 -- --
7 -- B o d y --
8 -- --
9 -- Copyright (C) 2001-2020, 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 -- 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
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
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
160 Underscore : Boolean;
161 -- This flag is set upon encountering an underscode in a debug switch
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;
345 CodePeer_Mode := True;
346
347 -- -gnatd (compiler debug options)
348
349 when 'd' =>
350 Dot := False;
351 Store_Switch := False;
352 Underscore := False;
353
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
384 ("-gnatd.b must be first if combined with other "
385 & "switches");
386 end if;
387
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
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
404 elsif C = '_' then
405 Underscore := True;
406
407 elsif Dot then
408 Bad_Switch ("-gnatd." & Switch_Chars (Ptr .. Max));
409
410 elsif Underscore then
411 Bad_Switch ("-gnatd_" & Switch_Chars (Ptr .. Max));
412
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 -- -gnateb (config file basenames and checksums in ALI)
490
491 when 'b' =>
492 Ptr := Ptr + 1;
493 Config_Files_Store_Basename := True;
494
495 -- -gnatec (configuration pragmas)
496
497 when 'c' =>
498 Store_Switch := False;
499 Ptr := Ptr + 1;
500
501 -- There may be an equal sign between -gnatec and
502 -- the path name of the config file.
503
504 if Ptr <= Max and then Switch_Chars (Ptr) = '=' then
505 Ptr := Ptr + 1;
506 end if;
507
508 if Ptr > Max then
509 Bad_Switch ("-gnatec");
510 end if;
511
512 declare
513 Config_File_Name : constant String_Access :=
514 new String'
515 (Switch_Chars (Ptr .. Max));
516
517 begin
518 if Config_File_Names = null then
519 Config_File_Names :=
520 new String_List'(1 => Config_File_Name);
521
522 else
523 declare
524 New_Names : constant String_List_Access :=
525 new String_List
526 (1 ..
527 Config_File_Names'Length + 1);
528
529 begin
530 for Index in Config_File_Names'Range loop
531 New_Names (Index) :=
532 Config_File_Names (Index);
533 Config_File_Names (Index) := null;
534 end loop;
535
536 New_Names (New_Names'Last) := Config_File_Name;
537 Free (Config_File_Names);
538 Config_File_Names := New_Names;
539 end;
540 end if;
541 end;
542
543 return;
544
545 -- -gnateC switch (generate CodePeer messages)
546
547 when 'C' =>
548 Ptr := Ptr + 1;
549
550 if not Generate_CodePeer_Messages then
551 Generate_CodePeer_Messages := True;
552 CodePeer_Mode := True;
553 Warning_Mode := Normal;
554 Warning_Doc_Switch := True; -- -gnatw.d
555
556 -- Enable warnings potentially useful for non GNAT
557 -- users.
558
559 Constant_Condition_Warnings := True; -- -gnatwc
560 Warn_On_Assertion_Failure := True; -- -gnatw.a
561 Warn_On_Assumed_Low_Bound := True; -- -gnatww
562 Warn_On_Bad_Fixed_Value := True; -- -gnatwb
563 Warn_On_Biased_Representation := True; -- -gnatw.b
564 Warn_On_Export_Import := True; -- -gnatwx
565 Warn_On_No_Value_Assigned := True; -- -gnatwv
566 Warn_On_Object_Renames_Function := True; -- -gnatw.r
567 Warn_On_Overlap := True; -- -gnatw.i
568 Warn_On_Parameter_Order := True; -- -gnatw.p
569 Warn_On_Questionable_Missing_Parens := True; -- -gnatwq
570 Warn_On_Redundant_Constructs := True; -- -gnatwr
571 Warn_On_Suspicious_Modulus_Value := True; -- -gnatw.m
572 end if;
573
574 -- -gnated switch (disable atomic synchronization)
575
576 when 'd' =>
577 Suppress_Options.Suppress (Atomic_Synchronization) :=
578 True;
579
580 -- -gnateD switch (preprocessing symbol definition)
581
582 when 'D' =>
583 Store_Switch := False;
584 Ptr := Ptr + 1;
585
586 if Ptr > Max then
587 Bad_Switch ("-gnateD");
588 end if;
589
590 Add_Symbol_Definition (Switch_Chars (Ptr .. Max));
591
592 -- Store the switch
593
594 Store_Compilation_Switch
595 ("-gnateD" & Switch_Chars (Ptr .. Max));
596 Ptr := Max + 1;
597
598 -- -gnateE (extra exception information)
599
600 when 'E' =>
601 Exception_Extra_Info := True;
602 Ptr := Ptr + 1;
603
604 -- -gnatef (full source path for brief error messages)
605
606 when 'f' =>
607 Store_Switch := False;
608 Ptr := Ptr + 1;
609 Full_Path_Name_For_Brief_Errors := True;
610
611 -- -gnateF (Check_Float_Overflow)
612
613 when 'F' =>
614 Ptr := Ptr + 1;
615 Check_Float_Overflow := not Machine_Overflows_On_Target;
616
617 -- -gnateg (generate C code)
618
619 when 'g' =>
620 -- Special check, -gnateg must occur after -gnatc
621
622 if Operating_Mode /= Check_Semantics then
623 Osint.Fail
624 ("gnateg requires previous occurrence of -gnatc");
625 end if;
626
627 Generate_C_Code := True;
628 Ptr := Ptr + 1;
629
630 -- -gnateG (save preprocessor output)
631
632 when 'G' =>
633 Generate_Processed_File := True;
634 Ptr := Ptr + 1;
635
636 -- -gnatei (max number of instantiations)
637
638 when 'i' =>
639 Ptr := Ptr + 1;
640 Scan_Pos
641 (Switch_Chars, Max, Ptr, Maximum_Instantiations, C);
642
643 -- -gnateI (index of unit in multi-unit source)
644
645 when 'I' =>
646 Ptr := Ptr + 1;
647 Scan_Pos (Switch_Chars, Max, Ptr, Multiple_Unit_Index, C);
648
649 -- -gnatel
650
651 when 'l' =>
652 Ptr := Ptr + 1;
653 Elab_Info_Messages := True;
654
655 -- -gnateL
656
657 when 'L' =>
658 Ptr := Ptr + 1;
659 Elab_Info_Messages := False;
660
661 -- -gnatem (mapping file)
662
663 when 'm' =>
664 Store_Switch := False;
665 Ptr := Ptr + 1;
666
667 -- There may be an equal sign between -gnatem and
668 -- the path name of the mapping file.
669
670 if Ptr <= Max and then Switch_Chars (Ptr) = '=' then
671 Ptr := Ptr + 1;
672 end if;
673
674 if Ptr > Max then
675 Bad_Switch ("-gnatem");
676 end if;
677
678 Mapping_File_Name :=
679 new String'(Switch_Chars (Ptr .. Max));
680 return;
681
682 -- -gnaten (memory to allocate for nodes)
683
684 when 'n' =>
685 Ptr := Ptr + 1;
686 Scan_Pos
687 (Switch_Chars, Max, Ptr, Nodes_Size_In_Meg, C);
688
689 -- -gnateO= (object path file)
690
691 -- This is an internal switch
692
693 when 'O' =>
694 Store_Switch := False;
695 Ptr := Ptr + 1;
696
697 -- Check for '='
698
699 if Ptr >= Max or else Switch_Chars (Ptr) /= '=' then
700 Bad_Switch ("-gnateO");
701 else
702 Object_Path_File_Name :=
703 new String'(Switch_Chars (Ptr + 1 .. Max));
704 end if;
705
706 return;
707
708 -- -gnatep (preprocessing data file)
709
710 when 'p' =>
711 Store_Switch := False;
712 Ptr := Ptr + 1;
713
714 -- There may be an equal sign between -gnatep and
715 -- the path name of the mapping file.
716
717 if Ptr <= Max and then Switch_Chars (Ptr) = '=' then
718 Ptr := Ptr + 1;
719 end if;
720
721 if Ptr > Max then
722 Bad_Switch ("-gnatep");
723 end if;
724
725 Preprocessing_Data_File :=
726 new String'(Switch_Chars (Ptr .. Max));
727
728 -- Store the switch, normalizing to -gnatep=
729
730 Store_Compilation_Switch
731 ("-gnatep=" & Preprocessing_Data_File.all);
732
733 Ptr := Max + 1;
734
735 -- -gnateP (Treat pragma Pure/Preelaborate errs as warnings)
736
737 when 'P' =>
738 Treat_Categorization_Errors_As_Warnings := True;
739 Ptr := Ptr + 1;
740
741 -- -gnates=file (specify extra file switches for gnat2why)
742
743 -- This is an internal switch
744
745 when 's' =>
746 if not First_Switch then
747 Osint.Fail
748 ("-gnates must not be combined with other switches");
749 end if;
750
751 -- Check for '='
752
753 Ptr := Ptr + 1;
754
755 if Ptr >= Max or else Switch_Chars (Ptr) /= '=' then
756 Bad_Switch ("-gnates");
757 else
758 SPARK_Switches_File_Name :=
759 new String'(Switch_Chars (Ptr + 1 .. Max));
760 end if;
761
762 return;
763
764 -- -gnateS (generate SCO information)
765
766 -- Include Source Coverage Obligation information in ALI
767 -- files for use by source coverage analysis tools
768 -- (gnatcov) (equivalent to -fdump-scos, provided for
769 -- backwards compatibility).
770
771 when 'S' =>
772 Generate_SCO := True;
773 Generate_SCO_Instance_Table := True;
774 Ptr := Ptr + 1;
775
776 -- -gnatet (write target dependent information)
777
778 when 't' =>
779 if not First_Switch then
780 Osint.Fail
781 ("-gnatet must not be combined with other switches");
782 end if;
783
784 -- Check for '='
785
786 Ptr := Ptr + 1;
787
788 if Ptr >= Max or else Switch_Chars (Ptr) /= '=' then
789 Bad_Switch ("-gnatet");
790 else
791 Target_Dependent_Info_Write_Name :=
792 new String'(Switch_Chars (Ptr + 1 .. Max));
793 end if;
794
795 return;
796
797 -- -gnateT (read target dependent information)
798
799 when 'T' =>
800 if not First_Switch then
801 Osint.Fail
802 ("-gnateT must not be combined with other switches");
803 end if;
804
805 -- Check for '='
806
807 Ptr := Ptr + 1;
808
809 if Ptr >= Max or else Switch_Chars (Ptr) /= '=' then
810 Bad_Switch ("-gnateT");
811 else
812 -- This parameter was stored by Set_Targ earlier
813
814 pragma Assert
815 (Target_Dependent_Info_Read_Name.all =
816 Switch_Chars (Ptr + 1 .. Max));
817 null;
818 end if;
819
820 return;
821
822 -- -gnateu (unrecognized y,V,w switches)
823
824 when 'u' =>
825 Ignore_Unrecognized_VWY_Switches := True;
826 Ptr := Ptr + 1;
827
828 -- -gnateV (validity checks on parameters)
829
830 when 'V' =>
831 Ptr := Ptr + 1;
832 Check_Validity_Of_Parameters := True;
833
834 -- -gnateY (ignore Style_Checks pragmas)
835
836 when 'Y' =>
837 Ignore_Style_Checks_Pragmas := True;
838 Ptr := Ptr + 1;
839
840 -- -gnatez (final delimiter of explicit switches)
841
842 -- This is an internal switch
843
844 -- All switches that come after -gnatez have been added by
845 -- the GCC driver and are not stored in the ALI file. See
846 -- also -gnatea above.
847
848 when 'z' =>
849 Store_Switch := False;
850 Disable_Switch_Storing;
851 Ptr := Ptr + 1;
852
853 -- All other -gnate? switches are unassigned
854
855 when others =>
856 Bad_Switch ("-gnate" & Switch_Chars (Ptr .. Max));
857 end case;
858
859 -- -gnatE (dynamic elaboration checks)
860
861 when 'E' =>
862 Ptr := Ptr + 1;
863 Dynamic_Elaboration_Checks := True;
864
865 -- -gnatf (full error messages)
866
867 when 'f' =>
868 Ptr := Ptr + 1;
869 All_Errors_Mode := True;
870
871 -- -gnatF (overflow of predefined float types)
872
873 when 'F' =>
874 Ptr := Ptr + 1;
875 External_Name_Exp_Casing := Uppercase;
876 External_Name_Imp_Casing := Uppercase;
877
878 -- -gnatg (GNAT implementation mode)
879
880 when 'g' =>
881 Ptr := Ptr + 1;
882 GNAT_Mode := True;
883 GNAT_Mode_Config := True;
884 Identifier_Character_Set := 'n';
885 System_Extend_Unit := Empty;
886 Warning_Mode := Treat_As_Error;
887 Style_Check_Main := True;
888 Ada_Version := Ada_2012;
889 Ada_Version_Explicit := Ada_2012;
890 Ada_Version_Pragma := Empty;
891
892 -- Set default warnings and style checks for -gnatg
893
894 Set_GNAT_Mode_Warnings;
895 Set_GNAT_Style_Check_Options;
896
897 -- -gnatG (output generated code)
898
899 when 'G' =>
900 Ptr := Ptr + 1;
901 Print_Generated_Code := True;
902
903 -- Scan optional integer line limit value
904
905 if Nat_Present (Switch_Chars, Max, Ptr) then
906 Scan_Nat (Switch_Chars, Max, Ptr, Sprint_Line_Limit, 'G');
907 Sprint_Line_Limit := Nat'Max (Sprint_Line_Limit, 40);
908 end if;
909
910 -- -gnath (help information)
911
912 when 'h' =>
913 Ptr := Ptr + 1;
914 Usage_Requested := True;
915
916 -- -gnatH (legacy static elaboration checking mode enabled)
917
918 when 'H' =>
919 Ptr := Ptr + 1;
920 Legacy_Elaboration_Checks := True;
921
922 -- -gnati (character set)
923
924 when 'i' =>
925 if Ptr = Max then
926 Bad_Switch ("-gnati");
927 end if;
928
929 Ptr := Ptr + 1;
930 C := Switch_Chars (Ptr);
931
932 if C in '1' .. '5'
933 or else C = '8'
934 or else C = '9'
935 or else C = 'p'
936 or else C = 'f'
937 or else C = 'n'
938 or else C = 'w'
939 then
940 Identifier_Character_Set := C;
941 Ptr := Ptr + 1;
942
943 else
944 Bad_Switch ("-gnati" & Switch_Chars (Ptr .. Max));
945 end if;
946
947 -- -gnatI (ignore representation clauses)
948
949 when 'I' =>
950 Ptr := Ptr + 1;
951 Ignore_Rep_Clauses := True;
952
953 -- -gnatj (messages in limited length lines)
954
955 when 'j' =>
956 Ptr := Ptr + 1;
957 Scan_Nat (Switch_Chars, Max, Ptr, Error_Msg_Line_Length, C);
958
959 -- -gnatJ (relaxed elaboration checking mode enabled)
960
961 when 'J' =>
962 Ptr := Ptr + 1;
963 Relaxed_Elaboration_Checks := True;
964
965 -- Common relaxations for both ABE mechanisms
966 --
967 -- -gnatd.G (ignore calls through generic formal parameters
968 -- for elaboration)
969 -- -gnatd.U (ignore indirect calls for static elaboration)
970 -- -gnatd.y (disable implicit pragma Elaborate_All on task
971 -- bodies)
972
973 Debug_Flag_Dot_GG := True;
974 Debug_Flag_Dot_UU := True;
975 Debug_Flag_Dot_Y := True;
976
977 -- Relaxatons to the legacy ABE mechanism
978
979 if Legacy_Elaboration_Checks then
980 null;
981
982 -- Relaxations to the default ABE mechanism
983 --
984 -- -gnatd_a (stop elaboration checks on accept or select
985 -- statement)
986 -- -gnatd_e (ignore entry calls and requeue statements for
987 -- elaboration)
988 -- -gnatd_i (ignore activations and calls to instances for
989 -- elaboration)
990 -- -gnatd_p (ignore assertion pragmas for elaboration)
991 -- -gnatd_s (stop elaboration checks on synchronous
992 -- suspension)
993 -- -gnatdL (ignore external calls from instances for
994 -- elaboration)
995
996 else
997 Debug_Flag_Underscore_A := True;
998 Debug_Flag_Underscore_E := True;
999 Debug_Flag_Underscore_I := True;
1000 Debug_Flag_Underscore_P := True;
1001 Debug_Flag_Underscore_S := True;
1002 Debug_Flag_LL := True;
1003 end if;
1004
1005 -- -gnatk (limit file name length)
1006
1007 when 'k' =>
1008 Ptr := Ptr + 1;
1009 Scan_Pos
1010 (Switch_Chars, Max, Ptr, Maximum_File_Name_Length, C);
1011
1012 -- -gnatl (output full source)
1013
1014 when 'l' =>
1015 Ptr := Ptr + 1;
1016 Full_List := True;
1017
1018 -- There may be an equal sign between -gnatl and a file name
1019
1020 if Ptr <= Max and then Switch_Chars (Ptr) = '=' then
1021 if Ptr = Max then
1022 Osint.Fail ("file name for -gnatl= is null");
1023 else
1024 Opt.Full_List_File_Name :=
1025 new String'(Switch_Chars (Ptr + 1 .. Max));
1026 Ptr := Max + 1;
1027 end if;
1028 end if;
1029
1030 -- -gnatL (corresponding source text)
1031
1032 when 'L' =>
1033 Ptr := Ptr + 1;
1034 Dump_Source_Text := True;
1035
1036 -- -gnatm (max number or errors/warnings)
1037
1038 when 'm' =>
1039 Ptr := Ptr + 1;
1040 Scan_Nat (Switch_Chars, Max, Ptr, Maximum_Messages, C);
1041
1042 -- -gnatn (enable pragma Inline)
1043
1044 when 'n' =>
1045 Ptr := Ptr + 1;
1046 Inline_Active := True;
1047
1048 -- There may be a digit (1 or 2) appended to the switch
1049
1050 if Ptr <= Max then
1051 C := Switch_Chars (Ptr);
1052
1053 if C in '1' .. '2' then
1054 Ptr := Ptr + 1;
1055 Inline_Level := Character'Pos (C) - Character'Pos ('0');
1056 end if;
1057 end if;
1058
1059 -- -gnatN (obsolescent)
1060
1061 when 'N' =>
1062 Ptr := Ptr + 1;
1063 Inline_Active := True;
1064 Front_End_Inlining := True;
1065
1066 -- -gnato (overflow checks)
1067
1068 when 'o' =>
1069 Ptr := Ptr + 1;
1070
1071 -- Case of -gnato0 (overflow checking turned off)
1072
1073 if Ptr <= Max and then Switch_Chars (Ptr) = '0' then
1074 Ptr := Ptr + 1;
1075 Suppress_Options.Suppress (Overflow_Check) := True;
1076
1077 -- We set strict mode in case overflow checking is turned
1078 -- on locally (also records that we had a -gnato switch).
1079
1080 Suppress_Options.Overflow_Mode_General := Strict;
1081 Suppress_Options.Overflow_Mode_Assertions := Strict;
1082
1083 -- All cases other than -gnato0 (overflow checking turned on)
1084
1085 else
1086 Suppress_Options.Suppress (Overflow_Check) := False;
1087
1088 -- Case of no digits after the -gnato
1089
1090 if Ptr > Max
1091 or else Switch_Chars (Ptr) not in '1' .. '3'
1092 then
1093 Suppress_Options.Overflow_Mode_General := Strict;
1094 Suppress_Options.Overflow_Mode_Assertions := Strict;
1095
1096 -- At least one digit after the -gnato
1097
1098 else
1099 -- Handle first digit after -gnato
1100
1101 Suppress_Options.Overflow_Mode_General :=
1102 Get_Overflow_Mode (Switch_Chars (Ptr));
1103 Ptr := Ptr + 1;
1104
1105 -- Only one digit after -gnato, set assertions mode to be
1106 -- the same as general mode.
1107
1108 if Ptr > Max
1109 or else Switch_Chars (Ptr) not in '1' .. '3'
1110 then
1111 Suppress_Options.Overflow_Mode_Assertions :=
1112 Suppress_Options.Overflow_Mode_General;
1113
1114 -- Process second digit after -gnato
1115
1116 else
1117 Suppress_Options.Overflow_Mode_Assertions :=
1118 Get_Overflow_Mode (Switch_Chars (Ptr));
1119 Ptr := Ptr + 1;
1120 end if;
1121 end if;
1122 end if;
1123
1124 -- -gnatO (specify name of the object file)
1125
1126 -- This is an internal switch
1127
1128 when 'O' =>
1129 Store_Switch := False;
1130 Ptr := Ptr + 1;
1131 Output_File_Name_Present := True;
1132
1133 -- -gnatp (suppress all checks)
1134
1135 when 'p' =>
1136 Ptr := Ptr + 1;
1137
1138 -- Skip processing if cancelled by subsequent -gnat-p
1139
1140 if Switch_Subsequently_Cancelled ("p", Args, Arg_Rank) then
1141 Store_Switch := False;
1142
1143 else
1144 -- Set all specific options as well as All_Checks in the
1145 -- Suppress_Options array, excluding Elaboration_Check,
1146 -- since this is treated specially because we do not want
1147 -- -gnatp to disable static elaboration processing. Also
1148 -- exclude Atomic_Synchronization, since this is not a real
1149 -- check.
1150
1151 for J in Suppress_Options.Suppress'Range loop
1152 if J /= Elaboration_Check
1153 and then
1154 J /= Atomic_Synchronization
1155 then
1156 Suppress_Options.Suppress (J) := True;
1157 end if;
1158 end loop;
1159
1160 Validity_Checks_On := False;
1161 Opt.Suppress_Checks := True;
1162
1163 -- Set overflow mode checking to strict in case it gets
1164 -- turned on locally (also signals that overflow checking
1165 -- has been specifically turned off).
1166
1167 Suppress_Options.Overflow_Mode_General := Strict;
1168 Suppress_Options.Overflow_Mode_Assertions := Strict;
1169 end if;
1170
1171 -- -gnatq (don't quit)
1172
1173 when 'q' =>
1174 Ptr := Ptr + 1;
1175 Try_Semantics := True;
1176
1177 -- -gnatQ (always write ALI file)
1178
1179 when 'Q' =>
1180 Ptr := Ptr + 1;
1181 Force_ALI_File := True;
1182 Try_Semantics := True;
1183
1184 -- -gnatr (restrictions as warnings)
1185
1186 when 'r' =>
1187 Ptr := Ptr + 1;
1188 Treat_Restrictions_As_Warnings := True;
1189
1190 -- -gnatR (list rep. info)
1191
1192 when 'R' =>
1193
1194 -- Not allowed if previous -gnatD given. See more extensive
1195 -- comments in the 'D' section for the inverse test.
1196
1197 if Debug_Generated_Code then
1198 Osint.Fail
1199 ("-gnatR not permitted since -gnatD given previously");
1200 end if;
1201
1202 -- Set to annotate rep info, and set default -gnatR mode
1203
1204 Back_Annotate_Rep_Info := True;
1205 List_Representation_Info := 1;
1206
1207 -- Scan possible parameter
1208
1209 Ptr := Ptr + 1;
1210 while Ptr <= Max loop
1211 C := Switch_Chars (Ptr);
1212
1213 case C is
1214
1215 when '0' .. '4' =>
1216 List_Representation_Info :=
1217 Character'Pos (C) - Character'Pos ('0');
1218
1219 when 's' =>
1220 List_Representation_Info_To_File := True;
1221
1222 when 'j' =>
1223 List_Representation_Info_To_JSON := True;
1224
1225 when 'm' =>
1226 List_Representation_Info_Mechanisms := True;
1227
1228 when 'e' =>
1229 List_Representation_Info_Extended := True;
1230
1231 when others =>
1232 Bad_Switch ("-gnatR" & Switch_Chars (Ptr .. Max));
1233 end case;
1234
1235 Ptr := Ptr + 1;
1236 end loop;
1237
1238 if List_Representation_Info_To_JSON
1239 and then List_Representation_Info_Extended
1240 then
1241 Osint.Fail ("-gnatRe is incompatible with -gnatRj");
1242 end if;
1243
1244 -- -gnats (syntax check only)
1245
1246 when 's' =>
1247 if not First_Switch then
1248 Osint.Fail
1249 ("-gnats must be first if combined with other switches");
1250 end if;
1251
1252 Ptr := Ptr + 1;
1253 Operating_Mode := Check_Syntax;
1254
1255 -- -gnatS (print package Standard)
1256
1257 when 'S' =>
1258 Print_Standard := True;
1259 Ptr := Ptr + 1;
1260
1261 -- -gnatT (change start of internal table sizes)
1262
1263 when 'T' =>
1264 Ptr := Ptr + 1;
1265 Scan_Pos (Switch_Chars, Max, Ptr, Table_Factor, C);
1266
1267 -- -gnatu (list units for compilation)
1268
1269 when 'u' =>
1270 Ptr := Ptr + 1;
1271 List_Units := True;
1272
1273 -- -gnatU (unique tags)
1274
1275 when 'U' =>
1276 Ptr := Ptr + 1;
1277 Unique_Error_Tag := True;
1278
1279 -- -gnatv (verbose mode)
1280
1281 when 'v' =>
1282 Ptr := Ptr + 1;
1283 Verbose_Mode := True;
1284
1285 -- -gnatV (validity checks)
1286
1287 when 'V' =>
1288 Store_Switch := False;
1289 Ptr := Ptr + 1;
1290
1291 if Ptr > Max then
1292 Bad_Switch ("-gnatV");
1293
1294 else
1295 declare
1296 OK : Boolean;
1297
1298 begin
1299 Set_Validity_Check_Options
1300 (Switch_Chars (Ptr .. Max), OK, Ptr);
1301
1302 if not OK then
1303 Bad_Switch ("-gnatV" & Switch_Chars (Ptr .. Max));
1304 end if;
1305
1306 for Index in First_Char + 1 .. Max loop
1307 Store_Compilation_Switch
1308 ("-gnatV" & Switch_Chars (Index));
1309 end loop;
1310 end;
1311 end if;
1312
1313 Ptr := Max + 1;
1314
1315 -- -gnatw (warning modes)
1316
1317 when 'w' =>
1318 Store_Switch := False;
1319 Ptr := Ptr + 1;
1320
1321 if Ptr > Max then
1322 Bad_Switch ("-gnatw");
1323 end if;
1324
1325 while Ptr <= Max loop
1326 C := Switch_Chars (Ptr);
1327
1328 -- Case of dot switch
1329
1330 if C = '.' and then Ptr < Max then
1331 Ptr := Ptr + 1;
1332 C := Switch_Chars (Ptr);
1333
1334 if Set_Dot_Warning_Switch (C) then
1335 Store_Compilation_Switch ("-gnatw." & C);
1336 else
1337 Bad_Switch ("-gnatw." & Switch_Chars (Ptr .. Max));
1338 end if;
1339
1340 -- Case of underscore switch
1341
1342 elsif C = '_' and then Ptr < Max then
1343 Ptr := Ptr + 1;
1344 C := Switch_Chars (Ptr);
1345
1346 if Set_Underscore_Warning_Switch (C) then
1347 Store_Compilation_Switch ("-gnatw_" & C);
1348 else
1349 Bad_Switch ("-gnatw_" & Switch_Chars (Ptr .. Max));
1350 end if;
1351
1352 -- Normal case
1353
1354 else
1355 if Set_Warning_Switch (C) then
1356 Store_Compilation_Switch ("-gnatw" & C);
1357 else
1358 Bad_Switch ("-gnatw" & Switch_Chars (Ptr .. Max));
1359 end if;
1360 end if;
1361
1362 Ptr := Ptr + 1;
1363 end loop;
1364
1365 return;
1366
1367 -- -gnatW (wide character encoding method)
1368
1369 when 'W' =>
1370 Ptr := Ptr + 1;
1371
1372 if Ptr > Max then
1373 Bad_Switch ("-gnatW");
1374 end if;
1375
1376 begin
1377 Wide_Character_Encoding_Method :=
1378 Get_WC_Encoding_Method (Switch_Chars (Ptr));
1379 exception
1380 when Constraint_Error =>
1381 Bad_Switch ("-gnatW" & Switch_Chars (Ptr .. Max));
1382 end;
1383
1384 Wide_Character_Encoding_Method_Specified := True;
1385
1386 Upper_Half_Encoding :=
1387 Wide_Character_Encoding_Method in
1388 WC_Upper_Half_Encoding_Method;
1389
1390 Ptr := Ptr + 1;
1391
1392 -- -gnatx (suppress cross-ref information)
1393
1394 when 'x' =>
1395 Ptr := Ptr + 1;
1396 Xref_Active := False;
1397
1398 -- -gnatX (language extensions)
1399
1400 when 'X' =>
1401 Ptr := Ptr + 1;
1402 Extensions_Allowed := True;
1403 Ada_Version := Ada_Version_Type'Last;
1404 Ada_Version_Explicit := Ada_Version_Type'Last;
1405 Ada_Version_Pragma := Empty;
1406
1407 -- -gnaty (style checks)
1408
1409 when 'y' =>
1410 Ptr := Ptr + 1;
1411 Style_Check_Main := True;
1412
1413 if Ptr > Max then
1414 Set_Default_Style_Check_Options;
1415
1416 else
1417 Store_Switch := False;
1418
1419 declare
1420 OK : Boolean;
1421
1422 begin
1423 Set_Style_Check_Options
1424 (Switch_Chars (Ptr .. Max), OK, Ptr);
1425
1426 if not OK then
1427 Osint.Fail
1428 ("bad -gnaty switch (" &
1429 Style_Msg_Buf (1 .. Style_Msg_Len) & ')');
1430 end if;
1431
1432 Ptr := First_Char + 1;
1433 while Ptr <= Max loop
1434 if Switch_Chars (Ptr) = 'M' then
1435 First_Char := Ptr;
1436 loop
1437 Ptr := Ptr + 1;
1438 exit when Ptr > Max
1439 or else Switch_Chars (Ptr) not in '0' .. '9';
1440 end loop;
1441
1442 Store_Compilation_Switch
1443 ("-gnaty" & Switch_Chars (First_Char .. Ptr - 1));
1444
1445 else
1446 Store_Compilation_Switch
1447 ("-gnaty" & Switch_Chars (Ptr));
1448 Ptr := Ptr + 1;
1449 end if;
1450 end loop;
1451 end;
1452 end if;
1453
1454 -- -gnatz (stub generation)
1455
1456 when 'z' =>
1457
1458 -- -gnatz must be the first and only switch in Switch_Chars,
1459 -- and is a two-letter switch.
1460
1461 if Ptr /= Switch_Chars'First + 5
1462 or else (Max - Ptr + 1) > 2
1463 then
1464 Osint.Fail
1465 ("-gnatz* may not be combined with other switches");
1466 end if;
1467
1468 if Ptr = Max then
1469 Bad_Switch ("-gnatz");
1470 end if;
1471
1472 Ptr := Ptr + 1;
1473
1474 -- Only one occurrence of -gnat* is permitted
1475
1476 if Distribution_Stub_Mode = No_Stubs then
1477 case Switch_Chars (Ptr) is
1478 when 'r' =>
1479 Distribution_Stub_Mode := Generate_Receiver_Stub_Body;
1480
1481 when 'c' =>
1482 Distribution_Stub_Mode := Generate_Caller_Stub_Body;
1483
1484 when others =>
1485 Bad_Switch ("-gnatz" & Switch_Chars (Ptr .. Max));
1486 end case;
1487
1488 Ptr := Ptr + 1;
1489
1490 else
1491 Osint.Fail ("only one -gnatz* switch allowed");
1492 end if;
1493
1494 -- -gnatZ (obsolescent)
1495
1496 when 'Z' =>
1497 Ptr := Ptr + 1;
1498 Osint.Fail
1499 ("-gnatZ is no longer supported: consider using --RTS=zcx");
1500
1501 -- Note on language version switches: whenever a new language
1502 -- version switch is added, Switch.M.Normalize_Compiler_Switches
1503 -- must be updated.
1504
1505 -- -gnat83
1506
1507 when '8' =>
1508 if Ptr = Max then
1509 Bad_Switch ("-gnat8");
1510 end if;
1511
1512 Ptr := Ptr + 1;
1513
1514 if Switch_Chars (Ptr) /= '3' or else Latest_Ada_Only then
1515 Bad_Switch ("-gnat8" & Switch_Chars (Ptr .. Max));
1516 else
1517 Ptr := Ptr + 1;
1518 Ada_Version := Ada_83;
1519 Ada_Version_Explicit := Ada_83;
1520 Ada_Version_Pragma := Empty;
1521 end if;
1522
1523 -- -gnat95
1524
1525 when '9' =>
1526 if Ptr = Max then
1527 Bad_Switch ("-gnat9");
1528 end if;
1529
1530 Ptr := Ptr + 1;
1531
1532 if Switch_Chars (Ptr) /= '5' or else Latest_Ada_Only then
1533 Bad_Switch ("-gnat9" & Switch_Chars (Ptr .. Max));
1534 else
1535 Ptr := Ptr + 1;
1536 Ada_Version := Ada_95;
1537 Ada_Version_Explicit := Ada_95;
1538 Ada_Version_Pragma := Empty;
1539 end if;
1540
1541 -- -gnat05
1542
1543 when '0' =>
1544 if Ptr = Max then
1545 Bad_Switch ("-gnat0");
1546 end if;
1547
1548 Ptr := Ptr + 1;
1549
1550 if Switch_Chars (Ptr) /= '5' or else Latest_Ada_Only then
1551 Bad_Switch ("-gnat0" & Switch_Chars (Ptr .. Max));
1552 else
1553 Ptr := Ptr + 1;
1554 Ada_Version := Ada_2005;
1555 Ada_Version_Explicit := Ada_2005;
1556 Ada_Version_Pragma := Empty;
1557 end if;
1558
1559 -- -gnat12
1560
1561 when '1' =>
1562 if Ptr = Max then
1563 Bad_Switch ("-gnat1");
1564 end if;
1565
1566 Ptr := Ptr + 1;
1567
1568 if Switch_Chars (Ptr) /= '2' then
1569 Bad_Switch ("-gnat1" & Switch_Chars (Ptr .. Max));
1570 else
1571 Ptr := Ptr + 1;
1572 Ada_Version := Ada_2012;
1573 Ada_Version_Explicit := Ada_2012;
1574 Ada_Version_Pragma := Empty;
1575 end if;
1576
1577 -- -gnat2005 and -gnat2012
1578
1579 when '2' =>
1580 if Ptr > Max - 3 then
1581 Bad_Switch ("-gnat" & Switch_Chars (Ptr .. Max));
1582
1583 elsif Switch_Chars (Ptr .. Ptr + 3) = "2005"
1584 and then not Latest_Ada_Only
1585 then
1586 Ada_Version := Ada_2005;
1587
1588 elsif Switch_Chars (Ptr .. Ptr + 3) = "2012" then
1589 Ada_Version := Ada_2012;
1590
1591 elsif Switch_Chars (Ptr .. Ptr + 3) = "2020" then
1592 Ada_Version := Ada_2020;
1593
1594 else
1595 Bad_Switch ("-gnat" & Switch_Chars (Ptr .. Ptr + 3));
1596 end if;
1597
1598 Ada_Version_Explicit := Ada_Version;
1599 Ada_Version_Pragma := Empty;
1600 Ptr := Ptr + 4;
1601
1602 -- Switch cancellation, currently only -gnat-p is allowed.
1603 -- All we do here is the error checking, since the actual
1604 -- processing for switch cancellation is done by calls to
1605 -- Switch_Subsequently_Cancelled at the appropriate point.
1606
1607 when '-' =>
1608
1609 -- Simple ignore -gnat-p
1610
1611 if Switch_Chars = "-gnat-p" then
1612 return;
1613
1614 -- Any other occurrence of minus is ignored. This is for
1615 -- maximum compatibility with previous version which ignored
1616 -- all occurrences of minus.
1617
1618 else
1619 Store_Switch := False;
1620 Ptr := Ptr + 1;
1621 end if;
1622
1623 -- We ignore '/' in switches, this is historical, still needed???
1624
1625 when '/' =>
1626 Store_Switch := False;
1627
1628 -- Anything else is an error (illegal switch character)
1629
1630 when others =>
1631 Bad_Switch ("-gnat" & Switch_Chars (Ptr .. Max));
1632 end case;
1633
1634 if Store_Switch then
1635 Store_Compilation_Switch
1636 ("-gnat" & Switch_Chars (First_Char .. Ptr - 1));
1637 end if;
1638
1639 First_Switch := False;
1640 end loop;
1641 end if;
1642 end Scan_Front_End_Switches;
1643
1644 -----------------------------------
1645 -- Switch_Subsequently_Cancelled --
1646 -----------------------------------
1647
1648 function Switch_Subsequently_Cancelled
1649 (C : String;
1650 Args : String_List;
1651 Arg_Rank : Positive) return Boolean
1652 is
1653 begin
1654 -- Loop through arguments following the current one
1655
1656 for Arg in Arg_Rank + 1 .. Args'Last loop
1657 if Args (Arg).all = "-gnat-" & C then
1658 return True;
1659 end if;
1660 end loop;
1661
1662 -- No match found, not cancelled
1663
1664 return False;
1665 end Switch_Subsequently_Cancelled;
1666
1667 end Switch.C;