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

pastojs: fixed accessing Self in anonymous function

Browse Source
This commit is contained in:
mattias 2019-03-10 08:08:21 +00:00
parent f14c29ee04
commit a25f1ebb22
2 changed files with 71 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -1278,6 +1278,13 @@ type
function GetJSBaseTypes(aBaseType: TPas2jsBaseType): TPasUnresolvedSymbolRef; inline;
procedure InternalAdd(Item: TPasIdentifier);
procedure OnClearHashItem(Item, Dummy: pointer);
protected
type
THasAnoFuncData = record
Expr: TProcedureExpr;
end;
PHasAnoFuncData = ^THasAnoFuncData;
procedure OnHasAnonymousEl(El: TPasElement; arg: pointer);
protected
// overloads: fix name clashes in JS
FOverloadScopes: TFPList; // list of TPasIdentifierScope
@ -1402,6 +1409,7 @@ type
false): string; override;
function HasTypeInfo(El: TPasType): boolean; override;
function ProcHasImplElements(Proc: TPasProcedure): boolean; override;
function HasAnonymousFunctions(El: TPasImplElement): boolean;
function GetTopLvlProcScope(El: TPasElement): TPas2JSProcedureScope;
function IsTObjectFreeMethod(El: TPasExpr): boolean; virtual;
function IsExternalBracketAccessor(El: TPasElement): boolean;
@ -2645,6 +2653,14 @@ begin
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;
WithElevatedLocal: boolean): boolean;
var
@ -5433,6 +5449,17 @@ begin
Result:=not Scope.EmptyJS;
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
): TPas2JSProcedureScope;
var
@ -14086,7 +14113,8 @@ begin
Call.AddArg(CreatePrimitiveDotExpr(ClassPath,PosEl));
end;
if (ImplProc.Body.Functions.Count>0) then
if (ImplProc.Body.Functions.Count>0)
or aResolver.HasAnonymousFunctions(ImplProc.Body.Body) then
begin
// has nested procs -> add "var self = this;"
FuncContext.AddLocalVar(GetBIName(pbivnSelf),FuncContext.ThisPas);

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

@ -346,6 +346,7 @@ type
Procedure TestAnonymousProc_ExceptOn;
Procedure TestAnonymousProc_Nested;
Procedure TestAnonymousProc_NestedAssignResult;
Procedure TestAnonymousProc_Class;
// enums, sets
Procedure TestEnum_Name;
@ -4735,6 +4736,47 @@ begin
'']));
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;
begin
StartProgram(false);