+ newer version of FloatToDecimal

  * use more precision for extended (Delphi compatible)

git-svn-id: trunk@5517 -

rtl/objpas/sysutils/sysstr.inc

@@ -1886,15 +1886,26 @@ Begin
 End;
 
 
-
-Procedure FloatToDecimal(Out Result: TFloatRec; Value: Extended; Precision, Decimals : integer);
-
+Procedure FloatToDecimal(Out Result: TFloatRec; const Value; ValueType: TFloatValue; Precision, Decimals : integer);
 var
   Buffer: String[254];  //Though str func returns only 25 chars, this might change in the future
   Error, N, L, Start, C: Integer;
   GotNonZeroBeforeDot, BeforeDot : boolean;
 begin
-  Str(Value:23, Buffer);
+  case ValueType of
+    fvExtended:
+      Str(Extended(Value):25, Buffer);
+    fvDouble,
+    fvReal:
+      Str(Double(Value):23, Buffer);
+    fvSingle:
+      Str(Single(Value):16, Buffer);
+    fvCurrency:
+      Str(Currency(Value):25, Buffer);
+    fvComp:
+      Str(Currency(Value):23, Buffer);
+  end;
+    
   N := 1;
   L := Byte(Buffer[0]);
   while Buffer[N]=' ' do
@@ -1989,6 +2000,13 @@ begin
     end;
 end;
 
+
+Procedure FloatToDecimal(Out Result: TFloatRec; Value: Extended; Precision, Decimals : integer);
+
+begin
+  FloatToDecimal(Result,Value,fvExtended,Precision,Decimals);
+end;
+
 Function FormatFloat(Const format: String; Value: Extended): String;
 
 Var

rtl/objpas/sysutils/sysstrh.inc

@@ -168,6 +168,7 @@ function TryStrToBool(const S: string; out Value: Boolean): Boolean;
 function LastDelimiter(const Delimiters, S: string): Integer;
 function StringReplace(const S, OldPattern, NewPattern: string;  Flags: TReplaceFlags): string;
 Function FloatToTextFmt(Buffer: PChar; Value: Extended; format: PChar): Integer;
+Procedure FloatToDecimal(Out Result: TFloatRec; const Value; ValueType: TFloatValue; Precision, Decimals : integer);
 Procedure FloatToDecimal(Out Result: TFloatRec; Value: Extended; Precision, Decimals : integer);
 Function FormatFloat(Const Format : String; Value : Extended) : String;
 Function IsDelimiter(const Delimiters, S: string; Index: Integer): Boolean;

tests/webtbs/tw7756.pp

@@ -17,6 +17,332 @@ var
         -1.1E256, -5.5E256, -1.1E-256, -5.5E-256, -pi, 0.0,  pi, 1.1E-256, 5.5E-256, 1.1E256, 5.5E256);
 
 const results: array[1..324] of string =
