From ecf4aa7f55129d7622acb3b54d900dc2c8a4f83f Mon Sep 17 00:00:00 2001 From: Jonas Maebe Date: Wed, 21 May 2008 16:55:31 +0000 Subject: [PATCH] * use rounding correction in str_real based on smallest possible delta for which 1.0 and 1.0+delta is different, rather than some power-of-10 ballpark equivalent (fixes mantis #11308) * print the same number of digits for doubles on systems which support extended as on those which don't (i.e., one digit less on the former). This solves regressions after the previous change and is Delphi-compatible. * adapted tests for the previous change git-svn-id: trunk@11025 - --- .gitattributes | 1 + rtl/inc/real2str.inc | 34 ++++++++++++---------------------- tests/test/cg/tstr.pp | 6 +++--- tests/webtbs/tw11308.pp | 17 +++++++++++++++++ tests/webtbs/tw1792a.pp | 2 +- tests/webtbs/tw2226.pp | 2 +- tests/webtbs/tw2643.pp | 2 +- 7 files changed, 36 insertions(+), 28 deletions(-) create mode 100644 tests/webtbs/tw11308.pp diff --git a/.gitattributes b/.gitattributes index 9f1b5ba566..b932e446ea 100644 --- a/.gitattributes +++ b/.gitattributes @@ -8275,6 +8275,7 @@ tests/webtbs/tw11254.pp svneol=native#text/plain tests/webtbs/tw11255.pp svneol=native#text/plain tests/webtbs/tw11288.pp svneol=native#text/plain tests/webtbs/tw11290.pp svneol=native#text/plain +tests/webtbs/tw11308.pp svneol=native#text/plain tests/webtbs/tw11312.pp svneol=native#text/plain tests/webtbs/tw1132.pp svneol=native#text/plain tests/webtbs/tw1133.pp svneol=native#text/plain diff --git a/rtl/inc/real2str.inc b/rtl/inc/real2str.inc index d66d4c6dd2..7c33f5fdb9 100644 --- a/rtl/inc/real2str.inc +++ b/rtl/inc/real2str.inc @@ -173,7 +173,7 @@ const { the fractional part is not used for rounding later } currprec := -1; { instead, round based on the next whole digit } - if (int(intPartStack[stackPtr]-corrVal) > 5.0 - roundCorr) then + if (int(intPartStack[stackPtr]-corrVal+roundcorr) >= 5.0) then roundStr(temp,spos); end; {$ifdef DEBUG_NASM} @@ -189,24 +189,13 @@ begin minlen:=8; explen:=4; { correction used with comparing to avoid rounding/precision errors } - roundCorr := (1/exp((16-4-3)*ln(10))); + roundCorr := 1.1920928955e-07; end; rt_s64real : begin -{ if the maximum supported type is double, we can print out one digit } -{ less, because otherwise we can't round properly and 1e-400 becomes } -{ 0.99999999999e-400 (JM) } -{$ifdef support_extended} - maxlen:=23; - { correction used with comparing to avoid rounding/precision errors } - roundCorr := (1/exp((23-5-3)*ln(10))); -{$else support_extended} -{$ifdef support_double} maxlen := 22; { correction used with comparing to avoid rounding/precision errors } - roundCorr := (1/exp((22-4-3)*ln(10))); -{$endif support_double} -{$endif support_extended} + roundCorr := 2.2204460493e-16; minlen:=9; explen:=5; end; @@ -217,7 +206,7 @@ begin minlen:=10; explen:=6; { correction used with comparing to avoid rounding/precision errors } - roundCorr := (1/exp((25-6-3)*ln(10))); + roundCorr := 1.0842021725e-19; end; rt_c64bit : begin @@ -226,7 +215,7 @@ begin { according to TP (was 5) (FK) } explen:=6; { correction used with comparing to avoid rounding/precision errors } - roundCorr := (1/exp((23-6-3)*ln(10))); + roundCorr := 2.2204460493e-16; end; rt_currency : begin @@ -235,7 +224,7 @@ begin minlen:=10; explen:=0; { correction used with comparing to avoid rounding/precision errors } - roundCorr := (1/exp((25-6-3)*ln(10))); + roundCorr := 1.0842021725e-19; end; rt_s128real : begin @@ -244,7 +233,7 @@ begin minlen:=10; explen:=6; { correction used with comparing to avoid rounding/precision errors } - roundCorr := (1/exp((25-6-3)*ln(10))); + roundCorr := 1.0842021725e-19; end; end; { check parameters } @@ -378,12 +367,13 @@ begin for fracCount := 1 to currPrec do factor := factor * 10.0; corrval := corrval / factor; - if d >= corrVal-roundCorr then + d:=d+roundCorr; + if d >= corrVal then d := d + corrVal; - if int(d+roundCorr) = 1 then + if int(d) = 1 then begin roundStr(temp,spos); - d := frac(d+roundCorr); + d := frac(d); if (f < 0) then begin dec(currprec); @@ -397,7 +387,7 @@ begin { calculate the necessary fractional digits } for fracCount := 1 to currPrec do begin - if d > 1.0- roundCorr then + if d > 1.0 then d := frac(d) * 10.0 else d := d * 10.0; inc(spos); diff --git a/tests/test/cg/tstr.pp b/tests/test/cg/tstr.pp index ba859755ed..d445ff9d44 100644 --- a/tests/test/cg/tstr.pp +++ b/tests/test/cg/tstr.pp @@ -68,7 +68,7 @@ begin str(f,s); if (sizeof(extended) = 10) or (sizeof(extended) = 12) then - check('-1.123450000000000E+000') + check('-1.12345000000000E+000') else if sizeof(extended) = 8 then check('-1.12345000000000E+000') else @@ -252,7 +252,7 @@ begin str(f,s); if (sizeof(extended) = 10) or (sizeof(extended) = 12) then - check('-1.123450000000000E+000') + check('-1.12345000000000E+000') else if sizeof(extended) = 8 then check('-1.12345000000000E+000') else @@ -436,7 +436,7 @@ begin {$IFOPT E-} str(f,s); if sizeof(extended) = 10 then - check('-1.123450000000000E+000') + check('-1.12345000000000E+000') else if sizeof(extended) = 8 then check('-1.12345000000000E+000') else diff --git a/tests/webtbs/tw11308.pp b/tests/webtbs/tw11308.pp new file mode 100644 index 0000000000..6560ed303f --- /dev/null +++ b/tests/webtbs/tw11308.pp @@ -0,0 +1,17 @@ +uses + sysutils; + +var + s: string; +begin + str(1.575:0:2,s); + writeln(s); + if (s<>'1.58') then + halt(1); + str(0.575:0:2,s); + writeln(s); + if (s<>'0.58') then + halt(2); +// writeln(FloatToStrF(1.575 ,ffFixed,19,2)); +// writeln(FloatToStrF(0.575 ,ffFixed,19,2)); +end. diff --git a/tests/webtbs/tw1792a.pp b/tests/webtbs/tw1792a.pp index c2ba829c0e..ea3a4aca1f 100644 --- a/tests/webtbs/tw1792a.pp +++ b/tests/webtbs/tw1792a.pp @@ -15,7 +15,7 @@ Begin {$ifdef FPC_HAS_TYPE_DOUBLE} str(double(intpower(2,63)),s); {$ifdef FPC_HAS_TYPE_EXTENDED} - if s<>' 9.223372036854776E+018' then + if s<>' 9.22337203685478E+018' then {$else FPC_HAS_TYPE_EXTENDED} if s<>' 9.22337203685478E+018' then {$endif FPC_HAS_TYPE_EXTENDED} diff --git a/tests/webtbs/tw2226.pp b/tests/webtbs/tw2226.pp index 0012a69868..85618a576d 100644 --- a/tests/webtbs/tw2226.pp +++ b/tests/webtbs/tw2226.pp @@ -10,7 +10,7 @@ var correct : string; begin case sizeof(extended) of - 10: correct := ' -Inf'; + 10: correct := ' -Inf'; 8: correct := ' -Inf'; end; str(mindouble,s); diff --git a/tests/webtbs/tw2643.pp b/tests/webtbs/tw2643.pp index 205ef82fd4..2b395f7da8 100644 --- a/tests/webtbs/tw2643.pp +++ b/tests/webtbs/tw2643.pp @@ -21,7 +21,7 @@ begin end; str(d,s); if sizeof(extended) > 8 then - s1 := ' 5.168568500000000E+006' + s1 := ' 5.16856850000000E+006' else s1 := ' 5.16856850000000E+006'; if s<>s1 then