Skip to content

R
riscv-gcc-1
Commit 37ae92c4 by Arnaud Charlet
Options

[multiple changes] 

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.

From-SVN: r192915
parent f6636994
Showing with 107 additions and 88 deletions
gcc/ada/ChangeLog
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):
......
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
......
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
......
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;
......
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;
......
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;
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
......
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
......
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;
......
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.
......
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);
......
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;
......
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);
......
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;
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;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment