Merge from mainline (167278:168000).
[official-gcc/graphite-test-results.git] / gcc / ada / switch-c.adb
bloba4423dc3143083fe6b46493c1052cfe1b53a8382
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-2010, 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 with Debug; use Debug;
27 with Lib; use Lib;
28 with Osint; use Osint;
29 with Opt; use Opt;
30 with Prepcomp; use Prepcomp;
31 with Validsw; use Validsw;
32 with Sem_Warn; use Sem_Warn;
33 with Stylesw; use Stylesw;
35 with System.Strings;
36 with System.WCh_Con; use System.WCh_Con;
38 package body Switch.C is
40 RTS_Specified : String_Access := null;
41 -- Used to detect multiple use of --RTS= flag
43 function Switch_Subsequently_Cancelled
44 (C : String;
45 Args : Argument_List;
46 Arg_Rank : Positive) return Boolean;
47 -- This function is called from Scan_Front_End_Switches. It determines if
48 -- the switch currently being scanned is followed by a switch of the form
49 -- "-gnat-" & C, where C is the argument. If so, then True is returned,
50 -- and Scan_Front_End_Switches will cancel the effect of the switch. If
51 -- no such switch is found, False is returned.
53 -----------------------------
54 -- Scan_Front_End_Switches --
55 -----------------------------
57 procedure Scan_Front_End_Switches
58 (Switch_Chars : String;
59 Args : Argument_List;
60 Arg_Rank : Positive)
62 First_Switch : Boolean := True;
63 -- False for all but first switch
65 Max : constant Natural := Switch_Chars'Last;
66 Ptr : Natural;
67 C : Character := ' ';
68 Dot : Boolean;
70 Store_Switch : Boolean;
71 -- For -gnatxx switches, the normal processing, signalled by this flag
72 -- being set to True, is to store the switch on exit from the case
73 -- statement, the switch stored is -gnat followed by the characters
74 -- from First_Char to Ptr-1. For cases like -gnaty, where the switch
75 -- is stored in separate pieces, this flag is set to False, and the
76 -- appropriate calls to Store_Compilation_Switch are made from within
77 -- the case branch.
79 First_Char : Positive;
80 -- Marks start of switch to be stored
82 begin
83 Ptr := Switch_Chars'First;
85 -- Skip past the initial character (must be the switch character)
87 if Ptr = Max then
88 Bad_Switch (C);
89 else
90 Ptr := Ptr + 1;
91 end if;
93 -- Handle switches that do not start with -gnat
95 if Ptr + 3 > Max
96 or else Switch_Chars (Ptr .. Ptr + 3) /= "gnat"
97 then
98 -- There are two front-end switches that do not start with -gnat:
99 -- -I, --RTS
101 if Switch_Chars (Ptr) = 'I' then
103 -- Set flag Search_Directory_Present if switch is "-I" only:
104 -- the directory will be the next argument.
106 if Ptr = Max then
107 Search_Directory_Present := True;
108 return;
109 end if;
111 Ptr := Ptr + 1;
113 -- Find out whether this is a -I- or regular -Ixxx switch
115 -- Note: -I switches are not recorded in the ALI file, since the
116 -- meaning of the program depends on the source files compiled,
117 -- not where they came from.
119 if Ptr = Max and then Switch_Chars (Ptr) = '-' then
120 Look_In_Primary_Dir := False;
121 else
122 Add_Src_Search_Dir (Switch_Chars (Ptr .. Max));
123 end if;
125 -- Processing of the --RTS switch. --RTS may have been modified by
126 -- gcc into -fRTS (for GCC targets).
128 elsif Ptr + 3 <= Max
129 and then (Switch_Chars (Ptr .. Ptr + 3) = "fRTS"
130 or else
131 Switch_Chars (Ptr .. Ptr + 3) = "-RTS")
132 then
133 Ptr := Ptr + 1;
135 if Ptr + 4 > Max
136 or else Switch_Chars (Ptr + 3) /= '='
137 then
138 Osint.Fail ("missing path for --RTS");
139 else
140 -- Check that this is the first time --RTS is specified or if
141 -- it is not the first time, the same path has been specified.
143 if RTS_Specified = null then
144 RTS_Specified := new String'(Switch_Chars (Ptr + 4 .. Max));
146 elsif
147 RTS_Specified.all /= Switch_Chars (Ptr + 4 .. Max)
148 then
149 Osint.Fail ("--RTS cannot be specified multiple times");
150 end if;
152 -- Valid --RTS switch
154 Opt.No_Stdinc := True;
155 Opt.RTS_Switch := True;
157 RTS_Src_Path_Name :=
158 Get_RTS_Search_Dir
159 (Switch_Chars (Ptr + 4 .. Max), Include);
161 RTS_Lib_Path_Name :=
162 Get_RTS_Search_Dir
163 (Switch_Chars (Ptr + 4 .. Max), Objects);
165 if RTS_Src_Path_Name /= null
166 and then RTS_Lib_Path_Name /= null
167 then
168 -- Store the -fRTS switch (Note: Store_Compilation_Switch
169 -- changes -fRTS back into --RTS for the actual output).
171 Store_Compilation_Switch (Switch_Chars);
173 elsif RTS_Src_Path_Name = null
174 and then RTS_Lib_Path_Name = null
175 then
176 Osint.Fail ("RTS path not valid: missing " &
177 "adainclude and adalib directories");
179 elsif RTS_Src_Path_Name = null then
180 Osint.Fail ("RTS path not valid: missing " &
181 "adainclude directory");
183 elsif RTS_Lib_Path_Name = null then
184 Osint.Fail ("RTS path not valid: missing " &
185 "adalib directory");
186 end if;
187 end if;
189 -- There are no other switches not starting with -gnat
191 else
192 Bad_Switch (Switch_Chars);
193 end if;
195 -- Case of switch starting with -gnat
197 else
198 Ptr := Ptr + 4;
200 -- Loop to scan through switches given in switch string
202 while Ptr <= Max loop
203 First_Char := Ptr;
204 Store_Switch := True;
206 C := Switch_Chars (Ptr);
208 case C is
210 when 'a' =>
211 Ptr := Ptr + 1;
212 Assertions_Enabled := True;
213 Debug_Pragmas_Enabled := True;
215 -- Processing for A switch
217 when 'A' =>
218 Ptr := Ptr + 1;
219 Config_File := False;
221 -- Processing for b switch
223 when 'b' =>
224 Ptr := Ptr + 1;
225 Brief_Output := True;
227 -- Processing for B switch
229 when 'B' =>
230 Ptr := Ptr + 1;
231 Assume_No_Invalid_Values := True;
233 -- Processing for c switch
235 when 'c' =>
236 if not First_Switch then
237 Osint.Fail
238 ("-gnatc must be first if combined with other switches");
239 end if;
241 Ptr := Ptr + 1;
242 Operating_Mode := Check_Semantics;
244 -- Processing for C switch
246 when 'C' =>
247 Ptr := Ptr + 1;
249 if not CodePeer_Mode then
250 CodePeer_Mode := True;
252 -- Suppress compiler warnings by default, since what we are
253 -- interested in here is what CodePeer can find out. Note
254 -- that if -gnatwxxx is specified after -gnatC on the
255 -- command line, we do not want to override this setting in
256 -- Adjust_Global_Switches, and assume that the user wants to
257 -- get both warnings from GNAT and CodePeer messages.
259 Warning_Mode := Suppress;
260 end if;
262 -- Processing for d switch
264 when 'd' =>
265 Store_Switch := False;
266 Dot := False;
268 -- Note: for the debug switch, the remaining characters in this
269 -- switch field must all be debug flags, since all valid switch
270 -- characters are also valid debug characters.
272 -- Loop to scan out debug flags
274 while Ptr < Max loop
275 Ptr := Ptr + 1;
276 C := Switch_Chars (Ptr);
277 exit when C = ASCII.NUL or else C = '/' or else C = '-';
279 if C in '1' .. '9' or else
280 C in 'a' .. 'z' or else
281 C in 'A' .. 'Z'
282 then
283 if Dot then
284 Set_Dotted_Debug_Flag (C);
285 Store_Compilation_Switch ("-gnatd." & C);
286 else
287 Set_Debug_Flag (C);
288 Store_Compilation_Switch ("-gnatd" & C);
289 end if;
291 elsif C = '.' then
292 Dot := True;
294 elsif Dot then
295 Bad_Switch ("-gnatd." & Switch_Chars (Ptr .. Max));
296 else
297 Bad_Switch ("-gnatd" & Switch_Chars (Ptr .. Max));
298 end if;
299 end loop;
301 return;
303 -- Processing for D switch
305 when 'D' =>
306 Ptr := Ptr + 1;
308 -- Scan optional integer line limit value
310 if Nat_Present (Switch_Chars, Max, Ptr) then
311 Scan_Nat (Switch_Chars, Max, Ptr, Sprint_Line_Limit, 'D');
312 Sprint_Line_Limit := Nat'Max (Sprint_Line_Limit, 40);
313 end if;
315 -- Note: -gnatD also sets -gnatx (to turn off cross-reference
316 -- generation in the ali file) since otherwise this generation
317 -- gets confused by the "wrong" Sloc values put in the tree.
319 Debug_Generated_Code := True;
320 Xref_Active := False;
321 Set_Debug_Flag ('g');
323 -- -gnate? (extended switches)
325 when 'e' =>
326 Ptr := Ptr + 1;
328 -- The -gnate? switches are all double character switches
329 -- so we must always have a character after the e.
331 if Ptr > Max then
332 Bad_Switch ("-gnate");
333 end if;
335 case Switch_Chars (Ptr) is
337 -- -gnatea (initial delimiter of explicit switches)
339 -- All switches that come before -gnatea have been added by
340 -- the GCC driver and are not stored in the ALI file.
341 -- See also -gnatez below.
343 when 'a' =>
344 Store_Switch := False;
345 Enable_Switch_Storing;
346 Ptr := Ptr + 1;
348 -- -gnatec (configuration pragmas)
350 when 'c' =>
351 Store_Switch := False;
352 Ptr := Ptr + 1;
354 -- There may be an equal sign between -gnatec and
355 -- the path name of the config file.
357 if Ptr <= Max and then Switch_Chars (Ptr) = '=' then
358 Ptr := Ptr + 1;
359 end if;
361 if Ptr > Max then
362 Bad_Switch ("-gnatec");
363 end if;
365 declare
366 Config_File_Name : constant String_Access :=
367 new String'
368 (Switch_Chars (Ptr .. Max));
370 begin
371 if Config_File_Names = null then
372 Config_File_Names :=
373 new String_List'(1 => Config_File_Name);
375 else
376 declare
377 New_Names : constant String_List_Access :=
378 new String_List
379 (1 ..
380 Config_File_Names'Length + 1);
382 begin
383 for Index in Config_File_Names'Range loop
384 New_Names (Index) :=
385 Config_File_Names (Index);
386 Config_File_Names (Index) := null;
387 end loop;
389 New_Names (New_Names'Last) := Config_File_Name;
390 Free (Config_File_Names);
391 Config_File_Names := New_Names;
392 end;
393 end if;
394 end;
396 return;
398 -- -gnateC switch (CodePeer SCIL generation)
400 -- Not enabled for now, keep it for later???
401 -- use -gnatd.I only for now
403 -- when 'C' =>
404 -- Ptr := Ptr + 1;
405 -- Generate_SCIL := True;
407 -- -gnateD switch (preprocessing symbol definition)
409 when 'D' =>
410 Store_Switch := False;
411 Ptr := Ptr + 1;
413 if Ptr > Max then
414 Bad_Switch ("-gnateD");
415 end if;
417 Add_Symbol_Definition (Switch_Chars (Ptr .. Max));
419 -- Store the switch
421 Store_Compilation_Switch
422 ("-gnateD" & Switch_Chars (Ptr .. Max));
423 Ptr := Max + 1;
425 -- -gnateE (extra exception information)
427 when 'E' =>
428 Exception_Extra_Info := True;
429 Ptr := Ptr + 1;
431 -- -gnatef (full source path for brief error messages)
433 when 'f' =>
434 Store_Switch := False;
435 Ptr := Ptr + 1;
436 Full_Path_Name_For_Brief_Errors := True;
438 -- -gnateG (save preprocessor output)
440 when 'G' =>
441 Generate_Processed_File := True;
442 Ptr := Ptr + 1;
444 -- -gnateI (index of unit in multi-unit source)
446 when 'I' =>
447 Ptr := Ptr + 1;
448 Scan_Pos (Switch_Chars, Max, Ptr, Multiple_Unit_Index, C);
450 -- -gnatem (mapping file)
452 when 'm' =>
453 Store_Switch := False;
454 Ptr := Ptr + 1;
456 -- There may be an equal sign between -gnatem and
457 -- the path name of the mapping file.
459 if Ptr <= Max and then Switch_Chars (Ptr) = '=' then
460 Ptr := Ptr + 1;
461 end if;
463 if Ptr > Max then
464 Bad_Switch ("-gnatem");
465 end if;
467 Mapping_File_Name :=
468 new String'(Switch_Chars (Ptr .. Max));
469 return;
471 -- -gnatep (preprocessing data file)
473 when 'p' =>
474 Store_Switch := False;
475 Ptr := Ptr + 1;
477 -- There may be an equal sign between -gnatep and
478 -- the path name of the mapping file.
480 if Ptr <= Max and then Switch_Chars (Ptr) = '=' then
481 Ptr := Ptr + 1;
482 end if;
484 if Ptr > Max then
485 Bad_Switch ("-gnatep");
486 end if;
488 Preprocessing_Data_File :=
489 new String'(Switch_Chars (Ptr .. Max));
491 -- Store the switch, normalizing to -gnatep=
493 Store_Compilation_Switch
494 ("-gnatep=" & Preprocessing_Data_File.all);
496 Ptr := Max + 1;
498 -- -gnateP (Treat pragma Pure/Preelaborate errs as warnings)
500 when 'P' =>
501 Treat_Categorization_Errors_As_Warnings := True;
503 -- -gnatez (final delimiter of explicit switches)
505 -- All switches that come after -gnatez have been added by
506 -- the GCC driver and are not stored in the ALI file. See
507 -- also -gnatea above.
509 when 'z' =>
510 Store_Switch := False;
511 Disable_Switch_Storing;
512 Ptr := Ptr + 1;
514 -- -gnateS (generate SCO information)
516 -- Include Source Coverage Obligation information in ALI
517 -- files for the benefit of source coverage analysis tools
518 -- (xcov).
520 when 'S' =>
521 Generate_SCO := True;
522 Ptr := Ptr + 1;
524 -- All other -gnate? switches are unassigned
526 when others =>
527 Bad_Switch ("-gnate" & Switch_Chars (Ptr .. Max));
528 end case;
530 -- -gnatE (dynamic elaboration checks)
532 when 'E' =>
533 Ptr := Ptr + 1;
534 Dynamic_Elaboration_Checks := True;
536 -- -gnatf (full error messages)
538 when 'f' =>
539 Ptr := Ptr + 1;
540 All_Errors_Mode := True;
542 -- Processing for F switch
544 when 'F' =>
545 Ptr := Ptr + 1;
546 External_Name_Exp_Casing := Uppercase;
547 External_Name_Imp_Casing := Uppercase;
549 -- Processing for g switch
551 when 'g' =>
552 Ptr := Ptr + 1;
553 GNAT_Mode := True;
554 Identifier_Character_Set := 'n';
555 System_Extend_Unit := Empty;
556 Warning_Mode := Treat_As_Error;
558 -- Set Ada 2012 mode explicitly. We don't want to rely on the
559 -- implicit setting here, since for example, we want
560 -- Preelaborate_05 treated as Preelaborate
562 Ada_Version := Ada_2012;
563 Ada_Version_Explicit := Ada_Version;
565 -- Set default warnings and style checks for -gnatg
567 Set_GNAT_Mode_Warnings;
568 Set_GNAT_Style_Check_Options;
570 -- Processing for G switch
572 when 'G' =>
573 Ptr := Ptr + 1;
574 Print_Generated_Code := True;
576 -- Scan optional integer line limit value
578 if Nat_Present (Switch_Chars, Max, Ptr) then
579 Scan_Nat (Switch_Chars, Max, Ptr, Sprint_Line_Limit, 'G');
580 Sprint_Line_Limit := Nat'Max (Sprint_Line_Limit, 40);
581 end if;
583 -- Processing for h switch
585 when 'h' =>
586 Ptr := Ptr + 1;
587 Usage_Requested := True;
589 -- Processing for H switch
591 when 'H' =>
592 Ptr := Ptr + 1;
593 HLO_Active := True;
595 -- Processing for i switch
597 when 'i' =>
598 if Ptr = Max then
599 Bad_Switch ("-gnati");
600 end if;
602 Ptr := Ptr + 1;
603 C := Switch_Chars (Ptr);
605 if C in '1' .. '5'
606 or else C = '8'
607 or else C = '9'
608 or else C = 'p'
609 or else C = 'f'
610 or else C = 'n'
611 or else C = 'w'
612 then
613 Identifier_Character_Set := C;
614 Ptr := Ptr + 1;
616 else
617 Bad_Switch ("-gnati" & Switch_Chars (Ptr .. Max));
618 end if;
620 -- Processing for I switch
622 when 'I' =>
623 Ptr := Ptr + 1;
624 Ignore_Rep_Clauses := True;
626 -- Processing for j switch
628 when 'j' =>
629 Ptr := Ptr + 1;
630 Scan_Nat (Switch_Chars, Max, Ptr, Error_Msg_Line_Length, C);
632 -- Processing for k switch
634 when 'k' =>
635 Ptr := Ptr + 1;
636 Scan_Pos
637 (Switch_Chars, Max, Ptr, Maximum_File_Name_Length, C);
639 -- Processing for l switch
641 when 'l' =>
642 Ptr := Ptr + 1;
643 Full_List := True;
645 -- There may be an equal sign between -gnatl and a file name
647 if Ptr <= Max and then Switch_Chars (Ptr) = '=' then
648 if Ptr = Max then
649 Osint.Fail ("file name for -gnatl= is null");
650 else
651 Opt.Full_List_File_Name :=
652 new String'(Switch_Chars (Ptr + 1 .. Max));
653 Ptr := Max + 1;
654 end if;
655 end if;
657 -- Processing for L switch
659 when 'L' =>
660 Ptr := Ptr + 1;
661 Dump_Source_Text := True;
663 -- Processing for m switch
665 when 'm' =>
666 Ptr := Ptr + 1;
667 Scan_Nat (Switch_Chars, Max, Ptr, Maximum_Messages, C);
669 -- Processing for n switch
671 when 'n' =>
672 Ptr := Ptr + 1;
673 Inline_Active := True;
675 -- Processing for N switch
677 when 'N' =>
678 Ptr := Ptr + 1;
679 Inline_Active := True;
680 Front_End_Inlining := True;
682 -- Processing for o switch
684 when 'o' =>
685 Ptr := Ptr + 1;
686 Suppress_Options (Overflow_Check) := False;
687 Opt.Enable_Overflow_Checks := True;
689 -- Processing for O switch
691 when 'O' =>
692 Store_Switch := False;
693 Ptr := Ptr + 1;
694 Output_File_Name_Present := True;
696 -- Processing for p switch
698 when 'p' =>
699 Ptr := Ptr + 1;
701 -- Skip processing if cancelled by subsequent -gnat-p
703 if Switch_Subsequently_Cancelled ("p", Args, Arg_Rank) then
704 Store_Switch := False;
706 else
707 -- Set all specific options as well as All_Checks in the
708 -- Suppress_Options array, excluding Elaboration_Check,
709 -- since this is treated specially because we do not want
710 -- -gnatp to disable static elaboration processing.
712 for J in Suppress_Options'Range loop
713 if J /= Elaboration_Check then
714 Suppress_Options (J) := True;
715 end if;
716 end loop;
718 Validity_Checks_On := False;
719 Opt.Suppress_Checks := True;
720 Opt.Enable_Overflow_Checks := False;
721 end if;
723 -- Processing for P switch
725 when 'P' =>
726 Ptr := Ptr + 1;
727 Polling_Required := True;
729 -- Processing for q switch
731 when 'q' =>
732 Ptr := Ptr + 1;
733 Try_Semantics := True;
735 -- Processing for Q switch
737 when 'Q' =>
738 Ptr := Ptr + 1;
739 Force_ALI_Tree_File := True;
740 Try_Semantics := True;
742 -- Processing for r switch
744 when 'r' =>
745 Ptr := Ptr + 1;
746 Treat_Restrictions_As_Warnings := True;
748 -- Processing for R switch
750 when 'R' =>
751 Back_Annotate_Rep_Info := True;
752 List_Representation_Info := 1;
754 Ptr := Ptr + 1;
755 while Ptr <= Max loop
756 C := Switch_Chars (Ptr);
758 if C in '1' .. '3' then
759 List_Representation_Info :=
760 Character'Pos (C) - Character'Pos ('0');
762 elsif Switch_Chars (Ptr) = 's' then
763 List_Representation_Info_To_File := True;
765 elsif Switch_Chars (Ptr) = 'm' then
766 List_Representation_Info_Mechanisms := True;
768 else
769 Bad_Switch ("-gnatR" & Switch_Chars (Ptr .. Max));
770 end if;
772 Ptr := Ptr + 1;
773 end loop;
775 -- Processing for s switch
777 when 's' =>
778 if not First_Switch then
779 Osint.Fail
780 ("-gnats must be first if combined with other switches");
781 end if;
783 Ptr := Ptr + 1;
784 Operating_Mode := Check_Syntax;
786 -- Processing for S switch
788 when 'S' =>
789 Print_Standard := True;
790 Ptr := Ptr + 1;
792 -- Processing for t switch
794 when 't' =>
795 Ptr := Ptr + 1;
796 Tree_Output := True;
797 Back_Annotate_Rep_Info := True;
799 -- Processing for T switch
801 when 'T' =>
802 Ptr := Ptr + 1;
803 Scan_Pos (Switch_Chars, Max, Ptr, Table_Factor, C);
805 -- Processing for u switch
807 when 'u' =>
808 Ptr := Ptr + 1;
809 List_Units := True;
811 -- Processing for U switch
813 when 'U' =>
814 Ptr := Ptr + 1;
815 Unique_Error_Tag := True;
817 -- Processing for v switch
819 when 'v' =>
820 Ptr := Ptr + 1;
821 Verbose_Mode := True;
823 -- Processing for V switch
825 when 'V' =>
826 Store_Switch := False;
827 Ptr := Ptr + 1;
829 if Ptr > Max then
830 Bad_Switch ("-gnatV");
832 else
833 declare
834 OK : Boolean;
836 begin
837 Set_Validity_Check_Options
838 (Switch_Chars (Ptr .. Max), OK, Ptr);
840 if not OK then
841 Bad_Switch ("-gnatV" & Switch_Chars (Ptr .. Max));
842 end if;
844 for Index in First_Char + 1 .. Max loop
845 Store_Compilation_Switch
846 ("-gnatV" & Switch_Chars (Index));
847 end loop;
848 end;
849 end if;
851 Ptr := Max + 1;
853 -- Processing for w switch
855 when 'w' =>
856 Store_Switch := False;
857 Ptr := Ptr + 1;
859 if Ptr > Max then
860 Bad_Switch ("-gnatw");
861 end if;
863 while Ptr <= Max loop
864 C := Switch_Chars (Ptr);
866 -- Case of dot switch
868 if C = '.' and then Ptr < Max then
869 Ptr := Ptr + 1;
870 C := Switch_Chars (Ptr);
872 if Set_Dot_Warning_Switch (C) then
873 Store_Compilation_Switch ("-gnatw." & C);
874 else
875 Bad_Switch ("-gnatw." & Switch_Chars (Ptr .. Max));
876 end if;
878 -- Normal case, no dot
880 else
881 if Set_Warning_Switch (C) then
882 Store_Compilation_Switch ("-gnatw" & C);
883 else
884 Bad_Switch ("-gnatw" & Switch_Chars (Ptr .. Max));
885 end if;
886 end if;
888 Ptr := Ptr + 1;
889 end loop;
891 return;
893 -- Processing for W switch
895 when 'W' =>
896 Ptr := Ptr + 1;
898 if Ptr > Max then
899 Bad_Switch ("-gnatW");
900 end if;
902 begin
903 Wide_Character_Encoding_Method :=
904 Get_WC_Encoding_Method (Switch_Chars (Ptr));
905 exception
906 when Constraint_Error =>
907 Bad_Switch ("-gnatW" & Switch_Chars (Ptr .. Max));
908 end;
910 Wide_Character_Encoding_Method_Specified := True;
912 Upper_Half_Encoding :=
913 Wide_Character_Encoding_Method in
914 WC_Upper_Half_Encoding_Method;
916 Ptr := Ptr + 1;
918 -- Processing for x switch
920 when 'x' =>
921 Ptr := Ptr + 1;
922 Xref_Active := False;
924 -- Processing for X switch
926 when 'X' =>
927 Ptr := Ptr + 1;
928 Extensions_Allowed := True;
929 Ada_Version := Ada_Version_Type'Last;
930 Ada_Version_Explicit := Ada_Version_Type'Last;
932 -- Processing for y switch
934 when 'y' =>
935 Ptr := Ptr + 1;
937 if Ptr > Max then
938 Set_Default_Style_Check_Options;
940 else
941 Store_Switch := False;
943 declare
944 OK : Boolean;
946 begin
947 Set_Style_Check_Options
948 (Switch_Chars (Ptr .. Max), OK, Ptr);
950 if not OK then
951 Osint.Fail
952 ("bad -gnaty switch (" &
953 Style_Msg_Buf (1 .. Style_Msg_Len) & ')');
954 end if;
956 Ptr := First_Char + 1;
957 while Ptr <= Max loop
958 if Switch_Chars (Ptr) = 'M' then
959 First_Char := Ptr;
960 loop
961 Ptr := Ptr + 1;
962 exit when Ptr > Max
963 or else Switch_Chars (Ptr) not in '0' .. '9';
964 end loop;
966 Store_Compilation_Switch
967 ("-gnaty" & Switch_Chars (First_Char .. Ptr - 1));
969 else
970 Store_Compilation_Switch
971 ("-gnaty" & Switch_Chars (Ptr));
972 Ptr := Ptr + 1;
973 end if;
974 end loop;
975 end;
976 end if;
978 -- Processing for z switch
980 when 'z' =>
982 -- -gnatz must be the first and only switch in Switch_Chars,
983 -- and is a two-letter switch.
985 if Ptr /= Switch_Chars'First + 5
986 or else (Max - Ptr + 1) > 2
987 then
988 Osint.Fail
989 ("-gnatz* may not be combined with other switches");
990 end if;
992 if Ptr = Max then
993 Bad_Switch ("-gnatz");
994 end if;
996 Ptr := Ptr + 1;
998 -- Only one occurrence of -gnat* is permitted
1000 if Distribution_Stub_Mode = No_Stubs then
1001 case Switch_Chars (Ptr) is
1002 when 'r' =>
1003 Distribution_Stub_Mode := Generate_Receiver_Stub_Body;
1005 when 'c' =>
1006 Distribution_Stub_Mode := Generate_Caller_Stub_Body;
1008 when others =>
1009 Bad_Switch ("-gnatz" & Switch_Chars (Ptr .. Max));
1010 end case;
1012 Ptr := Ptr + 1;
1014 else
1015 Osint.Fail ("only one -gnatz* switch allowed");
1016 end if;
1018 -- Processing for Z switch
1020 when 'Z' =>
1021 Ptr := Ptr + 1;
1022 Osint.Fail
1023 ("-gnatZ is no longer supported: consider using --RTS=zcx");
1025 -- Processing for 83 switch
1027 when '8' =>
1028 if Ptr = Max then
1029 Bad_Switch ("-gnat8");
1030 end if;
1032 Ptr := Ptr + 1;
1034 if Switch_Chars (Ptr) /= '3' then
1035 Bad_Switch ("-gnat8" & Switch_Chars (Ptr .. Max));
1036 else
1037 Ptr := Ptr + 1;
1038 Ada_Version := Ada_83;
1039 Ada_Version_Explicit := Ada_Version;
1040 end if;
1042 -- Processing for 95 switch
1044 when '9' =>
1045 if Ptr = Max then
1046 Bad_Switch ("-gnat9");
1047 end if;
1049 Ptr := Ptr + 1;
1051 if Switch_Chars (Ptr) /= '5' then
1052 Bad_Switch ("-gnat9" & Switch_Chars (Ptr .. Max));
1053 else
1054 Ptr := Ptr + 1;
1055 Ada_Version := Ada_95;
1056 Ada_Version_Explicit := Ada_Version;
1057 end if;
1059 -- Processing for 05 switch
1061 when '0' =>
1062 if Ptr = Max then
1063 Bad_Switch ("-gnat0");
1064 end if;
1066 Ptr := Ptr + 1;
1068 if Switch_Chars (Ptr) /= '5' then
1069 Bad_Switch ("-gnat0" & Switch_Chars (Ptr .. Max));
1070 else
1071 Ptr := Ptr + 1;
1072 Ada_Version := Ada_2005;
1073 Ada_Version_Explicit := Ada_Version;
1074 end if;
1076 -- Processing for 12 switch
1078 when '1' =>
1079 if Ptr = Max then
1080 Bad_Switch ("-gnat1");
1081 end if;
1083 Ptr := Ptr + 1;
1085 if Switch_Chars (Ptr) /= '2' then
1086 Bad_Switch ("-gnat1" & Switch_Chars (Ptr .. Max));
1087 else
1088 Ptr := Ptr + 1;
1089 Ada_Version := Ada_2012;
1090 Ada_Version_Explicit := Ada_Version;
1091 end if;
1093 -- Processing for 2005 and 2012 switches
1095 when '2' =>
1096 if Ptr > Max - 3 then
1097 Bad_Switch ("-gnat" & Switch_Chars (Ptr .. Max));
1099 elsif Switch_Chars (Ptr .. Ptr + 3) = "2005" then
1100 Ada_Version := Ada_2005;
1102 elsif Switch_Chars (Ptr .. Ptr + 3) = "2012" then
1103 Ada_Version := Ada_2012;
1105 else
1106 Bad_Switch ("-gnat" & Switch_Chars (Ptr .. Ptr + 3));
1107 end if;
1109 Ada_Version_Explicit := Ada_Version;
1110 Ptr := Ptr + 4;
1112 -- Switch cancellation, currently only -gnat-p is allowed.
1113 -- All we do here is the error checking, since the actual
1114 -- processing for switch cancellation is done by calls to
1115 -- Switch_Subsequently_Cancelled at the appropriate point.
1117 when '-' =>
1119 -- Simple ignore -gnat-p
1121 if Switch_Chars = "-gnat-p" then
1122 return;
1124 -- Any other occurrence of minus is ignored. This is for
1125 -- maximum compatibility with previous version which ignored
1126 -- all occurrences of minus.
1128 else
1129 Store_Switch := False;
1130 Ptr := Ptr + 1;
1131 end if;
1133 -- We ignore '/' in switches, this is historical, still needed???
1135 when '/' =>
1136 Store_Switch := False;
1138 -- Anything else is an error (illegal switch character)
1140 when others =>
1141 Bad_Switch ("-gnat" & Switch_Chars (Ptr .. Max));
1142 end case;
1144 if Store_Switch then
1145 Store_Compilation_Switch
1146 ("-gnat" & Switch_Chars (First_Char .. Ptr - 1));
1147 end if;
1149 First_Switch := False;
1150 end loop;
1151 end if;
1152 end Scan_Front_End_Switches;
1154 -----------------------------------
1155 -- Switch_Subsequently_Cancelled --
1156 -----------------------------------
1158 function Switch_Subsequently_Cancelled
1159 (C : String;
1160 Args : Argument_List;
1161 Arg_Rank : Positive) return Boolean
1163 use type System.Strings.String_Access;
1165 begin
1166 -- Loop through arguments following the current one
1168 for Arg in Arg_Rank + 1 .. Args'Last loop
1169 if Args (Arg).all = "-gnat-" & C then
1170 return True;
1171 end if;
1172 end loop;
1174 -- No match found, not cancelled
1176 return False;
1177 end Switch_Subsequently_Cancelled;
1179 end Switch.C;