paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-13 23:42:34 +02:00
Code Issues Packages Projects Releases Wiki Activity

compiler: always derive DispInterface from IDispatch, this solve a problem with assigning dispinterface to IUnknown or IDispatch variables

Browse Source 
git-svn-id: trunk@16756 -
This commit is contained in:
paul 2011-01-13 04:43:49 +00:00
parent dad8313512
commit 368c215070
4 changed files with 16 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
compiler/msg/errore.msg
View File

@ -1078,7 +1078,7 @@ parser_e_protected_or_private_expected=03214_E_Protected or private expected
parser_e_illegal_slice=03215_E_SLICE can't be used outside of parameter list parser_e_illegal_slice=03215_E_SLICE can't be used outside of parameter list
% \var{slice} can be used only for arguments accepting an open array parameter. % \var{slice} can be used only for arguments accepting an open array parameter.
parser_e_dispinterface_cant_have_parent=03216_E_A DISPINTERFACE can't have a parent class parser_e_dispinterface_cant_have_parent=03216_E_A DISPINTERFACE can't have a parent class
% A DISPINTERFACE is a special type of interface which can't have a parent class. % A DISPINTERFACE is a special type of interface which can't have a parent class. Dispinterface always derive from IDispatch type.
parser_e_dispinterface_needs_a_guid=03217_E_A DISPINTERFACE needs a guid parser_e_dispinterface_needs_a_guid=03217_E_A DISPINTERFACE needs a guid
% A DISPINTERFACE always needs an interface identification (a GUID). % A DISPINTERFACE always needs an interface identification (a GUID).
parser_w_overridden_methods_not_same_ret=03218_W_Overridden methods must have a related return type. This code may crash, it depends on a Delphi parser bug ("$2" is overridden by "$1" which has another return type) parser_w_overridden_methods_not_same_ret=03218_W_Overridden methods must have a related return type. This code may crash, it depends on a Delphi parser bug ("$2" is overridden by "$1" which has another return type)

7
compiler/pdecobj.pas
View File

@ -536,6 +536,8 @@ implementation
odt_interfacecom: odt_interfacecom:
if current_objectdef<>interface_iunknown then if current_objectdef<>interface_iunknown then
childof:=interface_iunknown; childof:=interface_iunknown;
odt_dispinterface:
childof:=interface_idispatch;
odt_objcclass: odt_objcclass:
CGMessage(parser_h_no_objc_parent); CGMessage(parser_h_no_objc_parent);
end; end;
@ -1027,7 +1029,10 @@ implementation
case current_objectdef.objecttype of case current_objectdef.objecttype of
odt_interfacecom : odt_interfacecom :
if (current_structdef.objname^='IUNKNOWN') then if (current_structdef.objname^='IUNKNOWN') then
interface_iunknown:=current_objectdef; interface_iunknown:=current_objectdef
else
if (current_structdef.objname^='IDISPATCH') then
interface_idispatch:=current_objectdef;
odt_class : odt_class :
if (current_structdef.objname^='TOBJECT') then if (current_structdef.objname^='TOBJECT') then
class_tobject:=current_objectdef; class_tobject:=current_objectdef;

11
compiler/symdef.pas
View File

@ -707,6 +707,8 @@ interface
class_tobject : tobjectdef; class_tobject : tobjectdef;
{ pointer to the ancestor of all COM interfaces } { pointer to the ancestor of all COM interfaces }
interface_iunknown : tobjectdef; interface_iunknown : tobjectdef;
{ pointer to the ancestor of all dispinterfaces }
interface_idispatch : tobjectdef;
{ pointer to the TGUID type { pointer to the TGUID type
of all interfaces } of all interfaces }
rec_tguid : trecorddef; rec_tguid : trecorddef;
@ -4134,9 +4136,12 @@ implementation
(objname^='TOBJECT') then (objname^='TOBJECT') then
class_tobject:=self; class_tobject:=self;
if (childof=nil) and if (childof=nil) and
(objecttype=odt_interfacecom) and (objecttype=odt_interfacecom) then
(objname^='IUNKNOWN') then if (objname^='IUNKNOWN') then
interface_iunknown:=self; interface_iunknown:=self
else
if (objname^='IDISPATCH') then
interface_idispatch:=self;
if (childof=nil) and if (childof=nil) and
(objecttype=odt_objcclass) and (objecttype=odt_objcclass) and
(objname^='PROTOCOL') then (objname^='PROTOCOL') then

1
compiler/symtable.pas
View File

@ -2800,6 +2800,7 @@ implementation
{ set some global vars to nil, might be important for the ide } { set some global vars to nil, might be important for the ide }
class_tobject:=nil; class_tobject:=nil;
interface_iunknown:=nil; interface_iunknown:=nil;
interface_idispatch:=nil;
rec_tguid:=nil; rec_tguid:=nil;
dupnr:=0; dupnr:=0;
end; end;