OSDN Git Service

gcc/
[pf3gnuchains/gcc-fork.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-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 ------------------------------------------------------------------------------
25
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;
34
35 with System.Strings;
36 with System.WCh_Con; use System.WCh_Con;
37
38 package body Switch.C is
39
40    RTS_Specified : String_Access := null;
41    --  Used to detect multiple use of --RTS= flag
42
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.
52
53    -----------------------------
54    -- Scan_Front_End_Switches --
55    -----------------------------
56
57    procedure Scan_Front_End_Switches
58      (Switch_Chars : String;
59       Args         : Argument_List;
60       Arg_Rank     : Positive)
61    is
62       First_Switch : Boolean := True;
63       --  False for all but first switch
64
65       Max : constant Natural := Switch_Chars'Last;
66       Ptr : Natural;
67       C   : Character := ' ';
68       Dot : Boolean;
69
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.
78
79       First_Char : Positive;
80       --  Marks start of switch to be stored
81
82    begin
83       Ptr := Switch_Chars'First;
84
85       --  Skip past the initial character (must be the switch character)
86
87       if Ptr = Max then
88          Bad_Switch (C);
89       else
90          Ptr := Ptr + 1;
91       end if;
92
93       --  Handle switches that do not start with -gnat
94
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
100
101          if Switch_Chars (Ptr) = 'I' then
102
103             --  Set flag Search_Directory_Present if switch is "-I" only:
104             --  the directory will be the next argument.
105
106             if Ptr = Max then
107                Search_Directory_Present := True;
108                return;
109             end if;
110
111             Ptr := Ptr + 1;
112
113             --  Find out whether this is a -I- or regular -Ixxx switch
114
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.
118
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;
124
125          --  Processing of the --RTS switch. --RTS may have been modified by
126          --  gcc into -fRTS (for GCC targets).
127
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;
134
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.
142
143                if RTS_Specified = null then
144                   RTS_Specified := new String'(Switch_Chars (Ptr + 4 .. Max));
145
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;
151
152                --  Valid --RTS switch
153
154                Opt.No_Stdinc := True;
155                Opt.RTS_Switch := True;
156
157                RTS_Src_Path_Name :=
158                  Get_RTS_Search_Dir
159                    (Switch_Chars (Ptr + 4 .. Max), Include);
160
161                RTS_Lib_Path_Name :=
162                  Get_RTS_Search_Dir
163                    (Switch_Chars (Ptr + 4 .. Max), Objects);
164
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).
170
171                   Store_Compilation_Switch (Switch_Chars);
172
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");
178
179                elsif RTS_Src_Path_Name = null then
180                   Osint.Fail ("RTS path not valid: missing " &
181                               "adainclude directory");
182
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;
188
189             --  There are no other switches not starting with -gnat
190
191          else
192             Bad_Switch (Switch_Chars);
193          end if;
194
195       --  Case of switch starting with -gnat
196
197       else
198          Ptr := Ptr + 4;
199
200          --  Loop to scan through switches given in switch string
201
202          while Ptr <= Max loop
203             First_Char := Ptr;
204             Store_Switch := True;
205
206             C := Switch_Chars (Ptr);
207
208             case C is
209
210             when 'a' =>
211                Ptr := Ptr + 1;
212                Assertions_Enabled := True;
213                Debug_Pragmas_Enabled := True;
214
215             --  Processing for A switch
216
217             when 'A' =>
218                Ptr := Ptr + 1;
219                Config_File := False;
220
221             --  Processing for b switch
222
223             when 'b' =>
224                Ptr := Ptr + 1;
225                Brief_Output := True;
226
227             --  Processing for B switch
228
229             when 'B' =>
230                Ptr := Ptr + 1;
231                Assume_No_Invalid_Values := True;
232
233             --  Processing for c switch
234
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;
240
241                Ptr := Ptr + 1;
242                Operating_Mode := Check_Semantics;
243
244             --  Processing for C switch
245
246             when 'C' =>
247                Ptr := Ptr + 1;
248                CodePeer_Mode := True;
249
250             --  Processing for d switch
251
252             when 'd' =>
253                Store_Switch := False;
254                Dot := False;
255
256                --  Note: for the debug switch, the remaining characters in this
257                --  switch field must all be debug flags, since all valid switch
258                --  characters are also valid debug characters.
259
260                --  Loop to scan out debug flags
261
262                while Ptr < Max loop
263                   Ptr := Ptr + 1;
264                   C := Switch_Chars (Ptr);
265                   exit when C = ASCII.NUL or else C = '/' or else C = '-';
266
267                   if C in '1' .. '9' or else
268                      C in 'a' .. 'z' or else
269                      C in 'A' .. 'Z'
270                   then
271                      if Dot then
272                         Set_Dotted_Debug_Flag (C);
273                         Store_Compilation_Switch ("-gnatd." & C);
274                      else
275                         Set_Debug_Flag (C);
276                         Store_Compilation_Switch ("-gnatd" & C);
277                      end if;
278
279                   elsif C = '.' then
280                      Dot := True;
281
282                   elsif Dot then
283                      Bad_Switch ("-gnatd." & Switch_Chars (Ptr .. Max));
284                   else
285                      Bad_Switch ("-gnatd" & Switch_Chars (Ptr .. Max));
286                   end if;
287                end loop;
288
289                return;
290
291             --  Processing for D switch
292
293             when 'D' =>
294                Ptr := Ptr + 1;
295
296                --  Scan optional integer line limit value
297
298                if Nat_Present (Switch_Chars, Max, Ptr) then
299                   Scan_Nat (Switch_Chars, Max, Ptr, Sprint_Line_Limit, 'D');
300                   Sprint_Line_Limit := Nat'Max (Sprint_Line_Limit, 40);
301                end if;
302
303                --  Note: -gnatD also sets -gnatx (to turn off cross-reference
304                --  generation in the ali file) since otherwise this generation
305                --  gets confused by the "wrong" Sloc values put in the tree.
306
307                Debug_Generated_Code := True;
308                Xref_Active := False;
309                Set_Debug_Flag ('g');
310
311             --  -gnate? (extended switches)
312
313             when 'e' =>
314                Ptr := Ptr + 1;
315
316                --  The -gnate? switches are all double character switches
317                --  so we must always have a character after the e.
318
319                if Ptr > Max then
320                   Bad_Switch ("-gnate");
321                end if;
322
323                case Switch_Chars (Ptr) is
324
325                   --  -gnatea (initial delimiter of explicit switches)
326
327                   --  All switches that come before -gnatea have been added by
328                   --  the GCC driver and are not stored in the ALI file.
329                   --  See also -gnatez below.
330
331                   when 'a' =>
332                      Store_Switch := False;
333                      Enable_Switch_Storing;
334                      Ptr := Ptr + 1;
335
336                   --  -gnatec (configuration pragmas)
337
338                   when 'c' =>
339                      Store_Switch := False;
340                      Ptr := Ptr + 1;
341
342                      --  There may be an equal sign between -gnatec and
343                      --  the path name of the config file.
344
345                      if Ptr <= Max and then Switch_Chars (Ptr) = '=' then
346                         Ptr := Ptr + 1;
347                      end if;
348
349                      if Ptr > Max then
350                         Bad_Switch ("-gnatec");
351                      end if;
352
353                      declare
354                         Config_File_Name : constant String_Access :=
355                                              new String'
356                                                   (Switch_Chars (Ptr .. Max));
357
358                      begin
359                         if Config_File_Names = null then
360                            Config_File_Names :=
361                              new String_List'(1 => Config_File_Name);
362
363                         else
364                            declare
365                               New_Names : constant String_List_Access :=
366                                             new String_List
367                                               (1 ..
368                                                Config_File_Names'Length + 1);
369
370                            begin
371                               for Index in Config_File_Names'Range loop
372                                  New_Names (Index) :=
373                                    Config_File_Names (Index);
374                                  Config_File_Names (Index) := null;
375                               end loop;
376
377                               New_Names (New_Names'Last) := Config_File_Name;
378                               Free (Config_File_Names);
379                               Config_File_Names := New_Names;
380                            end;
381                         end if;
382                      end;
383
384                      return;
385
386                   --  -gnateC switch (CodePeer SCIL generation)
387
388                   --  Not enabled for now, keep it for later???
389                   --  use -gnatd.I only for now
390
391                   --  when 'C' =>
392                   --     Ptr := Ptr + 1;
393                   --     Generate_SCIL := True;
394
395                   --  -gnateD switch (preprocessing symbol definition)
396
397                   when 'D' =>
398                      Store_Switch := False;
399                      Ptr := Ptr + 1;
400
401                      if Ptr > Max then
402                         Bad_Switch ("-gnateD");
403                      end if;
404
405                      Add_Symbol_Definition (Switch_Chars (Ptr .. Max));
406
407                      --  Store the switch
408
409                      Store_Compilation_Switch
410                        ("-gnateD" & Switch_Chars (Ptr .. Max));
411                      Ptr := Max + 1;
412
413                   --  -gnatef (full source path for brief error messages)
414
415                   when 'f' =>
416                      Store_Switch := False;
417                      Ptr := Ptr + 1;
418                      Full_Path_Name_For_Brief_Errors := True;
419
420                   --  -gnateG (save preprocessor output)
421
422                   when 'G' =>
423                      Generate_Processed_File := True;
424                      Ptr := Ptr + 1;
425
426                   --  -gnateI (index of unit in multi-unit source)
427
428                   when 'I' =>
429                      Ptr := Ptr + 1;
430                      Scan_Pos (Switch_Chars, Max, Ptr, Multiple_Unit_Index, C);
431
432                   --  -gnatem (mapping file)
433
434                   when 'm' =>
435                      Store_Switch := False;
436                      Ptr := Ptr + 1;
437
438                      --  There may be an equal sign between -gnatem and
439                      --  the path name of the mapping file.
440
441                      if Ptr <= Max and then Switch_Chars (Ptr) = '=' then
442                         Ptr := Ptr + 1;
443                      end if;
444
445                      if Ptr > Max then
446                         Bad_Switch ("-gnatem");
447                      end if;
448
449                      Mapping_File_Name :=
450                        new String'(Switch_Chars (Ptr .. Max));
451                      return;
452
453                   --  -gnatep (preprocessing data file)
454
455                   when 'p' =>
456                      Store_Switch := False;
457                      Ptr := Ptr + 1;
458
459                      --  There may be an equal sign between -gnatep and
460                      --  the path name of the mapping file.
461
462                      if Ptr <= Max and then Switch_Chars (Ptr) = '=' then
463                         Ptr := Ptr + 1;
464                      end if;
465
466                      if Ptr > Max then
467                         Bad_Switch ("-gnatep");
468                      end if;
469
470                      Preprocessing_Data_File :=
471                        new String'(Switch_Chars (Ptr .. Max));
472
473                      --  Store the switch, normalizing to -gnatep=
474
475                      Store_Compilation_Switch
476                        ("-gnatep=" & Preprocessing_Data_File.all);
477
478                      Ptr := Max + 1;
479
480                   --  -gnatez (final delimiter of explicit switches)
481
482                   --  All switches that come after -gnatez have been added by
483                   --  the GCC driver and are not stored in the ALI file. See
484                   --  also -gnatea above.
485
486                   when 'z' =>
487                      Store_Switch := False;
488                      Disable_Switch_Storing;
489                      Ptr := Ptr + 1;
490
491                   --  -gnateS (generate SCO information)
492
493                   --  Include Source Coverage Obligation information in ALI
494                   --  files for the benefit of source coverage analysis tools
495                   --  (xcov).
496
497                   when 'S' =>
498                      Generate_SCO := True;
499                      Ptr := Ptr + 1;
500
501                   --  All other -gnate? switches are unassigned
502
503                   when others =>
504                      Bad_Switch ("-gnate" & Switch_Chars (Ptr .. Max));
505                end case;
506
507             --  -gnatE (dynamic elaboration checks)
508
509             when 'E' =>
510                Ptr := Ptr + 1;
511                Dynamic_Elaboration_Checks := True;
512
513             --  -gnatf (full error messages)
514
515             when 'f' =>
516                Ptr := Ptr + 1;
517                All_Errors_Mode := True;
518
519             --  Processing for F switch
520
521             when 'F' =>
522                Ptr := Ptr + 1;
523                External_Name_Exp_Casing := Uppercase;
524                External_Name_Imp_Casing := Uppercase;
525
526             --  Processing for g switch
527
528             when 'g' =>
529                Ptr := Ptr + 1;
530                GNAT_Mode := True;
531                Identifier_Character_Set := 'n';
532                System_Extend_Unit := Empty;
533                Warning_Mode := Treat_As_Error;
534
535                --  Set Ada 2012 mode explicitly. We don't want to rely on the
536                --  implicit setting here, since for example, we want
537                --  Preelaborate_05 treated as Preelaborate
538
539                Ada_Version := Ada_12;
540                Ada_Version_Explicit := Ada_Version;
541
542                --  Set default warnings and style checks for -gnatg
543
544                Set_GNAT_Mode_Warnings;
545                Set_GNAT_Style_Check_Options;
546
547             --  Processing for G switch
548
549             when 'G' =>
550                Ptr := Ptr + 1;
551                Print_Generated_Code := True;
552
553                --  Scan optional integer line limit value
554
555                if Nat_Present (Switch_Chars, Max, Ptr) then
556                   Scan_Nat (Switch_Chars, Max, Ptr, Sprint_Line_Limit, 'G');
557                   Sprint_Line_Limit := Nat'Max (Sprint_Line_Limit, 40);
558                end if;
559
560             --  Processing for h switch
561
562             when 'h' =>
563                Ptr := Ptr + 1;
564                Usage_Requested := True;
565
566             --  Processing for H switch
567
568             when 'H' =>
569                Ptr := Ptr + 1;
570                HLO_Active := True;
571
572             --  Processing for i switch
573
574             when 'i' =>
575                if Ptr = Max then
576                   Bad_Switch ("-gnati");
577                end if;
578
579                Ptr := Ptr + 1;
580                C := Switch_Chars (Ptr);
581
582                if C in '1' .. '5'
583                  or else C = '8'
584                  or else C = '9'
585                  or else C = 'p'
586                  or else C = 'f'
587                  or else C = 'n'
588                  or else C = 'w'
589                then
590                   Identifier_Character_Set := C;
591                   Ptr := Ptr + 1;
592
593                else
594                   Bad_Switch ("-gnati" & Switch_Chars (Ptr .. Max));
595                end if;
596
597             --  Processing for I switch
598
599             when 'I' =>
600                Ptr := Ptr + 1;
601                Ignore_Rep_Clauses := True;
602
603             --  Processing for j switch
604
605             when 'j' =>
606                Ptr := Ptr + 1;
607                Scan_Nat (Switch_Chars, Max, Ptr, Error_Msg_Line_Length, C);
608
609             --  Processing for k switch
610
611             when 'k' =>
612                Ptr := Ptr + 1;
613                   Scan_Pos
614                     (Switch_Chars, Max, Ptr, Maximum_File_Name_Length, C);
615
616             --  Processing for l switch
617
618             when 'l' =>
619                Ptr := Ptr + 1;
620                Full_List := True;
621
622                --  There may be an equal sign between -gnatl and a file name
623
624                if Ptr <= Max and then Switch_Chars (Ptr) = '=' then
625                   if Ptr = Max then
626                      Osint.Fail ("file name for -gnatl= is null");
627                   else
628                      Opt.Full_List_File_Name :=
629                        new String'(Switch_Chars (Ptr + 1 .. Max));
630                      Ptr := Max + 1;
631                   end if;
632                end if;
633
634             --  Processing for L switch
635
636             when 'L' =>
637                Ptr := Ptr + 1;
638                Dump_Source_Text := True;
639
640             --  Processing for m switch
641
642             when 'm' =>
643                Ptr := Ptr + 1;
644                Scan_Nat (Switch_Chars, Max, Ptr, Maximum_Messages, C);
645
646             --  Processing for n switch
647
648             when 'n' =>
649                Ptr := Ptr + 1;
650                Inline_Active := True;
651
652             --  Processing for N switch
653
654             when 'N' =>
655                Ptr := Ptr + 1;
656                Inline_Active := True;
657                Front_End_Inlining := True;
658
659             --  Processing for o switch
660
661             when 'o' =>
662                Ptr := Ptr + 1;
663                Suppress_Options (Overflow_Check) := False;
664                Opt.Enable_Overflow_Checks := True;
665
666             --  Processing for O switch
667
668             when 'O' =>
669                Store_Switch := False;
670                Ptr := Ptr + 1;
671                Output_File_Name_Present := True;
672
673             --  Processing for p switch
674
675             when 'p' =>
676                Ptr := Ptr + 1;
677
678                --  Skip processing if cancelled by subsequent -gnat-p
679
680                if Switch_Subsequently_Cancelled ("p", Args, Arg_Rank) then
681                   Store_Switch := False;
682
683                else
684                   --  Set all specific options as well as All_Checks in the
685                   --  Suppress_Options array, excluding Elaboration_Check,
686                   --  since this is treated specially because we do not want
687                   --  -gnatp to disable static elaboration processing.
688
689                   for J in Suppress_Options'Range loop
690                      if J /= Elaboration_Check then
691                         Suppress_Options (J) := True;
692                      end if;
693                   end loop;
694
695                   Validity_Checks_On         := False;
696                   Opt.Suppress_Checks        := True;
697                   Opt.Enable_Overflow_Checks := False;
698                end if;
699
700             --  Processing for P switch
701
702             when 'P' =>
703                Ptr := Ptr + 1;
704                Polling_Required := True;
705
706             --  Processing for q switch
707
708             when 'q' =>
709                Ptr := Ptr + 1;
710                Try_Semantics := True;
711
712             --  Processing for Q switch
713
714             when 'Q' =>
715                Ptr := Ptr + 1;
716                Force_ALI_Tree_File := True;
717                Try_Semantics := True;
718
719                --  Processing for r switch
720
721             when 'r' =>
722                Ptr := Ptr + 1;
723                Treat_Restrictions_As_Warnings := True;
724
725             --  Processing for R switch
726
727             when 'R' =>
728                Back_Annotate_Rep_Info := True;
729                List_Representation_Info := 1;
730
731                Ptr := Ptr + 1;
732                while Ptr <= Max loop
733                   C := Switch_Chars (Ptr);
734
735                   if C in '1' .. '3' then
736                      List_Representation_Info :=
737                        Character'Pos (C) - Character'Pos ('0');
738
739                   elsif Switch_Chars (Ptr) = 's' then
740                      List_Representation_Info_To_File := True;
741
742                   elsif Switch_Chars (Ptr) = 'm' then
743                      List_Representation_Info_Mechanisms := True;
744
745                   else
746                      Bad_Switch ("-gnatR" & Switch_Chars (Ptr .. Max));
747                   end if;
748
749                   Ptr := Ptr + 1;
750                end loop;
751
752             --  Processing for s switch
753
754             when 's' =>
755                if not First_Switch then
756                   Osint.Fail
757                     ("-gnats must be first if combined with other switches");
758                end if;
759
760                Ptr := Ptr + 1;
761                Operating_Mode := Check_Syntax;
762
763             --  Processing for S switch
764
765             when 'S' =>
766                Print_Standard := True;
767                Ptr := Ptr + 1;
768
769             --  Processing for t switch
770
771             when 't' =>
772                Ptr := Ptr + 1;
773                Tree_Output := True;
774                Back_Annotate_Rep_Info := True;
775
776             --  Processing for T switch
777
778             when 'T' =>
779                Ptr := Ptr + 1;
780                Scan_Pos (Switch_Chars, Max, Ptr, Table_Factor, C);
781
782             --  Processing for u switch
783
784             when 'u' =>
785                Ptr := Ptr + 1;
786                List_Units := True;
787
788             --  Processing for U switch
789
790             when 'U' =>
791                Ptr := Ptr + 1;
792                Unique_Error_Tag := True;
793
794             --  Processing for v switch
795
796             when 'v' =>
797                Ptr := Ptr + 1;
798                Verbose_Mode := True;
799
800             --  Processing for V switch
801
802             when 'V' =>
803                Store_Switch := False;
804                Ptr := Ptr + 1;
805
806                if Ptr > Max then
807                   Bad_Switch ("-gnatV");
808
809                else
810                   declare
811                      OK  : Boolean;
812
813                   begin
814                      Set_Validity_Check_Options
815                        (Switch_Chars (Ptr .. Max), OK, Ptr);
816
817                      if not OK then
818                         Bad_Switch ("-gnatV" & Switch_Chars (Ptr .. Max));
819                      end if;
820
821                      for Index in First_Char + 1 .. Max loop
822                         Store_Compilation_Switch
823                           ("-gnatV" & Switch_Chars (Index));
824                      end loop;
825                   end;
826                end if;
827
828                Ptr := Max + 1;
829
830             --  Processing for w switch
831
832             when 'w' =>
833                Store_Switch := False;
834                Ptr := Ptr + 1;
835
836                if Ptr > Max then
837                   Bad_Switch ("-gnatw");
838                end if;
839
840                while Ptr <= Max loop
841                   C := Switch_Chars (Ptr);
842
843                   --  Case of dot switch
844
845                   if C = '.' and then Ptr < Max then
846                      Ptr := Ptr + 1;
847                      C := Switch_Chars (Ptr);
848
849                      if Set_Dot_Warning_Switch (C) then
850                         Store_Compilation_Switch ("-gnatw." & C);
851                      else
852                         Bad_Switch ("-gnatw." & Switch_Chars (Ptr .. Max));
853                      end if;
854
855                      --  Normal case, no dot
856
857                   else
858                      if Set_Warning_Switch (C) then
859                         Store_Compilation_Switch ("-gnatw" & C);
860                      else
861                         Bad_Switch ("-gnatw" & Switch_Chars (Ptr .. Max));
862                      end if;
863                   end if;
864
865                   Ptr := Ptr + 1;
866                end loop;
867
868                return;
869
870             --  Processing for W switch
871
872             when 'W' =>
873                Ptr := Ptr + 1;
874
875                if Ptr > Max then
876                   Bad_Switch ("-gnatW");
877                end if;
878
879                begin
880                   Wide_Character_Encoding_Method :=
881                     Get_WC_Encoding_Method (Switch_Chars (Ptr));
882                exception
883                   when Constraint_Error =>
884                      Bad_Switch ("-gnatW" & Switch_Chars (Ptr .. Max));
885                end;
886
887                Wide_Character_Encoding_Method_Specified := True;
888
889                Upper_Half_Encoding :=
890                  Wide_Character_Encoding_Method in
891                    WC_Upper_Half_Encoding_Method;
892
893                Ptr := Ptr + 1;
894
895             --  Processing for x switch
896
897             when 'x' =>
898                Ptr := Ptr + 1;
899                Xref_Active := False;
900
901             --  Processing for X switch
902
903             when 'X' =>
904                Ptr := Ptr + 1;
905                Extensions_Allowed := True;
906                Ada_Version := Ada_Version_Type'Last;
907                Ada_Version_Explicit := Ada_Version_Type'Last;
908
909             --  Processing for y switch
910
911             when 'y' =>
912                Ptr := Ptr + 1;
913
914                if Ptr > Max then
915                   Set_Default_Style_Check_Options;
916
917                else
918                   Store_Switch := False;
919
920                   declare
921                      OK  : Boolean;
922
923                   begin
924                      Set_Style_Check_Options
925                        (Switch_Chars (Ptr .. Max), OK, Ptr);
926
927                      if not OK then
928                         Osint.Fail
929                           ("bad -gnaty switch (" &
930                            Style_Msg_Buf (1 .. Style_Msg_Len) & ')');
931                      end if;
932
933                      Ptr := First_Char + 1;
934                      while Ptr <= Max loop
935                         if Switch_Chars (Ptr) = 'M' then
936                            First_Char := Ptr;
937                            loop
938                               Ptr := Ptr + 1;
939                               exit when Ptr > Max
940                                 or else Switch_Chars (Ptr) not in '0' .. '9';
941                            end loop;
942
943                            Store_Compilation_Switch
944                              ("-gnaty" & Switch_Chars (First_Char .. Ptr - 1));
945
946                         else
947                            Store_Compilation_Switch
948                              ("-gnaty" & Switch_Chars (Ptr));
949                            Ptr := Ptr + 1;
950                         end if;
951                      end loop;
952                   end;
953                end if;
954
955             --  Processing for z switch
956
957             when 'z' =>
958
959                --  -gnatz must be the first and only switch in Switch_Chars,
960                --  and is a two-letter switch.
961
962                if Ptr /= Switch_Chars'First + 5
963                  or else (Max - Ptr + 1) > 2
964                then
965                   Osint.Fail
966                     ("-gnatz* may not be combined with other switches");
967                end if;
968
969                if Ptr = Max then
970                   Bad_Switch ("-gnatz");
971                end if;
972
973                Ptr := Ptr + 1;
974
975                --  Only one occurrence of -gnat* is permitted
976
977                if Distribution_Stub_Mode = No_Stubs then
978                   case Switch_Chars (Ptr) is
979                      when 'r' =>
980                         Distribution_Stub_Mode := Generate_Receiver_Stub_Body;
981
982                      when 'c' =>
983                         Distribution_Stub_Mode := Generate_Caller_Stub_Body;
984
985                      when others =>
986                         Bad_Switch ("-gnatz" & Switch_Chars (Ptr .. Max));
987                   end case;
988
989                   Ptr := Ptr + 1;
990
991                else
992                   Osint.Fail ("only one -gnatz* switch allowed");
993                end if;
994
995             --  Processing for Z switch
996
997             when 'Z' =>
998                Ptr := Ptr + 1;
999                Osint.Fail
1000                  ("-gnatZ is no longer supported: consider using --RTS=zcx");
1001
1002             --  Processing for 83 switch
1003
1004             when '8' =>
1005                if Ptr = Max then
1006                   Bad_Switch ("-gnat8");
1007                end if;
1008
1009                Ptr := Ptr + 1;
1010
1011                if Switch_Chars (Ptr) /= '3' then
1012                   Bad_Switch ("-gnat8" & Switch_Chars (Ptr .. Max));
1013                else
1014                   Ptr := Ptr + 1;
1015                   Ada_Version := Ada_83;
1016                   Ada_Version_Explicit := Ada_Version;
1017                end if;
1018
1019             --  Processing for 95 switch
1020
1021             when '9' =>
1022                if Ptr = Max then
1023                   Bad_Switch ("-gnat9");
1024                end if;
1025
1026                Ptr := Ptr + 1;
1027
1028                if Switch_Chars (Ptr) /= '5' then
1029                   Bad_Switch ("-gnat9" & Switch_Chars (Ptr .. Max));
1030                else
1031                   Ptr := Ptr + 1;
1032                   Ada_Version := Ada_95;
1033                   Ada_Version_Explicit := Ada_Version;
1034                end if;
1035
1036             --  Processing for 05 switch
1037
1038             when '0' =>
1039                if Ptr = Max then
1040                   Bad_Switch ("-gnat0");
1041                end if;
1042
1043                Ptr := Ptr + 1;
1044
1045                if Switch_Chars (Ptr) /= '5' then
1046                   Bad_Switch ("-gnat0" & Switch_Chars (Ptr .. Max));
1047                else
1048                   Ptr := Ptr + 1;
1049                   Ada_Version := Ada_05;
1050                   Ada_Version_Explicit := Ada_Version;
1051                end if;
1052
1053             --  Processing for 12 switch
1054
1055             when '1' =>
1056                if Ptr = Max then
1057                   Bad_Switch ("-gnat1");
1058                end if;
1059
1060                Ptr := Ptr + 1;
1061
1062                if Switch_Chars (Ptr) /= '2' then
1063                   Bad_Switch ("-gnat1" & Switch_Chars (Ptr .. Max));
1064                else
1065                   Ptr := Ptr + 1;
1066                   Ada_Version := Ada_12;
1067                   Ada_Version_Explicit := Ada_Version;
1068                end if;
1069
1070             --  Processing for 2005 and 2012 switches
1071
1072             when '2' =>
1073                if Ptr > Max - 3 then
1074                   Bad_Switch ("-gnat" & Switch_Chars (Ptr .. Max));
1075
1076                elsif Switch_Chars (Ptr .. Ptr + 3) = "2005" then
1077                   Ada_Version := Ada_05;
1078
1079                elsif Switch_Chars (Ptr .. Ptr + 3) = "2012" then
1080                   Ada_Version := Ada_12;
1081
1082                else
1083                   Bad_Switch ("-gnat" & Switch_Chars (Ptr .. Ptr + 3));
1084                end if;
1085
1086                Ada_Version_Explicit := Ada_Version;
1087                Ptr := Ptr + 4;
1088
1089             --  Switch cancellation, currently only -gnat-p is allowed.
1090             --  All we do here is the error checking, since the actual
1091             --  processing for switch cancellation is done by calls to
1092             --  Switch_Subsequently_Cancelled at the appropriate point.
1093
1094             when '-' =>
1095
1096                --  Simple ignore -gnat-p
1097
1098                if Switch_Chars = "-gnat-p" then
1099                   return;
1100
1101                --  Any other occurrence of minus is ignored. This is for
1102                --  maximum compatibility with previous version which ignored
1103                --  all occurrences of minus.
1104
1105                else
1106                   Store_Switch := False;
1107                   Ptr := Ptr + 1;
1108                end if;
1109
1110             --  We ignore '/' in switches, this is historical, still needed???
1111
1112             when '/' =>
1113                Store_Switch := False;
1114
1115             --  Anything else is an error (illegal switch character)
1116
1117             when others =>
1118                Bad_Switch ("-gnat" & Switch_Chars (Ptr .. Max));
1119             end case;
1120
1121             if Store_Switch then
1122                Store_Compilation_Switch
1123                  ("-gnat" & Switch_Chars (First_Char .. Ptr - 1));
1124             end if;
1125
1126             First_Switch := False;
1127          end loop;
1128       end if;
1129    end Scan_Front_End_Switches;
1130
1131    -----------------------------------
1132    -- Switch_Subsequently_Cancelled --
1133    -----------------------------------
1134
1135    function Switch_Subsequently_Cancelled
1136      (C        : String;
1137       Args     : Argument_List;
1138       Arg_Rank : Positive) return Boolean
1139    is
1140       use type System.Strings.String_Access;
1141
1142    begin
1143       --  Loop through arguments following the current one
1144
1145       for Arg in Arg_Rank + 1 .. Args'Last loop
1146          if Args (Arg).all = "-gnat-" & C then
1147             return True;
1148          end if;
1149       end loop;
1150
1151       --  No match found, not cancelled
1152
1153       return False;
1154    end Switch_Subsequently_Cancelled;
1155
1156 end Switch.C;