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

git-svn-id: trunk@16756 -

compiler/msg/errore.msg

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

compiler/pdecobj.pas

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

compiler/symdef.pas

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

compiler/symtable.pas

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