[Ada] Fix bugs in Integer'Value
Arnaud Charlet
charlet@adacore.com
Wed Feb 15 10:22:00 GMT 2006
Tested on i686-linux, committed on trunk
Integer'Value("- 5") was returning -5. Now it correctly raises
Constraint_Error; the non-leading blank is wrong. This was happening
because Scan_Integer was skipping leading-blanks-and-sign, then calling
Scan_Unsigned which was ALSO skipping leading-blanks-and-sign.
This test:
with Ada.Text_IO; use Ada.Text_IO;
procedure Value_Test is
generic
Type_Name : String;
type My_Int is (<>);
procedure Generic_Test (Image : String);
procedure Generic_Test (Image : String) is
-- Test cases where 'Value is expected to fail.
Val: My_Int;
begin
Put (Type_Name & "'Value (""" & Image & """) --> ");
Val := My_Int'Value (Image);
Put_Line (My_Int'Image (Val) & " -- ERROR!");
exception
when Constraint_Error =>
Put_Line ("Constraint_Error raised -- OK.");
end Generic_Test;
procedure Integer_Test is new Generic_Test ("Integer", Integer);
procedure Long_Integer_Test is new Generic_Test ("Long_Integer", Long_Integer);
type Modular is mod 1000;
procedure Modular_Test is new Generic_Test ("Modular", Modular);
X: Integer := Integer'First;
Most_Negative: constant String := Integer'Image (X);
Long_X: Long_Integer := Long_Integer'First;
Long_Most_Negative: constant String := Long_Integer'Image (Long_X);
begin
Integer_Test ("- 5");
Integer_Test ("- 5");
Integer_Test ("--5");
Integer_Test ("-+5");
Integer_Test ("+-5");
Integer_Test ("++5");
X := Integer'Value (Most_Negative);
Put_Line ("X = " & Integer'Image (X) & " -- OK.");
Long_X := Long_Integer'Value (Long_Most_Negative);
Put_Line ("Long_X = " & Long_Integer'Image (Long_X) & " -- OK.");
Long_Integer_Test ("- 5");
Long_Integer_Test ("- 5");
Long_Integer_Test ("--5");
Long_Integer_Test ("-+5");
Long_Integer_Test ("+-5");
Long_Integer_Test ("++5");
Modular_Test ("-0");
Modular_Test ("-5");
Modular_Test ("- 5");
Modular_Test ("- 5");
Modular_Test ("--5");
Modular_Test ("-+5");
Modular_Test ("+-5");
Modular_Test ("++5");
end Value_Test;
Should produce this output:
Integer'Value ("- 5") --> Constraint_Error raised -- OK.
Integer'Value ("- 5") --> Constraint_Error raised -- OK.
Integer'Value ("--5") --> Constraint_Error raised -- OK.
Integer'Value ("-+5") --> Constraint_Error raised -- OK.
Integer'Value ("+-5") --> Constraint_Error raised -- OK.
Integer'Value ("++5") --> Constraint_Error raised -- OK.
X = -2147483648 -- OK.
Long_X = -2147483648 -- OK.
Long_Integer'Value ("- 5") --> Constraint_Error raised -- OK.
Long_Integer'Value ("- 5") --> Constraint_Error raised -- OK.
Long_Integer'Value ("--5") --> Constraint_Error raised -- OK.
Long_Integer'Value ("-+5") --> Constraint_Error raised -- OK.
Long_Integer'Value ("+-5") --> Constraint_Error raised -- OK.
Long_Integer'Value ("++5") --> Constraint_Error raised -- OK.
Modular'Value ("-0") --> Constraint_Error raised -- OK.
Modular'Value ("-5") --> Constraint_Error raised -- OK.
Modular'Value ("- 5") --> Constraint_Error raised -- OK.
Modular'Value ("- 5") --> Constraint_Error raised -- OK.
Modular'Value ("--5") --> Constraint_Error raised -- OK.
Modular'Value ("-+5") --> Constraint_Error raised -- OK.
Modular'Value ("+-5") --> Constraint_Error raised -- OK.
Modular'Value ("++5") --> Constraint_Error raised -- OK.
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.
-------------- next part --------------
Index: s-valint.adb
===================================================================
--- s-valint.adb (revision 110833)
+++ s-valint.adb (working copy)
@@ -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,8 +57,14 @@
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
if Uval > Unsigned (Integer'Last) then
Index: s-vallli.adb
===================================================================
--- s-vallli.adb (revision 110833)
+++ s-vallli.adb (working copy)
@@ -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 @@
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 @@
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;
Index: s-valllu.ads
===================================================================
--- s-valllu.ads (revision 110833)
+++ s-valllu.ads (working copy)
@@ -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,19 +39,20 @@
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.
--
- -- 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).
+ -- There are three cases for the return:
--
+ -- 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
-- exception Constraint_Error is raised.
@@ -59,16 +60,24 @@
-- 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
Index: s-valllu.adb
===================================================================
--- s-valllu.adb (revision 110833)
+++ s-valllu.adb (working copy)
@@ -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 @@
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 @@
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 @@
-- 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 @@
-- 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;
------------------------------
Index: s-valuns.ads
===================================================================
--- s-valuns.ads (revision 110833)
+++ s-valuns.ads (working copy)
@@ -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,26 +32,27 @@
------------------------------------------------------------------------------
-- 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.
--
- -- 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).
+ -- There are three cases for the return:
--
+ -- 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
-- exception Constraint_Error is raised.
@@ -59,16 +60,24 @@
-- 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
Index: s-valuns.adb
===================================================================
--- s-valuns.adb (revision 110833)
+++ s-valuns.adb (working copy)
@@ -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 @@
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 @@
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 @@
-- 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 @@
-- 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;
--------------------
Index: s-valuti.ads
===================================================================
--- s-valuti.ads (revision 110833)
+++ s-valuti.ads (working copy)
@@ -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 @@
-- 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;
Index: s-valuti.adb
===================================================================
--- s-valuti.adb (revision 110833)
+++ s-valuti.adb (working copy)
@@ -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 @@
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 --
---------------
More information about the Gcc-patches
mailing list