Skip to content

R
riscv-gcc-1
Commit bfe7c10c by Bob Duff Committed by Arnaud Charlet
Options

s-valint.adb (Scan_Integer): Call Scan_Raw_Unsigned instead of Scan_Unsigned... 

2006-02-13  Bob Duff  <duff@adacore.com>

	* s-valint.adb (Scan_Integer): Call Scan_Raw_Unsigned instead of
	Scan_Unsigned, so we do not scan leading blanks and sign twice.
	Integer'Value("- 5") and Integer'Value("-+5") now correctly
	raise Constraint_Error.

	* s-vallli.adb (Scan_Long_Long_Integer): Call
	Scan_Raw_Long_Long_Unsigned instead of Scan_Long_Long_Unsigned, so we
	do not scan leading blanks and sign twice.
	Integer'Value("- 5") and Integer'Value("-+5") now correctly
	raise Constraint_Error.

	* s-valllu.ads, s-valllu.adb (Scan_Raw_Long_Long_Unsigned,
	Scan_Long_Long_Unsigned): Split out most of the processing from
	Scan_Long_Long_Unsigned out into
	Scan_Raw_Long_Long_Unsigned, so that Val_LLI can call the Raw_ version.
	This prevents scanning leading blanks and sign twice.
	Also fixed a bug: Modular'Value("-0") should raise Constraint_Error
	See RM-3.5(44).

	* s-valuns.ads, s-valuns.adb (Scan_Raw_Unsigned, Scan_Unsigned): Split
	out most of the processing from Scan_Unsigned out into
	Scan_Raw_Unsigned, so that Val_LLI can call the Raw_ version.
	This prevents scanning leading blanks and sign twice.

	* s-valuti.ads, s-valuti.adb (Scan_Plus_Sign): Add Scan_Plus_Sign, for
	use with Modular'Value attribute.
	(Scan_Plus_Sign): Add Scan_Plus_Sign, for use with Modular'Value
	attribute.

