2
0
Эх сурвалжийг харах

fcl-js: fixed writing small floats

mattias 2 жил өмнө
parent
commit
3cec86390a

+ 13 - 5
packages/fcl-js/src/jswriter.pp

@@ -837,19 +837,25 @@ begin
               Delete(S,i,length(S))
             else if (Exp>=-6) and (Exp<=6) then
               begin
-              // small exponent -> use notation without E
+              // small exponent -> try using notation without E
               Delete(S,i,length(S));
+              if S[length(S)]='0' then
+                Delete(S,length(S),1);
+              if S[length(S)]='.' then
+                Delete(S,length(S),1);
+              S2:=S+'E'+IntToStr(Exp);
               j:=Pos('.',S);
               if j>0 then
+                begin
                 Delete(S,j,1)
+                end
               else
                 begin
-                j:=1;
-                while not (S[j] in ['0'..'9']) do inc(j);
+                j:=length(S)+1;
                 end;
               if Exp<0 then
                 begin
-                // e.g. -1.2  E-1
+                // e.g. -1.2E-3  S='-123' j=3  Exp=-3
                 while Exp<0 do
                   begin
                   if (j>1) and (S[j-1] in ['0'..'9']) then
@@ -866,7 +872,7 @@ begin
                 end
               else
                 begin
-                // e.g. -1.2  E1
+                // e.g. -1.2E3  S='-123' j=3  Exp=3
                 while Exp>0 do
                   begin
                   if (j<=length(S)) and (S[j] in ['0'..'9']) then
@@ -878,6 +884,8 @@ begin
                 if j<=length(S) then
                   Insert('.',S,j);
                 end;
+              if length(S)>length(S2) then
+                S:=S2;
               end
             else
               begin

+ 58 - 1
packages/pastojs/tests/tcmodules.pas

@@ -304,6 +304,7 @@ type
 
     // numbers
     Procedure TestDouble;
+    Procedure TestDoubleSmall;
     Procedure TestInteger;
     Procedure TestIntegerRange;
     Procedure TestIntegerTypecasts;
@@ -7944,7 +7945,7 @@ begin
     '$mod.d = 0.3;',
     '$mod.d = -0.1;',
     '$mod.d = -0.3;',
-    '$mod.d = -0.003;',
+    '$mod.d = -3E-3;',
     '$mod.d = -0.123456789;',
     '$mod.d = -300;',
     '$mod.d = -123456;',
@@ -7965,6 +7966,62 @@ begin
     '']));
 end;
 
+procedure TTestModule.TestDoubleSmall;
+begin
+  StartProgram(false);
+  Add([
+  'const',
+  '  a = 1e-1;',
+  '  b = 1e-2;',
+  '  c = 1e-3;',
+  '  d = 1e-4;',
+  '  e = 1e-5;',
+  '  f = 1e-6;',
+  '  g = 1e-7;',
+  '  h = -1e-1;',
+  '  i = -1e-2;',
+  'procedure Fly(d: double);',
+  'begin',
+  'end;',
+  'begin',
+  '  Fly(a);',
+  '  Fly(b);',
+  '  Fly(c);',
+  '  Fly(d);',
+  '  Fly(e);',
+  '  Fly(f);',
+  '  Fly(g);',
+  '  Fly(h);',
+  '  Fly(i);',
+  '']);
+  ConvertProgram;
+  CheckSource('TestDoubleSmall',
+    LinesToStr([
+    'this.a = 1e-1;',
+    'this.b = 1e-2;',
+    'this.c = 1e-3;',
+    'this.d = 1e-4;',
+    'this.e = 1e-5;',
+    'this.f = 1e-6;',
+    'this.g = 1e-7;',
+    'this.h = -1e-1;',
+    'this.i = -1e-2;',
+    'this.Fly = function (d) {',
+    '};',
+    '']),
+    LinesToStr([
+    '$mod.Fly(0.1);',
+    '$mod.Fly(0.01);',
+    '$mod.Fly(1E-3);',
+    '$mod.Fly(1E-4);',
+    '$mod.Fly(1E-5);',
+    '$mod.Fly(1E-6);',
+    '$mod.Fly(1E-7);',
+    '$mod.Fly(-0.1);',
+    '$mod.Fly(-0.01);',
+    '']));
+end;
+
 procedure TTestModule.TestInteger;
 begin
   StartProgram(false);