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

pastojs: fixed createcallback inside anonymous method

Browse Source
This commit is contained in:
mattias 2019-07-12 16:58:14 +00:00
parent cbb472795f
commit 0687f40919
2 changed files with 18 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -3321,13 +3321,19 @@ end;
function TPasProcedureScope.GetSelfScope: TPasProcedureScope;
var
Proc: TPasProcedure;
El: TPasElement;
begin
Result:=Self;
repeat
if Result.ClassRecScope<>nil then exit;
Proc:=TPasProcedure(Result.Element);
if not (Proc.Parent is TProcedureBody) then exit(nil);
Proc:=Proc.Parent.Parent as TPasProcedure;
El:=Proc.Parent;
repeat
if El=nil then exit(nil);
if El is TProcedureBody then break;
El:=El.Parent;
until false;
Proc:=El.Parent as TPasProcedure;
Result:=TPasProcedureScope(Proc.CustomData);
until false;
end;

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

@ -4787,15 +4787,21 @@ begin
Add([
'type',
' TProc = reference to procedure;',
' TEvent = procedure of object;',
' TObject = class',
' Size: word;',
' function GetIt: TProc;',
' procedure DoIt; virtual; abstract;',
' end;',
'function TObject.GetIt: TProc;',
'begin',
' Result:=procedure',
' var p: TEvent;',
' begin',
' Size:=Size;',
' Size:=Self.Size;',
' p:=@DoIt;',
' p:=@Self.DoIt;',
' end;',
'end;',
'begin']);
@ -4812,7 +4818,11 @@ begin
' var $Self = this;',
' var Result = null;',
' Result = function () {',
' var p = null;',
' $Self.Size = $Self.Size;',
' $Self.Size = $Self.Size;',
' p = rtl.createCallback($Self, "DoIt");',
' p = rtl.createCallback($Self, "DoIt");',
' };',
' return Result;',
' };',