paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-10 05:46:14 +02:00
Code Issues Packages Projects Releases Wiki Activity

* use rounding correction in str_real based on smallest possible

Browse Source 
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 -
This commit is contained in:
Jonas Maebe 2008-05-21 16:55:31 +00:00
parent f00beea41c
commit ecf4aa7f55
7 changed files with 36 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -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

34
rtl/inc/real2str.inc
View File

@ -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);

6
tests/test/cg/tstr.pp
View File

@ -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

17
tests/webtbs/tw11308.pp Normal file
View File

@ -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.

2
tests/webtbs/tw1792a.pp
View File

@ -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}

2
tests/webtbs/tw2226.pp
View File

@ -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);

2
tests/webtbs/tw2643.pp
View File

@ -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