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