From 798bb91e90c20f3df693d3329b631471fe4af866 Mon Sep 17 00:00:00 2001 From: svenbarth Date: Fri, 25 Oct 2013 19:44:27 +0000 Subject: [PATCH] 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 | 151 +++++++++++++++++++++++++++++++++++++-- compiler/htypechk.pas | 8 +-- compiler/jvm/njvmcnv.pas | 4 +- compiler/jvm/njvmflw.pas | 2 +- compiler/nadd.pas | 4 +- compiler/ncal.pas | 2 +- compiler/ncnv.pas | 12 ++-- compiler/ngtcon.pas | 2 +- compiler/nld.pas | 2 +- compiler/optvirt.pas | 3 +- compiler/pdecobj.pas | 2 +- compiler/pdecvar.pas | 2 +- compiler/pexpr.pas | 4 +- compiler/pgenutil.pas | 4 +- compiler/symdef.pas | 136 ++++------------------------------- compiler/symtable.pas | 20 +++--- compiler/symtype.pas | 7 -- 17 files changed, 198 insertions(+), 167 deletions(-) diff --git a/compiler/defcmp.pas b/compiler/defcmp.pas index 82ca9f8e1a..0a8fdd3939 100644 --- a/compiler/defcmp.pas +++ b/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. diff --git a/compiler/htypechk.pas b/compiler/htypechk.pas index ec2e286953..dfb57ac72b 100644 --- a/compiler/htypechk.pas +++ b/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 diff --git a/compiler/jvm/njvmcnv.pas b/compiler/jvm/njvmcnv.pas index 4864a1922c..a4a09a200f 100644 --- a/compiler/jvm/njvmcnv.pas +++ b/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 " to "array of FpcRecordBaseType" (normally diff --git a/compiler/jvm/njvmflw.pas b/compiler/jvm/njvmflw.pas index 2472f2a1c5..db86f059f9 100644 --- a/compiler/jvm/njvmflw.pas +++ b/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 diff --git a/compiler/nadd.pas b/compiler/nadd.pas index 0e66a5cfad..9b8a50ddba 100644 --- a/compiler/nadd.pas +++ b/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 diff --git a/compiler/ncal.pas b/compiler/ncal.pas index 4f611ff470..1e13b5ee58 100644 --- a/compiler/ncal.pas +++ b/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; diff --git a/compiler/ncnv.pas b/compiler/ncnv.pas index 5c62ad3f27..5bbeab56f5 100644 --- a/compiler/ncnv.pas +++ b/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), diff --git a/compiler/ngtcon.pas b/compiler/ngtcon.pas index 7649bf966d..7c598de8af 100644 --- a/compiler/ngtcon.pas +++ b/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; diff --git a/compiler/nld.pas b/compiler/nld.pas index 518ca3468e..ef36504ba1 100644 --- a/compiler/nld.pas +++ b/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 } diff --git a/compiler/optvirt.pas b/compiler/optvirt.pas index 9646c1b172..b646967dbb 100644 --- a/compiler/optvirt.pas +++ b/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); diff --git a/compiler/pdecobj.pas b/compiler/pdecobj.pas index 99dc457630..a7adfb736a 100644 --- a/compiler/pdecobj.pas +++ b/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; diff --git a/compiler/pdecvar.pas b/compiler/pdecvar.pas index 4ac114609b..653b7e251e 100644 --- a/compiler/pdecvar.pas +++ b/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; diff --git a/compiler/pexpr.pas b/compiler/pexpr.pas index 58787389fe..e54a3ac8af 100644 --- a/compiler/pexpr.pas +++ b/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 diff --git a/compiler/pgenutil.pas b/compiler/pgenutil.pas index 5e1a34aae3..5d27fdba41 100644 --- a/compiler/pgenutil.pas +++ b/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; diff --git a/compiler/symdef.pas b/compiler/symdef.pas index de7674d3c0..28b16af9a6 100644 --- a/compiler/symdef.pas +++ b/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 diff --git a/compiler/symtable.pas b/compiler/symtable.pas index 213bab6b36..7ad3d55a84 100644 --- a/compiler/symtable.pas +++ b/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 diff --git a/compiler/symtype.pas b/compiler/symtype.pas index ae68fbaf0d..114d1cf4d7 100644 --- a/compiler/symtype.pas +++ b/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;