paweld/pas2js
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/pas2js.git synced 2025-08-14 13:39:07 +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; function TPasProcedureScope.GetSelfScope: TPasProcedureScope;
var var
Proc: TPasProcedure; Proc: TPasProcedure;
El: TPasElement;
begin begin
Result:=Self; Result:=Self;
repeat repeat
if Result.ClassRecScope<>nil then exit; if Result.ClassRecScope<>nil then exit;
Proc:=TPasProcedure(Result.Element); Proc:=TPasProcedure(Result.Element);
if not (Proc.Parent is TProcedureBody) then exit(nil); El:=Proc.Parent;
Proc:=Proc.Parent.Parent as TPasProcedure; 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); Result:=TPasProcedureScope(Proc.CustomData);
until false; until false;
end; end;

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

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