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

* no longer perform precision correction for single precision values, because

Browse Source 
we support writing more digits than are defined (due to Delphi-
    compatibility) and
   a) correcting the precision of undefined digits makes no sense
   b) as a result, this precision correction made some numbers that can be
      represented exactly in single precision inexact
    -- fixes mantis #14230
  * no longer perform precision correction while determining the whole part
    of numbers (usually did nothing anyway, and the rest is caught by the
    final rounding)

git-svn-id: trunk@13574 -
This commit is contained in:
Jonas Maebe 2009-08-22 07:49:06 +00:00
parent 146a819615
commit a1363e95f7
3 changed files with 51 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -9233,6 +9233,7 @@ tests/webtbs/tw14149.pp svneol=native#text/plain
tests/webtbs/tw14155.pp svneol=native#text/plain tests/webtbs/tw14155.pp svneol=native#text/plain
tests/webtbs/tw1416.pp svneol=native#text/plain tests/webtbs/tw1416.pp svneol=native#text/plain
tests/webtbs/tw14174.pp svneol=native#text/plain tests/webtbs/tw14174.pp svneol=native#text/plain
tests/webtbs/tw14230.pp svneol=native#text/plain
tests/webtbs/tw14236.pp svneol=native#text/plain tests/webtbs/tw14236.pp svneol=native#text/plain
tests/webtbs/tw1430.pp svneol=native#text/plain tests/webtbs/tw1430.pp svneol=native#text/plain
tests/webtbs/tw14307.pp svneol=native#text/plain tests/webtbs/tw14307.pp svneol=native#text/plain

11
rtl/inc/real2str.inc
View File

@ -173,7 +173,7 @@ const
{ the fractional part is not used for rounding later } { the fractional part is not used for rounding later }
currprec := -1; currprec := -1;
{ instead, round based on the next whole digit } { instead, round based on the next whole digit }
if (int(intPartStack[stackPtr]-corrVal+roundcorr) >= 5.0) then if (int(intPartStack[stackPtr]-corrVal) >= 5.0) then
roundStr(temp,spos); roundStr(temp,spos);
end; end;
{$ifdef DEBUG_NASM} {$ifdef DEBUG_NASM}
@ -367,10 +367,11 @@ begin
for fracCount := 1 to currPrec do for fracCount := 1 to currPrec do
factor := factor * 10.0; factor := factor * 10.0;
corrval := corrval / factor; corrval := corrval / factor;
{ d is currently in [0.0,1.0[ and roundcorr has been chosen so that { for single, we may write more significant digits than are available,
1.0+roundcorr <> 1.0 -> add d*roundcorr to d to scale the correction so the rounding correction itself can show up -> don't round in that
to the actual value of d } case
if (d<>0.0) then }
if real_type<>rt_s32real then
d:=d+d*roundCorr; d:=d+d*roundCorr;
if d >= corrVal then if d >= corrVal then
d := d + corrVal; d := d + corrVal;

44
tests/webtbs/tw14230.pp Normal file
View File

@ -0,0 +1,44 @@
program test2;
//The i's are used to have a better understanding of what is actually happening...
type
tsrec = record i: single; end;
var i,new_i:longword;
j,new_j:single;
k:double;
s:string;
Err:integer;
count:int64;
begin
randomize;
count:=0;
repeat
//As k is set to be a single-precision number, there should not be
//any rounding off or truncation problem...
k:=2*random-1;
j:=k;
i:=longword(tsrec(j));
Str(j,s);
Val(s,new_j,Err);
if (err<>0) then
break;
new_i:=longword(tsrec(new_j));
count:=count+1;
until count=50000;
if (new_i<>i) then
begin
writeln;
writeln('Error occurs');
writeln;
writeln(' err=',err);
writeln(' i=',i);
writeln(' j=',j);
writeln(' k=',k);
writeln;
writeln(' s=',s);
writeln;
writeln('new_i=',new_i);
writeln('new_j=',new_j);
writeln(' k=',k);
halt(1);
end;
end.