pastojs: fixed accessing Self in anonymous function

git-svn-id: trunk@41665 -
This commit is contained in:
Mattias Gaertner 2019-03-10 08:07:54 +00:00
parent 492c0d58d8
commit fa87f8870c
2 changed files with 71 additions and 1 deletions

View File

@ -1300,6 +1300,13 @@ type
function GetJSBaseTypes(aBaseType: TPas2jsBaseType): TPasUnresolvedSymbolRef; inline; function GetJSBaseTypes(aBaseType: TPas2jsBaseType): TPasUnresolvedSymbolRef; inline;
procedure InternalAdd(Item: TPasIdentifier); procedure InternalAdd(Item: TPasIdentifier);
procedure OnClearHashItem(Item, Dummy: pointer); procedure OnClearHashItem(Item, Dummy: pointer);
protected
type
THasAnoFuncData = record
Expr: TProcedureExpr;
end;
PHasAnoFuncData = ^THasAnoFuncData;
procedure OnHasAnonymousEl(El: TPasElement; arg: pointer);
protected protected
// overloads: fix name clashes in JS // overloads: fix name clashes in JS
FOverloadScopes: TFPList; // list of TPasIdentifierScope FOverloadScopes: TFPList; // list of TPasIdentifierScope
@ -1426,6 +1433,7 @@ type
false): string; override; false): string; override;
function HasTypeInfo(El: TPasType): boolean; override; function HasTypeInfo(El: TPasType): boolean; override;
function ProcHasImplElements(Proc: TPasProcedure): boolean; override; function ProcHasImplElements(Proc: TPasProcedure): boolean; override;
function HasAnonymousFunctions(El: TPasImplElement): boolean;
function GetTopLvlProcScope(El: TPasElement): TPas2JSProcedureScope; function GetTopLvlProcScope(El: TPasElement): TPas2JSProcedureScope;
function IsTObjectFreeMethod(El: TPasExpr): boolean; virtual; function IsTObjectFreeMethod(El: TPasExpr): boolean; virtual;
function IsExternalBracketAccessor(El: TPasElement): boolean; function IsExternalBracketAccessor(El: TPasElement): boolean;
@ -2716,6 +2724,14 @@ begin
end; end;
end; end;
procedure TPas2JSResolver.OnHasAnonymousEl(El: TPasElement; arg: pointer);
var
Data: PHasAnoFuncData absolute arg;
begin
if (El=nil) or (Data^.Expr<>nil) or (El.ClassType<>TProcedureExpr) then exit;
Data^.Expr:=TProcedureExpr(El);
end;
function TPas2JSResolver.HasOverloadIndex(El: TPasElement; function TPas2JSResolver.HasOverloadIndex(El: TPasElement;
WithElevatedLocal: boolean): boolean; WithElevatedLocal: boolean): boolean;
var var
@ -5570,6 +5586,17 @@ begin
Result:=not Scope.EmptyJS; Result:=not Scope.EmptyJS;
end; end;
function TPas2JSResolver.HasAnonymousFunctions(El: TPasImplElement): boolean;
var
Data: THasAnoFuncData;
begin
if El=nil then
exit(false);
Data:=default(THasAnoFuncData);
El.ForEachCall(@OnHasAnonymousEl,@Data);
Result:=Data.Expr<>nil;
end;
function TPas2JSResolver.GetTopLvlProcScope(El: TPasElement function TPas2JSResolver.GetTopLvlProcScope(El: TPasElement
): TPas2JSProcedureScope; ): TPas2JSProcedureScope;
var var
@ -14253,7 +14280,8 @@ begin
Call.AddArg(CreatePrimitiveDotExpr(ClassPath,PosEl)); Call.AddArg(CreatePrimitiveDotExpr(ClassPath,PosEl));
end; end;
if (ImplProc.Body.Functions.Count>0) then if (ImplProc.Body.Functions.Count>0)
or aResolver.HasAnonymousFunctions(ImplProc.Body.Body) then
begin begin
// has nested procs -> add "var self = this;" // has nested procs -> add "var self = this;"
FuncContext.AddLocalVar(GetBIName(pbivnSelf),FuncContext.ThisPas); FuncContext.AddLocalVar(GetBIName(pbivnSelf),FuncContext.ThisPas);

View File

@ -346,6 +346,7 @@ type
Procedure TestAnonymousProc_ExceptOn; Procedure TestAnonymousProc_ExceptOn;
Procedure TestAnonymousProc_Nested; Procedure TestAnonymousProc_Nested;
Procedure TestAnonymousProc_NestedAssignResult; Procedure TestAnonymousProc_NestedAssignResult;
Procedure TestAnonymousProc_Class;
// enums, sets // enums, sets
Procedure TestEnum_Name; Procedure TestEnum_Name;
@ -4743,6 +4744,47 @@ begin
''])); '']));
end; end;
procedure TTestModule.TestAnonymousProc_Class;
begin
StartProgram(false);
Add([
'type',
' TProc = reference to procedure;',
' TObject = class',
' Size: word;',
' function GetIt: TProc;',
' end;',
'function TObject.GetIt: TProc;',
'begin',
' Result:=procedure',
' begin',
' Size:=Size;',
' end;',
'end;',
'begin']);
ConvertProgram;
CheckSource('TestAnonymousProc_Class',
LinesToStr([ // statements
'rtl.createClass($mod, "TObject", null, function () {',
' this.$init = function () {',
' this.Size = 0;',
' };',
' this.$final = function () {',
' };',
' this.GetIt = function () {',
' var $Self = this;',
' var Result = null;',
' Result = function () {',
' $Self.Size = $Self.Size;',
' };',
' return Result;',
' };',
'});',
'']),
LinesToStr([
'']));
end;
procedure TTestModule.TestEnum_Name; procedure TTestModule.TestEnum_Name;
begin begin
StartProgram(false); StartProgram(false);