paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-14 17:09:10 +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, pbifnIntf_Release,
pbifnIntfAddMap, pbifnIntfAddMap,
pbifnIntfAsClass, pbifnIntfAsClass,
pbifnIntfAsIntfT, // COM intfvar as intftype
pbifnIntfCreate, pbifnIntfCreate,
pbifnIntfCreateTGUID, pbifnIntfCreateTGUID,
pbifnIntfExprRefsAdd, pbifnIntfExprRefsAdd,
@ -603,6 +604,7 @@ type
pbifnIntfGetIntfT, pbifnIntfGetIntfT,
pbifnIntfGuidRToStr, pbifnIntfGuidRToStr,
pbifnIntfIsClass, pbifnIntfIsClass,
pbifnIntfIsIntf, // COM intfvar is intftype
pbifnIntfToClass, pbifnIntfToClass,
pbifnIntfSetIntfL, pbifnIntfSetIntfL,
pbifnIntfSetIntfP, pbifnIntfSetIntfP,
@ -762,6 +764,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
@ -771,6 +774,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
@ -7149,8 +7153,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;
@ -7670,7 +7679,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
packages/pastojs/tests/tcmodules.pas
View File

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