pastojs: fixed aPromise:=AsyncFunctionWithCOMIntfResult

git-svn-id: trunk@47444 -

packages/pastojs/src/fppas2js.pp

@@ -771,7 +771,7 @@ const
     'intfAsIntfT', // rtl.intfAsIntfT
     'createInterface', // rtl.createInterface
     'createTGUID', // rtl.createTGUID
-    'ref', // $ir.ref
+    'ref', // $ir.ref  pbifnIntfExprRefsAdd
     'createIntfRefs', // rtl.createIntfRefs
     'free', // $ir.free
     'getIntfGUIDR', // rtl.getIntfGUIDR
@@ -9856,6 +9856,7 @@ var
 
     NeedIntfRef:=false;
     if (ProcType is TPasFunctionType)
+        and not ProcType.IsAsync
         and AContext.Resolver.IsInterfaceType(
           TPasFunctionType(ProcType).ResultEl.ResultType,citCom)
     then
@@ -10431,6 +10432,7 @@ function TPasToJSConverter.ConvertInheritedExpr(El: TInheritedExpr;
         CreateProcedureCall(Call,ParamsExpr,AncestorProc.ProcType,AContext);
 
       if (AncestorProc is TPasFunction)
+          and not AncestorProc.IsAsync
           and AContext.Resolver.IsInterfaceType(
               TPasFunction(AncestorProc).FuncType.ResultEl.ResultType,citCom) then
         Call:=CreateIntfRef(Call,AContext,El);
@@ -11446,7 +11448,7 @@ var
   C: TClass;
   aName, ArgName: String;
   aClassTypeEl: TPasClassType;
-  ParamTypeEl, TypeEl: TPasType;
+  ParamTypeEl: TPasType;
   NeedIntfRef: Boolean;
   DestRange, SrcRange: TResEvalValue;
   LastArg: TJSArrayLiteralElement;
@@ -11826,10 +11828,8 @@ begin
   NeedIntfRef:=false;
   if (TargetProcType is TPasFunctionType) and (aResolver<>nil) then
     begin
-    TypeEl:=aResolver.ResolveAliasType(TPasFunctionType(TargetProcType).ResultEl.ResultType);
-    if (TypeEl is TPasClassType)
-        and (TPasClassType(TypeEl).ObjKind=okInterface)
-        and (TPasClassType(TypeEl).InterfaceType=citCom) then
+    if aResolver.IsInterfaceType(TPasFunctionType(TargetProcType).ResultEl.ResultType,citCom)
+        and not TargetProcType.IsAsync then
       NeedIntfRef:=true;
     end;
 

packages/pastojs/tests/tcmodules.pas

@@ -884,6 +884,7 @@ type
     Procedure TestAsync_ProcType;
     Procedure TestAsync_ProcTypeAsyncModMismatchFail;
     Procedure TestAsync_Inherited;
+    Procedure TestAsync_ClassInterface;
   end;
 
 function LinesToStr(Args: array of const): string;
@@ -32715,6 +32716,53 @@ begin
   CheckResolverUnexpectedHints();
 end;
 
+procedure TTestModule.TestAsync_ClassInterface;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode objfpc}',
+  '{$modeswitch externalclass}',
+  'type',
+  '  TJSPromise = class external name ''Promise''',
+  '  end;',
+  '  IUnknown = interface',
+  '    function _AddRef: longint;',
+  '    function _Release: longint;',
+  '  end;',
+  'function Run: IUnknown; async;',
+  'begin',
+  'end;',
+  'procedure Fly;',
+  'var p: TJSPromise;',
+  'begin',
+  '  Run;',
+  '  Run();',
+  '  p:=Run;',
+  '  p:=Run();',
+  'end;',
+  'begin',
+  '  ']);
+  ConvertProgram;
+  CheckSource('TestAsync_ClassInterface',
+    LinesToStr([ // statements
+    'rtl.createInterface(this, "IUnknown", "{D7ADB0E1-758A-322B-BDDF-21CD521DDFA9}", ["_AddRef", "_Release"], null);',
+    'this.Run = async function () {',
+    '  var Result = null;',
+    '  return Result;',
+    '};',
+    'this.Fly = function () {',
+    '  var p = null;',
+    '  $mod.Run();',
+    '  $mod.Run();',
+    '  p = $mod.Run();',
+    '  p = $mod.Run();',
+    '};',
+    '']),
+    LinesToStr([
+    '']));
+  CheckResolverUnexpectedHints();
+end;
+
 
 Initialization
   RegisterTests([TTestModule]);