Extract tdef.is_related plus its overrides in tobjectdef, trecorddef and tstringdef into a new function def_is_related in unit defcmp.

defcmp.pas:
  + add new function "def_is_related" which combines the "is_related" overloads of "tobjectdef", "trecorddef" and "tstringdef" (it returns "false" for other def types which is what "tdef.is_related" did)
  * compare_defs_ext & compatible_childmethod_resultdef: change call from "x.is_related" to "def_is_related(x,...)"
symtype.pas, tdef:
  - remove "is_related" method
symdef.pas:
  - remove "is_related" in "tobjectdef", "trecorddef" and "tstringdef"
  * tobjectdef.needs_inittable: for checking whether a Corba interface somehow inherits from a IInterface don't use "is_related" anymore (we want to avoid the dependency after all), but mimic the necessary functionality of "def_is_related"
htypechk.pas, nadd.pas, ncal.pas, ncnv.pas, ngtcon.pas, nld.pas, optvirt.pas, pdecobj.pas, pdecvar.pas, pexpr.pas, pgenutil.pas:
  * change call from "x.is_related" to "def_is_related(x,...)"
symtable.pas
  + use unit defcmp
  * change call from "x.is_related" to "def_is_related(x,...)"
jvm/njvmcnv.pas, jvm/njvmflw.pas:
  * change call from "x.is_related" to "def_is_related(x,...)"

git-svn-id: trunk@25847 -

compiler/defcmp.pas

