Browse Source

pastojs: fixed ComIntfInstance is/as IntfType

git-svn-id: trunk@42770 -
Mattias Gaertner 6 years ago
parent
commit
d773eb84fa
2 changed files with 21 additions and 5 deletions
  1. 19 3
      packages/pastojs/src/fppas2js.pp
  2. 2 2
      packages/pastojs/tests/tcmodules.pas

+ 19 - 3
packages/pastojs/src/fppas2js.pp

@@ -594,6 +594,7 @@ type
     pbifnIntf_Release,
     pbifnIntfAddMap,
     pbifnIntfAsClass,
+    pbifnIntfAsIntfT, // COM intfvar as intftype
     pbifnIntfCreate,
     pbifnIntfCreateTGUID,
     pbifnIntfExprRefsAdd,
@@ -603,6 +604,7 @@ type
     pbifnIntfGetIntfT,
     pbifnIntfGuidRToStr,
     pbifnIntfIsClass,
+    pbifnIntfIsIntf, // COM intfvar is intftype
     pbifnIntfToClass,
     pbifnIntfSetIntfL,
     pbifnIntfSetIntfP,
@@ -762,6 +764,7 @@ const
     '_Release', // rtl._Release
     'addIntf', // rtl.addIntf
     'intfAsClass', // rtl.intfAsClass
+    'intfAsIntfT', // rtl.intfAsIntfT
     'createInterface', // rtl.createInterface
     'createTGUID', // rtl.createTGUID
     'ref', // $ir.ref
@@ -771,6 +774,7 @@ const
     'getIntfT',   // rtl.getIntfT
     'guidrToStr', // rtl.guidrToStr
     'intfIsClass', // rtl.intfIsClass
+    'intfIsIntfT', // rtl.intfIsIntfT
     'intfToClass', // rtl.intfToClass
     'setIntfL', // rtl.setIntfL
     'setIntfP', // rtl.setIntfP
@@ -7149,8 +7153,13 @@ begin
                 // IntfVar as ClassType ->  rtl.intfAsClass(intfvar,classtype)
                 Call.Expr:=CreatePrimitiveDotExpr(GetBIName(pbivnRTL)+'.'+GetBIName(pbifnIntfAsClass),El);
               okInterface:
-                // IntfVar as IntfType -> "rtl.as(A,B)"
-                Call.Expr:=CreatePrimitiveDotExpr(GetBIName(pbivnRTL)+'.'+GetBIName(pbifnAs),El);
+                // IntfVar as IntfType
+                if TPasClassType(LeftTypeEl).InterfaceType=citCom then
+                  // COM -> "rtl.intfAsIntfT(A,B)"
+                  Call.Expr:=CreatePrimitiveDotExpr(GetBIName(pbivnRTL)+'.'+GetBIName(pbifnIntfAsIntfT),El)
+                else
+                  // CORBA -> "rtl.as(A,B)"
+                  Call.Expr:=CreatePrimitiveDotExpr(GetBIName(pbivnRTL)+'.'+GetBIName(pbifnAs),El);
               else
                 NotSupportedRes(20180327214545);
               end;
@@ -7670,7 +7679,14 @@ begin
               Call.AddArg(B); B:=nil;
               exit;
               end;
-            okInterface: ;
+            okInterface:
+              if TPasClassType(LeftTypeEl).InterfaceType=citCom then
+                begin
+                // COM: IntfVar is IntfType  ->  rtl.intfIsIntfT(A,B)
+                Call.Expr:=CreateMemberExpression([GetBIName(pbivnRTL),GetBIName(pbifnIntfIsIntf)]);
+                Call.AddArg(B); B:=nil;
+                exit;
+                end;
             else
               NotSupported(20180327210741);
             end;

+ 2 - 2
packages/pastojs/tests/tcmodules.pas

@@ -18433,10 +18433,10 @@ begin
     'this.DoDefault = function (i, j, o) {',
     '  rtl._AddRef(i);',
     '  try {',
-    '    if ($mod.IUnknown.isPrototypeOf(i)) ;',
+    '    if (rtl.intfIsIntfT(i, $mod.IUnknown)) ;',
     '    if (rtl.queryIntfIsT(o, $mod.IUnknown)) ;',
     '    if (rtl.intfIsClass(i, $mod.TObject)) ;',
-    '    i = rtl.setIntfL(i, rtl.as(j, $mod.IUnknown));',
+    '    i = rtl.setIntfL(i, rtl.intfAsIntfT(j, $mod.IUnknown));',
     '    i = rtl.setIntfL(i, rtl.queryIntfT(o, $mod.IUnknown), true);',
     '    o = rtl.intfAsClass(j, $mod.TObject);',
     '    i = rtl.setIntfL(i, j);',