paweld/pas2js
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/pas2js.git synced 2025-08-14 10:09:05 +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, 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)" // IntfVar as IntfType
Call.Expr:=CreatePrimitiveDotExpr(GetBIName(pbivnRTL)+'.'+GetBIName(pbifnAs),El); 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;

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

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

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

@ -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));
}, },