From 37ae92c459ceb0fa65ff4041403f918d286ece25 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Mon, 29 Oct 2012 10:58:27 +0100 Subject: [PATCH] [multiple changes] 2012-10-29 Thomas Quinot * sem_elab.adb: Minor reformatting and code reorganization. 2012-10-29 Robert Dewar * par-ch4.adb (P_Primary): Warn on bad use of unary minus. 2012-10-29 Robert Dewar * s-valuti.ads, s-valuti.adb (Bad_Value): New procedure. * s-valllu.adb, s-valwch.adb, s-valcha.adb, s-valint.adb, s-valuns.adb, s-valrea.adb, s-valboo.adb, s-valenu.adb, s-vallli.adb: Use Bad_Value everywhere. 2012-10-29 Yannick Moy * gnat1drv.adb (Adjust_Global_Switches): Do not suppress checks in Alfa mode. From-SVN: r192915 --- gcc/ada/ChangeLog | 20 ++++++++++++++++++++ gcc/ada/gnat1drv.adb | 17 +++++++---------- gcc/ada/par-ch4.adb | 10 +++++++++- gcc/ada/s-valboo.adb | 4 ++-- gcc/ada/s-valcha.adb | 4 ++-- gcc/ada/s-valenu.adb | 9 +++++---- gcc/ada/s-valint.adb | 6 +++--- gcc/ada/s-vallli.adb | 6 +++--- gcc/ada/s-valllu.adb | 6 +++--- gcc/ada/s-valrea.adb | 33 +++++++++------------------------ gcc/ada/s-valuns.adb | 8 ++++---- gcc/ada/s-valuti.adb | 36 ++++++++++++++++++++++-------------- gcc/ada/s-valuti.ads | 6 +++++- gcc/ada/s-valwch.adb | 17 ++++++++--------- gcc/ada/sem_elab.adb | 13 +++++-------- 15 files changed, 107 insertions(+), 88 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 0b7f5412c06..73abf151ff5 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,23 @@ +2012-10-29 Thomas Quinot + + * sem_elab.adb: Minor reformatting and code reorganization. + +2012-10-29 Robert Dewar + + * par-ch4.adb (P_Primary): Warn on bad use of unary minus. + +2012-10-29 Robert Dewar + + * s-valuti.ads, s-valuti.adb (Bad_Value): New procedure. + * s-valllu.adb, s-valwch.adb, s-valcha.adb, s-valint.adb, + s-valuns.adb, s-valrea.adb, s-valboo.adb, s-valenu.adb, + s-vallli.adb: Use Bad_Value everywhere. + +2012-10-29 Yannick Moy + + * gnat1drv.adb (Adjust_Global_Switches): Do not suppress checks + in Alfa mode. + 2012-10-29 Yannick Moy * checks.adb (Apply_Arithmetic_Overflow_Minimized_Eliminated): diff --git a/gcc/ada/gnat1drv.adb b/gcc/ada/gnat1drv.adb index a4d01c9f8ba..a8eb320667a 100644 --- a/gcc/ada/gnat1drv.adb +++ b/gcc/ada/gnat1drv.adb @@ -419,7 +419,6 @@ procedure Gnat1drv is -- Set switches for formal verification mode if Debug_Flag_Dot_FF then - Alfa_Mode := True; -- Set strict standard interpretation of compiler permissions @@ -448,15 +447,13 @@ procedure Gnat1drv is Restrict.Restrictions.Set (No_Initialize_Scalars) := True; - -- Suppress all language checks since they are handled implicitly by - -- the formal verification backend. - -- Turn off dynamic elaboration checks. - -- Turn off alignment checks. - -- Turn off validity checking. - - Suppress_Options := Suppress_All; - Dynamic_Elaboration_Checks := False; - Reset_Validity_Check_Options; + -- Note: at this point we used to suppress various checks, but that + -- is not what we want. We need the semantic processing for these + -- checks (which will set flags like Do_Overflow_Check, showing the + -- points at which potential checks are required semantically). We + -- don't want the expansion associated with these checks, but that + -- happens anyway because this expansion is simply not done in the + -- Alfa version of the expander. -- Kill debug of generated code, since it messes up sloc values diff --git a/gcc/ada/par-ch4.adb b/gcc/ada/par-ch4.adb index df13d005855..352feeaf86e 100644 --- a/gcc/ada/par-ch4.adb +++ b/gcc/ada/par-ch4.adb @@ -2364,6 +2364,7 @@ package body Ch4 is begin -- The loop runs more than once only if misplaced pragmas are found + -- or if a misplaced unary minus is skipped. loop case Token is @@ -2537,8 +2538,15 @@ package body Ch4 is return P_Identifier; end if; + -- Minus may well be an improper attempt at a unary minus. Give + -- a message, skip the minus and keep going! + + when Tok_Minus => + Error_Msg_SC ("parentheses required for unary minus"); + Scan; -- past minus + -- Anything else is illegal as the first token of a primary, but - -- we test for a reserved identifier so that it is treated nicely + -- we test for some common errors, to improve error messages. when others => if Is_Reserved_Identifier then diff --git a/gcc/ada/s-valboo.adb b/gcc/ada/s-valboo.adb index bea2140656e..59c79ef15a9 100644 --- a/gcc/ada/s-valboo.adb +++ b/gcc/ada/s-valboo.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2009, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2012, 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- -- @@ -52,7 +52,7 @@ package body System.Val_Bool is return False; else - raise Constraint_Error; + Bad_Value (Str); end if; end Value_Boolean; diff --git a/gcc/ada/s-valcha.adb b/gcc/ada/s-valcha.adb index 8dddcf58403..799145fa893 100644 --- a/gcc/ada/s-valcha.adb +++ b/gcc/ada/s-valcha.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2010, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2012, 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- -- @@ -69,7 +69,7 @@ package body System.Val_Char is return Character'Val (16#AD#); end if; - raise Constraint_Error; + Bad_Value (Str); end if; end Value_Character; diff --git a/gcc/ada/s-valenu.adb b/gcc/ada/s-valenu.adb index 66a84ec8248..0de1a9520ee 100644 --- a/gcc/ada/s-valenu.adb +++ b/gcc/ada/s-valenu.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2009, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2012, 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- -- @@ -30,6 +30,7 @@ ------------------------------------------------------------------------------ with Ada.Unchecked_Conversion; + with System.Val_Util; use System.Val_Util; package body System.Val_Enum is @@ -70,7 +71,7 @@ package body System.Val_Enum is end if; end loop; - raise Constraint_Error; + Bad_Value (Str); end Value_Enumeration_8; -------------------------- @@ -109,7 +110,7 @@ package body System.Val_Enum is end if; end loop; - raise Constraint_Error; + Bad_Value (Str); end Value_Enumeration_16; -------------------------- @@ -148,7 +149,7 @@ package body System.Val_Enum is end if; end loop; - raise Constraint_Error; + Bad_Value (Str); end Value_Enumeration_32; end System.Val_Enum; diff --git a/gcc/ada/s-valint.adb b/gcc/ada/s-valint.adb index c37b9dcf0f9..d77de09ef2f 100644 --- a/gcc/ada/s-valint.adb +++ b/gcc/ada/s-valint.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2009, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2012, 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- -- @@ -58,7 +58,7 @@ package body System.Val_Int is if Str (Ptr.all) not in '0' .. '9' then Ptr.all := Start; - raise Constraint_Error; + Bad_Value (Str); end if; Uval := Scan_Raw_Unsigned (Str, Ptr, Max); @@ -69,7 +69,7 @@ package body System.Val_Int is if Minus and then Uval = Unsigned (-(Integer'First)) then return Integer'First; else - raise Constraint_Error; + Bad_Value (Str); end if; -- Negative values diff --git a/gcc/ada/s-vallli.adb b/gcc/ada/s-vallli.adb index 66f93f7a668..035a95d0c99 100644 --- a/gcc/ada/s-vallli.adb +++ b/gcc/ada/s-vallli.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2009, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2012, 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- -- @@ -58,7 +58,7 @@ package body System.Val_LLI is if Str (Ptr.all) not in '0' .. '9' then Ptr.all := Start; - raise Constraint_Error; + Bad_Value (Str); end if; Uval := Scan_Raw_Long_Long_Unsigned (Str, Ptr, Max); @@ -71,7 +71,7 @@ package body System.Val_LLI is then return Long_Long_Integer'First; else - raise Constraint_Error; + Bad_Value (Str); end if; -- Negative values diff --git a/gcc/ada/s-valllu.adb b/gcc/ada/s-valllu.adb index f59bf2fe9cc..c37781fca2e 100644 --- a/gcc/ada/s-valllu.adb +++ b/gcc/ada/s-valllu.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2009, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2012, 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- -- @@ -207,7 +207,7 @@ package body System.Val_LLU is if P > Max then Ptr.all := P; - raise Constraint_Error; + Bad_Value (Str); end if; -- If terminating base character, we are done with loop @@ -257,7 +257,7 @@ package body System.Val_LLU is -- Return result, dealing with sign and overflow if Overflow then - raise Constraint_Error; + Bad_Value (Str); else return Uval; end if; diff --git a/gcc/ada/s-valrea.adb b/gcc/ada/s-valrea.adb index 00c6e43a3df..e8debff1e46 100644 --- a/gcc/ada/s-valrea.adb +++ b/gcc/ada/s-valrea.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2011, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2012, 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- -- @@ -29,8 +29,8 @@ -- -- ------------------------------------------------------------------------------ -with System.Powten_Table; use System.Powten_Table; -with System.Val_Util; use System.Val_Util; +with System.Powten_Table; use System.Powten_Table; +with System.Val_Util; use System.Val_Util; with System.Float_Control; package body System.Val_Real is @@ -82,10 +82,6 @@ package body System.Val_Real is -- necessarily required in a case like this where the result is not -- a machine number, but it is certainly a desirable behavior. - procedure Bad_Based_Value; - pragma No_Return (Bad_Based_Value); - -- Raise exception for bad based value - procedure Scanf; -- Scans integer literal value starting at current character position. -- For each digit encountered, Uval is multiplied by 10.0, and the new @@ -95,16 +91,6 @@ package body System.Val_Real is -- return P points past the last character. On entry, the current -- character is known to be a digit, so a numeral is definitely present. - --------------------- - -- Bad_Based_Value -- - --------------------- - - procedure Bad_Based_Value is - begin - raise Constraint_Error with - "invalid based literal for 'Value"; - end Bad_Based_Value; - ----------- -- Scanf -- ----------- @@ -194,8 +180,7 @@ package body System.Val_Real is -- Any other initial character is an error else - raise Constraint_Error with - "invalid character in 'Value string"; + Bad_Value (Str); end if; -- Deal with based case @@ -233,7 +218,7 @@ package body System.Val_Real is loop if P > Max then - Bad_Based_Value; + Bad_Value (Str); elsif Str (P) in Digs then Digit := Character'Pos (Str (P)) - Character'Pos ('0'); @@ -247,7 +232,7 @@ package body System.Val_Real is Character'Pos (Str (P)) - (Character'Pos ('a') - 10); else - Bad_Based_Value; + Bad_Value (Str); end if; -- Save up trailing zeroes after the decimal point @@ -281,7 +266,7 @@ package body System.Val_Real is P := P + 1; if P > Max then - Bad_Based_Value; + Bad_Value (Str); elsif Str (P) = '_' then Scan_Underscore (Str, P, Ptr, Max, True); @@ -296,7 +281,7 @@ package body System.Val_Real is After_Point := 1; if P > Max then - Bad_Based_Value; + Bad_Value (Str); end if; end if; @@ -372,7 +357,7 @@ package body System.Val_Real is -- Here is where we check for a bad based number if Bad_Base then - Bad_Based_Value; + Bad_Value (Str); -- If OK, then deal with initial minus sign, note that this processing -- is done even if Uval is zero, so that -0.0 is correctly interpreted. diff --git a/gcc/ada/s-valuns.adb b/gcc/ada/s-valuns.adb index d2e0a91443f..84da2b16e08 100644 --- a/gcc/ada/s-valuns.adb +++ b/gcc/ada/s-valuns.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2009, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2012, 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- -- @@ -205,7 +205,7 @@ package body System.Val_Uns is if P > Max then Ptr.all := P; - raise Constraint_Error; + Bad_Value (Str); end if; -- If terminating base character, we are done with loop @@ -254,7 +254,7 @@ package body System.Val_Uns is -- Return result, dealing with sign and overflow if Overflow then - raise Constraint_Error; + Bad_Value (Str); else return Uval; end if; @@ -277,7 +277,7 @@ package body System.Val_Uns is if Str (Ptr.all) not in '0' .. '9' then Ptr.all := Start; - raise Constraint_Error; + Bad_Value (Str); end if; return Scan_Raw_Unsigned (Str, Ptr, Max); diff --git a/gcc/ada/s-valuti.adb b/gcc/ada/s-valuti.adb index 86274e7bffa..e25f78c4501 100644 --- a/gcc/ada/s-valuti.adb +++ b/gcc/ada/s-valuti.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2009, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2012, 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- -- @@ -33,6 +33,15 @@ with System.Case_Util; use System.Case_Util; package body System.Val_Util is + --------------- + -- Bad_Value -- + --------------- + + procedure Bad_Value (S : String) is + begin + raise Constraint_Error with "bad input for 'Value: """ & S & '"'; + end Bad_Value; + ---------------------- -- Normalize_String -- ---------------------- @@ -54,7 +63,7 @@ package body System.Val_Util is -- Check for case when the string contained no characters if F > L then - raise Constraint_Error; + Bad_Value (S); end if; -- Scan for trailing spaces @@ -169,7 +178,7 @@ package body System.Val_Util is begin if P > Max then - raise Constraint_Error; + Bad_Value (Str); end if; -- Scan past initial blanks @@ -179,7 +188,7 @@ package body System.Val_Util is if P > Max then Ptr.all := P; - raise Constraint_Error; + Bad_Value (Str); end if; end loop; @@ -192,7 +201,7 @@ package body System.Val_Util is if P > Max then Ptr.all := Start; - raise Constraint_Error; + Bad_Value (Str); end if; end if; @@ -217,7 +226,7 @@ package body System.Val_Util is -- raise constraint error, with Ptr unchanged, and thus > Max. if P > Max then - raise Constraint_Error; + Bad_Value (Str); end if; -- Scan past initial blanks @@ -227,7 +236,7 @@ package body System.Val_Util is if P > Max then Ptr.all := P; - raise Constraint_Error; + Bad_Value (Str); end if; end loop; @@ -241,7 +250,7 @@ package body System.Val_Util is if P > Max then Ptr.all := Start; - raise Constraint_Error; + Bad_Value (Str); end if; -- Skip past an initial plus sign @@ -252,7 +261,7 @@ package body System.Val_Util is if P > Max then Ptr.all := Start; - raise Constraint_Error; + Bad_Value (Str); end if; else @@ -270,7 +279,7 @@ package body System.Val_Util is begin for J in P .. Str'Last loop if Str (J) /= ' ' then - raise Constraint_Error; + Bad_Value (Str); end if; end loop; end Scan_Trailing_Blanks; @@ -304,7 +313,7 @@ package body System.Val_Util is if P > Max then Ptr.all := P; - raise Constraint_Error; + Bad_Value (Str); end if; -- Similarly, if no digit follows the underscore raise an error. This @@ -313,13 +322,12 @@ package body System.Val_Util is C := Str (P); if C in '0' .. '9' - or else - (Ext and then (C in 'A' .. 'F' or else C in 'a' .. 'f')) + or else (Ext and then (C in 'A' .. 'F' or else C in 'a' .. 'f')) then return; else Ptr.all := P; - raise Constraint_Error; + Bad_Value (Str); end if; end Scan_Underscore; diff --git a/gcc/ada/s-valuti.ads b/gcc/ada/s-valuti.ads index 0a92352a3e3..ce9dc3b8ff1 100644 --- a/gcc/ada/s-valuti.ads +++ b/gcc/ada/s-valuti.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2009, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2012, 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- -- @@ -34,6 +34,10 @@ package System.Val_Util is pragma Pure; + procedure Bad_Value (S : String); + pragma No_Return (Bad_Value); + -- Raises constraint error with message: bad input for 'Value: "xxx" + procedure Normalize_String (S : in out String; F, L : out Integer); diff --git a/gcc/ada/s-valwch.adb b/gcc/ada/s-valwch.adb index b2db5005adc..87e85464301 100644 --- a/gcc/ada/s-valwch.adb +++ b/gcc/ada/s-valwch.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2009, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2012, 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- -- @@ -48,8 +48,7 @@ package body System.Val_WChar is WV : constant Unsigned_32 := Wide_Wide_Character'Pos (WC); begin if WV > 16#FFFF# then - raise Constraint_Error with - "out of range character for Value attribute"; + Bad_Value (Str); else return Wide_Character'Val (WV); end if; @@ -77,7 +76,7 @@ package body System.Val_WChar is -- Must be at least three characters if L - F < 2 then - raise Constraint_Error; + Bad_Value (Str); -- If just three characters, simple character case @@ -103,7 +102,7 @@ package body System.Val_WChar is P := P + 1; if P = Str'Last then - raise Constraint_Error; + Bad_Value (Str); end if; return Str (P); @@ -124,7 +123,7 @@ package body System.Val_WChar is end if; if P /= L - 1 then - raise Constraint_Error; + Bad_Value (Str); end if; return W; @@ -150,12 +149,12 @@ package body System.Val_WChar is elsif Str (J) in 'a' .. 'f' then W := W - Character'Pos ('a') + 10; else - raise Constraint_Error; + Bad_Value (Str); end if; end loop; if W > 16#7FFF_FFFF# then - raise Constraint_Error; + Bad_Value (Str); else return Wide_Wide_Character'Val (W); end if; @@ -170,7 +169,7 @@ package body System.Val_WChar is exception when Constraint_Error => - raise Constraint_Error with "invalid string for value attribute"; + Bad_Value (Str); end Value_Wide_Wide_Character; end System.Val_WChar; diff --git a/gcc/ada/sem_elab.adb b/gcc/ada/sem_elab.adb index 4065eb386cc..34aa69169d1 100644 --- a/gcc/ada/sem_elab.adb +++ b/gcc/ada/sem_elab.adb @@ -1884,18 +1884,15 @@ package body Sem_Elab is begin -- If not function or procedure call or instantiation, then ignore - -- call (this happens in some error case and rewriting cases) + -- call (this happens in some error cases and rewriting cases). - if Nkind (N) /= N_Function_Call - and then - Nkind (N) /= N_Procedure_Call_Statement - and then - not Inst_Case + if not Nkind_In (N, N_Function_Call, N_Procedure_Call_Statement) + and then not Inst_Case then return; - -- Nothing to do if this is a call or instantiation that has - -- already been found to be a sure ABE + -- Nothing to do if this is a call or instantiation that has already + -- been found to be a sure ABE. elsif ABE_Is_Certain (N) then return; -- 2.30.2