@@ -156,6 +156,14 @@ interface
     { the interface intfdef and returns the corresponding "implementation link }
     function find_implemented_interface(impldef,intfdef:tobjectdef):timplementedinterface;
 
+    { Checks whether to defs are related to each other. Thereby the following  }
+    { cases of curdef are implemented:                                         }
+    { - stringdef: on JVM JLObject, JLString and AnsiString are compatible     }
+    { - recorddef: on JVM records are compatible to java_fpcbaserecordtype     }
+    {              and JLObject                                                }
+    { - objectdef: if it inherits from otherdef or they are equal              }
+    function def_is_related(curdef,otherdef:tdef):boolean;
+
 
 implementation
 
@@ -1323,7 +1331,7 @@ implementation
                       if (
                           (tpointerdef(def_from).pointeddef.typ=objectdef) and
                           (tpointerdef(def_to).pointeddef.typ=objectdef) and
-                          tobjectdef(tpointerdef(def_from).pointeddef).is_related(
+                          def_is_related(tobjectdef(tpointerdef(def_from).pointeddef),
                             tobjectdef(tpointerdef(def_to).pointeddef))
                          ) then
                        begin
@@ -1520,7 +1528,7 @@ implementation
              begin
                { object pascal objects }
                if (def_from.typ=objectdef) and
-                  (tobjectdef(def_from).is_related(tobjectdef(def_to))) then
+                  (def_is_related(tobjectdef(def_from),tobjectdef(def_to))) then
                 begin
                   doconv:=tc_equal;
                   { also update in htypechk.pas/var_para_allowed if changed
@@ -1667,7 +1675,7 @@ implementation
                     begin
                       doconv:=tc_equal;
                       if (cdo_explicit in cdoptions) or
-                         tobjectdef(tclassrefdef(def_from).pointeddef).is_related(
+                         def_is_related(tobjectdef(tclassrefdef(def_from).pointeddef),
                            tobjectdef(tclassrefdef(def_to).pointeddef)) then
                         eq:=te_convert_l1;
                     end;
@@ -2193,7 +2201,7 @@ implementation
            (childretdef.typ=objectdef) and
            is_class_or_interface_or_objc_or_java(parentretdef) and
            is_class_or_interface_or_objc_or_java(childretdef) and
-           (tobjectdef(childretdef).is_related(tobjectdef(parentretdef))))
+           (def_is_related(tobjectdef(childretdef),tobjectdef(parentretdef))))
       end;
 
 
@@ -2220,4 +2228,139 @@ implementation
           end;
       end;
 
+
+    function stringdef_is_related(curdef:tstringdef;otherdef:tdef):boolean;
+      begin
+        result:=
+          (target_info.system in systems_jvm) and
+          (((curdef.stringtype in [st_unicodestring,st_widestring]) and
+            ((otherdef=java_jlobject) or
+             (otherdef=java_jlstring))) or
+           ((curdef.stringtype=st_ansistring) and
+            ((otherdef=java_jlobject) or
+             (otherdef=java_ansistring))));
+      end;
+
+
+    function recorddef_is_related(curdef:trecorddef;otherdef:tdef):boolean;
+      begin
+        { records are implemented via classes in the JVM target, and are
+          all descendents of the java_fpcbaserecordtype class }
+        result:=false;
+        if (target_info.system in systems_jvm) then
+          begin
+            if otherdef.typ=objectdef then
+              begin
+                otherdef:=find_real_class_definition(tobjectdef(otherdef),false);
+                if (otherdef=java_jlobject) or
+                   (otherdef=java_fpcbaserecordtype) then
+                  result:=true
+              end;
+          end;
+      end;
+
+
+    { true if prot implements d (or if they are equal) }
+    function is_related_interface_multiple(prot:tobjectdef;d:tdef):boolean;
+      var
+        i : longint;
+      begin
+        { objcprotocols have multiple inheritance, all protocols from which
+          the current protocol inherits are stored in implementedinterfaces }
+        result:=prot=d;
+        if result then
+          exit;
+
+        for i:=0 to prot.implementedinterfaces.count-1 do
+          begin
+            result:=is_related_interface_multiple(timplementedinterface(prot.implementedinterfaces[i]).intfdef,d);
+            if result then
+              exit;
+          end;
+      end;
+
+
+    function objectdef_is_related(curdef:tobjectdef;otherdef:tdef):boolean;
+      var
+         realself,
+         hp : tobjectdef;
+      begin
+        if (otherdef.typ=objectdef) then
+          otherdef:=find_real_class_definition(tobjectdef(otherdef),false);
+        realself:=find_real_class_definition(curdef,false);
+        if realself=otherdef then
+          begin
+            result:=true;
+            exit;
+          end;
+
+        if (otherdef.typ<>objectdef) then
+          begin
+            result:=false;
+            exit;
+          end;
+
+        { Objective-C protocols and Java interfaces can use multiple
+           inheritance }
+        if (realself.objecttype in [odt_objcprotocol,odt_interfacejava]) then
+          begin
+            result:=is_related_interface_multiple(realself,otherdef);
+            exit;
+          end;
+
+        { formally declared Objective-C and Java classes match Objective-C/Java
+          classes with the same name. In case of Java, the package must also
+          match (still required even though we looked up the real definitions
+          above, because these may be two different formal declarations that
+          cannot be resolved yet) }
+        if (realself.objecttype in [odt_objcclass,odt_javaclass]) and
+           (tobjectdef(otherdef).objecttype=curdef.objecttype) and
+           ((oo_is_formal in curdef.objectoptions) or
+            (oo_is_formal in tobjectdef(otherdef).objectoptions)) and
+           (curdef.objrealname^=tobjectdef(otherdef).objrealname^) then
+          begin
+            { check package name for Java }
+            if curdef.objecttype=odt_objcclass then
+              result:=true
+            else
+              begin
+                result:=
+                  assigned(curdef.import_lib)=assigned(tobjectdef(otherdef).import_lib);
+                if result and
+                   assigned(curdef.import_lib) then
+                  result:=curdef.import_lib^=tobjectdef(otherdef).import_lib^;
+              end;
+            exit;
+          end;
+
+        hp:=realself.childof;
+        while assigned(hp) do
+          begin
+             if hp=otherdef then
+               begin
+                  result:=true;
+                  exit;
+               end;
+             hp:=hp.childof;
+          end;
+        result:=false;
+      end;
+
+
+    function def_is_related(curdef,otherdef:tdef):boolean;
+      begin
+        if not assigned(curdef) then
+          internalerror(2013102303);
+        case curdef.typ of
+          stringdef:
+            result:=stringdef_is_related(tstringdef(curdef),otherdef);
+          recorddef:
+            result:=recorddef_is_related(trecorddef(curdef),otherdef);
+          objectdef:
+            result:=objectdef_is_related(tobjectdef(curdef),otherdef);
+          else
+            result:=false;
+        end;
+      end;
+
 end.

compiler/htypechk.pas

@@ -1472,7 +1472,7 @@ implementation
                         is_open_array(fromdef) or
                         is_open_array(todef) or
                         ((fromdef.typ=pointerdef) and (todef.typ=arraydef)) or
-                        (fromdef.is_related(todef))) and
+                        (def_is_related(fromdef,todef))) and
                     (fromdef.size<>todef.size) then
                   begin
                     { in TP it is allowed to typecast to smaller types. But the variable can't
@@ -1964,7 +1964,7 @@ implementation
                   (tobjectdef(def_from).objecttype=odt_object) and
                   (tobjectdef(def_to).objecttype=odt_object)
                  ) and
