X-Git-Url: https://git.libre-soc.org/?a=blobdiff_plain;f=gcc%2Fada%2Fswitch-c.adb;h=b282245ddcd22beba61224328a7d6d82ebe50aab;hb=1e60643a12e9c6d8278fd8531b0ccfdfbe920f43;hp=89b219afe8026c2b91a4529d7f46c10e317fb2ec;hpb=667b3d84361144ef7028afeae26033898ab51659;p=gcc.git diff --git a/gcc/ada/switch-c.adb b/gcc/ada/switch-c.adb index 89b219afe80..b282245ddcd 100644 --- a/gcc/ada/switch-c.adb +++ b/gcc/ada/switch-c.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2001-2009, Free Software Foundation, Inc. -- +-- Copyright (C) 2001-2016, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -23,29 +23,113 @@ -- -- ------------------------------------------------------------------------------ +-- This package is for switch processing and should not depend on higher level +-- packages such as those for the scanner, parser, etc. Doing so may cause +-- circularities, especially for back ends using Adabkend. + with Debug; use Debug; with Lib; use Lib; with Osint; use Osint; with Opt; use Opt; -with Prepcomp; use Prepcomp; -with Validsw; use Validsw; -with Sem_Warn; use Sem_Warn; with Stylesw; use Stylesw; +with Targparm; use Targparm; +with Ttypes; use Ttypes; +with Validsw; use Validsw; +with Warnsw; use Warnsw; -with System.OS_Lib; use System.OS_Lib; +with Ada.Unchecked_Deallocation; with System.WCh_Con; use System.WCh_Con; +with System.OS_Lib; package body Switch.C is RTS_Specified : String_Access := null; -- Used to detect multiple use of --RTS= flag + procedure Add_Symbol_Definition (Def : String); + -- Add a symbol definition from the command line + + procedure Free is + new Ada.Unchecked_Deallocation (String_List, String_List_Access); + -- Avoid using System.Strings.Free, which also frees the designated strings + + function Get_Overflow_Mode (C : Character) return Overflow_Mode_Type; + -- Given a digit in the range 0 .. 3, returns the corresponding value of + -- Overflow_Mode_Type. Raises Program_Error if C is outside this range. + + function Switch_Subsequently_Cancelled + (C : String; + Args : String_List; + Arg_Rank : Positive) return Boolean; + -- This function is called from Scan_Front_End_Switches. It determines if + -- the switch currently being scanned is followed by a switch of the form + -- "-gnat-" & C, where C is the argument. If so, then True is returned, + -- and Scan_Front_End_Switches will cancel the effect of the switch. If + -- no such switch is found, False is returned. + + --------------------------- + -- Add_Symbol_Definition -- + --------------------------- + + procedure Add_Symbol_Definition (Def : String) is + begin + -- If Preprocessor_Symbol_Defs is not large enough, double its size + + if Preprocessing_Symbol_Last = Preprocessing_Symbol_Defs'Last then + declare + New_Symbol_Definitions : constant String_List_Access := + new String_List (1 .. 2 * Preprocessing_Symbol_Last); + begin + New_Symbol_Definitions (Preprocessing_Symbol_Defs'Range) := + Preprocessing_Symbol_Defs.all; + Free (Preprocessing_Symbol_Defs); + Preprocessing_Symbol_Defs := New_Symbol_Definitions; + end; + end if; + + Preprocessing_Symbol_Last := Preprocessing_Symbol_Last + 1; + Preprocessing_Symbol_Defs (Preprocessing_Symbol_Last) := + new String'(Def); + end Add_Symbol_Definition; + + ----------------------- + -- Get_Overflow_Mode -- + ----------------------- + + function Get_Overflow_Mode (C : Character) return Overflow_Mode_Type is + begin + case C is + when '1' => + return Strict; + + when '2' => + return Minimized; + + -- Eliminated allowed only if Long_Long_Integer is 64 bits (since + -- the current implementation of System.Bignums assumes this). + + when '3' => + if Standard_Long_Long_Integer_Size /= 64 then + Bad_Switch ("-gnato3 not implemented for this configuration"); + else + return Eliminated; + end if; + + when others => + raise Program_Error; + end case; + end Get_Overflow_Mode; + ----------------------------- -- Scan_Front_End_Switches -- ----------------------------- - procedure Scan_Front_End_Switches (Switch_Chars : String) is + procedure Scan_Front_End_Switches + (Switch_Chars : String; + Args : String_List; + Arg_Rank : Positive) + is First_Switch : Boolean := True; -- False for all but first switch @@ -66,6 +150,10 @@ package body Switch.C is First_Char : Positive; -- Marks start of switch to be stored + First_Ptr : Positive; + -- Save position of first character after -gnatd (for checking that + -- debug flags that must come first are first, in particular -gnatd.b), + begin Ptr := Switch_Chars'First; @@ -79,9 +167,8 @@ package body Switch.C is -- Handle switches that do not start with -gnat - if Ptr + 3 > Max - or else Switch_Chars (Ptr .. Ptr + 3) /= "gnat" - then + if Ptr + 3 > Max or else Switch_Chars (Ptr .. Ptr + 3) /= "gnat" then + -- There are two front-end switches that do not start with -gnat: -- -I, --RTS @@ -123,54 +210,70 @@ package body Switch.C is or else Switch_Chars (Ptr + 3) /= '=' then Osint.Fail ("missing path for --RTS"); - else - -- Check that this is the first time --RTS is specified or if - -- it is not the first time, the same path has been specified. - if RTS_Specified = null then - RTS_Specified := new String'(Switch_Chars (Ptr + 4 .. Max)); + else + declare + Runtime_Dir : String_Access; + begin + if System.OS_Lib.Is_Absolute_Path + (Switch_Chars (Ptr + 4 .. Max)) + then + Runtime_Dir := + new String'(System.OS_Lib.Normalize_Pathname + (Switch_Chars (Ptr + 4 .. Max))); + else + Runtime_Dir := + new String'(Switch_Chars (Ptr + 4 .. Max)); + end if; - elsif - RTS_Specified.all /= Switch_Chars (Ptr + 4 .. Max) - then - Osint.Fail ("--RTS cannot be specified multiple times"); - end if; + -- Valid --RTS switch - -- Valid --RTS switch + Opt.No_Stdinc := True; + Opt.RTS_Switch := True; - Opt.No_Stdinc := True; - Opt.RTS_Switch := True; + RTS_Src_Path_Name := + Get_RTS_Search_Dir (Runtime_Dir.all, Include); - RTS_Src_Path_Name := - Get_RTS_Search_Dir - (Switch_Chars (Ptr + 4 .. Max), Include); + RTS_Lib_Path_Name := + Get_RTS_Search_Dir (Runtime_Dir.all, Objects); - RTS_Lib_Path_Name := - Get_RTS_Search_Dir - (Switch_Chars (Ptr + 4 .. Max), Objects); + if RTS_Specified /= null then + if RTS_Src_Path_Name = null + or else RTS_Lib_Path_Name = null + or else + System.OS_Lib.Normalize_Pathname + (RTS_Specified.all) /= + System.OS_Lib.Normalize_Pathname + (RTS_Lib_Path_Name.all) + then + Osint.Fail + ("--RTS cannot be specified multiple times"); + end if; - if RTS_Src_Path_Name /= null - and then RTS_Lib_Path_Name /= null - then - -- Store the -fRTS switch (Note: Store_Compilation_Switch - -- changes -fRTS back into --RTS for the actual output). + elsif RTS_Src_Path_Name /= null + and then RTS_Lib_Path_Name /= null + then + -- Store the -fRTS switch (Note: Store_Compilation_Switch + -- changes -fRTS back into --RTS for the actual output). - Store_Compilation_Switch (Switch_Chars); + Store_Compilation_Switch (Switch_Chars); + RTS_Specified := new String'(RTS_Lib_Path_Name.all); - elsif RTS_Src_Path_Name = null - and then RTS_Lib_Path_Name = null - then - Osint.Fail ("RTS path not valid: missing " & - "adainclude and adalib directories"); + elsif RTS_Src_Path_Name = null + and then RTS_Lib_Path_Name = null + then + Osint.Fail ("RTS path not valid: missing " + & "adainclude and adalib directories"); - elsif RTS_Src_Path_Name = null then - Osint.Fail ("RTS path not valid: missing " & - "adainclude directory"); + elsif RTS_Src_Path_Name = null then + Osint.Fail ("RTS path not valid: missing " + & "adainclude directory"); - elsif RTS_Lib_Path_Name = null then - Osint.Fail ("RTS path not valid: missing " & - "adalib directory"); - end if; + elsif RTS_Lib_Path_Name = null then + Osint.Fail ("RTS path not valid: missing " + & "adalib directory"); + end if; + end; end if; -- There are no other switches not starting with -gnat @@ -194,30 +297,31 @@ package body Switch.C is case C is + -- -gnata (assertions enabled) + when 'a' => Ptr := Ptr + 1; Assertions_Enabled := True; - Debug_Pragmas_Enabled := True; - -- Processing for A switch + -- -gnatA (disregard gnat.adc) when 'A' => Ptr := Ptr + 1; Config_File := False; - -- Processing for b switch + -- -gnatb (brief messages to stderr) when 'b' => Ptr := Ptr + 1; Brief_Output := True; - -- Processing for B switch + -- -gnatB (assume no invalid values) when 'B' => Ptr := Ptr + 1; Assume_No_Invalid_Values := True; - -- Processing for c switch + -- -gnatc (check syntax and semantics only) when 'c' => if not First_Switch then @@ -228,17 +332,30 @@ package body Switch.C is Ptr := Ptr + 1; Operating_Mode := Check_Semantics; - -- Processing for C switch + -- -gnatC (Generate CodePeer information) when 'C' => Ptr := Ptr + 1; - CodePeer_Mode := True; - -- Processing for d switch + if not CodePeer_Mode then + CodePeer_Mode := True; + + -- Suppress compiler warnings by default, since what we are + -- interested in here is what CodePeer can find out. Note + -- that if -gnatwxxx is specified after -gnatC on the + -- command line, we do not want to override this setting in + -- Adjust_Global_Switches, and assume that the user wants to + -- get both warnings from GNAT and CodePeer messages. + + Warning_Mode := Suppress; + end if; + + -- -gnatd (compiler debug options) when 'd' => Store_Switch := False; Dot := False; + First_Ptr := Ptr + 1; -- Note: for the debug switch, the remaining characters in this -- switch field must all be debug flags, since all valid switch @@ -255,9 +372,25 @@ package body Switch.C is C in 'a' .. 'z' or else C in 'A' .. 'Z' then + -- Case of dotted flag + if Dot then Set_Dotted_Debug_Flag (C); Store_Compilation_Switch ("-gnatd." & C); + + -- Special check, -gnatd.b must come first + + if C = 'b' + and then (Ptr /= First_Ptr + 1 + or else not First_Switch) + then + Osint.Fail + ("-gnatd.b must be first if combined " + & "with other switches"); + end if; + + -- Not a dotted flag + else Set_Debug_Flag (C); Store_Compilation_Switch ("-gnatd" & C); @@ -275,11 +408,27 @@ package body Switch.C is return; - -- Processing for D switch + -- -gnatD (debug expanded code) when 'D' => Ptr := Ptr + 1; + -- Not allowed if previous -gnatR given + + -- The reason for this prohibition is that the rewriting of + -- Sloc values causes strange malfunctions in the tests of + -- whether units belong to the main source. This is really a + -- bug, but too hard to fix for a marginal capability ??? + + -- The proper fix is to completely redo -gnatD processing so + -- that the tree is not messed with, and instead a separate + -- table is built on the side for debug information generation. + + if List_Representation_Info /= 0 then + Osint.Fail + ("-gnatD not permitted since -gnatR given previously"); + end if; + -- Scan optional integer line limit value if Nat_Present (Switch_Chars, Max, Ptr) then @@ -311,6 +460,8 @@ package body Switch.C is -- -gnatea (initial delimiter of explicit switches) + -- This is an internal switch + -- All switches that come before -gnatea have been added by -- the GCC driver and are not stored in the ALI file. -- See also -gnatez below. @@ -320,6 +471,12 @@ package body Switch.C is Enable_Switch_Storing; Ptr := Ptr + 1; + -- -gnateA (aliasing checks on parameters) + + when 'A' => + Ptr := Ptr + 1; + Check_Aliasing_Of_Parameters := True; + -- -gnatec (configuration pragmas) when 'c' => @@ -370,14 +527,17 @@ package body Switch.C is return; - -- -gnateC switch (CodePeer SCIL generation) + -- -gnateC switch (generate CodePeer messages) + + when 'C' => + Ptr := Ptr + 1; + Generate_CodePeer_Messages := True; - -- Not enabled for now, keep it for later??? - -- use -gnatd.I only for now + -- -gnated switch (disable atomic synchronization) - -- when 'C' => - -- Ptr := Ptr + 1; - -- Generate_SCIL := True; + when 'd' => + Suppress_Options.Suppress (Atomic_Synchronization) := + True; -- -gnateD switch (preprocessing symbol definition) @@ -397,6 +557,12 @@ package body Switch.C is ("-gnateD" & Switch_Chars (Ptr .. Max)); Ptr := Max + 1; + -- -gnateE (extra exception information) + + when 'E' => + Exception_Extra_Info := True; + Ptr := Ptr + 1; + -- -gnatef (full source path for brief error messages) when 'f' => @@ -404,18 +570,56 @@ package body Switch.C is Ptr := Ptr + 1; Full_Path_Name_For_Brief_Errors := True; + -- -gnateF (Check_Float_Overflow) + + when 'F' => + Ptr := Ptr + 1; + Check_Float_Overflow := not Machine_Overflows_On_Target; + + -- -gnateg (generate C code) + + when 'g' => + -- Special check, -gnateg must occur after -gnatc + + if Operating_Mode /= Check_Semantics then + Osint.Fail + ("gnateg requires previous occurrence of -gnatc"); + end if; + + Generate_C_Code := True; + Ptr := Ptr + 1; + -- -gnateG (save preprocessor output) when 'G' => Generate_Processed_File := True; Ptr := Ptr + 1; + -- -gnatei (max number of instantiations) + + when 'i' => + Ptr := Ptr + 1; + Scan_Pos + (Switch_Chars, Max, Ptr, Maximum_Instantiations, C); + -- -gnateI (index of unit in multi-unit source) when 'I' => Ptr := Ptr + 1; Scan_Pos (Switch_Chars, Max, Ptr, Multiple_Unit_Index, C); + -- -gnatel + + when 'l' => + Ptr := Ptr + 1; + Elab_Info_Messages := True; + + -- -gnateL + + when 'L' => + Ptr := Ptr + 1; + Elab_Info_Messages := False; + -- -gnatem (mapping file) when 'm' => @@ -437,6 +641,25 @@ package body Switch.C is new String'(Switch_Chars (Ptr .. Max)); return; + -- -gnateO= (object path file) + + -- This is an internal switch + + when 'O' => + Store_Switch := False; + Ptr := Ptr + 1; + + -- Check for '=' + + if Ptr >= Max or else Switch_Chars (Ptr) /= '=' then + Bad_Switch ("-gnateO"); + else + Object_Path_File_Name := + new String'(Switch_Chars (Ptr + 1 .. Max)); + end if; + + return; + -- -gnatep (preprocessing data file) when 'p' => @@ -464,25 +687,121 @@ package body Switch.C is Ptr := Max + 1; - -- -gnatez (final delimiter of explicit switches) + -- -gnateP (Treat pragma Pure/Preelaborate errs as warnings) - -- All switches that come after -gnatez have been added by - -- the GCC driver and are not stored in the ALI file. See - -- also -gnatea above. + when 'P' => + Treat_Categorization_Errors_As_Warnings := True; + + -- -gnates=file (specify extra file switches for gnat2why) + + -- This is an internal switch + + when 's' => + if not First_Switch then + Osint.Fail + ("-gnates must not be combined with other switches"); + end if; + + -- Check for '=' - when 'z' => - Store_Switch := False; - Disable_Switch_Storing; Ptr := Ptr + 1; + if Ptr >= Max or else Switch_Chars (Ptr) /= '=' then + Bad_Switch ("-gnates"); + else + SPARK_Switches_File_Name := + new String'(Switch_Chars (Ptr + 1 .. Max)); + end if; + + return; + -- -gnateS (generate SCO information) -- Include Source Coverage Obligation information in ALI - -- files for the benefit of source coverage analysis tools - -- (xcov). + -- files for use by source coverage analysis tools + -- (gnatcov) (equivalent to -fdump-scos, provided for + -- backwards compatibility). when 'S' => Generate_SCO := True; + Generate_SCO_Instance_Table := True; + Ptr := Ptr + 1; + + -- -gnatet (write target dependent information) + + when 't' => + if not First_Switch then + Osint.Fail + ("-gnatet must not be combined with other switches"); + end if; + + -- Check for '=' + + Ptr := Ptr + 1; + + if Ptr >= Max or else Switch_Chars (Ptr) /= '=' then + Bad_Switch ("-gnatet"); + else + Target_Dependent_Info_Write_Name := + new String'(Switch_Chars (Ptr + 1 .. Max)); + end if; + + return; + + -- -gnateT (read target dependent information) + + when 'T' => + if not First_Switch then + Osint.Fail + ("-gnateT must not be combined with other switches"); + end if; + + -- Check for '=' + + Ptr := Ptr + 1; + + if Ptr >= Max or else Switch_Chars (Ptr) /= '=' then + Bad_Switch ("-gnateT"); + else + -- This parameter was stored by Set_Targ earlier + + pragma Assert + (Target_Dependent_Info_Read_Name.all = + Switch_Chars (Ptr + 1 .. Max)); + null; + end if; + + return; + + -- -gnateu (unrecognized y,V,w switches) + + when 'u' => + Ptr := Ptr + 1; + Ignore_Unrecognized_VWY_Switches := True; + + -- -gnateV (validity checks on parameters) + + when 'V' => + Ptr := Ptr + 1; + Check_Validity_Of_Parameters := True; + + -- -gnateY (ignore Style_Checks pragmas) + + when 'Y' => + Ignore_Style_Checks_Pragmas := True; + Ptr := Ptr + 1; + + -- -gnatez (final delimiter of explicit switches) + + -- This is an internal switch + + -- All switches that come after -gnatez have been added by + -- the GCC driver and are not stored in the ALI file. See + -- also -gnatea above. + + when 'z' => + Store_Switch := False; + Disable_Switch_Storing; Ptr := Ptr + 1; -- All other -gnate? switches are unassigned @@ -503,35 +822,33 @@ package body Switch.C is Ptr := Ptr + 1; All_Errors_Mode := True; - -- Processing for F switch + -- -gnatF (overflow of predefined float types) when 'F' => Ptr := Ptr + 1; External_Name_Exp_Casing := Uppercase; External_Name_Imp_Casing := Uppercase; - -- Processing for g switch + -- -gnatg (GNAT implementation mode) when 'g' => Ptr := Ptr + 1; GNAT_Mode := True; + GNAT_Mode_Config := True; Identifier_Character_Set := 'n'; System_Extend_Unit := Empty; Warning_Mode := Treat_As_Error; - - -- Set Ada 2005 mode explicitly. We don't want to rely on the - -- implicit setting here, since for example, we want - -- Preelaborate_05 treated as Preelaborate - - Ada_Version := Ada_05; - Ada_Version_Explicit := Ada_Version; + Style_Check_Main := True; + Ada_Version := Ada_2012; + Ada_Version_Explicit := Ada_2012; + Ada_Version_Pragma := Empty; -- Set default warnings and style checks for -gnatg Set_GNAT_Mode_Warnings; Set_GNAT_Style_Check_Options; - -- Processing for G switch + -- -gnatG (output generated code) when 'G' => Ptr := Ptr + 1; @@ -544,19 +861,13 @@ package body Switch.C is Sprint_Line_Limit := Nat'Max (Sprint_Line_Limit, 40); end if; - -- Processing for h switch + -- -gnath (help information) when 'h' => Ptr := Ptr + 1; Usage_Requested := True; - -- Processing for H switch - - when 'H' => - Ptr := Ptr + 1; - HLO_Active := True; - - -- Processing for i switch + -- -gnati (character set) when 'i' => if Ptr = Max then @@ -581,26 +892,26 @@ package body Switch.C is Bad_Switch ("-gnati" & Switch_Chars (Ptr .. Max)); end if; - -- Processing for I switch + -- -gnatI (ignore representation clauses) when 'I' => Ptr := Ptr + 1; Ignore_Rep_Clauses := True; - -- Processing for j switch + -- -gnatj (messages in limited length lines) when 'j' => Ptr := Ptr + 1; Scan_Nat (Switch_Chars, Max, Ptr, Error_Msg_Line_Length, C); - -- Processing for k switch + -- -gnatk (limit file name length) when 'k' => Ptr := Ptr + 1; Scan_Pos (Switch_Chars, Max, Ptr, Maximum_File_Name_Length, C); - -- Processing for l switch + -- -gnatl (output full source) when 'l' => Ptr := Ptr + 1; @@ -618,96 +929,191 @@ package body Switch.C is end if; end if; - -- Processing for L switch + -- -gnatL (corresponding source text) when 'L' => Ptr := Ptr + 1; Dump_Source_Text := True; - -- Processing for m switch + -- -gnatm (max number or errors/warnings) when 'm' => Ptr := Ptr + 1; Scan_Nat (Switch_Chars, Max, Ptr, Maximum_Messages, C); - -- Processing for n switch + -- -gnatn (enable pragma Inline) when 'n' => Ptr := Ptr + 1; Inline_Active := True; - -- Processing for N switch + -- There may be a digit (1 or 2) appended to the switch + + if Ptr <= Max then + C := Switch_Chars (Ptr); + + if C in '1' .. '2' then + Ptr := Ptr + 1; + Inline_Level := Character'Pos (C) - Character'Pos ('0'); + end if; + end if; + + -- -gnatN (obsolescent) when 'N' => Ptr := Ptr + 1; Inline_Active := True; Front_End_Inlining := True; - -- Processing for o switch + -- -gnato (overflow checks) when 'o' => Ptr := Ptr + 1; - Suppress_Options (Overflow_Check) := False; - Opt.Enable_Overflow_Checks := True; - -- Processing for O switch + -- Case of -gnato0 (overflow checking turned off) + + if Ptr <= Max and then Switch_Chars (Ptr) = '0' then + Ptr := Ptr + 1; + Suppress_Options.Suppress (Overflow_Check) := True; + + -- We set strict mode in case overflow checking is turned + -- on locally (also records that we had a -gnato switch). + + Suppress_Options.Overflow_Mode_General := Strict; + Suppress_Options.Overflow_Mode_Assertions := Strict; + + -- All cases other than -gnato0 (overflow checking turned on) + + else + Suppress_Options.Suppress (Overflow_Check) := False; + + -- Case of no digits after the -gnato + + if Ptr > Max + or else Switch_Chars (Ptr) not in '1' .. '3' + then + Suppress_Options.Overflow_Mode_General := Strict; + Suppress_Options.Overflow_Mode_Assertions := Strict; + + -- At least one digit after the -gnato + + else + -- Handle first digit after -gnato + + Suppress_Options.Overflow_Mode_General := + Get_Overflow_Mode (Switch_Chars (Ptr)); + Ptr := Ptr + 1; + + -- Only one digit after -gnato, set assertions mode to be + -- the same as general mode. + + if Ptr > Max + or else Switch_Chars (Ptr) not in '1' .. '3' + then + Suppress_Options.Overflow_Mode_Assertions := + Suppress_Options.Overflow_Mode_General; + + -- Process second digit after -gnato + + else + Suppress_Options.Overflow_Mode_Assertions := + Get_Overflow_Mode (Switch_Chars (Ptr)); + Ptr := Ptr + 1; + end if; + end if; + end if; + + -- -gnatO (specify name of the object file) + + -- This is an internal switch when 'O' => Store_Switch := False; Ptr := Ptr + 1; Output_File_Name_Present := True; - -- Processing for p switch + -- -gnatp (suppress all checks) when 'p' => Ptr := Ptr + 1; - -- Set all specific options as well as All_Checks in the - -- Suppress_Options array, excluding Elaboration_Check, since - -- this is treated specially because we do not want -gnatp to - -- disable static elaboration processing. + -- Skip processing if cancelled by subsequent -gnat-p - for J in Suppress_Options'Range loop - if J /= Elaboration_Check then - Suppress_Options (J) := True; - end if; - end loop; + if Switch_Subsequently_Cancelled ("p", Args, Arg_Rank) then + Store_Switch := False; - Validity_Checks_On := False; - Opt.Suppress_Checks := True; - Opt.Enable_Overflow_Checks := False; + else + -- Set all specific options as well as All_Checks in the + -- Suppress_Options array, excluding Elaboration_Check, + -- since this is treated specially because we do not want + -- -gnatp to disable static elaboration processing. Also + -- exclude Atomic_Synchronization, since this is not a real + -- check. + + for J in Suppress_Options.Suppress'Range loop + if J /= Elaboration_Check + and then + J /= Atomic_Synchronization + then + Suppress_Options.Suppress (J) := True; + end if; + end loop; + + Validity_Checks_On := False; + Opt.Suppress_Checks := True; - -- Processing for P switch + -- Set overflow mode checking to strict in case it gets + -- turned on locally (also signals that overflow checking + -- has been specifically turned off). + + Suppress_Options.Overflow_Mode_General := Strict; + Suppress_Options.Overflow_Mode_Assertions := Strict; + end if; + + -- -gnatP (periodic poll) when 'P' => Ptr := Ptr + 1; Polling_Required := True; - -- Processing for q switch + -- -gnatq (don't quit) when 'q' => Ptr := Ptr + 1; Try_Semantics := True; - -- Processing for Q switch + -- -gnatQ (always write ALI file) when 'Q' => Ptr := Ptr + 1; Force_ALI_Tree_File := True; Try_Semantics := True; - -- Processing for r switch + -- -gnatr (restrictions as warnings) when 'r' => Ptr := Ptr + 1; Treat_Restrictions_As_Warnings := True; - -- Processing for R switch + -- -gnatR (list rep. info) when 'R' => + + -- Not allowed if previous -gnatD given. See more extensive + -- comments in the 'D' section for the inverse test. + + if Debug_Generated_Code then + Osint.Fail + ("-gnatR not permitted since -gnatD given previously"); + end if; + + -- Set to annotate rep info, and set default -gnatR mode + Back_Annotate_Rep_Info := True; List_Representation_Info := 1; + -- Scan possible parameter + Ptr := Ptr + 1; while Ptr <= Max loop C := Switch_Chars (Ptr); @@ -729,7 +1135,7 @@ package body Switch.C is Ptr := Ptr + 1; end loop; - -- Processing for s switch + -- -gnats (syntax check only) when 's' => if not First_Switch then @@ -740,44 +1146,44 @@ package body Switch.C is Ptr := Ptr + 1; Operating_Mode := Check_Syntax; - -- Processing for S switch + -- -gnatS (print package Standard) when 'S' => Print_Standard := True; Ptr := Ptr + 1; - -- Processing for t switch + -- -gnatt (output tree) when 't' => Ptr := Ptr + 1; Tree_Output := True; Back_Annotate_Rep_Info := True; - -- Processing for T switch + -- -gnatT (change start of internal table sizes) when 'T' => Ptr := Ptr + 1; Scan_Pos (Switch_Chars, Max, Ptr, Table_Factor, C); - -- Processing for u switch + -- -gnatu (list units for compilation) when 'u' => Ptr := Ptr + 1; List_Units := True; - -- Processing for U switch + -- -gnatU (unique tags) when 'U' => Ptr := Ptr + 1; Unique_Error_Tag := True; - -- Processing for v switch + -- -gnatv (verbose mode) when 'v' => Ptr := Ptr + 1; Verbose_Mode := True; - -- Processing for V switch + -- -gnatV (validity checks) when 'V' => Store_Switch := False; @@ -807,7 +1213,7 @@ package body Switch.C is Ptr := Max + 1; - -- Processing for w switch + -- -gnatw (warning modes) when 'w' => Store_Switch := False; @@ -847,7 +1253,7 @@ package body Switch.C is return; - -- Processing for W switch + -- -gnatW (wide character encoding method) when 'W' => Ptr := Ptr + 1; @@ -872,22 +1278,26 @@ package body Switch.C is Ptr := Ptr + 1; - -- Processing for x switch + -- -gnatx (suppress cross-ref information) when 'x' => Ptr := Ptr + 1; Xref_Active := False; - -- Processing for X switch + -- -gnatX (language extensions) when 'X' => Ptr := Ptr + 1; - Extensions_Allowed := True; + Extensions_Allowed := True; + Ada_Version := Ada_Version_Type'Last; + Ada_Version_Explicit := Ada_Version_Type'Last; + Ada_Version_Pragma := Empty; - -- Processing for y switch + -- -gnaty (style checks) when 'y' => Ptr := Ptr + 1; + Style_Check_Main := True; if Ptr > Max then Set_Default_Style_Check_Options; @@ -930,13 +1340,27 @@ package body Switch.C is end; end if; - -- Processing for z switch + -- -gnatz (stub generation) when 'z' => + + -- -gnatz must be the first and only switch in Switch_Chars, + -- and is a two-letter switch. + + if Ptr /= Switch_Chars'First + 5 + or else (Max - Ptr + 1) > 2 + then + Osint.Fail + ("-gnatz* may not be combined with other switches"); + end if; + + if Ptr = Max then + Bad_Switch ("-gnatz"); + end if; + Ptr := Ptr + 1; - -- Allowed for compiler only if this is the only - -- -z switch, we do not allow multiple occurrences + -- Only one occurrence of -gnat* is permitted if Distribution_Stub_Mode = No_Stubs then case Switch_Chars (Ptr) is @@ -951,16 +1375,23 @@ package body Switch.C is end case; Ptr := Ptr + 1; + + else + Osint.Fail ("only one -gnatz* switch allowed"); end if; - -- Processing for Z switch + -- -gnatZ (obsolescent) when 'Z' => Ptr := Ptr + 1; Osint.Fail ("-gnatZ is no longer supported: consider using --RTS=zcx"); - -- Processing for 83 switch + -- Note on language version switches: whenever a new language + -- version switch is added, Switch.M.Normalize_Compiler_Switches + -- must be updated. + + -- -gnat83 when '8' => if Ptr = Max then @@ -969,15 +1400,16 @@ package body Switch.C is Ptr := Ptr + 1; - if Switch_Chars (Ptr) /= '3' then + if Switch_Chars (Ptr) /= '3' or else Latest_Ada_Only then Bad_Switch ("-gnat8" & Switch_Chars (Ptr .. Max)); else Ptr := Ptr + 1; - Ada_Version := Ada_83; - Ada_Version_Explicit := Ada_Version; + Ada_Version := Ada_83; + Ada_Version_Explicit := Ada_83; + Ada_Version_Pragma := Empty; end if; - -- Processing for 95 switch + -- -gnat95 when '9' => if Ptr = Max then @@ -986,15 +1418,16 @@ package body Switch.C is Ptr := Ptr + 1; - if Switch_Chars (Ptr) /= '5' then + if Switch_Chars (Ptr) /= '5' or else Latest_Ada_Only then Bad_Switch ("-gnat9" & Switch_Chars (Ptr .. Max)); else Ptr := Ptr + 1; - Ada_Version := Ada_95; - Ada_Version_Explicit := Ada_Version; + Ada_Version := Ada_95; + Ada_Version_Explicit := Ada_95; + Ada_Version_Pragma := Empty; end if; - -- Processing for 05 switch + -- -gnat05 when '0' => if Ptr = Max then @@ -1003,19 +1436,81 @@ package body Switch.C is Ptr := Ptr + 1; - if Switch_Chars (Ptr) /= '5' then + if Switch_Chars (Ptr) /= '5' or else Latest_Ada_Only then Bad_Switch ("-gnat0" & Switch_Chars (Ptr .. Max)); else Ptr := Ptr + 1; - Ada_Version := Ada_05; - Ada_Version_Explicit := Ada_Version; + Ada_Version := Ada_2005; + Ada_Version_Explicit := Ada_2005; + Ada_Version_Pragma := Empty; end if; - -- Ignore extra switch character + -- -gnat12 + + when '1' => + if Ptr = Max then + Bad_Switch ("-gnat1"); + end if; - when '/' | '-' => Ptr := Ptr + 1; + if Switch_Chars (Ptr) /= '2' then + Bad_Switch ("-gnat1" & Switch_Chars (Ptr .. Max)); + else + Ptr := Ptr + 1; + Ada_Version := Ada_2012; + Ada_Version_Explicit := Ada_2012; + Ada_Version_Pragma := Empty; + end if; + + -- -gnat2005 and -gnat2012 + + when '2' => + if Ptr > Max - 3 then + Bad_Switch ("-gnat" & Switch_Chars (Ptr .. Max)); + + elsif Switch_Chars (Ptr .. Ptr + 3) = "2005" + and then not Latest_Ada_Only + then + Ada_Version := Ada_2005; + + elsif Switch_Chars (Ptr .. Ptr + 3) = "2012" then + Ada_Version := Ada_2012; + + else + Bad_Switch ("-gnat" & Switch_Chars (Ptr .. Ptr + 3)); + end if; + + Ada_Version_Explicit := Ada_Version; + Ada_Version_Pragma := Empty; + Ptr := Ptr + 4; + + -- Switch cancellation, currently only -gnat-p is allowed. + -- All we do here is the error checking, since the actual + -- processing for switch cancellation is done by calls to + -- Switch_Subsequently_Cancelled at the appropriate point. + + when '-' => + + -- Simple ignore -gnat-p + + if Switch_Chars = "-gnat-p" then + return; + + -- Any other occurrence of minus is ignored. This is for + -- maximum compatibility with previous version which ignored + -- all occurrences of minus. + + else + Store_Switch := False; + Ptr := Ptr + 1; + end if; + + -- We ignore '/' in switches, this is historical, still needed??? + + when '/' => + Store_Switch := False; + -- Anything else is an error (illegal switch character) when others => @@ -1032,4 +1527,27 @@ package body Switch.C is end if; end Scan_Front_End_Switches; + ----------------------------------- + -- Switch_Subsequently_Cancelled -- + ----------------------------------- + + function Switch_Subsequently_Cancelled + (C : String; + Args : String_List; + Arg_Rank : Positive) return Boolean + is + begin + -- Loop through arguments following the current one + + for Arg in Arg_Rank + 1 .. Args'Last loop + if Args (Arg).all = "-gnat-" & C then + return True; + end if; + end loop; + + -- No match found, not cancelled + + return False; + end Switch_Subsequently_Cancelled; + end Switch.C;