* fixed web bug #7756

git-svn-id: trunk@5516 -

.gitattributes

@@ -7745,6 +7745,7 @@ tests/webtbs/tw7568.pp svneol=native#text/plain
 tests/webtbs/tw7637.pp svneol=native#text/plain
 tests/webtbs/tw7643.pp svneol=native#text/plain
 tests/webtbs/tw7679.pp svneol=native#text/plain
+tests/webtbs/tw7756.pp svneol=native#text/plain
 tests/webtbs/tw7817a.pp svneol=native#text/plain
 tests/webtbs/tw7817b.pp svneol=native#text/plain
 tests/webtbs/ub1873.pp svneol=native#text/plain

rtl/objpas/sysutils/sysstr.inc

@@ -1887,69 +1887,107 @@ End;
 
 
 
-Procedure FloatToDecimal(Var Result: TFloatRec; Value: Extended; Precision, Decimals : integer);
+Procedure FloatToDecimal(Out Result: TFloatRec; Value: Extended; Precision, Decimals : integer);
 
-Var
-  Buffer: String[24];
-  Error, N: Integer;
-
-Begin
+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);
-  Result.Negative := (Buffer[1] = '-');
-  Val(Copy(Buffer, 19, 5), Result.Exponent, Error);
-  Inc(Result. Exponent);
-  Result.Digits[0] := Buffer[2];
-  Move(Buffer[4], Result.Digits[1], 14);
-  If Decimals + Result.Exponent < Precision Then
+  N := 1;
+  L := Byte(Buffer[0]);
+  while Buffer[N]=' ' do
+    Inc(N);
+  Result.Negative := (Buffer[N] = '-');
+  if Result.Negative then
+    Inc(N);
+  Start := N;  //Start of digits
+  Result.Exponent := 0; BeforeDot := true;
+  GotNonZeroBeforeDot := false;
+  while (L>=N) and (Buffer[N]<>'E') do
+    begin
+      if Buffer[N]='.' then
+        BeforeDot := false
+      else
+        begin
+          if BeforeDot then
+            begin  // Currently this is always 1 char
+              Inc(Result.Exponent);
+              Result.Digits[N-Start] := Buffer[N];
+              if Buffer[N] <> '0' then
+                GotNonZeroBeforeDot := true;
+            end
+          else
+            Result.Digits[N-Start-1] := Buffer[N]
+        end;
+      Inc(N);
+    end;
+  Inc(N); // Pass through 'E'
+  if N<=L then
+    begin
+      Val(Copy(Buffer, N, L-N+1), C, Error); // Get exponent after 'E'
+      Inc(Result.Exponent, C);
+    end;
+  // Calculate number of digits we have from str
+  if BeforeDot then
+    N := N - Start - 1
+  else
+    N := N - Start - 2;
+  L := SizeOf(Result.Digits);
+  if N<L then
+    FillChar(Result.Digits[N], L-N, '0');  //Zero remaining space
+  if Decimals + Result.Exponent < Precision Then //After this it is the same as in FloatToDecimal
     N := Decimals + Result.Exponent
   Else
     N := Precision;
-  If N > maxdigits Then
-    N := maxdigits;
-  If N = 0 Then
-    Begin
-    If Result.Digits[0] >= '5' Then
-      Begin
-      Result.Digits[0] := '1';
-      Result.Digits[1] := #0;
-      Inc(Result.Exponent);
-      End
-    Else
-      Result.Digits[0] := #0;
-    End
-  Else If N > 0 Then
-    Begin
-    If Result.Digits[N] >= '5' Then
-      Begin
-      Repeat
-        Result.Digits[N] := #0;
-        Dec(N);
-        Inc(Result.Digits[N]);
-      Until (N = 0) Or (Result.Digits[N] < ':');
-      If Result.Digits[0] = ':' Then
-        Begin
-        Result.Digits[0] := '1';
-        Inc(Result.Exponent);
-        End;
-      End
-    Else
-      Begin
-      Result.Digits[N] := '0';
-      While (Result.Digits[N] = '0') And (N > -1) Do
-        Begin
-        Result.Digits[N] := #0;
-        Dec(N);
-        End;
-      End;
-    End
+  if N >= L Then
+    N := L-1;
+  if N = 0 Then
+    begin
+      if Result.Digits[0] >= '5' Then
+        begin
+          Result.Digits[0] := '1';
+          Result.Digits[1] := #0;
+          Inc(Result.Exponent);
+        end
+      Else
+        Result.Digits[0] := #0;
+    end  //N=0
+  Else if N > 0 Then
+    begin
+      if Result.Digits[N] >= '5' Then
+        begin
+          Repeat
+            Result.Digits[N] := #0;
+            Dec(N);
+            Inc(Result.Digits[N]);
+          Until (N = 0) Or (Result.Digits[N] < ':');
+          If Result.Digits[0] = ':' Then
+            begin
+              Result.Digits[0] := '1';
+              Inc(Result.Exponent);
+            end;
+        end
+      Else
+        begin
+          Result.Digits[N] := '0';
+          While (N > -1) And (Result.Digits[N] = '0') Do
+            begin
+              Result.Digits[N] := #0;
+              Dec(N);
+            end;
+        end;
+      end //N>0
   Else
     Result.Digits[0] := #0;
