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

    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 -

.gitattributes

@@ -9233,6 +9233,7 @@ tests/webtbs/tw14149.pp svneol=native#text/plain
 tests/webtbs/tw14155.pp svneol=native#text/plain
 tests/webtbs/tw1416.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/tw1430.pp svneol=native#text/plain
 tests/webtbs/tw14307.pp svneol=native#text/plain

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

tests/webtbs/tw14230.pp

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