paweld/pas2js
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/pas2js.git synced 2025-04-13 16:49:22 +02:00
Code Issues Packages Projects Releases Wiki Activity

pas2js: fixed try exit(value) finally read Result end

Browse Source
This commit is contained in:
mattias 2020-06-29 21:13:31 +00:00
parent a9af2a4169
commit 66bec81336
4 changed files with 182 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
compiler/packages/fcl-passrc/src/pasresolver.pp
View File

@ -1176,6 +1176,7 @@ type
TPRResolveVarAccesses = set of TResolvedRefAccess;
const
rraAllRead = [rraRead,rraReadAndAssign,rraVarParam];
rraAllWrite = [rraAssign,rraReadAndAssign,rraVarParam,rraOutParam];
ResolvedToPSRefAccess: array[TResolvedRefAccess] of TPSRefAccess = (

3
compiler/packages/fcl-passrc/src/pastree.pp
View File

@ -1128,6 +1128,7 @@ type
{ TPasClassOperator }
TPasClassOperator = class(TPasOperator)
public
function TypeName: string; override;
function GetProcTypeEnum: TProcType; override;
end;
@ -1576,7 +1577,7 @@ type
TPasImplTryExceptElse = class(TPasImplTryHandler)
end;
{ TPasImplExceptOn }
{ TPasImplExceptOn - Parent is TPasImplTryExcept }
TPasImplExceptOn = class(TPasImplStatement)
public

126
compiler/packages/pastojs/src/fppas2js.pp
View File

@ -1295,6 +1295,14 @@ type
end;
PHasAnoFuncData = ^THasAnoFuncData;
procedure OnHasAnonymousEl(El: TPasElement; arg: pointer);
protected
type
THasElReadingDeclData = record
Decl: TPasElement;
El: TPasElement;
end;
PHasElReadingDeclData = ^THasElReadingDeclData;
procedure OnHasElReadingDecl(El: TPasElement; arg: pointer);
protected
// overloads: fix name clashes in JS
FOverloadScopes: TFPList; // list of TPasIdentifierScope
@ -1432,7 +1440,8 @@ type
InResolved: TPasResolverResult; out ArgResolved, LengthResolved,
PropResultResolved: TPasResolverResult): boolean;
function IsHelperMethod(El: TPasElement): boolean; override;
function IsHelperForMember(El: TPasElement): boolean;
function IsHelperForMember(El: TPasElement): boolean; virtual;
function ImplBlockReadsDecl(Block: TPasImplBlock; Decl: TPasElement): boolean; virtual;
end;
//------------------------------------------------------------------------------
@ -2719,6 +2728,22 @@ begin
Data^.Expr:=TProcedureExpr(El);
end;
procedure TPas2JSResolver.OnHasElReadingDecl(El: TPasElement; arg: pointer);
var
Data: PHasElReadingDeclData absolute arg;
Ref: TResolvedReference;
begin
if Data^.El<>nil then exit;
if El.CustomData is TResolvedReference then
begin
Ref:=TResolvedReference(El.CustomData);
if (Ref.Declaration=Data^.Decl) and (Ref.Access in rraAllRead) then
begin
Data^.El:=El;
end;
end;
end;
function TPas2JSResolver.HasOverloadIndex(El: TPasElement;
WithElevatedLocal: boolean): boolean;
var
@ -5742,6 +5767,17 @@ begin
Result:=true;
end;
function TPas2JSResolver.ImplBlockReadsDecl(Block: TPasImplBlock;
Decl: TPasElement): boolean;
var
Data: THasElReadingDeclData;
begin
Data.Decl:=Decl;
Data.El:=nil;
Block.ForEachCall(@OnHasElReadingDecl,@Data);
Result:=Data.El<>nil;
end;
{ TParamContext }
constructor TParamContext.Create(PasEl: TPasElement; JSEl: TJSElement;
@ -10765,39 +10801,91 @@ function TPasToJSConverter.ConvertBuiltIn_Exit(El: TPasExpr;
// convert "exit;" -> in a function: "return result;" in a procedure: "return;"
// convert "exit(param);" -> "return param;"
var
ProcEl: TPasElement;
Scope: TPas2JSProcedureScope;
VarName: String;
ParentEl: TPasElement;
ImplProcScope: TPas2JSProcedureScope;
ResultVarName: String;
FuncContext: TFunctionContext;
AssignSt: TJSSimpleAssignStatement;
St: TJSStatementList;
Proc: TPasProcedure;
ImplProc, DeclProc: TPasProcedure;
ImplTry: TPasImplTry;
ResultIsRead: Boolean;
ResultEl: TPasResultElement;
begin
{$IFDEF VerbosePas2JS}
writeln('TPasToJSConverter.ConvertBuiltIn_Exit ',GetObjName(El));
{$ENDIF}
ProcEl:=El.Parent;
while (ProcEl<>nil) and not (ProcEl is TPasProcedure) do
ProcEl:=ProcEl.Parent;
// ProcEl can be nil, when exit is in program begin block
Proc:=TPasProcedure(ProcEl);
ParentEl:=El.Parent;
while (ParentEl<>nil) and not (ParentEl is TPasProcedure) do
ParentEl:=ParentEl.Parent;
// ParentEl can be nil, when exit is in program begin block
ImplProc:=TPasProcedure(ParentEl);
ResultVarName:='';
if ImplProc<>nil then
begin
ImplProcScope:=ImplProc.CustomData as TPas2JSProcedureScope;
if ImplProc.ProcType is TPasFunctionType then
begin
ResultVarName:=ImplProcScope.ResultVarName; // ResultVarName needs ImplProc
if ResultVarName='' then
ResultVarName:=ResolverResultVar;
end;
end;
Result:=TJSReturnStatement(CreateElement(TJSReturnStatement,El));
if (El is TParamsExpr) and (length(TParamsExpr(El).Params)>0) then
begin
// with parameter. convert "exit(param);" -> "return param;"
TJSReturnStatement(Result).Expr:=ConvertExpression(TParamsExpr(El).Params[0],AContext);
// with parameter, e.g. "exit(param);"
ResultIsRead:=false;
if (ResultVarName<>'') then
begin
DeclProc:=ImplProcScope.DeclarationProc;
if DeclProc=nil then
DeclProc:=ImplProc; // Note: references refer to ResultEl of DeclProc
ResultEl:=TPasFunctionType(DeclProc.ProcType).ResultEl;
ParentEl:=El.Parent;
while (ParentEl<>ImplProc) do
begin
if ParentEl is TPasImplTry then
begin
ImplTry:=TPasImplTry(ParentEl);
if ImplTry.FinallyExcept is TPasImplTryFinally then
begin
if AContext.Resolver.ImplBlockReadsDecl(ImplTry.FinallyExcept,ResultEl) then
begin
ResultIsRead:=true;
break;
end;
end;
end;
ParentEl:=ParentEl.Parent;
end;
end;
if ResultIsRead then
begin
// create "Result = param; return Result;"
AssignSt:=TJSSimpleAssignStatement(CreateElement(TJSSimpleAssignStatement,El));
AssignSt.LHS:=CreatePrimitiveDotExpr(ResultVarName,El);
AssignSt.Expr:=ConvertExpression(TParamsExpr(El).Params[0],AContext);
TJSReturnStatement(Result).Expr:=CreatePrimitiveDotExpr(ResultVarName,El);
St:=TJSStatementList(CreateElement(TJSStatementList,El));
St.A:=AssignSt;
St.B:=Result;
Result:=St;
end
else
begin
// create "return param;"
TJSReturnStatement(Result).Expr:=ConvertExpression(TParamsExpr(El).Params[0],AContext);
end;
end
else
begin
// without parameter
if (Proc<>nil) and (Proc.ProcType is TPasFunctionType) then
if (ResultVarName<>'') then
begin
// in a function, "return result;"
Scope:=Proc.CustomData as TPas2JSProcedureScope;
VarName:=Scope.ResultVarName;
if VarName='' then
VarName:=ResolverResultVar;
TJSReturnStatement(Result).Expr:=CreatePrimitiveDotExpr(VarName,El);
// in a function, "return Result;"
TJSReturnStatement(Result).Expr:=CreatePrimitiveDotExpr(ResultVarName,El);
end
else
; // in a procedure, "return;" which means "return undefined;"

72
compiler/packages/pastojs/tests/tcmodules.pas
View File

@ -317,6 +317,7 @@ type
Procedure TestFunctionResultInForLoop;
Procedure TestFunctionResultInTypeCast;
Procedure TestExit;
Procedure TestExit_ResultInFinally;
Procedure TestBreak;
Procedure TestBreakAsVar;
Procedure TestContinue;
@ -3634,6 +3635,77 @@ begin
'']));
end;
procedure TTestModule.TestExit_ResultInFinally;
begin
StartProgram(false);
Add([
'function Run: word;',
'begin',
' try',
' exit(3);', // no Result in finally -> use return 3
' finally',
' end;',
'end;',
'function Fly: word;',
'begin',
' try',
' exit(3);',
' finally',
' if Result>0 then ;',
' end;',
'end;',
'function Jump: word;',
'begin',
' try',
' try',
' exit(4);',
' finally',
' end;',
' finally',
' if Result>0 then ;',
' end;',
'end;',
'begin',
'']);
ConvertProgram;
CheckSource('TestExit_ResultInFinally',
LinesToStr([ // statements
'this.Run = function () {',
' var Result = 0;',
' try {',
' return 3;',
' } finally {',
' };',
' return Result;',
'};',
'this.Fly = function () {',
' var Result = 0;',
' try {',
' Result = 3;',
' return Result;',
' } finally {',
' if (Result > 0) ;',
' };',
' return Result;',
'};',
'this.Jump = function () {',
' var Result = 0;',
' try {',
' try {',
' Result = 4;',
' return Result;',
' } finally {',
' };',
' } finally {',
' if (Result > 0) ;',
' };',
' return Result;',
'};',
'']),
LinesToStr([
'']));
end;
procedure TTestModule.TestBreak;
begin
StartProgram(false);