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