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