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-2019, 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 -- -gnatd_s (stop elaboration checks on synchronous 978 -- suspension) 979 -- -gnatdL (ignore external calls from instances for 980 -- elaboration) 981 982 else 983 Debug_Flag_Underscore_A := True; 984 Debug_Flag_Underscore_E := True; 985 Debug_Flag_Underscore_I := True; 986 Debug_Flag_Underscore_P := True; 987 Debug_Flag_Underscore_S := True; 988 Debug_Flag_LL := True; 989 end if; 990 991 -- -gnatk (limit file name length) 992 993 when 'k' => 994 Ptr := Ptr + 1; 995 Scan_Pos 996 (Switch_Chars, Max, Ptr, Maximum_File_Name_Length, C); 997 998 -- -gnatl (output full source) 999 1000 when 'l' => 1001 Ptr := Ptr + 1; 1002 Full_List := True; 1003 1004 -- There may be an equal sign between -gnatl and a file name 1005 1006 if Ptr <= Max and then Switch_Chars (Ptr) = '=' then 1007 if Ptr = Max then 1008 Osint.Fail ("file name for -gnatl= is null"); 1009 else 1010 Opt.Full_List_File_Name := 1011 new String'(Switch_Chars (Ptr + 1 .. Max)); 1012 Ptr := Max + 1; 1013 end if; 1014 end if; 1015 1016 -- -gnatL (corresponding source text) 1017 1018 when 'L' => 1019 Ptr := Ptr + 1; 1020 Dump_Source_Text := True; 1021 1022 -- -gnatm (max number or errors/warnings) 1023 1024 when 'm' => 1025 Ptr := Ptr + 1; 1026 Scan_Nat (Switch_Chars, Max, Ptr, Maximum_Messages, C); 1027 1028 -- -gnatn (enable pragma Inline) 1029 1030 when 'n' => 1031 Ptr := Ptr + 1; 1032 Inline_Active := True; 1033 1034 -- There may be a digit (1 or 2) appended to the switch 1035 1036 if Ptr <= Max then 1037 C := Switch_Chars (Ptr); 1038 1039 if C in '1' .. '2' then 1040 Ptr := Ptr + 1; 1041 Inline_Level := Character'Pos (C) - Character'Pos ('0'); 1042 end if; 1043 end if; 1044 1045 -- -gnatN (obsolescent) 1046 1047 when 'N' => 1048 Ptr := Ptr + 1; 1049 Inline_Active := True; 1050 Front_End_Inlining := True; 1051 1052 -- -gnato (overflow checks) 1053 1054 when 'o' => 1055 Ptr := Ptr + 1; 1056 1057 -- Case of -gnato0 (overflow checking turned off) 1058 1059 if Ptr <= Max and then Switch_Chars (Ptr) = '0' then 1060 Ptr := Ptr + 1; 1061 Suppress_Options.Suppress (Overflow_Check) := True; 1062 1063 -- We set strict mode in case overflow checking is turned 1064 -- on locally (also records that we had a -gnato switch). 1065 1066 Suppress_Options.Overflow_Mode_General := Strict; 1067 Suppress_Options.Overflow_Mode_Assertions := Strict; 1068 1069 -- All cases other than -gnato0 (overflow checking turned on) 1070 1071 else 1072 Suppress_Options.Suppress (Overflow_Check) := False; 1073 1074 -- Case of no digits after the -gnato 1075 1076 if Ptr > Max 1077 or else Switch_Chars (Ptr) not in '1' .. '3' 1078 then 1079 Suppress_Options.Overflow_Mode_General := Strict; 1080 Suppress_Options.Overflow_Mode_Assertions := Strict; 1081 1082 -- At least one digit after the -gnato 1083 1084 else 1085 -- Handle first digit after -gnato 1086 1087 Suppress_Options.Overflow_Mode_General := 1088 Get_Overflow_Mode (Switch_Chars (Ptr)); 1089 Ptr := Ptr + 1; 1090 1091 -- Only one digit after -gnato, set assertions mode to be 1092 -- the same as general mode. 1093 1094 if Ptr > Max 1095 or else Switch_Chars (Ptr) not in '1' .. '3' 1096 then 1097 Suppress_Options.Overflow_Mode_Assertions := 1098 Suppress_Options.Overflow_Mode_General; 1099 1100 -- Process second digit after -gnato 1101 1102 else 1103 Suppress_Options.Overflow_Mode_Assertions := 1104 Get_Overflow_Mode (Switch_Chars (Ptr)); 1105 Ptr := Ptr + 1; 1106 end if; 1107 end if; 1108 end if; 1109 1110 -- -gnatO (specify name of the object file) 1111 1112 -- This is an internal switch 1113 1114 when 'O' => 1115 Store_Switch := False; 1116 Ptr := Ptr + 1; 1117 Output_File_Name_Present := True; 1118 1119 -- -gnatp (suppress all checks) 1120 1121 when 'p' => 1122 Ptr := Ptr + 1; 1123 1124 -- Skip processing if cancelled by subsequent -gnat-p 1125 1126 if Switch_Subsequently_Cancelled ("p", Args, Arg_Rank) then 1127 Store_Switch := False; 1128 1129 else 1130 -- Set all specific options as well as All_Checks in the 1131 -- Suppress_Options array, excluding Elaboration_Check, 1132 -- since this is treated specially because we do not want 1133 -- -gnatp to disable static elaboration processing. Also 1134 -- exclude Atomic_Synchronization, since this is not a real 1135 -- check. 1136 1137 for J in Suppress_Options.Suppress'Range loop 1138 if J /= Elaboration_Check 1139 and then 1140 J /= Atomic_Synchronization 1141 then 1142 Suppress_Options.Suppress (J) := True; 1143 end if; 1144 end loop; 1145 1146 Validity_Checks_On := False; 1147 Opt.Suppress_Checks := True; 1148 1149 -- Set overflow mode checking to strict in case it gets 1150 -- turned on locally (also signals that overflow checking 1151 -- has been specifically turned off). 1152 1153 Suppress_Options.Overflow_Mode_General := Strict; 1154 Suppress_Options.Overflow_Mode_Assertions := Strict; 1155 end if; 1156 1157 -- -gnatP (periodic poll) 1158 1159 when 'P' => 1160 Ptr := Ptr + 1; 1161 Polling_Required := True; 1162 1163 -- -gnatq (don't quit) 1164 1165 when 'q' => 1166 Ptr := Ptr + 1; 1167 Try_Semantics := True; 1168 1169 -- -gnatQ (always write ALI file) 1170 1171 when 'Q' => 1172 Ptr := Ptr + 1; 1173 Force_ALI_Tree_File := True; 1174 Try_Semantics := True; 1175 1176 -- -gnatr (restrictions as warnings) 1177 1178 when 'r' => 1179 Ptr := Ptr + 1; 1180 Treat_Restrictions_As_Warnings := True; 1181 1182 -- -gnatR (list rep. info) 1183 1184 when 'R' => 1185 1186 -- Not allowed if previous -gnatD given. See more extensive 1187 -- comments in the 'D' section for the inverse test. 1188 1189 if Debug_Generated_Code then 1190 Osint.Fail 1191 ("-gnatR not permitted since -gnatD given previously"); 1192 end if; 1193 1194 -- Set to annotate rep info, and set default -gnatR mode 1195 1196 Back_Annotate_Rep_Info := True; 1197 List_Representation_Info := 1; 1198 1199 -- Scan possible parameter 1200 1201 Ptr := Ptr + 1; 1202 while Ptr <= Max loop 1203 C := Switch_Chars (Ptr); 1204 1205 case C is 1206 1207 when '0' .. '4' => 1208 List_Representation_Info := 1209 Character'Pos (C) - Character'Pos ('0'); 1210 1211 when 's' => 1212 List_Representation_Info_To_File := True; 1213 1214 when 'j' => 1215 List_Representation_Info_To_JSON := True; 1216 1217 when 'm' => 1218 List_Representation_Info_Mechanisms := True; 1219 1220 when 'e' => 1221 List_Representation_Info_Extended := True; 1222 1223 when others => 1224 Bad_Switch ("-gnatR" & Switch_Chars (Ptr .. Max)); 1225 end case; 1226 1227 Ptr := Ptr + 1; 1228 end loop; 1229 1230 if List_Representation_Info_To_JSON 1231 and then List_Representation_Info_Extended 1232 then 1233 Osint.Fail ("-gnatRe is incompatible with -gnatRj"); 1234 end if; 1235 1236 -- -gnats (syntax check only) 1237 1238 when 's' => 1239 if not First_Switch then 1240 Osint.Fail 1241 ("-gnats must be first if combined with other switches"); 1242 end if; 1243 1244 Ptr := Ptr + 1; 1245 Operating_Mode := Check_Syntax; 1246 1247 -- -gnatS (print package Standard) 1248 1249 when 'S' => 1250 Print_Standard := True; 1251 Ptr := Ptr + 1; 1252 1253 -- -gnatt (output tree) 1254 1255 when 't' => 1256 Ptr := Ptr + 1; 1257 Tree_Output := True; 1258 Back_Annotate_Rep_Info := True; 1259 1260 -- -gnatT (change start of internal table sizes) 1261 1262 when 'T' => 1263 Ptr := Ptr + 1; 1264 Scan_Pos (Switch_Chars, Max, Ptr, Table_Factor, C); 1265 1266 -- -gnatu (list units for compilation) 1267 1268 when 'u' => 1269 Ptr := Ptr + 1; 1270 List_Units := True; 1271 1272 -- -gnatU (unique tags) 1273 1274 when 'U' => 1275 Ptr := Ptr + 1; 1276 Unique_Error_Tag := True; 1277 1278 -- -gnatv (verbose mode) 1279 1280 when 'v' => 1281 Ptr := Ptr + 1; 1282 Verbose_Mode := True; 1283 1284 -- -gnatV (validity checks) 1285 1286 when 'V' => 1287 Store_Switch := False; 1288 Ptr := Ptr + 1; 1289 1290 if Ptr > Max then 1291 Bad_Switch ("-gnatV"); 1292 1293 else 1294 declare 1295 OK : Boolean; 1296 1297 begin 1298 Set_Validity_Check_Options 1299 (Switch_Chars (Ptr .. Max), OK, Ptr); 1300 1301 if not OK then 1302 Bad_Switch ("-gnatV" & Switch_Chars (Ptr .. Max)); 1303 end if; 1304 1305 for Index in First_Char + 1 .. Max loop 1306 Store_Compilation_Switch 1307 ("-gnatV" & Switch_Chars (Index)); 1308 end loop; 1309 end; 1310 end if; 1311 1312 Ptr := Max + 1; 1313 1314 -- -gnatw (warning modes) 1315 1316 when 'w' => 1317 Store_Switch := False; 1318 Ptr := Ptr + 1; 1319 1320 if Ptr > Max then 1321 Bad_Switch ("-gnatw"); 1322 end if; 1323 1324 while Ptr <= Max loop 1325 C := Switch_Chars (Ptr); 1326 1327 -- Case of dot switch 1328 1329 if C = '.' and then Ptr < Max then 1330 Ptr := Ptr + 1; 1331 C := Switch_Chars (Ptr); 1332 1333 if Set_Dot_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 -- Case of underscore switch 1340 1341 elsif C = '_' and then Ptr < Max then 1342 Ptr := Ptr + 1; 1343 C := Switch_Chars (Ptr); 1344 1345 if Set_Underscore_Warning_Switch (C) then 1346 Store_Compilation_Switch ("-gnatw_" & C); 1347 else 1348 Bad_Switch ("-gnatw_" & Switch_Chars (Ptr .. Max)); 1349 end if; 1350 1351 -- Normal case 1352 1353 else 1354 if Set_Warning_Switch (C) then 1355 Store_Compilation_Switch ("-gnatw" & C); 1356 else 1357 Bad_Switch ("-gnatw" & Switch_Chars (Ptr .. Max)); 1358 end if; 1359 end if; 1360 1361 Ptr := Ptr + 1; 1362 end loop; 1363 1364 return; 1365 1366 -- -gnatW (wide character encoding method) 1367 1368 when 'W' => 1369 Ptr := Ptr + 1; 1370 1371 if Ptr > Max then 1372 Bad_Switch ("-gnatW"); 1373 end if; 1374 1375 begin 1376 Wide_Character_Encoding_Method := 1377 Get_WC_Encoding_Method (Switch_Chars (Ptr)); 1378 exception 1379 when Constraint_Error => 1380 Bad_Switch ("-gnatW" & Switch_Chars (Ptr .. Max)); 1381 end; 1382 1383 Wide_Character_Encoding_Method_Specified := True; 1384 1385 Upper_Half_Encoding := 1386 Wide_Character_Encoding_Method in 1387 WC_Upper_Half_Encoding_Method; 1388 1389 Ptr := Ptr + 1; 1390 1391 -- -gnatx (suppress cross-ref information) 1392 1393 when 'x' => 1394 Ptr := Ptr + 1; 1395 Xref_Active := False; 1396 1397 -- -gnatX (language extensions) 1398 1399 when 'X' => 1400 Ptr := Ptr + 1; 1401 Extensions_Allowed := True; 1402 Ada_Version := Ada_Version_Type'Last; 1403 Ada_Version_Explicit := Ada_Version_Type'Last; 1404 Ada_Version_Pragma := Empty; 1405 1406 -- -gnaty (style checks) 1407 1408 when 'y' => 1409 Ptr := Ptr + 1; 1410 Style_Check_Main := True; 1411 1412 if Ptr > Max then 1413 Set_Default_Style_Check_Options; 1414 1415 else 1416 Store_Switch := False; 1417 1418 declare 1419 OK : Boolean; 1420 1421 begin 1422 Set_Style_Check_Options 1423 (Switch_Chars (Ptr .. Max), OK, Ptr); 1424 1425 if not OK then 1426 Osint.Fail 1427 ("bad -gnaty switch (" & 1428 Style_Msg_Buf (1 .. Style_Msg_Len) & ')'); 1429 end if; 1430 1431 Ptr := First_Char + 1; 1432 while Ptr <= Max loop 1433 if Switch_Chars (Ptr) = 'M' then 1434 First_Char := Ptr; 1435 loop 1436 Ptr := Ptr + 1; 1437 exit when Ptr > Max 1438 or else Switch_Chars (Ptr) not in '0' .. '9'; 1439 end loop; 1440 1441 Store_Compilation_Switch 1442 ("-gnaty" & Switch_Chars (First_Char .. Ptr - 1)); 1443 1444 else 1445 Store_Compilation_Switch 1446 ("-gnaty" & Switch_Chars (Ptr)); 1447 Ptr := Ptr + 1; 1448 end if; 1449 end loop; 1450 end; 1451 end if; 1452 1453 -- -gnatz (stub generation) 1454 1455 when 'z' => 1456 1457 -- -gnatz must be the first and only switch in Switch_Chars, 1458 -- and is a two-letter switch. 1459 1460 if Ptr /= Switch_Chars'First + 5 1461 or else (Max - Ptr + 1) > 2 1462 then 1463 Osint.Fail 1464 ("-gnatz* may not be combined with other switches"); 1465 end if; 1466 1467 if Ptr = Max then 1468 Bad_Switch ("-gnatz"); 1469 end if; 1470 1471 Ptr := Ptr + 1; 1472 1473 -- Only one occurrence of -gnat* is permitted 1474 1475 if Distribution_Stub_Mode = No_Stubs then 1476 case Switch_Chars (Ptr) is 1477 when 'r' => 1478 Distribution_Stub_Mode := Generate_Receiver_Stub_Body; 1479 1480 when 'c' => 1481 Distribution_Stub_Mode := Generate_Caller_Stub_Body; 1482 1483 when others => 1484 Bad_Switch ("-gnatz" & Switch_Chars (Ptr .. Max)); 1485 end case; 1486 1487 Ptr := Ptr + 1; 1488 1489 else 1490 Osint.Fail ("only one -gnatz* switch allowed"); 1491 end if; 1492 1493 -- -gnatZ (obsolescent) 1494 1495 when 'Z' => 1496 Ptr := Ptr + 1; 1497 Osint.Fail 1498 ("-gnatZ is no longer supported: consider using --RTS=zcx"); 1499 1500 -- Note on language version switches: whenever a new language 1501 -- version switch is added, Switch.M.Normalize_Compiler_Switches 1502 -- must be updated. 1503 1504 -- -gnat83 1505 1506 when '8' => 1507 if Ptr = Max then 1508 Bad_Switch ("-gnat8"); 1509 end if; 1510 1511 Ptr := Ptr + 1; 1512 1513 if Switch_Chars (Ptr) /= '3' or else Latest_Ada_Only then 1514 Bad_Switch ("-gnat8" & Switch_Chars (Ptr .. Max)); 1515 else 1516 Ptr := Ptr + 1; 1517 Ada_Version := Ada_83; 1518 Ada_Version_Explicit := Ada_83; 1519 Ada_Version_Pragma := Empty; 1520 end if; 1521 1522 -- -gnat95 1523 1524 when '9' => 1525 if Ptr = Max then 1526 Bad_Switch ("-gnat9"); 1527 end if; 1528 1529 Ptr := Ptr + 1; 1530 1531 if Switch_Chars (Ptr) /= '5' or else Latest_Ada_Only then 1532 Bad_Switch ("-gnat9" & Switch_Chars (Ptr .. Max)); 1533 else 1534 Ptr := Ptr + 1; 1535 Ada_Version := Ada_95; 1536 Ada_Version_Explicit := Ada_95; 1537 Ada_Version_Pragma := Empty; 1538 end if; 1539 1540 -- -gnat05 1541 1542 when '0' => 1543 if Ptr = Max then 1544 Bad_Switch ("-gnat0"); 1545 end if; 1546 1547 Ptr := Ptr + 1; 1548 1549 if Switch_Chars (Ptr) /= '5' or else Latest_Ada_Only then 1550 Bad_Switch ("-gnat0" & Switch_Chars (Ptr .. Max)); 1551 else 1552 Ptr := Ptr + 1; 1553 Ada_Version := Ada_2005; 1554 Ada_Version_Explicit := Ada_2005; 1555 Ada_Version_Pragma := Empty; 1556 end if; 1557 1558 -- -gnat12 1559 1560 when '1' => 1561 if Ptr = Max then 1562 Bad_Switch ("-gnat1"); 1563 end if; 1564 1565 Ptr := Ptr + 1; 1566 1567 if Switch_Chars (Ptr) /= '2' then 1568 Bad_Switch ("-gnat1" & Switch_Chars (Ptr .. Max)); 1569 else 1570 Ptr := Ptr + 1; 1571 Ada_Version := Ada_2012; 1572 Ada_Version_Explicit := Ada_2012; 1573 Ada_Version_Pragma := Empty; 1574 end if; 1575 1576 -- -gnat2005 and -gnat2012 1577 1578 when '2' => 1579 if Ptr > Max - 3 then 1580 Bad_Switch ("-gnat" & Switch_Chars (Ptr .. Max)); 1581 1582 elsif Switch_Chars (Ptr .. Ptr + 3) = "2005" 1583 and then not Latest_Ada_Only 1584 then 1585 Ada_Version := Ada_2005; 1586 1587 elsif Switch_Chars (Ptr .. Ptr + 3) = "2012" then 1588 Ada_Version := Ada_2012; 1589 1590 elsif Switch_Chars (Ptr .. Ptr + 3) = "2020" then 1591 Ada_Version := Ada_2020; 1592 1593 else 1594 Bad_Switch ("-gnat" & Switch_Chars (Ptr .. Ptr + 3)); 1595 end if; 1596 1597 Ada_Version_Explicit := Ada_Version; 1598 Ada_Version_Pragma := Empty; 1599 Ptr := Ptr + 4; 1600 1601 -- Switch cancellation, currently only -gnat-p is allowed. 1602 -- All we do here is the error checking, since the actual 1603 -- processing for switch cancellation is done by calls to 1604 -- Switch_Subsequently_Cancelled at the appropriate point. 1605 1606 when '-' => 1607 1608 -- Simple ignore -gnat-p 1609 1610 if Switch_Chars = "-gnat-p" then 1611 return; 1612 1613 -- Any other occurrence of minus is ignored. This is for 1614 -- maximum compatibility with previous version which ignored 1615 -- all occurrences of minus. 1616 1617 else 1618 Store_Switch := False; 1619 Ptr := Ptr + 1; 1620 end if; 1621 1622 -- We ignore '/' in switches, this is historical, still needed??? 1623 1624 when '/' => 1625 Store_Switch := False; 1626 1627 -- Anything else is an error (illegal switch character) 1628 1629 when others => 1630 Bad_Switch ("-gnat" & Switch_Chars (Ptr .. Max)); 1631 end case; 1632 1633 if Store_Switch then 1634 Store_Compilation_Switch 1635 ("-gnat" & Switch_Chars (First_Char .. Ptr - 1)); 1636 end if; 1637 1638 First_Switch := False; 1639 end loop; 1640 end if; 1641 end Scan_Front_End_Switches; 1642 1643 ----------------------------------- 1644 -- Switch_Subsequently_Cancelled -- 1645 ----------------------------------- 1646 1647 function Switch_Subsequently_Cancelled 1648 (C : String; 1649 Args : String_List; 1650 Arg_Rank : Positive) return Boolean 1651 is 1652 begin 1653 -- Loop through arguments following the current one 1654 1655 for Arg in Arg_Rank + 1 .. Args'Last loop 1656 if Args (Arg).all = "-gnat-" & C then 1657 return True; 1658 end if; 1659 end loop; 1660 1661 -- No match found, not cancelled 1662 1663 return False; 1664 end Switch_Subsequently_Cancelled; 1665 1666end Switch.C; 1667