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