From-SVN: r111101
parent 744ab580
Showing with 175 additions and 76 deletions
gcc/ada/s-valint.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2006, 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- --
......@@ -57,7 +57,13 @@ package body System.Val_Int is
begin
Scan_Sign (Str, Ptr, Max, Minus, Start);
Uval := Scan_Unsigned (Str, Ptr, Max);
if Str (Ptr.all) not in '0' .. '9' then
Ptr.all := Start;
raise Constraint_Error;
end if;
Uval := Scan_Raw_Unsigned (Str, Ptr, Max);
-- Deal with overflow cases, and also with maximum negative number
......
gcc/ada/s-vallli.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2006, 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- --
......@@ -37,9 +37,9 @@ with System.Val_Util; use System.Val_Util;
package body System.Val_LLI is
---------------------------
-- Scn_Long_Long_Integer --
---------------------------
----------------------------
-- Scan_Long_Long_Integer --
----------------------------
function Scan_Long_Long_Integer
(Str : String;
......@@ -57,13 +57,20 @@ package body System.Val_LLI is
begin
Scan_Sign (Str, Ptr, Max, Minus, Start);
Uval := Scan_Long_Long_Unsigned (Str, Ptr, Max);
if Str (Ptr.all) not in '0' .. '9' then
Ptr.all := Start;
raise Constraint_Error;
end if;
Uval := Scan_Raw_Long_Long_Unsigned (Str, Ptr, Max);
-- Deal with overflow cases, and also with maximum negative number
if Uval > Long_Long_Unsigned (Long_Long_Integer'Last) then
if Minus
and then Uval = Long_Long_Unsigned (-(Long_Long_Integer'First)) then
and then Uval = Long_Long_Unsigned (-(Long_Long_Integer'First))
then
return Long_Long_Integer'First;
else
raise Constraint_Error;
......
gcc/ada/s-valllu.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2006, 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- --
......@@ -36,11 +36,11 @@ with System.Val_Util; use System.Val_Util;
package body System.Val_LLU is
-----------------------------
-- Scan_Long_Long_Unsigned --
-----------------------------
---------------------------------
-- Scan_Raw_Long_Long_Unsigned --
---------------------------------
function Scan_Long_Long_Unsigned
function Scan_Raw_Long_Long_Unsigned
(Str : String;
Ptr : access Integer;
Max : Integer) return Long_Long_Unsigned
......@@ -54,17 +54,9 @@ package body System.Val_LLU is
Expon : Integer;
-- Exponent value
Minus : Boolean := False;
-- Set to True if minus sign is present, otherwise to False. Note that
-- a minus sign is permissible for the singular case of -0, and in any
-- case the pointer is left pointing past a negative integer literal.
Overflow : Boolean := False;
-- Set True if overflow is detected at any point
Start : Positive;
-- Save location of first non-blank character
Base_Char : Character;
-- Base character (# or :) in based case
......@@ -75,13 +67,6 @@ package body System.Val_LLU is
-- Digit value
begin
Scan_Sign (Str, Ptr, Max, Minus, Start);
if Str (Ptr.all) not in '0' .. '9' then
Ptr.all := Start;
raise Constraint_Error;
end if;
P := Ptr.all;
Uval := Character'Pos (Str (P)) - Character'Pos ('0');
P := P + 1;
......@@ -273,11 +258,34 @@ package body System.Val_LLU is
-- Return result, dealing with sign and overflow
if Overflow or else (Minus and then Uval /= 0) then
if Overflow then
raise Constraint_Error;
else
return Uval;
end if;
end Scan_Raw_Long_Long_Unsigned;
-----------------------------
-- Scan_Long_Long_Unsigned --
-----------------------------
function Scan_Long_Long_Unsigned
(Str : String;
Ptr : access Integer;
Max : Integer) return Long_Long_Unsigned
is
Start : Positive;
-- Save location of first non-blank character
begin
Scan_Plus_Sign (Str, Ptr, Max, Start);
if Str (Ptr.all) not in '0' .. '9' then
Ptr.all := Start;
raise Constraint_Error;
end if;
return Scan_Raw_Long_Long_Unsigned (Str, Ptr, Max);
end Scan_Long_Long_Unsigned;
------------------------------
......
gcc/ada/s-valllu.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2006, 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- --
......@@ -31,7 +31,7 @@
-- --
------------------------------------------------------------------------------
-- This package contains routines for scanning unsigned Long_Long_Unsigned
-- This package contains routines for scanning modular Long_Long_Unsigned
-- values for use in Text_IO.Modular_IO, and the Value attribute.
with System.Unsigned_Types;
......@@ -39,18 +39,19 @@ with System.Unsigned_Types;
package System.Val_LLU is
pragma Pure;
function Scan_Long_Long_Unsigned
function Scan_Raw_Long_Long_Unsigned
(Str : String;
Ptr : access Integer;
Max : Integer) return System.Unsigned_Types.Long_Long_Unsigned;
-- This function scans the string starting at Str (Ptr.all) for a valid
-- integer according to the syntax described in (RM 3.5(43)). The substring
-- scanned extends no further than Str (Max). There are three cases for the
-- return:
-- scanned extends no further than Str (Max). Note: this does not scan
-- leading or trailing blanks, nor leading sign.
--
-- There are three cases for the return:
--
-- If a valid integer is found after scanning past any initial spaces, then
-- Ptr.all is updated past the last character of the integer (but trailing
-- spaces are not scanned out).
-- If a valid integer is found, then Ptr.all is updated past the last
-- character of the integer.
--
-- If no valid integer is found, then Ptr.all points either to an initial
-- non-digit character, or to Max + 1 if the field is all spaces and the
......@@ -59,16 +60,24 @@ package System.Val_LLU is
-- If a syntactically valid integer is scanned, but the value is out of
-- range, or, in the based case, the base value is out of range or there
-- is an out of range digit, then Ptr.all points past the integer, and
-- Constraint_Error is raised. Note that if a minus sign is present, and
-- the integer value is non-zero, then constraint error will be raised.
-- Constraint_Error is raised.
--
-- Note: these rules correspond to the requirements for leaving the pointer
-- positioned in Text_Io.Get
-- positioned in Text_IO.Get
--
-- Note: if Str is null, i.e. if Max is less than Ptr, then this is a
-- Note: if Str is empty, i.e. if Max is less than Ptr, then this is a
-- special case of an all-blank string, and Ptr is unchanged, and hence
-- is greater than Max as required in this case.
function Scan_Long_Long_Unsigned
(Str : String;
Ptr : access Integer;
Max : Integer) return System.Unsigned_Types.Long_Long_Unsigned;
-- Same as Scan_Raw_Long_Long_Unsigned, except scans optional leading
-- blanks, and an optional leading plus sign.
-- Note: if a minus sign is present, Constraint_Error will be raised.
-- Note: trailing blanks are not scanned.
function Value_Long_Long_Unsigned
(Str : String) return System.Unsigned_Types.Long_Long_Unsigned;
-- Used in computing X'Value (Str) where X is a modular integer type whose
......
gcc/ada/s-valuns.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2006, 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- --
......@@ -36,11 +36,11 @@ with System.Val_Util; use System.Val_Util;
package body System.Val_Uns is
-------------------
-- Scan_Unsigned --
-------------------
-----------------------
-- Scan_Raw_Unsigned --
-----------------------
function Scan_Unsigned
function Scan_Raw_Unsigned
(Str : String;
Ptr : access Integer;
Max : Integer) return Unsigned
......@@ -54,17 +54,9 @@ package body System.Val_Uns is
Expon : Integer;
-- Exponent value
Minus : Boolean := False;
-- Set to True if minus sign is present, otherwise to False. Note that
-- a minus sign is permissible for the singular case of -0, and in any
-- case the pointer is left pointing past a negative integer literal.
Overflow : Boolean := False;
-- Set True if overflow is detected at any point
Start : Positive;
-- Save location of first non-blank character
Base_Char : Character;
-- Base character (# or :) in based case
......@@ -75,13 +67,6 @@ package body System.Val_Uns is
-- Digit value
begin
Scan_Sign (Str, Ptr, Max, Minus, Start);
if Str (Ptr.all) not in '0' .. '9' then
Ptr.all := Start;
raise Constraint_Error;
end if;
P := Ptr.all;
Uval := Character'Pos (Str (P)) - Character'Pos ('0');
P := P + 1;
......@@ -270,11 +255,34 @@ package body System.Val_Uns is
-- Return result, dealing with sign and overflow
if Overflow or else (Minus and then Uval /= 0) then
if Overflow then
raise Constraint_Error;
else
return Uval;
end if;
end Scan_Raw_Unsigned;
-------------------
-- Scan_Unsigned --
-------------------
function Scan_Unsigned
(Str : String;
Ptr : access Integer;
Max : Integer) return Unsigned
is
Start : Positive;
-- Save location of first non-blank character
begin
Scan_Plus_Sign (Str, Ptr, Max, Start);
if Str (Ptr.all) not in '0' .. '9' then
Ptr.all := Start;
raise Constraint_Error;
end if;
return Scan_Raw_Unsigned (Str, Ptr, Max);
end Scan_Unsigned;
--------------------
......
gcc/ada/s-valuns.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2006, 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- --
......@@ -32,25 +32,26 @@
------------------------------------------------------------------------------
-- This package contains routines for scanning modular Unsigned
-- values for use in Text_IO.Modular, and the Value attribute.
-- values for use in Text_IO.Modular_IO, and the Value attribute.
with System.Unsigned_Types;
package System.Val_Uns is
pragma Pure;
function Scan_Unsigned
function Scan_Raw_Unsigned
(Str : String;
Ptr : access Integer;
Max : Integer) return System.Unsigned_Types.Unsigned;
-- This function scans the string starting at Str (Ptr.all) for a valid
-- integer according to the syntax described in (RM 3.5(43)). The substring
-- scanned extends no further than Str (Max). There are three cases for the
-- return:
-- scanned extends no further than Str (Max). Note: this does not scan
-- leading or trailing blanks, nor leading sign.
--
-- There are three cases for the return:
--
-- If a valid integer is found after scanning past any initial spaces, then
-- Ptr.all is updated past the last character of the integer (but trailing
-- spaces are not scanned out).
-- If a valid integer is found, then Ptr.all is updated past the last
-- character of the integer.
--
-- If no valid integer is found, then Ptr.all points either to an initial
-- non-digit character, or to Max + 1 if the field is all spaces and the
......@@ -59,16 +60,24 @@ package System.Val_Uns is
-- If a syntactically valid integer is scanned, but the value is out of
-- range, or, in the based case, the base value is out of range or there
-- is an out of range digit, then Ptr.all points past the integer, and
-- Constraint_Error is raised. Note that if a minus sign is present, and
-- the integer value is non-zero, then constraint error will be raised.
-- Constraint_Error is raised.
--
-- Note: these rules correspond to the requirements for leaving the pointer
-- positioned in Text_Io.Get
-- positioned in Text_IO.Get
--
-- Note: if Str is null, i.e. if Max is less than Ptr, then this is a
-- Note: if Str is empty, i.e. if Max is less than Ptr, then this is a
-- special case of an all-blank string, and Ptr is unchanged, and hence
-- is greater than Max as required in this case.
function Scan_Unsigned
(Str : String;
Ptr : access Integer;
Max : Integer) return System.Unsigned_Types.Unsigned;
-- Same as Scan_Raw_Unsigned, except scans optional leading
-- blanks, and an optional leading plus sign.
-- Note: if a minus sign is present, Constraint_Error will be raised.
-- Note: trailing blanks are not scanned.
function Value_Unsigned
(Str : String) return System.Unsigned_Types.Unsigned;
-- Used in computing X'Value (Str) where X is a modular integer type whose
......
gcc/ada/s-valuti.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2006, 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- --
......@@ -159,6 +159,50 @@ package body System.Val_Util is
end Scan_Exponent;
--------------------
-- Scan_Plus_Sign --
--------------------
procedure Scan_Plus_Sign
(Str : String;
Ptr : access Integer;
Max : Integer;
Start : out Positive)
is
P : Natural := Ptr.all;
begin
if P > Max then
raise Constraint_Error;
end if;
-- Scan past initial blanks
while Str (P) = ' ' loop
P := P + 1;
if P > Max then
Ptr.all := P;
raise Constraint_Error;
end if;
end loop;
Start := P;
-- Skip past an initial plus sign
if Str (P) = '+' then
P := P + 1;
if P > Max then
Ptr.all := Start;
raise Constraint_Error;
end if;
end if;
Ptr.all := P;
end Scan_Plus_Sign;
---------------
-- Scan_Sign --
---------------
......
gcc/ada/s-valuti.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2006, 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- --
......@@ -70,6 +70,14 @@ package System.Val_Util is
-- is greater than Max as required in this case. Constraint_Error is
-- also raised in this case.
procedure Scan_Plus_Sign
(Str : String;
Ptr : access Integer;
Max : Integer;
Start : out Positive);
-- Same as Scan_Sign, but allows only plus, not minus.
-- This is used for modular types.
function Scan_Exponent
(Str : String;
Ptr : access Integer;
......
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