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