From 0687f40919e3626631a03ce3b80ccc1f2753b339 Mon Sep 17 00:00:00 2001
From: mattias <mattias@idefix.freepascal.org>
Date: Fri, 12 Jul 2019 16:58:14 +0000
Subject: [PATCH] pastojs: fixed createcallback inside anonymous method

---
 compiler/packages/fcl-passrc/src/pasresolver.pp | 10 ++++++++--
 compiler/packages/pastojs/tests/tcmodules.pas   | 10 ++++++++++
 2 files changed, 18 insertions(+), 2 deletions(-)

diff --git a/compiler/packages/fcl-passrc/src/pasresolver.pp b/compiler/packages/fcl-passrc/src/pasresolver.pp
index 8fef8a4..e792e37 100644
--- a/compiler/packages/fcl-passrc/src/pasresolver.pp
+++ b/compiler/packages/fcl-passrc/src/pasresolver.pp
@@ -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;
diff --git a/compiler/packages/pastojs/tests/tcmodules.pas b/compiler/packages/pastojs/tests/tcmodules.pas
index eaba319..f06951e 100644
--- a/compiler/packages/pastojs/tests/tcmodules.pas
+++ b/compiler/packages/pastojs/tests/tcmodules.pas
@@ -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;',
     '  };',