-                 (tobjectdef(def_from).is_related(tobjectdef(def_to))) then
+                 (def_is_related(tobjectdef(def_from),tobjectdef(def_to))) then
                 eq:=te_convert_l1;
             end;
           filedef :
@@ -2728,7 +2728,7 @@ implementation
                   (def_from.typ=objectdef) and
                   (def_to.typ=objectdef) and
                   (tobjectdef(def_from).objecttype=tobjectdef(def_to).objecttype) and
-                  tobjectdef(def_from).is_related(tobjectdef(def_to)) then
+                  def_is_related(tobjectdef(def_from),tobjectdef(def_to)) then
                  begin
                    eq:=te_convert_l1;
                    objdef:=tobjectdef(def_from);
@@ -3226,7 +3226,7 @@ implementation
                   the struct in which the current best method was found }
                 if assigned(pd.struct) and
                    (pd.struct<>tprocdef(bestpd).struct) and
-                   tprocdef(bestpd).struct.is_related(pd.struct) then
+                   def_is_related(tprocdef(bestpd).struct,pd.struct) then
                   break;
                 if (pd.proctypeoption=bestpd.proctypeoption) and
                    ((pd.procoptions*[po_classmethod,po_methodpointer])=(bestpd.procoptions*[po_classmethod,po_methodpointer])) and

compiler/jvm/njvmcnv.pas

@@ -1083,7 +1083,7 @@ implementation
             but do not allow records to be directly typecasted into class/
             pointer types (you have to use FpcBaseRecordType(@rec) instead) }
           if not is_record(fromdef) and
-             fromdef.is_related(todef) then
+             is_related(fromdef,todef) then
             exit;
           if check_type_equality(fromdef,todef) then
             exit;
@@ -1100,7 +1100,7 @@ implementation
             exit;
           if (fromdef.typ=classrefdef) and
              (todef.typ=classrefdef) and
