diff --git a/compiler/packages/pastojs/src/fppas2js.pp b/compiler/packages/pastojs/src/fppas2js.pp index a3aa883..093e5a9 100644 --- a/compiler/packages/pastojs/src/fppas2js.pp +++ b/compiler/packages/pastojs/src/fppas2js.pp @@ -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); diff --git a/compiler/packages/pastojs/tests/tcmodules.pas b/compiler/packages/pastojs/tests/tcmodules.pas index afe84d5..6f34a0b 100644 --- a/compiler/packages/pastojs/tests/tcmodules.pas +++ b/compiler/packages/pastojs/tests/tcmodules.pas @@ -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);