浏览代码

pastojs: fixed searching TJSPromise in global scopes

(cherry picked from commit 385b271bcd6b4a8b845c89e12bdde6a48e8ba314)
mattias 3 年之前
父节点
当前提交
aec96f8acd
共有 3 个文件被更改,包括 69 次插入26 次删除
  1. 33 0
      packages/fcl-passrc/src/pasresolver.pp
  2. 1 1
      packages/pastojs/src/fppas2js.pp
  3. 35 25
      packages/pastojs/tests/tcmodules.pas

+ 33 - 0
packages/fcl-passrc/src/pasresolver.pp

@@ -2101,6 +2101,9 @@ type
     procedure IterateElements(const aName: string;
       const OnIterateElement: TIterateScopeElement; Data: Pointer;
       var Abort: boolean); virtual;
+    procedure IterateGlobalElements(const aName: string;
+      const OnIterateElement: TIterateScopeElement; Data: Pointer;
+      var Abort: boolean); virtual;
     procedure CheckFoundElement(const FindData: TPRFindData;
       Ref: TResolvedReference); virtual;
     procedure CheckFoundElementVisibility(const FindData: TPRFindData;
@@ -21678,6 +21681,36 @@ begin
     end;
 end;
 
+procedure TPasResolver.IterateGlobalElements(const aName: string;
+  const OnIterateElement: TIterateScopeElement; Data: Pointer;
+  var Abort: boolean);
+var
+  i: Integer;
+  Scope: TPasScope;
+  C: TClass;
+begin
+  i:=0;
+  while i<FScopeCount do
+    begin
+    Scope:=Scopes[i];
+    C:=Scope.ClassType;
+    if (C.InheritsFrom(TPasDefaultScope))
+        or (C.InheritsFrom(TPasModuleScope))
+        or (C.InheritsFrom(TPasSectionScope)) then
+      inc(i)
+    else
+      break;
+    end;
+  while i>0 do
+    begin
+    dec(i);
+    Scope:=Scopes[i];
+    Scope.IterateElements(AName,Scope,OnIterateElement,Data,Abort);
+    if Abort then
+      exit;
+    end;
+end;
+
 procedure TPasResolver.CheckFoundElement(
   const FindData: TPRFindData; Ref: TResolvedReference);
 // check visibility rules

+ 1 - 1
packages/pastojs/src/fppas2js.pp

@@ -5089,7 +5089,7 @@ begin
   Data.ErrorPosEl:=ErrorEl;
   Data.JSName:=JSName;
   Abort:=false;
-  IterateElements(aClassName,@OnFindExtSystemClass,@Data,Abort);
+  IterateGlobalElements(aClassName,@OnFindExtSystemClass,@Data,Abort);
   Result:=Data.Found;
   if (ErrorEl<>nil) and (Result=nil) then
     RaiseIdentifierNotFound(20200526095647,aClassName+' = class external name '''+JSName+'''',ErrorEl);

+ 35 - 25
packages/pastojs/tests/tcmodules.pas

@@ -946,7 +946,7 @@ type
     Procedure TestAWait_Result;
     Procedure TestAWait_ResultPromiseMissingTypeFail; // await(AsyncCallResultPromise) needs T
     Procedure TestAsync_AnonymousProc;
-    Procedure TestAsync_AnonymousProc_PassAsyncAsArg; // ToDo
+    Procedure TestAsync_AnonymousProc_PromiseViaDotContext;
     Procedure TestAsync_ProcType;
     Procedure TestAsync_ProcTypeAsyncModMismatchFail;
     Procedure TestAsync_Inherited;
@@ -34715,7 +34715,7 @@ begin
   '  end;',
   '  Func:=function(c:double):word async assembler asm',
   '  end;',
-  '  ']);
+  '']);
   ConvertProgram;
   CheckSource('TestAsync_AnonymousProc',
     LinesToStr([ // statements
@@ -34737,10 +34737,8 @@ begin
   CheckResolverUnexpectedHints();
 end;
 
-procedure TTestModule.TestAsync_AnonymousProc_PassAsyncAsArg;
+procedure TTestModule.TestAsync_AnonymousProc_PromiseViaDotContext;
 begin
-  exit;
-
   StartProgram(false);
   Add([
   '{$mode objfpc}',
@@ -34748,37 +34746,49 @@ begin
   'type',
   '  TJSPromise = class external name ''Promise''',
   '  end;',
-  'type',
-  '  TFunc = reference to function(x: double): word; async;',
+  '  TObject = class',
+  '  public',
+  '    procedure Fly(Prom: TJSPromise);',
+  '  end;',
+  '  TFunc = reference to procedure(Bird: TObject);',
+  'procedure TObject.Fly(Prom: TJSPromise);',
+  'begin',
+  'end;',
   'function Crawl: jsvalue; async;',
   'begin',
   'end;',
+  'procedure Add(Func: TFunc);',
   'begin',
-  '  function(c:double):word async begin',
-  '    Result:=await(Crawl(c));',
-  '  end;',
-  '  Func:=function(c:double):word async assembler asm',
-  '  end;',
-  '  ']);
+  'end;',
+  'begin',
+  '  Add(procedure(Bird: TObject)',
+  '    begin',
+  '      Bird.Fly(Crawl());',
+  '    end);',
+  '']);
   ConvertProgram;
-  CheckSource('TestAsync_AnonymousProc',
+  CheckSource('TestAsync_AnonymousProc_PromiseViaDotContext',
     LinesToStr([ // statements
-    'this.Crawl = async function (d) {',
-    '  var Result = 0;',
+    'rtl.createClass(this, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '  this.Fly = function (Prom) {',
+    '  };',
+    '});',
+    'this.Crawl = async function () {',
+    '  var Result = undefined;',
     '  return Result;',
     '};',
-    'this.Func = null;',
+    'this.Add = function (Func) {',
+    '};',
     '']),
     LinesToStr([
-    '$mod.Func = async function (c) {',
-    '  var Result = 0;',
-    '  Result = await $mod.Crawl(c);',
-    '  return Result;',
-    '};',
-    '$mod.Func = async function (c) {',
-    '};',
+    '$mod.Add(function (Bird) {',
+    '  Bird.Fly($mod.Crawl());',
+    '});',
     '']));
-  CheckResolverUnexpectedHints();
 end;
 
 procedure TTestModule.TestAsync_ProcType;