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

pastojs: fixed ComIntfInstance is/as IntfType

Browse Source 
git-svn-id: trunk@42770 -
This commit is contained in:
Mattias Gaertner 2019-08-23 09:33:48 +00:00
parent 26c87910f8
commit d773eb84fa
2 changed files with 21 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -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;

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

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