math.parser: don't accept hex float without expt

Part of #372
db4
Joe Groff 2011-11-26 15:15:46 -08:00
parent e58afa8ab5
commit a97a9ede15
2 changed files with 21 additions and 9 deletions

View File

@ -220,14 +220,14 @@ unit-test
[ "1.0p-1074" ] [ 1 bits>double >hex ] unit-test
[ "-0.0" ] [ -0.0 >hex ] unit-test
[ 1.0 ] [ "1.0" hex> ] unit-test
[ 1.5 ] [ "1.8" hex> ] unit-test
[ 1.875 ] [ "1.e" hex> ] unit-test
[ 1.90625 ] [ "1.e8" hex> ] unit-test
[ 1.03125 ] [ "1.08" hex> ] unit-test
[ 15.5 ] [ "f.8" hex> ] unit-test
[ 15.53125 ] [ "f.88" hex> ] unit-test
[ -15.5 ] [ "-f.8" hex> ] unit-test
[ 1.0 ] [ "1.0p0" hex> ] unit-test
[ 1.5 ] [ "1.8p0" hex> ] unit-test
[ 1.875 ] [ "1.ep0" hex> ] unit-test
[ 1.90625 ] [ "1.e8p0" hex> ] unit-test
[ 1.03125 ] [ "1.08p0" hex> ] unit-test
[ 15.5 ] [ "f.8p0" hex> ] unit-test
[ 15.53125 ] [ "f.88p0" hex> ] unit-test
[ -15.5 ] [ "-f.8p0" hex> ] unit-test
[ 15.5 ] [ "f.8p0" hex> ] unit-test
[ -15.5 ] [ "-f.8p0" hex> ] unit-test
[ 62.0 ] [ "f.8p2" hex> ] unit-test
@ -285,3 +285,7 @@ unit-test
[ f ] [ "0x1," string>number ] unit-test
[ f ] [ "0b1," string>number ] unit-test
[ f ] [ "0o1," string>number ] unit-test
! #372
! hex float requires exponent
[ f ] [ "0x1.0" string>number ] unit-test

View File

@ -74,8 +74,16 @@ TUPLE: float-parse
[ nip swap /f ]
[ drop 2.0 swap exponent>> (pow) * ] 2tri ; inline
: ?default-exponent ( float-parse n/f -- float-parse' n/f' )
over exponent>> [
over radix>> 10 =
[ [ [ radix>> ] [ point>> ] bi 0 float-parse boa ] dip ]
[ drop f ] if
] unless ; inline
: ?make-float ( float-parse n/f -- float/f )
{ float-parse object } declare
?default-exponent
{
{ [ dup not ] [ 2drop f ] }
{ [ over radix>> 10 = ] [ make-float-dec-exponent ] }
@ -98,7 +106,7 @@ TUPLE: float-parse
-rot [ str>> ] [ length>> ] bi 10 number-parse boa 0 ; inline
: <float-parse> ( i number-parse n -- float-parse i number-parse n )
[ drop nip radix>> 0 0 float-parse boa ] 3keep ; inline
[ drop nip radix>> 0 f float-parse boa ] 3keep ; inline
DEFER: @exponent-digit
DEFER: @mantissa-digit