diff options
author | charlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4> | 2006-02-15 09:46:41 +0000 |
---|---|---|
committer | charlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4> | 2006-02-15 09:46:41 +0000 |
commit | 9ce02b233ca3dcfa6be1a342fb0747113b3c7693 (patch) | |
tree | cc8ecc6bf75735f2544635ed3a30db37cf84caf2 /gcc/ada | |
parent | a6eae12a1d4f6ac29bab2e0eeb21f6a937a4e7f2 (diff) | |
download | gcc-9ce02b233ca3dcfa6be1a342fb0747113b3c7693.tar.gz |
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.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@111101 138bc75d-0d04-0410-961f-82ee72b054a4
Diffstat (limited to 'gcc/ada')
-rw-r--r-- | gcc/ada/s-valint.adb | 10 | ||||
-rw-r--r-- | gcc/ada/s-vallli.adb | 19 | ||||
-rw-r--r-- | gcc/ada/s-valllu.adb | 50 | ||||
-rw-r--r-- | gcc/ada/s-valllu.ads | 33 | ||||
-rw-r--r-- | gcc/ada/s-valuns.adb | 50 | ||||
-rw-r--r-- | gcc/ada/s-valuns.ads | 33 | ||||
-rw-r--r-- | gcc/ada/s-valuti.adb | 46 | ||||
-rw-r--r-- | gcc/ada/s-valuti.ads | 10 |
8 files changed, 175 insertions, 76 deletions
diff --git a/gcc/ada/s-valint.adb b/gcc/ada/s-valint.adb index 8bfb3733d4b..60c761fdfd3 100644 --- a/gcc/ada/s-valint.adb +++ b/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 diff --git a/gcc/ada/s-vallli.adb b/gcc/ada/s-vallli.adb index ad54db94607..850bdf1b7a9 100644 --- a/gcc/ada/s-vallli.adb +++ b/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; diff --git a/gcc/ada/s-valllu.adb b/gcc/ada/s-valllu.adb index ca4cbb2a38c..ab5752f4c7c 100644 --- a/gcc/ada/s-valllu.adb +++ b/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; ------------------------------ diff --git a/gcc/ada/s-valllu.ads b/gcc/ada/s-valllu.ads index 603e4b6bc80..e6c740f8a50 100644 --- a/gcc/ada/s-valllu.ads +++ b/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 diff --git a/gcc/ada/s-valuns.adb b/gcc/ada/s-valuns.adb index 885db28f3c7..d9d7940a356 100644 --- a/gcc/ada/s-valuns.adb +++ b/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; -------------------- diff --git a/gcc/ada/s-valuns.ads b/gcc/ada/s-valuns.ads index bd41849e98f..7503ca4b720 100644 --- a/gcc/ada/s-valuns.ads +++ b/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 diff --git a/gcc/ada/s-valuti.adb b/gcc/ada/s-valuti.adb index 07f067b79cc..258620e24b6 100644 --- a/gcc/ada/s-valuti.adb +++ b/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 -- --------------- diff --git a/gcc/ada/s-valuti.ads b/gcc/ada/s-valuti.ads index ac905096862..944b945a2ae 100644 --- a/gcc/ada/s-valuti.ads +++ b/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; |