paweld/pas2js
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/pas2js.git synced 2025-04-21 13:59:21 +02:00
Code Issues Packages Projects Releases Wiki Activity

pastojs: fixed ComIntfInstance is/as IntfType using QueryInterface

Browse Source
This commit is contained in:
mattias 2019-08-23 09:34:51 +00:00
parent 0fd5a961a3
commit 3889384344
3 changed files with 34 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
compiler/packages/pastojs/src/fppas2js.pp
View File

@ -588,6 +588,7 @@ type
pbifnIntf_Release,
pbifnIntfAddMap,
pbifnIntfAsClass,
pbifnIntfAsIntfT, // COM intfvar as intftype
pbifnIntfCreate,
pbifnIntfCreateTGUID,
pbifnIntfExprRefsAdd,
@ -597,6 +598,7 @@ type
pbifnIntfGetIntfT,
pbifnIntfGuidRToStr,
pbifnIntfIsClass,
pbifnIntfIsIntf, // COM intfvar is intftype
pbifnIntfToClass,
pbifnIntfSetIntfL,
pbifnIntfSetIntfP,
@ -749,6 +751,7 @@ const
'_Release', // rtl._Release
'addIntf', // rtl.addIntf
'intfAsClass', // rtl.intfAsClass
'intfAsIntfT', // rtl.intfAsIntfT
'createInterface', // rtl.createInterface
'createTGUID', // rtl.createTGUID
'ref', // $ir.ref
@ -758,6 +761,7 @@ const
'getIntfT', // rtl.getIntfT
'guidrToStr', // rtl.guidrToStr
'intfIsClass', // rtl.intfIsClass
'intfIsIntfT', // rtl.intfIsIntfT
'intfToClass', // rtl.intfToClass
'setIntfL', // rtl.setIntfL
'setIntfP', // rtl.setIntfP
@ -6872,8 +6876,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;
@ -7376,7 +7385,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;

4
compiler/packages/pastojs/tests/tcmodules.pas
View File

@ -18154,10 +18154,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);',

14
compiler/utils/pas2js/dist/rtl.js vendored
View File

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