Browse Source

pastojs: fixed pas2js async proc requiring TJSPromise

mattias 1 week ago
parent
commit
54c4c7f5e0
2 changed files with 91 additions and 11 deletions
  1. 8 7
      packages/pastojs/src/fppas2js.pp
  2. 83 4
      packages/pastojs/tests/tcmodules.pas

+ 8 - 7
packages/pastojs/src/fppas2js.pp

@@ -7316,13 +7316,14 @@ begin
     Proc:=TPasProcedure(El);
     Proc:=TPasProcedure(El);
     if Proc.IsAsync then
     if Proc.IsAsync then
       begin
       begin
-      // an async function call returns a TJSPromise
-      JSPromiseClass:=FindTJSPromise(StartEl);
-
-      SetResolverIdentifier(ResolvedEl, btContext, El, JSPromiseClass,
-        JSPromiseClass, [rrfReadable, rrfWritable]);
-
-      Exit;
+      // an async function call returns a TJSPromise if available
+      JSPromiseClass:=FindTJSPromise(nil);
+      if JSPromiseClass<>nil then
+        begin
+         SetResolverIdentifier(ResolvedEl, btContext, El, JSPromiseClass,
+           JSPromiseClass, [rrfReadable, rrfWritable]);
+         Exit;
+        end;
       end;
       end;
     end;
     end;
   inherited ComputeElement(El,ResolvedEl,Flags,StartEl);
   inherited ComputeElement(El,ResolvedEl,Flags,StartEl);

+ 83 - 4
packages/pastojs/tests/tcmodules.pas

@@ -963,7 +963,8 @@ type
 
 
     // Async/AWait
     // Async/AWait
     Procedure TestAsync_Proc;
     Procedure TestAsync_Proc;
-    Procedure TestAsync_CallResultIsPromise;
+    Procedure TestAsync_CallFuncResultIsPromise;
+    Procedure TestAsync_CallProcResultIsPromise;
     Procedure TestAsync_ConstructorFail;
     Procedure TestAsync_ConstructorFail;
     Procedure TestAsync_PropertyGetterFail;
     Procedure TestAsync_PropertyGetterFail;
     Procedure TestAwait_NonPromiseWithTypeFail;
     Procedure TestAwait_NonPromiseWithTypeFail;
@@ -35946,7 +35947,7 @@ begin
     '']));
     '']));
 end;
 end;
 
 
-procedure TTestModule.TestAsync_CallResultIsPromise;
+procedure TTestModule.TestAsync_CallFuncResultIsPromise;
 begin
 begin
   StartProgram(false);
   StartProgram(false);
   Add([
   Add([
@@ -35994,7 +35995,7 @@ begin
   '']);
   '']);
   CheckResolverUnexpectedHints();
   CheckResolverUnexpectedHints();
   ConvertProgram;
   ConvertProgram;
-  CheckSource('TestAsync_CallResultIsPromise',
+  CheckSource('TestAsync_CallFuncResultIsPromise',
     LinesToStr([ // statements
     LinesToStr([ // statements
     'rtl.createClass(this, "TObject", null, function () {',
     'rtl.createClass(this, "TObject", null, function () {',
     '  this.$init = function () {',
     '  this.$init = function () {',
@@ -36040,6 +36041,84 @@ begin
     '']));
     '']));
 end;
 end;
 
 
+procedure TTestModule.TestAsync_CallProcResultIsPromise;
+begin
+  StartProgram(false);
+  Add([
+  '{$modeswitch externalclass}',
+  'type',
+  '  TObject = class',
+  '  end;',
+  '  TJSPromise = class external name ''Promise''',
+  '  end;',
+  '  TBird = class',
+  '    procedure Fly; async; ',
+  '  end;',
+  'procedure TBird.Fly; async; ',
+  'begin',
+  'end;',
+  'procedure Run; async;',
+  'begin',
+  'end;',
+  'var',
+  '  p: TJSPromise;',
+  '  o: TBird;',
+  'begin',
+  '  p:=Run;',
+  '  p:=Run();',
+  '  if Run=p then ;',
+  '  if p=Run then ;',
+  '  if Run()=p then ;',
+  '  if p=Run() then ;',
+  '  p:=o.Fly;',
+  '  p:=o.Fly();',
+  '  if o.Fly=p then ;',
+  '  if o.Fly()=p then ;',
+  '  with o do begin',
+  '    p:=Fly;',
+  '    p:=Fly();',
+  '    if Fly=p then ;',
+  '    if Fly()=p then ;',
+  '  end;',
+  '']);
+  CheckResolverUnexpectedHints();
+  ConvertProgram;
+  CheckSource('TestAsync_CallProcResultIsPromise',
+    LinesToStr([ // statements
+    'rtl.createClass(this, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '});',
+    'rtl.createClass(this, "TBird", this.TObject, function () {',
+    '  this.Fly = async function () {',
+    '  };',
+    '});',
+    'this.Run = async function () {',
+    '};',
+    'this.p = null;',
+    'this.o = null;',
+    '']),
+    LinesToStr([
+    '$mod.p = $mod.Run();',
+    '$mod.p = $mod.Run();',
+    'if ($mod.Run() === $mod.p) ;',
+    'if ($mod.p === $mod.Run()) ;',
+    'if ($mod.Run() === $mod.p) ;',
+    'if ($mod.p === $mod.Run()) ;',
+    '$mod.p = $mod.o.Fly();',
+    '$mod.p = $mod.o.Fly();',
+    'if ($mod.o.Fly() === $mod.p) ;',
+    'if ($mod.o.Fly() === $mod.p) ;',
+    'var $with = $mod.o;',
+    '$mod.p = $with.Fly();',
+    '$mod.p = $with.Fly();',
+    'if ($with.Fly() === $mod.p) ;',
+    'if ($with.Fly() === $mod.p) ;',
+    '']));
+end;
+
 procedure TTestModule.TestAsync_ConstructorFail;
 procedure TTestModule.TestAsync_ConstructorFail;
 begin
 begin
   StartProgram(false);
   StartProgram(false);
@@ -36174,7 +36253,7 @@ begin
   'begin',
   'begin',
   '  Result:=await(word,p);', // promise needs type
   '  Result:=await(word,p);', // promise needs type
   '  Result:=await(word,Fly(3));', // promise needs type
   '  Result:=await(word,Fly(3));', // promise needs type
-  '  Result:=await(Jump(4));', // async non promise must omit the type
+  '  Result:=await(Jump(4));', // async non promise can omit the type
   '  Result:=await(word,Jump(5));', // async call can provide fitting type
   '  Result:=await(word,Jump(5));', // async call can provide fitting type
   '  Result:=await(word,Eat(6));', // promise needs type
   '  Result:=await(word,Eat(6));', // promise needs type
   'end;',
   'end;',