From 27e62da61b0bf3718a418d43a0a6c71dfc35cae7 Mon Sep 17 00:00:00 2001 From: michael Date: Fri, 13 Nov 2020 20:41:07 +0000 Subject: * Merging revisions 46778 from trunk: ------------------------------------------------------------------------ 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 --- rtl/objpas/sysutils/fmtflt.inc | 13 ++- tests/test/units/sysutils/tw37374.pp | 193 +++++++++++++++++++++++++++++++++++ 2 files changed, 203 insertions(+), 3 deletions(-) create mode 100755 tests/test/units/sysutils/tw37374.pp 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. + -- cgit v1.2.1