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