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