-             tclassrefdef(fromdef).pointeddef.is_related(tclassrefdef(todef).pointeddef) then
+             def_is_related(tclassrefdef(fromdef).pointeddef,tclassrefdef(todef).pointeddef) then
             exit;
           { special case: "array of shortstring" to "array of ShortstringClass"
             and "array of <record>" to "array of FpcRecordBaseType" (normally

compiler/jvm/njvmflw.pas

@@ -127,7 +127,7 @@ implementation
            exit;
          { Java exceptions must descend from java.lang.Throwable }
          if assigned(left) and
-            not(left.resultdef).is_related(java_jlthrowable) then
+            not def_is_related(left.resultdef,java_jlthrowable) then
            MessagePos2(left.fileinfo,type_e_incompatible_types,left.resultdef.typename,'class(JLThrowable)');
          { Java exceptions cannot be raised "at" a specific location }
          if assigned(right) then

compiler/nadd.pas

@@ -1829,7 +1829,7 @@ implementation
               begin
                 if is_implicit_pointer_object_type(rd) and is_implicit_pointer_object_type(ld) then
                  begin
-                   if tobjectdef(rd).is_related(tobjectdef(ld)) then
+                   if def_is_related(tobjectdef(rd),tobjectdef(ld)) then
                     inserttypeconv(right,left.resultdef)
                    else
                     inserttypeconv(left,right.resultdef);
@@ -1847,7 +1847,7 @@ implementation
           begin
             if (nodetype in [equaln,unequaln]) then
               begin
-                if tobjectdef(tclassrefdef(rd).pointeddef).is_related(
+                if def_is_related(tobjectdef(tclassrefdef(rd).pointeddef),
                         tobjectdef(tclassrefdef(ld).pointeddef)) then
                   inserttypeconv(right,left.resultdef)
                 else

compiler/ncal.pas

@@ -360,7 +360,7 @@ implementation
           if is_interfacecom_or_dispinterface(sourcedef) then
             begin
               { distinct IDispatch and IUnknown interfaces }
-              if tobjectdef(sourcedef).is_related(tobjectdef(search_system_type('IDISPATCH').typedef)) then
+              if def_is_related(tobjectdef(sourcedef),tobjectdef(search_system_type('IDISPATCH').typedef)) then
                 result:=vardispatch
               else
                 result:=varunknown;

compiler/ncnv.pas

@@ -1679,7 +1679,7 @@ implementation
 
     function ttypeconvnode.typecheck_variant_to_interface : tnode;
       begin
-        if tobjectdef(resultdef).is_related(tobjectdef(search_system_type('IDISPATCH').typedef)) then
+        if def_is_related(tobjectdef(resultdef),tobjectdef(search_system_type('IDISPATCH').typedef)) then
           result := ccallnode.createinternres(
             'fpc_variant_to_idispatch',
               ccallparanode.create(left,nil)
@@ -1696,7 +1696,7 @@ implementation
 
     function ttypeconvnode.typecheck_interface_to_variant : tnode;
       begin
-        if tobjectdef(left.resultdef).is_related(tobjectdef(search_system_type('IDISPATCH').typedef)) then
+        if def_is_related(tobjectdef(left.resultdef),tobjectdef(search_system_type('IDISPATCH').typedef)) then
           result := ccallnode.createinternres(
             'fpc_idispatch_to_variant',
               ccallparanode.create(left,nil)
@@ -2294,8 +2294,8 @@ implementation
                        begin
                          { check if the types are related }
                          if not(nf_internal in flags) and
-                            (not(tobjectdef(left.resultdef).is_related(tobjectdef(resultdef)))) and
-                            (not(tobjectdef(resultdef).is_related(tobjectdef(left.resultdef)))) then
+                            (not(def_is_related(tobjectdef(left.resultdef),tobjectdef(resultdef)))) and
+                            (not(def_is_related(tobjectdef(resultdef),tobjectdef(left.resultdef)))) then
                            begin
                              { Give an error when typecasting class to interface, this is compatible
                                with delphi }
@@ -3823,9 +3823,9 @@ implementation
                     is_javaclass(left.resultdef) then
               begin
                 { the operands must be related }
-                if (not(tobjectdef(left.resultdef).is_related(
+                if (not(def_is_related(tobjectdef(left.resultdef),
                    tobjectdef(tclassrefdef(right.resultdef).pointeddef)))) and
-                   (not(tobjectdef(tclassrefdef(right.resultdef).pointeddef).is_related(
+                   (not(def_is_related(tobjectdef(tclassrefdef(right.resultdef).pointeddef),
                    tobjectdef(left.resultdef)))) then
                   CGMessage2(type_e_classes_not_related,
                      FullTypeName(left.resultdef,tclassrefdef(right.resultdef).pointeddef),

compiler/ngtcon.pas

@@ -750,7 +750,7 @@ function get_next_varsym(def: tabstractrecorddef; const SymList:TFPHashObjectLis
         case node.nodetype of
           loadvmtaddrn:
             begin
-              if not Tobjectdef(tclassrefdef(node.resultdef).pointeddef).is_related(tobjectdef(def.pointeddef)) then
+              if not def_is_related(tobjectdef(tclassrefdef(node.resultdef).pointeddef),tobjectdef(def.pointeddef)) then
                 IncompatibleTypes(node.resultdef, def);
               list.concat(Tai_const.Create_sym(current_asmdata.RefAsmSymbol(Tobjectdef(tclassrefdef(node.resultdef).pointeddef).vmt_mangledname,AT_DATA)));
             end;

compiler/nld.pas

@@ -727,7 +727,7 @@ implementation
         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
+           if not def_is_related(right.resultdef,left.resultdef) then
              begin
                { remove property flag to avoid errors, see comments for }
                { tf_winlikewidestring assignments below                 }

compiler/optvirt.pas

@@ -171,6 +171,7 @@ unit optvirt;
       symconst,
       symbase,
       symtable,
+      defcmp,
       nobj,
       verbose;
 
@@ -357,7 +358,7 @@ unit optvirt;
            write('   Checking for classrefdef inheritance of ',def.typename);
 {$endif debug_devirt}
            for i:=0 to classrefdefs.count-1 do
-             if tobjectdef(def).is_related(tobjectdef(classrefdefs[i])) then
+             if def_is_related(tobjectdef(def),tobjectdef(classrefdefs[i])) then
                begin
 {$ifdef debug_devirt}
                  writeln('... Found: inherits from Class Of ',tobjectdef(classrefdefs[i]).typename);

compiler/pdecobj.pas

@@ -757,7 +757,7 @@ implementation
                       begin
                         if not is_class(current_objectdef.childof.extendeddef) then
                           Internalerror(2011021101);
-                        if not hdef.is_related(current_objectdef.childof.extendeddef) then
+                        if not def_is_related(hdef,current_objectdef.childof.extendeddef) then
                           Message1(type_e_class_helper_must_extend_subclass,current_objectdef.childof.extendeddef.typename);
                       end;
                   end;

compiler/pdecvar.pas

@@ -823,7 +823,7 @@ implementation
              if is_interface(p.propdef) then
                begin
                  { an interface type may delegate itself or one of its ancestors }
-                 if not p.propdef.is_related(def) then
+                 if not def_is_related(p.propdef,def) then
                    begin
                      message2(parser_e_implements_must_have_correct_type,def.typename,p.propdef.typename);
                      exit;

compiler/pexpr.pas

@@ -1377,7 +1377,7 @@ implementation
                using "parentobject.methodname()" }
              if assigned(current_structdef) and
                 not(getaddr) and
-                current_structdef.is_related(hdef) then
+                def_is_related(current_structdef,hdef) then
                begin
                  result:=ctypenode.create(hdef);
                  ttypenode(result).typesym:=sym;
@@ -2976,7 +2976,7 @@ implementation
                                    to }
                                  if (srsym.Owner.defowner.typ=objectdef) and
                                      is_objectpascal_helper(tobjectdef(srsym.Owner.defowner)) then
-                                   if current_structdef.is_related(tdef(srsym.Owner.defowner)) and
+                                   if def_is_related(current_structdef,tdef(srsym.Owner.defowner)) and
                                        assigned(tobjectdef(current_structdef).childof) then
                                      hdef:=tobjectdef(current_structdef).childof
                                    else

compiler/pgenutil.pas

@@ -182,7 +182,7 @@ uses
                           odt_interfacecorba,
                           odt_interfacejava,
                           odt_dispinterface:
-                            if not paraobjdef.is_related(formalobjdef.childof) then
+                            if not def_is_related(paraobjdef,formalobjdef.childof) then
                               begin
                                 MessagePos2(filepos,type_e_incompatible_types,paraobjdef.typename,formalobjdef.childof.typename);
                                 result:=false;
@@ -226,7 +226,7 @@ uses
                             continue;
                           end;
                         if assigned(formalobjdef.childof) and
-                            not paradef.is_related(formalobjdef.childof) then
+                            not def_is_related(paradef,formalobjdef.childof) then
                           begin
                             MessagePos2(filepos,type_e_incompatible_types,paraobjdef.typename,formalobjdef.childof.typename);
                             result:=false;

compiler/symdef.pas

@@ -291,8 +291,6 @@ interface
           { debug }
           function  needs_inittable : boolean;override;
           function  needs_separate_initrtti:boolean;override;
-          { jvm }
-          function  is_related(d : tdef) : boolean;override;
        end;
 
        tobjectdef = class;
@@ -399,7 +397,6 @@ interface
           { this should be called when this class implements an interface }
           procedure prepareguid;
           function  is_publishable : boolean;override;
-          function  is_related(d : tdef) : boolean;override;
           function  needs_inittable : boolean;override;
           function  needs_separate_initrtti : boolean;override;
           function  rtti_mangledname(rt:trttitype):string;override;
@@ -770,7 +767,6 @@ interface
           function alignment : shortint;override;
           function  needs_inittable : boolean;override;
           function  getvardef:longint;override;
-          function  is_related(d : tdef) : boolean;override;
        end;
 
        { tenumdef }
@@ -2158,18 +2154,6 @@ implementation
         result:=vardef[stringtype];
       end;
 
-    function tstringdef.is_related(d: tdef): boolean;
-      begin
-        result:=
-          (target_info.system in systems_jvm) and
-          (((stringtype in [st_unicodestring,st_widestring]) and
-            ((d=java_jlobject) or
-             (d=java_jlstring))) or
-           ((stringtype=st_ansistring) and
-            ((d=java_jlobject) or
-             (d=java_ansistring))));
-      end;
-
 
     function tstringdef.alignment : shortint;
       begin
@@ -3859,23 +3843,6 @@ implementation
         result:=true;
       end;
 
-    function trecorddef.is_related(d: tdef): boolean;
-      begin
-        { records are implemented via classes in the JVM target, and are
-          all descendents of the java_fpcbaserecordtype class }
-        is_related:=false;
-        if (target_info.system in systems_jvm) then
-          begin
-            if d.typ=objectdef then
-              begin
-                d:=find_real_class_definition(tobjectdef(d),false);
-                if (d=java_jlobject) or
-                   (d=java_fpcbaserecordtype) then
-                  is_related:=true
-              end;
-          end;
-      end;
-
 
     procedure trecorddef.buildderef;
       begin
@@ -6184,93 +6151,6 @@ implementation
      end;
 
 
-   { true if prot implements d (or if they are equal) }
-   function is_related_interface_multiple(prot: tobjectdef; d : tdef) : boolean;
-     var
-       i  : longint;
-     begin
-       { objcprotocols have multiple inheritance, all protocols from which
-         the current protocol inherits are stored in implementedinterfaces }
-       result:=prot=d;
-       if result then
-         exit;
-
-       for i:=0 to prot.ImplementedInterfaces.count-1 do
-         begin
-           result:=is_related_interface_multiple(TImplementedInterface(prot.ImplementedInterfaces[i]).intfdef,d);
-           if result then
-             exit;
-         end;
-     end;
-
-
-   { true, if self inherits from d (or if they are equal) }
-   function tobjectdef.is_related(d : tdef) : boolean;
-     var
-        realself,
-        hp : tobjectdef;
-     begin
-        if (d.typ=objectdef) then
-          d:=find_real_class_definition(tobjectdef(d),false);
-        realself:=find_real_class_definition(self,false);
-        if realself=d then
-          begin
-            is_related:=true;
-            exit;
-          end;
-
-        if (d.typ<>objectdef) then
-          begin
-            is_related:=false;
-            exit;
-          end;
-
-        { Objective-C protocols and Java interfaces can use multiple
-           inheritance }
-        if (realself.objecttype in [odt_objcprotocol,odt_interfacejava]) then
-          begin
-            is_related:=is_related_interface_multiple(realself,d);
-            exit
-          end;
-
-        { formally declared Objective-C and Java classes match Objective-C/Java
-          classes with the same name. In case of Java, the package must also
-          match (still required even though we looked up the real definitions
-          above, because these may be two different formal declarations that
-          cannot be resolved yet) }
-        if (realself.objecttype in [odt_objcclass,odt_javaclass]) and
-           (tobjectdef(d).objecttype=objecttype) and
-           ((oo_is_formal in objectoptions) or
-            (oo_is_formal in tobjectdef(d).objectoptions)) and
-           (objrealname^=tobjectdef(d).objrealname^) then
-          begin
-            { check package name for Java }
-            if objecttype=odt_objcclass then
-              is_related:=true
-            else
-              begin
-                is_related:=
-                  assigned(import_lib)=assigned(tobjectdef(d).import_lib);
-                if is_related and
-                   assigned(import_lib) then
-                  is_related:=import_lib^=tobjectdef(d).import_lib^;
-              end;
-            exit;
-          end;
-
-        hp:=realself.childof;
-        while assigned(hp) do
-          begin
-             if hp=d then
-               begin
-                  is_related:=true;
-                  exit;
-               end;
-             hp:=hp.childof;
-          end;
-        is_related:=false;
-     end;
-
    function tobjectdef.find_destructor: tprocdef;
      var
        objdef: tobjectdef;
@@ -6356,6 +6236,8 @@ implementation
 
 
     function tobjectdef.needs_inittable : boolean;
+      var
+        hp : tobjectdef;
       begin
          case objecttype of
             odt_helper,
@@ -6365,7 +6247,19 @@ implementation
             odt_interfacecom:
               needs_inittable:=true;
             odt_interfacecorba:
-              needs_inittable:=is_related(interface_iunknown);
+              begin
+                hp:=childof;
+                while assigned(hp) do
+                  begin
+                    if hp=interface_iunknown then
+                      begin
+                        needs_inittable:=true;
+                        exit;
+                      end;
+                    hp:=hp.childof;
+                  end;
+                needs_inittable:=false;
+              end;
             odt_object:
               needs_inittable:=
                 tObjectSymtable(symtable).needs_init_final or

compiler/symtable.pas

@@ -360,7 +360,7 @@ implementation
       { global }
       verbose,globals,
       { symtable }
-      symutil,defutil,
+      symutil,defutil,defcmp,
       { module }
       fmodule,
       { codegen }
@@ -2249,19 +2249,19 @@ implementation
                          { access from child class }
                          assigned(contextobjdef) and
                          assigned(current_structdef) and
-                         contextobjdef.is_related(symownerdef) and
-                         current_structdef.is_related(contextobjdef)
+                         def_is_related(contextobjdef,symownerdef) and
+                         def_is_related(current_structdef,contextobjdef)
                        ) or
                        (
                          { helpers can access strict protected symbols }
                          is_objectpascal_helper(contextobjdef) and
-                         tobjectdef(contextobjdef).extendeddef.is_related(symownerdef)
+                         def_is_related(tobjectdef(contextobjdef).extendeddef,symownerdef)
                        ) or
                        (
                          { same as above, but from context of call node inside
                            helper method }
                          is_objectpascal_helper(current_structdef) and
-                         tobjectdef(current_structdef).extendeddef.is_related(symownerdef)
+                         def_is_related(tobjectdef(current_structdef).extendeddef,symownerdef)
                        );
             end;
           vis_protected :
@@ -2278,7 +2278,7 @@ implementation
                         assigned(contextobjdef) and
                         (contextobjdef.owner.symtabletype in [globalsymtable,staticsymtable,ObjectSymtable]) and
                         (contextobjdef.owner.iscurrentunit) and
-                        contextobjdef.is_related(symownerdef)
+                        def_is_related(contextobjdef,symownerdef)
                        ) or
                        ( // the case of specialize inside the generic declaration and nested types
                         (symownerdef.owner.symtabletype in [objectsymtable,recordsymtable]) and
@@ -2296,7 +2296,7 @@ implementation
                         (
                           { helpers can access protected symbols }
                           is_objectpascal_helper(contextobjdef) and
-                          tobjectdef(contextobjdef).extendeddef.is_related(symownerdef)
+                          def_is_related(tobjectdef(contextobjdef).extendeddef,symownerdef)
                         )
                        )
                       );
@@ -2681,11 +2681,11 @@ implementation
             { The contextclassh is used for visibility. The classh must be equal to
               or be a parent of contextclassh. E.g. for inherited searches the classh is the
               parent or a class helper. }
-            if not (contextclassh.is_related(classh) or
+            if not (def_is_related(contextclassh,classh) or
                 (is_classhelper(contextclassh) and
                  assigned(tobjectdef(contextclassh).extendeddef) and
                 (tobjectdef(contextclassh).extendeddef.typ=objectdef) and
-                tobjectdef(contextclassh).extendeddef.is_related(classh))) then
+                def_is_related(tobjectdef(contextclassh).extendeddef,classh))) then
               internalerror(200811161);
           end;
         result:=false;
@@ -3252,7 +3252,7 @@ implementation
                     }
                     defowner:=tobjectdef(tprocdef(tprocsym(srsym).procdeflist[i]).owner.defowner);
                     if (oo_is_classhelper in defowner.objectoptions) and
-                       pd.is_related(defowner.childof) then
+                       def_is_related(pd,defowner.childof) then
                       begin
                         { we need to know if a procedure references symbols
                           in the static symtable, because then it can't be

compiler/symtype.pas

@@ -87,7 +87,6 @@ interface
          function  is_publishable:boolean;virtual;abstract;
          function  needs_inittable:boolean;virtual;abstract;
          function  needs_separate_initrtti:boolean;virtual;abstract;
-         function  is_related(def:tdef):boolean;virtual;
          procedure ChangeOwner(st:TSymtable);
          procedure register_created_object_type;virtual;
       end;
@@ -331,12 +330,6 @@ implementation
       end;
 
 
-    function tdef.is_related(def:tdef):boolean;
-      begin
-        result:=false;
-      end;
-
-
     function tdef.packedbitsize:asizeint;
       begin
         result:=size * 8;