-  If Result.Digits[0] = #0 Then
-    Begin
-    Result.Exponent := 0;
-    Result.Negative := False;
-    End;
-End;
+  if (Result.Digits[0] = #0) and
+     not GotNonZeroBeforeDot then
+    begin
+      Result.Exponent := 0;
+      Result.Negative := False;
+    end;
+end;
 
 Function FormatFloat(Const format: String; Value: Extended): String;
 

rtl/objpas/sysutils/sysstrh.inc

@@ -168,7 +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(Var Result: TFloatRec; Value: Extended; 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;
 function FormatCurr(const Format: string; Value: Currency): string;

tests/webtbs/tw7756.pp

@@ -0,0 +1,391 @@
+program tw7756;
+
+{$mode objfpc}
+
+uses Variants, SysUtils;
+
+var
+//  s : string;
+  cp, cd, ci, ce, cg : integer; //iterators
+  fr : TFloatRec;
+  v : variant;
+  precs : array [1..3] of integer = (0, 15, 50);
+  decs : array [1..6] of integer =
+      (0, 5, 15, 25, 50, 60);
+  i : array [1..7] of integer = (-9057, -9194, -9059, 0, 9057, 9194, 9059);
+  e : array [1..11] of extended = (
+        -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 =
+('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-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',
+'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');
+
+function DecimalToStr(fr: TFloatRec): string;
+var
+  s : string;
+begin
+        s := IntToStr(fr.Exponent);
+        if fr.Negative
+          then s := s+ '-'
+          else s := s+ '+';
+        s := s + StrPas(@fr.Digits[0]);
+        Result := s;
+end;
+
+BEGIN
+  cg := 1; // grid row index
+  for cp := Low(Precs) to High(Precs) do  //itarete through precisions
+    for cd := Low(decs) to High(decs) do  //itarete through decimals
+      for ce := Low(e) to High(e) do  //itarete through extended values
+        begin
+//        write(IntToStr(precs[cp]):2,';',IntToStr(decs[cd]):2,';');
+//        str(e[ce]:250, s); s := Trim(s);
+        v := e[ce];
+//        write(s:25, ';');
+        FloatToDecimal(fr, v, precs[cp], decs[cd]);
+//        write(DecimalToStr(fr):25, ';');
+//        writeln(DecimalToStr(fr));
+        if DecimalToStr(fr) <> results[cg] then
+          halt(1);
+        inc(cg);
+        end;
+  // integers
+  for cp := Low(Precs) to High(Precs) do  //itarete through precisions
+    for cd := Low(decs) to High(decs) do  //itarete through decimals
+      for ci := Low(i) to High(i) do  //itarete through integers
+        begin
+//        write(IntToStr(precs[cp]):2, ';', IntToStr(decs[cd]):2, ';');
+//        s := IntToStr(i[ci]);
+        v := i[ci];
+//        write(s:25, ';');
+        FloatToDecimal(fr, v, precs[cp], decs[cd]);
+//        write(DecimalToStr(fr):25, ';');
+//        writeln(DecimalToStr(fr));
+        if DecimalToStr(fr) <> results[cg] then
+          halt(1);
+        inc(cg);
+        end;
+END.
+