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