paweld/pas2js
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/pas2js.git synced 2025-09-25 08:29:06 +02:00
Code Issues Packages Projects Releases Wiki Activity

fcl-js: write TJSStatementList using a heap stack to avoid large stack depths

Browse Source
This commit is contained in:
mattias 2020-04-11 11:06:10 +00:00
parent 738fe0d771
commit 7807d83d77
2 changed files with 100 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

103
compiler/packages/fcl-js/src/jswriter.pp
View File

@ -1228,9 +1228,46 @@ procedure TJSWriter.WriteStatementList(El: TJSStatementList);
Var
C : Boolean;
B : Boolean;
LastEl: TJSElement;
ElStack: array of TJSElement;
ElStackIndex: integer;
procedure WriteNonListEl(CurEl: TJSElement);
begin
if IsEmptyStatement(CurEl) then exit;
if (LastEl<>nil) then
begin
if FLastChar<>';' then
Write(';');
if C then
Write(' ')
else
Writeln('');
end;
WriteJS(CurEl);
LastEl:=CurEl;
end;
procedure Push(CurEl: TJSElement);
begin
if CurEl=nil then exit;
if ElStackIndex=length(ElStack) then
SetLength(ElStack,ElStackIndex+8);
ElStack[ElStackIndex]:=CurEl;
inc(ElStackIndex);
end;
function Pop: TJSElement;
begin
if ElStackIndex=0 then exit(nil);
dec(ElStackIndex);
Result:=ElStack[ElStackIndex];
end;
var
B : Boolean;
CurEl: TJSElement;
List: TJSStatementList;
begin
//write('TJSWriter.WriteStatementList '+BoolToStr(FSkipCurlyBrackets,true));
//if El.A<>nil then write(' El.A='+El.A.ClassName) else write(' El.A=nil');
@ -1239,43 +1276,55 @@ begin
C:=(woCompact in Options);
B:= Not FSkipCurlyBrackets;
FSkipCurlyBrackets:=True;
if B then
begin
Write('{');
Indent;
if not C then writeln('');
end;
if not IsEmptyStatement(El.A) then
// traverse statementlist using a heap stack to avoid large stack depths
LastEl:=nil;
ElStackIndex:=0;
CurEl:=El;
while CurEl<>nil do
begin
WriteJS(El.A);
LastEl:=El.A;
if Assigned(El.B) then
if CurEl is TJSStatementList then
begin
if not (LastEl is TJSStatementList) then
List:=TJSStatementList(CurEl);
if List.A is TJSStatementList then
begin
if FLastChar<>';' then
Write(';');
if C then
Write(' ')
else
Writeln('');
end;
FSkipCurlyBrackets:=True;
WriteJS(El.B);
LastEl:=El.B;
end;
if (not C) and not (LastEl is TJSStatementList) then
writeln(';');
end
else if Assigned(El.B) and not IsEmptyStatement(El.B) then
begin
WriteJS(El.B);
if (not C) and not (El.B is TJSStatementList) then
if FLastChar=';' then
writeln('')
Push(List.B);
CurEl:=List.A;
end
else
writeln(';');
begin
WriteNonListEl(List.A);
if List.B is TJSStatementList then
CurEl:=List.B
else
begin
WriteNonListEl(List.B);
CurEl:=nil;
end;
end;
end
else
begin
WriteNonListEl(CurEl);
CurEl:=nil;
end;
if CurEl=nil then
CurEl:=Pop;
end;
if (LastEl<>nil) and not C then
if FLastChar=';' then
writeln('')
else
writeln(';');
if B then
begin
Undent;

24
compiler/packages/fcl-js/tests/tcwriter.pp
View File

@ -157,6 +157,7 @@ type
Procedure TestStatementListOneStatementCompact;
Procedure TestStatementListTwoStatements;
Procedure TestStatementListTwoStatementsCompact;
Procedure TestStatementListTree4;
Procedure TestStatementListFor;
Procedure TestEmptyFunctionDef;
Procedure TestEmptyFunctionDefCompact;
@ -1696,6 +1697,29 @@ begin
AssertWrite('Statement list','{a=b; a=b}',S);
end;
procedure TTestStatementWriter.TestStatementListTree4;
var
S1, S11, S12: TJSStatementList;
begin
Writer.Options:=[woUseUTF8];
S1:=TJSStatementList.Create(0,0);
S11:=TJSStatementList.Create(0,0);
S1.A:=S11;
S12:=TJSStatementList.Create(0,0);
S1.B:=S12;
S11.A:=CreateAssignment(nil);
S11.B:=CreateAssignment(nil);
S12.A:=CreateAssignment(nil);
S12.B:=CreateAssignment(nil);
AssertWrite('Statement list',
'{'+sLineBreak
+'a = b;'+sLineBreak
+'a = b;'+sLineBreak
+'a = b;'+sLineBreak
+'a = b;'+sLineBreak
+'}',S1);
end;
procedure TTestStatementWriter.TestStatementListFor;
Var
S : TJSStatementList;