* Merging revisions 46778 from trunk:release_3_2_0

    ------------------------------------------------------------------------
    r46778 | jonas | 2020-09-05 20:44:57 +0200 (Sat, 05 Sep 2020) | 2 lines
    
      * fix formatfloat for 0 in exponential format (based on patch by
        Jamie Philbrook, mantis #37374)
    ------------------------------------------------------------------------


git-svn-id: https://svn.freepascal.org/svn/fpc/tags/release_3_2_0@47409 3ad0048d-3df7-0310-abae-a5850022a9f2

2 files changed, 203 insertions, 3 deletions

diff --git a/rtl/objpas/sysutils/fmtflt.inc b/rtl/objpas/sysutils/fmtflt.inc
index 999908261f..2c6c5802ea 100644
--- a/rtl/objpas/sysutils/fmtflt.inc
+++ b/rtl/objpas/sysutils/fmtflt.inc
@@ -298,11 +298,13 @@ var
   Function FormatExponent(ASign: FChar; aExponent: Integer) : FString;
 
   begin
-    Result:=IntToStr(aExponent);
+    if E = 0 then
+      aExponent := 0;
+    Result:=IntToStr(Abs(aExponent));
     Result:=StringOfChar('0',ExpSize-Length(Result))+Result;
     if (aExponent<0) then
       Result:='-'+Result
-    else if (aExponent>0) and (aSign='+') then
+    else if (aExponent>=0) and (aSign='+') then
       Result:=aSign+Result;
   end;
 
@@ -383,7 +385,12 @@ begin
                 Inc(I);
               end;
             end;
-          end;  
+          end
+        else if I< SectionLength Then
+          begin
+          inc(I);
+          ToResult(Section[i]);
+          end;
         end;
       else
         ToResult(C);
diff --git a/tests/test/units/sysutils/tw37374.pp b/tests/test/units/sysutils/tw37374.pp
new file mode 100755
index 0000000000..c8acbfd150
--- /dev/null
+++ b/tests/test/units/sysutils/tw37374.pp
@@ -0,0 +1,193 @@
+program formatfloat_test;
+
+uses
+  SysUtils//, MyFormatFloat
+  ;
+
+var
+  fails: Integer = 0;
+  testCount: Integer = 0;
+
+  procedure Test(AFormat: String; AValue: Double; AResult: String);
+  var
+    s: String;
+  begin
+    s := FormatFloat(AFormat, AValue);
+    if s <> AResult then
+    begin
+      WriteLn('Format(' + AFormat + ', ', AValue:0:6, ') --> ', s, '; SHOULD BE: ', AResult);
+      inc(fails);
+    end;
+    inc(testCount);
+  end;
+
+const
+  VALUES: array[0..4] of Double = (0, 0.00001234, 0.123456, 1.23456, 1123.4567);
+var
+  fmt: String;
+
+begin
+  DefaultFormatSettings.DecimalSeparator := '.';
+  DefaultFormatSettings.ThousandSeparator := ',';
+
+  fmt := '0.00';
+  Test(fmt, VALUES[0], '0.00');
+  Test(fmt, VALUES[1], '0.00');
+  Test(fmt, VALUES[2], '0.12');
+  Test(fmt, VALUES[3], '1.23');
+  Test(fmt, VALUES[4], '1123.46');
+  Test(fmt, -VALUES[1], '-0.00');
+  Test(fmt, -VALUES[2], '-0.12');
+  Test(fmt, -VALUES[3], '-1.23');
+  Test(fmt, -VALUES[4], '-1123.46');
+
+  fmt := '.00';
+  Test(fmt, VALUES[0], '.00');
+  Test(fmt, VALUES[1], '.00');
+  Test(fmt, VALUES[2], '.12');
+  Test(fmt, VALUES[3], '1.23');
+  Test(fmt, VALUES[4], '1123.46');
+  Test(fmt, -VALUES[1], '-.00');
+  Test(fmt, -VALUES[2], '-.12');
+  Test(fmt, -VALUES[3], '-1.23');
+  Test(fmt, -VALUES[4], '-1123.46');
+
+  fmt := '0.00000###';
+  Test(fmt, VALUES[0], '0.00000');
+  Test(fmt, VALUES[1], '0.00001234');
+  Test(fmt, VALUES[2], '0.123456');
+  Test(fmt, VALUES[3], '1.23456');
+  Test(fmt, VALUES[4], '1123.45670');
+  Test(fmt, -VALUES[1], '-0.00001234');
+  Test(fmt, -VALUES[2], '-0.123456');
+  Test(fmt, -VALUES[3], '-1.23456');
+  Test(fmt, -VALUES[4], '-1123.45670');
+
+  fmt := '000';
+  Test(fmt, VALUES[0], '000');
+  Test(fmt, VALUES[1], '000');
+  Test(fmt, VALUES[2], '000');
+  Test(fmt, VALUES[3], '001');
+  Test(fmt, VALUES[4], '1123');
+  Test(fmt, -VALUES[1], '-000');
+  Test(fmt, -VALUES[2], '-000');
+  Test(fmt, -VALUES[3], '-001');
+  Test(fmt, -VALUES[4], '-1123');
+
+  fmt := '0.00E+00';
+  Test(fmt, VALUES[0], '0.00E+00');
+  Test(fmt, VALUES[1], '1.23E-05');
+  Test(fmt, VALUES[2], '1.23E-01');
+  Test(fmt, VALUES[3], '1.23E+00');
+  Test(fmt, VALUES[4], '1.12E+03');
+  Test(fmt, -VALUES[1], '-1.23E-05');
+  Test(fmt, -VALUES[2], '-1.23E-01');
+  Test(fmt, -VALUES[3], '-1.23E+00');
+  Test(fmt, -VALUES[4], '-1.12E+03');
+
+  fmt := '0.00E-00';
+  Test(fmt, VALUES[0], '0.00E00');
+  Test(fmt, VALUES[1], '1.23E-05');
+  Test(fmt, VALUES[2], '1.23E-01');
+  Test(fmt, VALUES[3], '1.23E00');
+  Test(fmt, VALUES[4], '1.12E03');
+  Test(fmt, -VALUES[1], '-1.23E-05');
+  Test(fmt, -VALUES[2], '-1.23E-01');
+  Test(fmt, -VALUES[3], '-1.23E00');
+  Test(fmt, -VALUES[4], '-1.12E03');
+
+  fmt := '0.00 EUR';
+  Test(fmt, VALUES[0], '0.00 EUR');
+  Test(fmt, VALUES[1], '0.00 EUR');
+  Test(fmt, VALUES[2], '0.12 EUR');
+  Test(fmt, VALUES[3], '1.23 EUR');
+  Test(fmt, VALUES[4], '1123.46 EUR');
+  Test(fmt, -VALUES[1], '-0.00 EUR');
+  Test(fmt, -VALUES[2], '-0.12 EUR');
+  Test(fmt, -VALUES[3], '-1.23 EUR');
+  Test(fmt, -VALUES[4], '-1123.46 EUR');
+
+  fmt := '0.00 "EUR"';
+  Test(fmt, VALUES[0], '0.00 EUR');
+  Test(fmt, VALUES[1], '0.00 EUR');
+  Test(fmt, VALUES[2], '0.12 EUR');
+  Test(fmt, VALUES[3], '1.23 EUR');
+  Test(fmt, VALUES[4], '1123.46 EUR');
+  Test(fmt, -VALUES[1], '-0.00 EUR');
+  Test(fmt, -VALUES[2], '-0.12 EUR');
+  Test(fmt, -VALUES[3], '-1.23 EUR');
+  Test(fmt, -VALUES[4], '-1123.46 EUR');
+
+  fmt := '0.00"E+00"';
+  Test(fmt, VALUES[0], '0.00E+00');
+  Test(fmt, VALUES[1], '0.00E+00');
+  Test(fmt, VALUES[2], '0.12E+00');
+  Test(fmt, VALUES[3], '1.23E+00');
+  Test(fmt, VALUES[4], '1123.46E+00');
+  Test(fmt, -VALUES[1], '-0.00E+00');
+  Test(fmt, -VALUES[2], '-0.12E+00');
+  Test(fmt, -VALUES[3], '-1.23E+00');
+  Test(fmt, -VALUES[4], '-1123.46E+00');
+
+  fmt := '#,##0.0';
+  Test(fmt, VALUES[0], '0.0');
+  Test(fmt, VALUES[1], '0.0');
+  Test(fmt, VALUES[2], '0.1');
+  Test(fmt, VALUES[3], '1.2');
+  Test(fmt, VALUES[4], '1,123.5');
+  Test(fmt, -VALUES[1], '-0.0');
+  Test(fmt, -VALUES[2], '-0.1');
+  Test(fmt, -VALUES[3], '-1.2');
+  Test(fmt, -VALUES[4], '-1,123.5');
+
+  fmt := ',0.0';
+  Test(fmt, VALUES[0], '0.0');
+  Test(fmt, VALUES[1], '0.0');
+  Test(fmt, VALUES[2], '0.1');
+  Test(fmt, VALUES[3], '1.2');
+  Test(fmt, VALUES[4], '1,123.5');
+  Test(fmt, -VALUES[1], '-0.0');
+  Test(fmt, -VALUES[2], '-0.1');
+  Test(fmt, -VALUES[3], '-1.2');
+  Test(fmt, -VALUES[4], '-1,123.5');
+
+  fmt := '#,##0.00;(#,##0.00);zero';
+  Test(fmt, VALUES[0], 'zero');
+  Test(fmt, VALUES[1], '0.00');
+  Test(fmt, VALUES[2], '0.12');
+  Test(fmt, VALUES[3], '1.23');
+  Test(fmt, VALUES[4], '1,123.46');
+  Test(fmt, -VALUES[1], '(0.00)');
+  Test(fmt, -VALUES[2], '(0.12)');
+  Test(fmt, -VALUES[3], '(1.23)');
+  Test(fmt, -VALUES[4], '(1,123.46)');
+
+  fmt := '#,##0.00 EUR;(#,##0.00 EUR);zero';
+  Test(fmt, VALUES[0], 'zero');
+  Test(fmt, VALUES[1], '0.00 EUR');
+  Test(fmt, VALUES[2], '0.12 EUR');
+  Test(fmt, VALUES[3], '1.23 EUR');
+  Test(fmt, VALUES[4], '1,123.46 EUR');
+  Test(fmt, -VALUES[1], '(0.00 EUR)');
+  Test(fmt, -VALUES[2], '(0.12 EUR)');
+  Test(fmt, -VALUES[3], '(1.23 EUR)');
+  Test(fmt, -VALUES[4], '(1,123.46 EUR)');
+
+  fmt := 'EUR #,##0.00;(EUR #,##0.00);-';
+  Test(fmt, VALUES[0], '-');
+  Test(fmt, VALUES[1], 'EUR 0.00');
+  Test(fmt, VALUES[2], 'EUR 0.12');
+  Test(fmt, VALUES[3], 'EUR 1.23');
+  Test(fmt, VALUES[4], 'EUR 1,123.46');
+  Test(fmt, -VALUES[1], '(EUR 0.00)');
+  Test(fmt, -VALUES[2], '(EUR 0.12)');
+  Test(fmt, -VALUES[3], '(EUR 1.23)');
+  Test(fmt, -VALUES[4], '(EUR 1,123.46)');
+
+  WriteLn(testCount, ' tests executed.');
+  if fails = 0 then
+    WriteLn('All tests passed.')
+  else
+    halt(1);
+end.
+