* 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

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

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

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

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.

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}

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

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