+2012-10-29 Thomas Quinot <quinot@adacore.com>
+
+ * sem_elab.adb: Minor reformatting and code reorganization.
+
+2012-10-29 Robert Dewar <dewar@adacore.com>
+
+ * par-ch4.adb (P_Primary): Warn on bad use of unary minus.
+
+2012-10-29 Robert Dewar <dewar@adacore.com>
+
+ * 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 <moy@adacore.com>
+
+ * gnat1drv.adb (Adjust_Global_Switches): Do not suppress checks
+ in Alfa mode.
+
2012-10-29 Yannick Moy <moy@adacore.com>
* checks.adb (Apply_Arithmetic_Overflow_Minimized_Eliminated):
-- Set switches for formal verification mode
if Debug_Flag_Dot_FF then
-
Alfa_Mode := True;
-- Set strict standard interpretation of compiler permissions
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
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
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
-- --
-- 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- --
return False;
else
- raise Constraint_Error;
+ Bad_Value (Str);
end if;
end Value_Boolean;
-- --
-- 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- --
return Character'Val (16#AD#);
end if;
- raise Constraint_Error;
+ Bad_Value (Str);
end if;
end Value_Character;
-- --
-- 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- --
------------------------------------------------------------------------------
with Ada.Unchecked_Conversion;
+
with System.Val_Util; use System.Val_Util;
package body System.Val_Enum is
end if;
end loop;
- raise Constraint_Error;
+ Bad_Value (Str);
end Value_Enumeration_8;
--------------------------
end if;
end loop;
- raise Constraint_Error;
+ Bad_Value (Str);
end Value_Enumeration_16;
--------------------------
end if;
end loop;
- raise Constraint_Error;
+ Bad_Value (Str);
end Value_Enumeration_32;
end System.Val_Enum;
-- --
-- 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- --
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);
if Minus and then Uval = Unsigned (-(Integer'First)) then
return Integer'First;
else
- raise Constraint_Error;
+ Bad_Value (Str);
end if;
-- Negative values
-- --
-- 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- --
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);
then
return Long_Long_Integer'First;
else
- raise Constraint_Error;
+ Bad_Value (Str);
end if;
-- Negative values
-- --
-- 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- --
if P > Max then
Ptr.all := P;
- raise Constraint_Error;
+ Bad_Value (Str);
end if;
-- If terminating base character, we are done with loop
-- Return result, dealing with sign and overflow
if Overflow then
- raise Constraint_Error;
+ Bad_Value (Str);
else
return Uval;
end if;
-- --
-- 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- --
-- --
------------------------------------------------------------------------------
-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
-- 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
-- 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 --
-----------
-- 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
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');
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
P := P + 1;
if P > Max then
- Bad_Based_Value;
+ Bad_Value (Str);
elsif Str (P) = '_' then
Scan_Underscore (Str, P, Ptr, Max, True);
After_Point := 1;
if P > Max then
- Bad_Based_Value;
+ Bad_Value (Str);
end if;
end if;
-- 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.
-- --
-- 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- --
if P > Max then
Ptr.all := P;
- raise Constraint_Error;
+ Bad_Value (Str);
end if;
-- If terminating base character, we are done with loop
-- Return result, dealing with sign and overflow
if Overflow then
- raise Constraint_Error;
+ Bad_Value (Str);
else
return Uval;
end if;
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);
-- --
-- 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- --
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 --
----------------------
-- 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
begin
if P > Max then
- raise Constraint_Error;
+ Bad_Value (Str);
end if;
-- Scan past initial blanks
if P > Max then
Ptr.all := P;
- raise Constraint_Error;
+ Bad_Value (Str);
end if;
end loop;
if P > Max then
Ptr.all := Start;
- raise Constraint_Error;
+ Bad_Value (Str);
end if;
end if;
-- 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
if P > Max then
Ptr.all := P;
- raise Constraint_Error;
+ Bad_Value (Str);
end if;
end loop;
if P > Max then
Ptr.all := Start;
- raise Constraint_Error;
+ Bad_Value (Str);
end if;
-- Skip past an initial plus sign
if P > Max then
Ptr.all := Start;
- raise Constraint_Error;
+ Bad_Value (Str);
end if;
else
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;
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
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;
-- --
-- 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- --
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);
-- --
-- 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- --
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;
-- Must be at least three characters
if L - F < 2 then
- raise Constraint_Error;
+ Bad_Value (Str);
-- If just three characters, simple character case
P := P + 1;
if P = Str'Last then
- raise Constraint_Error;
+ Bad_Value (Str);
end if;
return Str (P);
end if;
if P /= L - 1 then
- raise Constraint_Error;
+ Bad_Value (Str);
end if;
return W;
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;
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;
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;
projects / gcc.git / commitdiff