paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-06 09:07:59 +02:00
Code Issues Packages Projects Releases Wiki Activity

fcl-js: fixed writing small floats

Browse Source
This commit is contained in:
mattias 2023-03-03 23:17:55 +01:00
parent acb1e59862
commit 3cec86390a
2 changed files with 71 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
packages/fcl-js/src/jswriter.pp
View File

@ -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

59
packages/pastojs/tests/tcmodules.pas
View File

@ -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);