Browse Source

pastojs: fixed ComIntfInstance is/as IntfType using QueryInterface

mattias 6 years ago
parent
commit
3889384344

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

@@ -588,6 +588,7 @@ type
     pbifnIntf_Release,
     pbifnIntf_Release,
     pbifnIntfAddMap,
     pbifnIntfAddMap,
     pbifnIntfAsClass,
     pbifnIntfAsClass,
+    pbifnIntfAsIntfT, // COM intfvar as intftype
     pbifnIntfCreate,
     pbifnIntfCreate,
     pbifnIntfCreateTGUID,
     pbifnIntfCreateTGUID,
     pbifnIntfExprRefsAdd,
     pbifnIntfExprRefsAdd,
@@ -597,6 +598,7 @@ type
     pbifnIntfGetIntfT,
     pbifnIntfGetIntfT,
     pbifnIntfGuidRToStr,
     pbifnIntfGuidRToStr,
     pbifnIntfIsClass,
     pbifnIntfIsClass,
+    pbifnIntfIsIntf, // COM intfvar is intftype
     pbifnIntfToClass,
     pbifnIntfToClass,
     pbifnIntfSetIntfL,
     pbifnIntfSetIntfL,
     pbifnIntfSetIntfP,
     pbifnIntfSetIntfP,
@@ -749,6 +751,7 @@ const
     '_Release', // rtl._Release
     '_Release', // rtl._Release
     'addIntf', // rtl.addIntf
     'addIntf', // rtl.addIntf
     'intfAsClass', // rtl.intfAsClass
     'intfAsClass', // rtl.intfAsClass
+    'intfAsIntfT', // rtl.intfAsIntfT
     'createInterface', // rtl.createInterface
     'createInterface', // rtl.createInterface
     'createTGUID', // rtl.createTGUID
     'createTGUID', // rtl.createTGUID
     'ref', // $ir.ref
     'ref', // $ir.ref
@@ -758,6 +761,7 @@ const
     'getIntfT',   // rtl.getIntfT
     'getIntfT',   // rtl.getIntfT
     'guidrToStr', // rtl.guidrToStr
     'guidrToStr', // rtl.guidrToStr
     'intfIsClass', // rtl.intfIsClass
     'intfIsClass', // rtl.intfIsClass
+    'intfIsIntfT', // rtl.intfIsIntfT
     'intfToClass', // rtl.intfToClass
     'intfToClass', // rtl.intfToClass
     'setIntfL', // rtl.setIntfL
     'setIntfL', // rtl.setIntfL
     'setIntfP', // rtl.setIntfP
     'setIntfP', // rtl.setIntfP
@@ -6872,8 +6876,13 @@ begin
                 // IntfVar as ClassType ->  rtl.intfAsClass(intfvar,classtype)
                 // IntfVar as ClassType ->  rtl.intfAsClass(intfvar,classtype)
                 Call.Expr:=CreatePrimitiveDotExpr(GetBIName(pbivnRTL)+'.'+GetBIName(pbifnIntfAsClass),El);
                 Call.Expr:=CreatePrimitiveDotExpr(GetBIName(pbivnRTL)+'.'+GetBIName(pbifnIntfAsClass),El);
               okInterface:
               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
               else
                 NotSupportedRes(20180327214545);
                 NotSupportedRes(20180327214545);
               end;
               end;
@@ -7376,7 +7385,14 @@ begin
               Call.AddArg(B); B:=nil;
               Call.AddArg(B); B:=nil;
               exit;
               exit;
               end;
               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
             else
               NotSupported(20180327210741);
               NotSupported(20180327210741);
             end;
             end;

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

@@ -18154,10 +18154,10 @@ begin
     'this.DoDefault = function (i, j, o) {',
     'this.DoDefault = function (i, j, o) {',
     '  rtl._AddRef(i);',
     '  rtl._AddRef(i);',
     '  try {',
     '  try {',
-    '    if ($mod.IUnknown.isPrototypeOf(i)) ;',
+    '    if (rtl.intfIsIntfT(i, $mod.IUnknown)) ;',
     '    if (rtl.queryIntfIsT(o, $mod.IUnknown)) ;',
     '    if (rtl.queryIntfIsT(o, $mod.IUnknown)) ;',
     '    if (rtl.intfIsClass(i, $mod.TObject)) ;',
     '    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);',
     '    i = rtl.setIntfL(i, rtl.queryIntfT(o, $mod.IUnknown), true);',
     '    o = rtl.intfAsClass(j, $mod.TObject);',
     '    o = rtl.intfAsClass(j, $mod.TObject);',
     '    i = rtl.setIntfL(i, j);',
     '    i = rtl.setIntfL(i, j);',

+ 13 - 1
compiler/utils/pas2js/dist/rtl.js

@@ -626,7 +626,7 @@ var rtl = {
   },
   },
 
 
   queryIntfIsT: function(obj,intftype){
   queryIntfIsT: function(obj,intftype){
-    var i = rtl.queryIntfG(obj,intftype.$guid);
+    var i = rtl.getIntfG(obj,intftype.$guid);
     if (!i) return false;
     if (!i) return false;
     if (i.$kind === 'com') i._Release();
     if (i.$kind === 'com') i._Release();
     return true;
     return true;
@@ -638,6 +638,18 @@ var rtl = {
     rtl.raiseEInvalidCast();
     rtl.raiseEInvalidCast();
   },
   },
 
 
+  intfIsIntfT: function(intf,intftype){
+    return (intf!==null) && rtl.queryIntfIsT(intf.$o,intftype);
+  },
+
+  intfAsIntfT: function (intf,intftype){
+    if (intf){
+      var i = rtl.getIntfG(intf.$o,intftype.$guid);
+      if (i!==null) return i;
+    }
+    rtl.raiseEInvalidCast();
+  },
+
   intfIsClass: function(intf,classtype){
   intfIsClass: function(intf,classtype){
     return (intf!=null) && (rtl.is(intf.$o,classtype));
     return (intf!=null) && (rtl.is(intf.$o,classtype));
   },
   },