OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[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
This commit is contained in:
Arnaud Charlet 2012-10-29 10:58:27 +01:00
parent f66369942f
commit 37ae92c459
15 changed files with 107 additions and 88 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
gcc/ada/ChangeLog
View File

@ -1,3 +1,23 @@
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> 2012-10-29 Yannick Moy <moy@adacore.com>
* checks.adb (Apply_Arithmetic_Overflow_Minimized_Eliminated): * checks.adb (Apply_Arithmetic_Overflow_Minimized_Eliminated):

17
gcc/ada/gnat1drv.adb
View File

@ -419,7 +419,6 @@ procedure Gnat1drv is
-- Set switches for formal verification mode -- Set switches for formal verification mode
if Debug_Flag_Dot_FF then if Debug_Flag_Dot_FF then
Alfa_Mode := True; Alfa_Mode := True;
-- Set strict standard interpretation of compiler permissions -- Set strict standard interpretation of compiler permissions
@ -448,15 +447,13 @@ procedure Gnat1drv is
Restrict.Restrictions.Set (No_Initialize_Scalars) := True; Restrict.Restrictions.Set (No_Initialize_Scalars) := True;
-- Suppress all language checks since they are handled implicitly by -- Note: at this point we used to suppress various checks, but that
-- the formal verification backend. -- is not what we want. We need the semantic processing for these
-- Turn off dynamic elaboration checks. -- checks (which will set flags like Do_Overflow_Check, showing the
-- Turn off alignment checks. -- points at which potential checks are required semantically). We
-- Turn off validity checking. -- don't want the expansion associated with these checks, but that
-- happens anyway because this expansion is simply not done in the
Suppress_Options := Suppress_All; -- Alfa version of the expander.
Dynamic_Elaboration_Checks := False;
Reset_Validity_Check_Options;
-- Kill debug of generated code, since it messes up sloc values -- Kill debug of generated code, since it messes up sloc values

10
gcc/ada/par-ch4.adb
View File

@ -2364,6 +2364,7 @@ package body Ch4 is
begin begin
-- The loop runs more than once only if misplaced pragmas are found -- The loop runs more than once only if misplaced pragmas are found
-- or if a misplaced unary minus is skipped.
loop loop
case Token is case Token is
@ -2537,8 +2538,15 @@ package body Ch4 is
return P_Identifier; return P_Identifier;
end if; 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 -- 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 => when others =>
if Is_Reserved_Identifier then if Is_Reserved_Identifier then

4
gcc/ada/s-valboo.adb
View File

@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- 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; return False;
else else
raise Constraint_Error; Bad_Value (Str);
end if; end if;
end Value_Boolean; end Value_Boolean;

4
gcc/ada/s-valcha.adb
View File

@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- 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#); return Character'Val (16#AD#);
end if; end if;
raise Constraint_Error; Bad_Value (Str);
end if; end if;
end Value_Character; end Value_Character;

9
gcc/ada/s-valenu.adb
View File

@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
@ -30,6 +30,7 @@
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
with Ada.Unchecked_Conversion; with Ada.Unchecked_Conversion;
with System.Val_Util; use System.Val_Util; with System.Val_Util; use System.Val_Util;
package body System.Val_Enum is package body System.Val_Enum is
@ -70,7 +71,7 @@ package body System.Val_Enum is
end if; end if;
end loop; end loop;
raise Constraint_Error; Bad_Value (Str);
end Value_Enumeration_8; end Value_Enumeration_8;
-------------------------- --------------------------
@ -109,7 +110,7 @@ package body System.Val_Enum is
end if; end if;
end loop; end loop;
raise Constraint_Error; Bad_Value (Str);
end Value_Enumeration_16; end Value_Enumeration_16;
-------------------------- --------------------------
@ -148,7 +149,7 @@ package body System.Val_Enum is
end if; end if;
end loop; end loop;
raise Constraint_Error; Bad_Value (Str);
end Value_Enumeration_32; end Value_Enumeration_32;
end System.Val_Enum; end System.Val_Enum;

6
gcc/ada/s-valint.adb
View File

@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- 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 if Str (Ptr.all) not in '0' .. '9' then
Ptr.all := Start; Ptr.all := Start;
raise Constraint_Error; Bad_Value (Str);
end if; end if;
Uval := Scan_Raw_Unsigned (Str, Ptr, Max); 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 if Minus and then Uval = Unsigned (-(Integer'First)) then
return Integer'First; return Integer'First;
else else
raise Constraint_Error; Bad_Value (Str);
end if; end if;
-- Negative values -- Negative values

6
gcc/ada/s-vallli.adb
View File

@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- 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 if Str (Ptr.all) not in '0' .. '9' then
Ptr.all := Start; Ptr.all := Start;
raise Constraint_Error; Bad_Value (Str);
end if; end if;
Uval := Scan_Raw_Long_Long_Unsigned (Str, Ptr, Max); Uval := Scan_Raw_Long_Long_Unsigned (Str, Ptr, Max);
@ -71,7 +71,7 @@ package body System.Val_LLI is
then then
return Long_Long_Integer'First; return Long_Long_Integer'First;
else else
raise Constraint_Error; Bad_Value (Str);
end if; end if;
-- Negative values -- Negative values

6
gcc/ada/s-valllu.adb
View File

@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- 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 if P > Max then
Ptr.all := P; Ptr.all := P;
raise Constraint_Error; Bad_Value (Str);
end if; end if;
-- If terminating base character, we are done with loop -- 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 -- Return result, dealing with sign and overflow
if Overflow then if Overflow then
raise Constraint_Error; Bad_Value (Str);
else else
return Uval; return Uval;
end if; end if;

33
gcc/ada/s-valrea.adb
View File

@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- 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.Powten_Table; use System.Powten_Table;
with System.Val_Util; use System.Val_Util; with System.Val_Util; use System.Val_Util;
with System.Float_Control; with System.Float_Control;
package body System.Val_Real is 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 -- necessarily required in a case like this where the result is not
-- a machine number, but it is certainly a desirable behavior. -- 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; procedure Scanf;
-- Scans integer literal value starting at current character position. -- Scans integer literal value starting at current character position.
-- For each digit encountered, Uval is multiplied by 10.0, and the new -- 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 -- return P points past the last character. On entry, the current
-- character is known to be a digit, so a numeral is definitely present. -- 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 -- -- Scanf --
----------- -----------
@ -194,8 +180,7 @@ package body System.Val_Real is
-- Any other initial character is an error -- Any other initial character is an error
else else
raise Constraint_Error with Bad_Value (Str);
"invalid character in 'Value string";
end if; end if;
-- Deal with based case -- Deal with based case
@ -233,7 +218,7 @@ package body System.Val_Real is
loop loop
if P > Max then if P > Max then
Bad_Based_Value; Bad_Value (Str);
elsif Str (P) in Digs then elsif Str (P) in Digs then
Digit := Character'Pos (Str (P)) - Character'Pos ('0'); 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); Character'Pos (Str (P)) - (Character'Pos ('a') - 10);
else else
Bad_Based_Value; Bad_Value (Str);
end if; end if;
-- Save up trailing zeroes after the decimal point -- Save up trailing zeroes after the decimal point
@ -281,7 +266,7 @@ package body System.Val_Real is
P := P + 1; P := P + 1;
if P > Max then if P > Max then
Bad_Based_Value; Bad_Value (Str);
elsif Str (P) = '_' then elsif Str (P) = '_' then
Scan_Underscore (Str, P, Ptr, Max, True); Scan_Underscore (Str, P, Ptr, Max, True);
@ -296,7 +281,7 @@ package body System.Val_Real is
After_Point := 1; After_Point := 1;
if P > Max then if P > Max then
Bad_Based_Value; Bad_Value (Str);
end if; end if;
end if; end if;
@ -372,7 +357,7 @@ package body System.Val_Real is
-- Here is where we check for a bad based number -- Here is where we check for a bad based number
if Bad_Base then if Bad_Base then
Bad_Based_Value; Bad_Value (Str);
-- If OK, then deal with initial minus sign, note that this processing -- 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. -- is done even if Uval is zero, so that -0.0 is correctly interpreted.

8
gcc/ada/s-valuns.adb
View File

@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- 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 if P > Max then
Ptr.all := P; Ptr.all := P;
raise Constraint_Error; Bad_Value (Str);
end if; end if;
-- If terminating base character, we are done with loop -- 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 -- Return result, dealing with sign and overflow
if Overflow then if Overflow then
raise Constraint_Error; Bad_Value (Str);
else else
return Uval; return Uval;
end if; end if;
@ -277,7 +277,7 @@ package body System.Val_Uns is
if Str (Ptr.all) not in '0' .. '9' then if Str (Ptr.all) not in '0' .. '9' then
Ptr.all := Start; Ptr.all := Start;
raise Constraint_Error; Bad_Value (Str);
end if; end if;
return Scan_Raw_Unsigned (Str, Ptr, Max); return Scan_Raw_Unsigned (Str, Ptr, Max);

36
gcc/ada/s-valuti.adb
View File

@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- 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 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 -- -- Normalize_String --
---------------------- ----------------------
@ -54,7 +63,7 @@ package body System.Val_Util is
-- Check for case when the string contained no characters -- Check for case when the string contained no characters
if F > L then if F > L then
raise Constraint_Error; Bad_Value (S);
end if; end if;
-- Scan for trailing spaces -- Scan for trailing spaces
@ -169,7 +178,7 @@ package body System.Val_Util is
begin begin
if P > Max then if P > Max then
raise Constraint_Error; Bad_Value (Str);
end if; end if;
-- Scan past initial blanks -- Scan past initial blanks
@ -179,7 +188,7 @@ package body System.Val_Util is
if P > Max then if P > Max then
Ptr.all := P; Ptr.all := P;
raise Constraint_Error; Bad_Value (Str);
end if; end if;
end loop; end loop;
@ -192,7 +201,7 @@ package body System.Val_Util is
if P > Max then if P > Max then
Ptr.all := Start; Ptr.all := Start;
raise Constraint_Error; Bad_Value (Str);
end if; end if;
end if; end if;
@ -217,7 +226,7 @@ package body System.Val_Util is
-- raise constraint error, with Ptr unchanged, and thus > Max. -- raise constraint error, with Ptr unchanged, and thus > Max.
if P > Max then if P > Max then
raise Constraint_Error; Bad_Value (Str);
end if; end if;
-- Scan past initial blanks -- Scan past initial blanks
@ -227,7 +236,7 @@ package body System.Val_Util is
if P > Max then if P > Max then
Ptr.all := P; Ptr.all := P;
raise Constraint_Error; Bad_Value (Str);
end if; end if;
end loop; end loop;
@ -241,7 +250,7 @@ package body System.Val_Util is
if P > Max then if P > Max then
Ptr.all := Start; Ptr.all := Start;
raise Constraint_Error; Bad_Value (Str);
end if; end if;
-- Skip past an initial plus sign -- Skip past an initial plus sign
@ -252,7 +261,7 @@ package body System.Val_Util is
if P > Max then if P > Max then
Ptr.all := Start; Ptr.all := Start;
raise Constraint_Error; Bad_Value (Str);
end if; end if;
else else
@ -270,7 +279,7 @@ package body System.Val_Util is
begin begin
for J in P .. Str'Last loop for J in P .. Str'Last loop
if Str (J) /= ' ' then if Str (J) /= ' ' then
raise Constraint_Error; Bad_Value (Str);
end if; end if;
end loop; end loop;
end Scan_Trailing_Blanks; end Scan_Trailing_Blanks;
@ -304,7 +313,7 @@ package body System.Val_Util is
if P > Max then if P > Max then
Ptr.all := P; Ptr.all := P;
raise Constraint_Error; Bad_Value (Str);
end if; end if;
-- Similarly, if no digit follows the underscore raise an error. This -- Similarly, if no digit follows the underscore raise an error. This
@ -313,13 +322,12 @@ package body System.Val_Util is
C := Str (P); C := Str (P);
if C in '0' .. '9' if C in '0' .. '9'
or else or else (Ext and then (C in 'A' .. 'F' or else C in 'a' .. 'f'))
(Ext and then (C in 'A' .. 'F' or else C in 'a' .. 'f'))
then then
return; return;
else else
Ptr.all := P; Ptr.all := P;
raise Constraint_Error; Bad_Value (Str);
end if; end if;
end Scan_Underscore; end Scan_Underscore;

6
gcc/ada/s-valuti.ads
View File

@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
@ -34,6 +34,10 @@
package System.Val_Util is package System.Val_Util is
pragma Pure; 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 procedure Normalize_String
(S : in out String; (S : in out String;
F, L : out Integer); F, L : out Integer);

17
gcc/ada/s-valwch.adb
View File

@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- 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); WV : constant Unsigned_32 := Wide_Wide_Character'Pos (WC);
begin begin
if WV > 16#FFFF# then if WV > 16#FFFF# then
raise Constraint_Error with Bad_Value (Str);
"out of range character for Value attribute";
else else
return Wide_Character'Val (WV); return Wide_Character'Val (WV);
end if; end if;
@ -77,7 +76,7 @@ package body System.Val_WChar is
-- Must be at least three characters -- Must be at least three characters
if L - F < 2 then if L - F < 2 then
raise Constraint_Error; Bad_Value (Str);
-- If just three characters, simple character case -- If just three characters, simple character case
@ -103,7 +102,7 @@ package body System.Val_WChar is
P := P + 1; P := P + 1;
if P = Str'Last then if P = Str'Last then
raise Constraint_Error; Bad_Value (Str);
end if; end if;
return Str (P); return Str (P);
@ -124,7 +123,7 @@ package body System.Val_WChar is
end if; end if;
if P /= L - 1 then if P /= L - 1 then
raise Constraint_Error; Bad_Value (Str);
end if; end if;
return W; return W;
@ -150,12 +149,12 @@ package body System.Val_WChar is
elsif Str (J) in 'a' .. 'f' then elsif Str (J) in 'a' .. 'f' then
W := W - Character'Pos ('a') + 10; W := W - Character'Pos ('a') + 10;
else else
raise Constraint_Error; Bad_Value (Str);
end if; end if;
end loop; end loop;
if W > 16#7FFF_FFFF# then if W > 16#7FFF_FFFF# then
raise Constraint_Error; Bad_Value (Str);
else else
return Wide_Wide_Character'Val (W); return Wide_Wide_Character'Val (W);
end if; end if;
@ -170,7 +169,7 @@ package body System.Val_WChar is
exception exception
when Constraint_Error => when Constraint_Error =>
raise Constraint_Error with "invalid string for value attribute"; Bad_Value (Str);
end Value_Wide_Wide_Character; end Value_Wide_Wide_Character;
end System.Val_WChar; end System.Val_WChar;

13
gcc/ada/sem_elab.adb
View File

@ -1884,18 +1884,15 @@ package body Sem_Elab is
begin begin
-- If not function or procedure call or instantiation, then ignore -- 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 if not Nkind_In (N, N_Function_Call, N_Procedure_Call_Statement)
and then and then not Inst_Case
Nkind (N) /= N_Procedure_Call_Statement
and then
not Inst_Case
then then
return; return;
-- Nothing to do if this is a call or instantiation that has -- Nothing to do if this is a call or instantiation that has already
-- already been found to be a sure ABE -- been found to be a sure ABE.
elsif ABE_Is_Certain (N) then elsif ABE_Is_Certain (N) then
return; return;