mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-17 10:39:33 +02:00
* let FloatToStr output the correct number of decimals in case the
first significant digit is preceded by several zeroes (patch by
C. Western, mantis #16907)
git-svn-id: trunk@19738 -
This commit is contained in:
Jonas Maebe
parent
e2b5ba756d
commit
a4804a3c25
@ -1161,8 +1161,8 @@ const
|
||||
|
||||
Function FloatToStrFIntl(const Value; format: TFloatFormat; Precision, Digits: Integer; ValueType: TFloatValue; Const FormatSettings: TFormatSettings): String;
|
||||
Var
|
||||
P: Integer;
|
||||
Negative, TooSmall, TooLarge: Boolean;
|
||||
P, PE, Q, Exponent: Integer;
|
||||
Negative: Boolean;
|
||||
DS: Char;
|
||||
|
||||
function RemoveLeadingNegativeSign(var AValue: String): Boolean;
|
||||
@ -1197,82 +1197,102 @@ Begin
|
||||
Begin
|
||||
case ValueType of
|
||||
fvCurrency:
|
||||
begin
|
||||
If (Precision = -1) Or (Precision > 19) Then Precision := 19;
|
||||
TooSmall:=False;
|
||||
end;
|
||||
else
|
||||
begin
|
||||
If (Precision = -1) Or (Precision > maxdigits) Then Precision := maxdigits;
|
||||
TooSmall := (Abs(Extended(Value)) < 0.00001) and (Extended(Value)<>0.0);
|
||||
end;
|
||||
end;
|
||||
If Not TooSmall Then
|
||||
Begin
|
||||
case ValueType of
|
||||
fvDouble:
|
||||
Str(Double(Extended(Value)):0:precision, Result);
|
||||
fvSingle:
|
||||
Str(Single(Extended(Value)):0:precision, Result);
|
||||
fvCurrency:
|
||||
{ First convert to scientific format, with correct precision }
|
||||
case ValueType of
|
||||
fvDouble:
|
||||
Str(Double(Extended(Value)):precision+7, Result);
|
||||
fvSingle:
|
||||
Str(Single(Extended(Value)):precision+6, Result);
|
||||
fvCurrency:
|
||||
{$ifdef FPC_HAS_STR_CURRENCY}
|
||||
Str(Currency(Value):0:precision, Result);
|
||||
Str(Currency(Value):precision+6, Result);
|
||||
{$else}
|
||||
Str(Extended(Currency(Value)):0:precision, Result);
|
||||
Str(Extended(Currency(Value)):precision+8, Result);
|
||||
{$endif FPC_HAS_STR_CURRENCY}
|
||||
else
|
||||
Str(Extended(Value):0:precision, Result);
|
||||
else
|
||||
Str(Extended(Value):precision+8, Result);
|
||||
end;
|
||||
{ Delete leading spaces }
|
||||
while Result[1] = ' ' do
|
||||
System.Delete(Result, 1, 1);
|
||||
P := Pos('.', Result);
|
||||
if P<>0 then
|
||||
Result[P] := DS
|
||||
else
|
||||
Exit; { NAN or other special case }
|
||||
{ Consider removing exponent }
|
||||
PE:=Pos('E',Result);
|
||||
if PE > 0 then begin
|
||||
{ Read exponent }
|
||||
Q := PE+2;
|
||||
Exponent := 0;
|
||||
while (Q <= Length(Result)) do begin
|
||||
Exponent := Exponent*10 + Ord(Result[Q])-Ord('0');
|
||||
Inc(Q);
|
||||
end;
|
||||
Negative := Result[1] = '-';
|
||||
P := Pos('.', Result);
|
||||
if P<>0 then
|
||||
Result[P] := DS;
|
||||
TooLarge :=(P > Precision + ord(Negative) + 1) or (Pos('E', Result)<>0);
|
||||
End;
|
||||
|
||||
If TooSmall Or TooLarge Then
|
||||
begin
|
||||
Result := FloatToStrFIntl(Value, ffExponent, Precision, Digits, ValueType,FormatSettings);
|
||||
// Strip unneeded zeroes.
|
||||
P:=Pos('E',result)-1;
|
||||
If P<>-1 then
|
||||
begin
|
||||
{ delete superfluous +? }
|
||||
if result[p+2]='+' then
|
||||
system.Delete(Result,P+2,1);
|
||||
While (P>1) and (Result[P]='0') do
|
||||
begin
|
||||
system.Delete(Result,P,1);
|
||||
Dec(P);
|
||||
end;
|
||||
If (P>0) and (Result[P]=DS) Then
|
||||
begin
|
||||
system.Delete(Result,P,1);
|
||||
Dec(P);
|
||||
end;
|
||||
if Result[PE+1] = '-' then
|
||||
Exponent := -Exponent;
|
||||
if (P+Exponent < PE) and (Exponent > -6) then begin
|
||||
{ OK to remove exponent }
|
||||
SetLength(Result,PE-1); { Trim exponent }
|
||||
if Exponent >= 0 then begin
|
||||
{ Shift point to right }
|
||||
for Q := 0 to Exponent-1 do begin
|
||||
Result[P] := Result[P+1];
|
||||
Inc(P);
|
||||
end;
|
||||
end
|
||||
else if (P<>0) then // we have a decimalseparator
|
||||
begin
|
||||
{ it seems that in this unit "precision" must mean "number of }
|
||||
{ significant digits" rather than "number of digits after the }
|
||||
{ decimal point" (as it does in the system unit) -> adjust }
|
||||
{ (precision+1 to count the decimal point character) }
|
||||
{ don't just cut off the string, as rounding must be taken }
|
||||
{ into account based on the final digit }
|
||||
|
||||
if (Length(Result) > Precision + ord(Negative) + 1) and
|
||||
(Precision + ord(Negative) + 1 >= P) then
|
||||
Result := FloatToStrFIntl(Value, ffFixed,
|
||||
0, Precision - (P - Ord(Negative) - 1),
|
||||
ValueType, FormatSettings);
|
||||
P := Length(Result);
|
||||
While (P>0) and (Result[P] = '0') Do
|
||||
Dec(P);
|
||||
If (P>0) and (Result[P]=DS) Then
|
||||
Dec(P);
|
||||
SetLength(Result, P);
|
||||
Result[P] := DS;
|
||||
P := 1;
|
||||
if Result[P] = '-' then
|
||||
Inc(P);
|
||||
while (Result[P] = '0') and (P < Length(Result)) and (Result[P+1] <> DS) do
|
||||
{ Trim leading zeros; conversion above should not give any, but occasionally does
|
||||
because of rounding }
|
||||
System.Delete(Result,P,1);
|
||||
end else begin
|
||||
{ Add zeros at start }
|
||||
Insert(Copy('00000',1,-Exponent),Result,P-1);
|
||||
Result[P-Exponent] := Result[P-Exponent-1]; { Copy leading digit }
|
||||
Result[P] := DS;
|
||||
if Exponent <> -1 then
|
||||
Result[P-Exponent-1] := '0';
|
||||
end;
|
||||
{ Remove trailing zeros }
|
||||
Q := Length(Result);
|
||||
while (Q > 0) and (Result[Q] = '0') do
|
||||
Dec(Q);
|
||||
if Result[Q] = DS then
|
||||
Dec(Q); { Remove trailing decimal point }
|
||||
if (Q = 0) or ((Q=1) and (Result[1] = '-')) then
|
||||
Result := '0'
|
||||
else
|
||||
SetLength(Result,Q);
|
||||
end else begin
|
||||
{ Need exponent, but remove superfluous characters }
|
||||
{ Delete trailing zeros }
|
||||
while Result[PE-1] = '0' do begin
|
||||
System.Delete(Result,PE-1,1);
|
||||
Dec(PE);
|
||||
end;
|
||||
{ If number ends in decimal point, remove it }
|
||||
if Result[PE-1] = DS then begin
|
||||
System.Delete(Result,PE-1,1);
|
||||
Dec(PE);
|
||||
end;
|
||||
{ delete superfluous + in exponent }
|
||||
if Result[PE+1]='+' then
|
||||
System.Delete(Result,PE+1,1)
|
||||
else
|
||||
Inc(PE);
|
||||
while Result[PE+1] = '0' do
|
||||
{ Delete leading zeros in exponent }
|
||||
System.Delete(Result,PE+1,1)
|
||||
end;
|
||||
end;
|
||||
End;
|
||||
|
||||
ffExponent:
|
||||
|
||||
@ -9,6 +9,49 @@ const
|
||||
var
|
||||
ErrCount: longint;
|
||||
|
||||
procedure CheckVal(f: Extended);
|
||||
var
|
||||
s: string;
|
||||
f1: Extended;
|
||||
begin
|
||||
s := FloatToStr(f);
|
||||
f1 := StrToFloat(s);
|
||||
if (f<>f1) and (Abs(f-f1)/Abs(f) > 6e-15) then begin
|
||||
WriteLn('Error (Double):',Abs(f-f1)/Abs(f), ' Input:', f, ' Output:', s);
|
||||
Inc(ErrCount);
|
||||
end;
|
||||
f := Single(f);
|
||||
s := FloatToStr(Single(f));
|
||||
f1 := StrToFloat(s);
|
||||
if (f<>f1) and (Abs(f-f1)/Abs(f) > 6e-10) then begin
|
||||
WriteLn('Error (Single):',Abs(f-f1)/Abs(f), ' Input:', f, ' Output:', s);
|
||||
Inc(ErrCount);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure Cycle(f: Extended);
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
for i := 1 to 50 do begin
|
||||
CheckVal(f);
|
||||
CheckVal(-f);
|
||||
f := f/10;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure CycleInc(f, increment: Extended);
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
Cycle(f);
|
||||
for i := 0 to 30 do begin
|
||||
Cycle(f+increment);
|
||||
Cycle(f-increment);
|
||||
increment := increment/10;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure CheckResult(const s, ref: string);
|
||||
begin
|
||||
if s <> ref then
|
||||
@ -24,6 +67,8 @@ var
|
||||
d: double;
|
||||
s: single;
|
||||
c: currency;
|
||||
i: Integer;
|
||||
tests: array [0..4] of Double = (123456789123456789., 1e20, 1.6e20, 5e20, 9e20);
|
||||
begin
|
||||
e:=1234567890123.4;
|
||||
d:=12345.12345;
|
||||
@ -46,6 +91,14 @@ begin
|
||||
NegCurrFormat:=8;
|
||||
CheckResult(FloatToStrF(-12345.1234,ffCurrency,19,4), '-12' + ThousandSeparator + '345'+DecimalSeparator+'1234 ' + CurrencyString);
|
||||
CheckResult(FloatToStrF(MinCurrency,ffCurrency,19,4), '-922' + ThousandSeparator + '337' + ThousandSeparator + '203' + ThousandSeparator + '685' + ThousandSeparator + '477'+DecimalSeparator+'5807 ' + CurrencyString);
|
||||
for i := 0 to High(tests) do begin
|
||||
e := tests[i];
|
||||
CycleInc(e,1e20);
|
||||
CycleInc(e,9e20);
|
||||
CycleInc(e,e);
|
||||
CycleInc(e,e/2);
|
||||
CycleInc(e,e/3);
|
||||
end;
|
||||
if ErrCount > 0 then
|
||||
begin
|
||||
writeln('Test failed. Errors: ', ErrCount);
|
||||
|
||||
Loading…
Reference in New Issue
Block a user