paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-07-31 13:46:17 +02:00
Code Issues Packages Projects Releases Wiki Activity

compiler: handle dispinterfaces the same way as com interfaces because they are IDispatch descendants: increment/decrement they references in assignments and parameters passing by _AddRef, _Release

Browse Source 
git-svn-id: trunk@16755 -
This commit is contained in:
paul 2011-01-13 03:38:45 +00:00
parent a9b8343a7e
commit dad8313512
5 changed files with 20 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
compiler/cgobj.pas
View File

@ -3473,7 +3473,7 @@ implementation
cgpara2.init;
paramanager.getintparaloc(pocall_default,1,cgpara1);
paramanager.getintparaloc(pocall_default,2,cgpara2);
if is_interfacecom(t) then
if is_interfacecom_or_dispinterface(t) then
incrfunc:='FPC_INTF_INCR_REF'
else if is_ansistring(t) then
incrfunc:='FPC_ANSISTR_INCR_REF'
@ -3529,7 +3529,7 @@ implementation
paramanager.getintparaloc(pocall_default,1,cgpara1);
paramanager.getintparaloc(pocall_default,2,cgpara2);
needrtti:=false;
if is_interfacecom(t) then
if is_interfacecom_or_dispinterface(t) then
decrfunc:='FPC_INTF_DECR_REF'
else if is_ansistring(t) then
decrfunc:='FPC_ANSISTR_DECR_REF'
@ -3593,7 +3593,7 @@ implementation
if is_ansistring(t) or
is_widestring(t) or
is_unicodestring(t) or
is_interfacecom(t) or
is_interfacecom_or_dispinterface(t) or
is_dynamic_array(t) then
a_load_const_ref(list,OS_ADDR,0,ref)
else
@ -3624,7 +3624,7 @@ implementation
if is_ansistring(t) or
is_widestring(t) or
is_unicodestring(t) or
is_interfacecom(t) then
is_interfacecom_or_dispinterface(t) then
begin
g_decrrefcount(list,t,ref);
a_load_const_ref(list,OS_ADDR,0,ref);

2
compiler/defcmp.pas
View File

@ -1445,7 +1445,7 @@ implementation
begin
{ interface -> guid }
if (def_to=rec_tguid) and
(is_interfacecom(def_from) or is_dispinterface(def_from)) then
(is_interfacecom_or_dispinterface(def_from)) then
begin
doconv:=tc_intf_2_guid;
eq:=te_convert_l1;

4
compiler/nld.pas
View File

@ -626,7 +626,7 @@ implementation
end;
{ call helpers for interface }
if is_interfacecom(left.resultdef) then
if is_interfacecom_or_dispinterface(left.resultdef) then
begin
{ Normal interface assignments are handled by the generic refcount incr/decr }
if not right.resultdef.is_related(left.resultdef) then
@ -712,7 +712,7 @@ implementation
{ call helpers for composite types containing automated types }
else if is_managed_type(left.resultdef) and
(left.resultdef.typ in [arraydef,objectdef,recorddef]) and
not is_interfacecom(left.resultdef) and
not is_interfacecom_or_dispinterface(left.resultdef) and
not is_dynamic_array(left.resultdef) then
begin
hp:=ccallparanode.create(caddrnode.create_internal(

4
compiler/nutils.pas
View File

@ -592,7 +592,7 @@ implementation
typecheckpass(p);
if is_ansistring(p.resultdef) or
is_wide_or_unicode_string(p.resultdef) or
is_interfacecom(p.resultdef) or
is_interfacecom_or_dispinterface(p.resultdef) or
is_dynamic_array(p.resultdef) then
begin
result:=cassignmentnode.create(
@ -656,7 +656,7 @@ implementation
cnilnode.create
));
end
else if is_interfacecom(p.resultdef) then
else if is_interfacecom_or_dispinterface(p.resultdef) then
begin
result:=internalstatements(newstatement);
addstatement(newstatement,ccallnode.createintern('fpc_intf_decr_ref',

13
compiler/symdef.pas
View File

@ -768,6 +768,7 @@ interface
{ should be in the types unit, but the types unit uses the node stuff :( }
function is_interfacecom(def: tdef): boolean;
function is_interfacecom_or_dispinterface(def: tdef): boolean;
function is_interfacecorba(def: tdef): boolean;
function is_interface(def: tdef): boolean;
function is_dispinterface(def: tdef): boolean;
@ -4645,7 +4646,7 @@ implementation
odt_objcclass,
odt_objcprotocol:
vmtmethodoffset:=0;
odt_interfacecom,odt_interfacecorba:
odt_interfacecom,odt_interfacecorba,odt_dispinterface:
vmtmethodoffset:=index*sizeof(pint);
else
{$ifdef WITHDMT}
@ -4668,9 +4669,9 @@ implementation
function tobjectdef.needs_inittable : boolean;
begin
case objecttype of
odt_dispinterface,
odt_class :
needs_inittable:=false;
odt_dispinterface,
odt_interfacecom:
needs_inittable:=true;
odt_interfacecorba:
@ -5364,6 +5365,14 @@ implementation
(tobjectdef(def).objecttype=odt_interfacecom);
end;
function is_interfacecom_or_dispinterface(def: tdef): boolean;
begin
is_interfacecom_or_dispinterface:=
assigned(def) and
(def.typ=objectdef) and
(tobjectdef(def).objecttype in [odt_interfacecom,odt_dispinterface]);
end;
function is_interfacecorba(def: tdef): boolean;
begin
is_interfacecorba:=