paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-20 18:29:28 +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
% \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
% 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
% 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)

7
compiler/pdecobj.pas
View File

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

11
compiler/symdef.pas
View File

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