paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-06 22:07:56 +02:00
Code Issues Packages Projects Releases Wiki Activity

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

Browse Source 
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 -
This commit is contained in:
svenbarth 2013-10-25 19:44:27 +00:00
parent ebf70342c5
commit 798bb91e90
17 changed files with 198 additions and 167 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

151
compiler/defcmp.pas
View File

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

8
compiler/htypechk.pas
View File

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

4
compiler/jvm/njvmcnv.pas
View File

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

2
compiler/jvm/njvmflw.pas
View File

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

4
compiler/nadd.pas
View File

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

2
compiler/ncal.pas
View File

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

12
compiler/ncnv.pas
View File

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

2
compiler/ngtcon.pas
View File

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

2
compiler/nld.pas
View File

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

3
compiler/optvirt.pas
View File

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

2
compiler/pdecobj.pas
View File

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

2
compiler/pdecvar.pas
View File

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

4
compiler/pexpr.pas
View File

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

4
compiler/pgenutil.pas
View File

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

136
compiler/symdef.pas
View File

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

20
compiler/symtable.pas
View File

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

7
compiler/symtype.pas
View File

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