+{$ifdef FPC_HAS_TYPE_EXTENDED}
+('257-',
+'258-1',
+'-255-',
+'-255-',
+'1-',
+'0+',
+'1+',
+'-255+',
+'-255+',
+'257+',
+'258+1',
+'257-',
+'258-1',
+'-255-',
+'-255-',
+'1-',
+'0+',
+'1+',
+'-255+',
+'-255+',
+'257+',
+'258+1',
+'257-',
+'258-1',
+'-255-',
+'-255-',
+'1-',
+'0+',
+'1+',
+'-255+',
+'-255+',
+'257+',
+'258+1',
+'257-',
+'258-1',
+'-255-',
+'-255-',
+'1-',
+'0+',
+'1+',
+'-255+',
+'-255+',
+'257+',
+'258+1',
+'257-',
+'258-1',
+'-255-',
+'-255-',
+'1-',
+'0+',
+'1+',
+'-255+',
+'-255+',
+'257+',
+'258+1',
+'257-',
+'258-1',
+'-255-',
+'-255-',
+'1-',
+'0+',
+'1+',
+'-255+',
+'-255+',
+'257+',
+'258+1',
+'257-11',
+'257-55',
+'-255-',
+'-255-',
+'1-3',
+'0+',
+'1+3',
+'-255+',
+'-255+',
+'257+11',
+'257+55',
+'257-11',
+'257-55',
+'-255-',
+'-255-',
+'1-314159',
+'0+',
+'1+314159',
+'-255+',
+'-255+',
+'257+11',
+'257+55',
+'257-11',
+'257-55',
+'-255-',
+'-255-',
+'1-314159265358979',
+'0+',
+'1+314159265358979',
+'-255+',
+'-255+',
+'257+11',
+'257+55',
+'257-11',
+'257-55',
+'-255-',
+'-255-',
+'1-314159265358979',
+'0+',
+'1+314159265358979',
+'-255+',
+'-255+',
+'257+11',
+'257+55',
+'257-11',
+'257-55',
+'-255-',
+'-255-',
+'1-314159265358979',
+'0+',
+'1+314159265358979',
+'-255+',
+'-255+',
+'257+11',
+'257+55',
+'257-11',
+'257-55',
+'-255-',
+'-255-',
+'1-314159265358979',
+'0+',
+'1+314159265358979',
+'-255+',
+'-255+',
+'257+11',
+'257+55',
+'257-11',
+'257-54999999999999998',
+'-255-',
+'-255-',
+'1-3',
+'0+',
+'1+3',
+'-255+',
+'-255+',
+'257+11',
+'257+54999999999999998',
+'257-11',
+'257-54999999999999998',
+'-255-',
+'-255-',
+'1-314159',
+'0+',
+'1+314159',
+'-255+',
+'-255+',
+'257+11',
+'257+54999999999999998',
+'257-11',
+'257-54999999999999998',
+'-255-',
+'-255-',
+'1-3141592653589793',
+'0+',
+'1+3141592653589793',
+'-255+',
+'-255+',
+'257+11',
+'257+54999999999999998',
+'257-11',
+'257-54999999999999998',
+'-255-',
+'-255-',
+'1-31415926535897931',
+'0+',
+'1+31415926535897931',
+'-255+',
+'-255+',
+'257+11',
+'257+54999999999999998',
+'257-11',
+'257-54999999999999998',
+'-255-',
+'-255-',
+'1-31415926535897931',
+'0+',
+'1+31415926535897931',
+'-255+',
+'-255+',
+'257+11',
+'257+54999999999999998',
+'257-11',
+'257-54999999999999998',
+'-255-',
+'-255-',
+'1-31415926535897931',
+'0+',
+'1+31415926535897931',
+'-255+',
+'-255+',
+'257+11',
+'257+54999999999999998',
+'5-1',
+'5-1',
+'5-1',
+'0+',
+'5+1',
+'5+1',
+'5+1',
+'5-1',
+'5-1',
+'5-1',
+'0+',
+'5+1',
+'5+1',
+'5+1',
+'5-1',
+'5-1',
+'5-1',
+'0+',
+'5+1',
+'5+1',
+'5+1',
+'5-1',
+'5-1',
+'5-1',
+'0+',
+'5+1',
+'5+1',
+'5+1',
+'5-1',
+'5-1',
+'5-1',
+'0+',
+'5+1',
+'5+1',
+'5+1',
+'5-1',
+'5-1',
+'5-1',
+'0+',
+'5+1',
+'5+1',
+'5+1',
+'4-9057',
+'4-9194',
+'4-9059',
+'0+',
+'4+9057',
+'4+9194',
+'4+9059',
+'4-9057',
+'4-9194',
+'4-9059',
+'0+',
+'4+9057',
+'4+9194',
+'4+9059',
+'4-9057',
+'4-9194',
+'4-9059',
+'0+',
+'4+9057',
+'4+9194',
+'4+9059',
+'4-9057',
+'4-9194',
+'4-9059',
+'0+',
+'4+9057',
+'4+9194',
+'4+9059',
+'4-9057',
+'4-9194',
+'4-9059',
+'0+',
+'4+9057',
+'4+9194',
+'4+9059',
+'4-9057',
+'4-9194',
+'4-9059',
+'0+',
+'4+9057',
+'4+9194',
+'4+9059',
+'4-9057',
+'4-9194',
+'4-9059',
+'0+',
+'4+9057',
+'4+9194',
+'4+9059',
+'4-9057',
+'4-9194',
+'4-9059',
+'0+',
+'4+9057',
+'4+9194',
+'4+9059',
+'4-9057',
+'4-9194',
+'4-9059',
+'0+',
+'4+9057',
+'4+9194',
+'4+9059',
+'4-9057',
+'4-9194',
+'4-9059',
+'0+',
+'4+9057',
+'4+9194',
+'4+9059',
+'4-9057',
+'4-9194',
+'4-9059',
+'0+',
+'4+9057',
+'4+9194',
+'4+9059',
+'4-9057',
+'4-9194',
+'4-9059',
+'0+',
+'4+9057',
+'4+9194',
+'4+9059');
+{$else}
 ('257-',
 '258-1',
 '-255-',
@@ -341,6 +667,7 @@ const results: array[1..324] of string =
 '4+9057',
 '4+9194',
 '4+9059');
+{$endif}
 
 function DecimalToStr(fr: TFloatRec): string;
 var
@@ -389,3 +716,4 @@ BEGIN
         end;
 END.
 
+