diff --git a/compiler/htypechk.pas b/compiler/htypechk.pas index 431133de65..465f967048 100644 --- a/compiler/htypechk.pas +++ b/compiler/htypechk.pas @@ -1781,7 +1781,7 @@ implementation ( ignorevisibility or (pd.owner.symtabletype<>objectsymtable) or - pd.is_visible_for_object(contextobjdef,nil) + is_visible_for_object(pd,contextobjdef) ) then begin { don't add duplicates, only compare visible parameters for the user } diff --git a/compiler/nobj.pas b/compiler/nobj.pas index bbe57ba001..90610b8f5a 100644 --- a/compiler/nobj.pas +++ b/compiler/nobj.pas @@ -210,7 +210,7 @@ implementation new(procdefcoll); procdefcoll^.data:=pd; procdefcoll^.hidden:=false; - procdefcoll^.visible:=pd.is_visible_for_object(_class,nil); + procdefcoll^.visible:=is_visible_for_object(pd,_class); VMTSymEntry.ProcdefList.Add(procdefcoll); { Register virtual method and give it a number } @@ -252,7 +252,7 @@ implementation procdefs, because they can be reused in the next class. The check to skip the invisible methods that are in the list is futher down in the code } - is_visible:=pd.is_visible_for_object(_class,nil); + is_visible:=is_visible_for_object(pd,_class); { Load other values for easier readability } hasoverloads:=(tprocsym(pd.procsym).ProcdefList.Count>1); pdoverload:=(po_overload in pd.procoptions); diff --git a/compiler/pinline.pas b/compiler/pinline.pas index 857184d752..bed7566aa9 100644 --- a/compiler/pinline.pas +++ b/compiler/pinline.pas @@ -430,7 +430,7 @@ implementation { search the constructor also in the symbol tables of the parents } afterassignment:=false; - searchsym_in_class(classh,nil,pattern,srsym,srsymtable); + searchsym_in_class(classh,classh,pattern,srsym,srsymtable); consume(_ID); do_member_read(classh,false,srsym,p1,again,[cnf_new_call]); { we need to know which procedure is called } diff --git a/compiler/symdef.pas b/compiler/symdef.pas index 54544c3d25..b1a7f6ee3d 100644 --- a/compiler/symdef.pas +++ b/compiler/symdef.pas @@ -487,7 +487,6 @@ interface function cplusplusmangledname : string; function is_methodpointer:boolean;override; function is_addressonly:boolean;override; - function is_visible_for_object(currobjdef,contextobjdef:tobjectdef):boolean; end; { single linked list of overloaded procs } @@ -3177,60 +3176,6 @@ implementation end; - function tprocdef.is_visible_for_object(currobjdef,contextobjdef:tobjectdef):boolean; - var - contextst : TSymtable; - begin - result:=false; - - { Support passing a context in which module we are to find protected members } - if assigned(contextobjdef) then - contextst:=contextobjdef.owner - else - contextst:=nil; - - { private symbols are allowed when we are in the same - module as they are defined } - if (visibility=vis_private) and - (owner.defowner.owner.symtabletype in [globalsymtable,staticsymtable]) and - not(owner.defowner.owner.iscurrentunit or (owner.defowner.owner=contextst)) then - exit; - - if (visibility=vis_strictprivate) then - begin - result:=currobjdef=tobjectdef(owner.defowner); - exit; - end; - - if (visibility=vis_strictprotected) then - begin - result:=assigned(currobjdef) and - currobjdef.is_related(tobjectdef(owner.defowner)); - exit; - end; - - { protected symbols are visible in the module that defines them and - also visible to related objects. The related object must be defined - in the current module } - if (visibility=vis_protected) and - ( - ( - (owner.defowner.owner.symtabletype in [globalsymtable,staticsymtable]) and - not((owner.defowner.owner.iscurrentunit) or (owner.defowner.owner=contextst)) - ) and - not( - assigned(currobjdef) and - (currobjdef.owner.symtabletype in [globalsymtable,staticsymtable]) and - (currobjdef.owner.iscurrentunit) and - currobjdef.is_related(tobjectdef(owner.defowner)) - ) - ) then - exit; - - result:=true; - end; - - function tprocdef.GetSymtable(t:tGetSymtable):TSymtable; begin case t of diff --git a/compiler/symsym.pas b/compiler/symsym.pas index 8d220ea28c..7cf02d4160 100644 --- a/compiler/symsym.pas +++ b/compiler/symsym.pas @@ -99,9 +99,6 @@ interface function find_procdef_bypara(para:TFPObjectList;retdef:tdef;cpoptions:tcompare_paras_options):Tprocdef; function find_procdef_byprocvardef(d:Tprocvardef):Tprocdef; function find_procdef_assignment_operator(fromdef,todef:tdef;var besteq:tequaltype):Tprocdef; - { currobjdef is the object def to assume, this is necessary for protected and - private, context is the object def we're really in, this is for the strict stuff } - function is_visible_for_object(currobjdef:tdef;context:tdef):boolean;override; property ProcdefList:TFPObjectList read FProcdefList; end; @@ -752,27 +749,6 @@ implementation end; - function tprocsym.is_visible_for_object(currobjdef:tdef;context:tdef):boolean; - var - i : longint; - pd : tprocdef; - begin - { This procsym is visible, when there is at least - one of the procdefs visible } - result:=false; - for i:=0 to ProcdefList.Count-1 do - begin - pd:=tprocdef(ProcdefList[i]); - if (pd.owner=owner) and - pd.is_visible_for_object(tobjectdef(currobjdef),tobjectdef(context)) then - begin - result:=true; - exit; - end; - end; - end; - - {**************************************************************************** TERRORSYM ****************************************************************************} diff --git a/compiler/symtable.pas b/compiler/symtable.pas index 64944d6d61..ca53259251 100644 --- a/compiler/symtable.pas +++ b/compiler/symtable.pas @@ -190,6 +190,9 @@ interface {*** Search ***} procedure addsymref(sym:tsym); + function is_visible_for_object(symst:tsymtable;symvisibility:tvisibility;contextobjdef:tobjectdef):boolean; + function is_visible_for_object(pd:tprocdef;contextobjdef:tobjectdef):boolean; + function is_visible_for_object(sym:tsym;contextobjdef:tobjectdef):boolean; function searchsym(const s : TIDString;out srsym:tsym;out srsymtable:TSymtable):boolean; function searchsym_type(const s : TIDString;out srsym:tsym;out srsymtable:TSymtable):boolean; function searchsym_in_module(pm:pointer;const s : TIDString;out srsym:tsym;out srsymtable:TSymtable):boolean; @@ -1094,8 +1097,9 @@ implementation hsym:=search_class_member(tobjectdef(defowner),hashedid.id); if assigned(hsym) and ( - (not(m_delphi in current_settings.modeswitches) and - tsym(hsym).is_visible_for_object(tobjectdef(defowner),tobjectdef(defowner)) + ( + not(m_delphi in current_settings.modeswitches) and + is_visible_for_object(hsym,tobjectdef(defowner)) ) or ( { In Delphi, you can repeat members of a parent class. You can't } @@ -1537,11 +1541,95 @@ implementation end; + function is_visible_for_object(symst:tsymtable;symvisibility:tvisibility;contextobjdef:tobjectdef):boolean; + var + symownerdef : tobjectdef; + begin + result:=false; + + { Get objdectdef owner of the symtable for the is_related checks } + if not assigned(symst) or + (symst.symtabletype<>objectsymtable) then + internalerror(200810285); + symownerdef:=tobjectdef(symst.defowner); + case symvisibility of + vis_private : + begin + { private symbols are allowed when we are in the same + module as they are defined } + result:=(symownerdef.owner.symtabletype in [globalsymtable,staticsymtable]) and + (symownerdef.owner.iscurrentunit); + end; + vis_strictprivate : + begin + result:=assigned(current_objectdef) and + (current_objectdef=symownerdef); + end; + vis_strictprotected : + begin + result:=assigned(current_objectdef) and + current_objectdef.is_related(symownerdef); + end; + vis_protected : + begin + { protected symbols are visible in the module that defines them and + also visible to related objects. The related object must be defined + in the current module } + result:=( + ( + (symownerdef.owner.symtabletype in [globalsymtable,staticsymtable]) and + (symownerdef.owner.iscurrentunit) + ) or + ( + assigned(contextobjdef) and + (contextobjdef.owner.symtabletype in [globalsymtable,staticsymtable]) and + (contextobjdef.owner.iscurrentunit) and + contextobjdef.is_related(symownerdef) + ) + ); + end; + vis_public, + vis_published : + result:=true; + end; + end; + + + function is_visible_for_object(pd:tprocdef;contextobjdef:tobjectdef):boolean; + begin + result:=is_visible_for_object(pd.owner,pd.visibility,contextobjdef); + end; + + + function is_visible_for_object(sym:tsym;contextobjdef:tobjectdef):boolean; + var + i : longint; + pd : tprocdef; + begin + if sym.typ=procsym then + begin + { A procsym is visible, when there is at least one of the procdefs visible } + result:=false; + for i:=0 to tprocsym(sym).ProcdefList.Count-1 do + begin + pd:=tprocdef(tprocsym(sym).ProcdefList[i]); + if (pd.owner=sym.owner) and + is_visible_for_object(pd,contextobjdef) then + begin + result:=true; + exit; + end; + end; + end + else + result:=is_visible_for_object(sym.owner,sym.visibility,contextobjdef); + end; + + function searchsym(const s : TIDString;out srsym:tsym;out srsymtable:TSymtable):boolean; var hashedid : THashedIDString; - topclass : tobjectdef; - context : tobjectdef; + contextobjdef : tobjectdef; stackitem : psymtablestackitem; begin result:=false; @@ -1553,7 +1641,6 @@ implementation srsym:=tsym(srsymtable.FindWithHash(hashedid)); if assigned(srsym) then begin - topclass:=nil; { use the class from withsymtable only when it is defined in this unit } if (srsymtable.symtabletype=withsymtable) and @@ -1561,11 +1648,11 @@ implementation (srsymtable.defowner.typ=objectdef) and (srsymtable.defowner.owner.symtabletype in [globalsymtable,staticsymtable]) and (srsymtable.defowner.owner.iscurrentunit) then - topclass:=tobjectdef(srsymtable.defowner) + contextobjdef:=tobjectdef(srsymtable.defowner) else - topclass:=current_objectdef; - context:=current_objectdef; - if tsym(srsym).is_visible_for_object(topclass,context) then + contextobjdef:=current_objectdef; + if (srsym.owner.symtabletype<>objectsymtable) or + is_visible_for_object(srsym,contextobjdef) then begin { we need to know if a procedure references symbols in the static symtable, because then it can't be @@ -1614,8 +1701,10 @@ implementation srsym:=tsym(srsymtable.FindWithHash(hashedid)); if assigned(srsym) and not(srsym.typ in [fieldvarsym,paravarsym]) and - (not assigned(current_objectdef) or - tsym(srsym).is_visible_for_object(current_objectdef,current_objectdef)) then + ( + (srsym.owner.symtabletype<>objectsymtable) or + is_visible_for_object(srsym,current_objectdef) + ) then begin { we need to know if a procedure references symbols in the static symtable, because then it can't be @@ -1674,8 +1763,14 @@ implementation function searchsym_in_class(classh,contextclassh:tobjectdef;const s : TIDString;out srsym:tsym;out srsymtable:TSymtable):boolean; var - hashedid : THashedIDString; + hashedid : THashedIDString; begin + { 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. } + if assigned(classh) and + not contextclassh.is_related(classh) then + internalerror(200811161); result:=false; hashedid.id:=s; while assigned(classh) do @@ -1683,7 +1778,7 @@ implementation srsymtable:=classh.symtable; srsym:=tsym(srsymtable.FindWithHash(hashedid)); if assigned(srsym) and - tsym(srsym).is_visible_for_object(contextclassh,current_objectdef) then + is_visible_for_object(srsym,contextclassh) then begin addsymref(srsym); result:=true; diff --git a/compiler/symtype.pas b/compiler/symtype.pas index 34b37c4c39..34c9a3f3a4 100644 --- a/compiler/symtype.pas +++ b/compiler/symtype.pas @@ -106,11 +106,6 @@ interface function mangledname:string; virtual; procedure buildderef;virtual; procedure deref;virtual; - { currobjdef is the object def to assume, this is necessary for protected and - private, - context is the object def we're really in, this is for the strict stuff - } - function is_visible_for_object(currobjdef:tdef;context : tdef):boolean;virtual; procedure ChangeOwner(st:TSymtable); procedure IncRefCount; procedure IncRefCountBy(AValue : longint); @@ -388,58 +383,8 @@ implementation end; - function tsym.is_visible_for_object(currobjdef:Tdef;context : tdef):boolean; - begin - is_visible_for_object:=false; - - { private symbols are allowed when we are in the same - module as they are defined } - if (visibility=vis_private) and - assigned(owner.defowner) and - (owner.defowner.owner.symtabletype in [globalsymtable,staticsymtable]) and - (not owner.defowner.owner.iscurrentunit) then - exit; - - if (visibility=vis_strictprivate) then - begin - result:=assigned(currobjdef) and - (context=tdef(owner.defowner)); - exit; - end; - - if (visibility=vis_strictprotected) then - begin - result:=assigned(context) and - context.is_related(tdef(owner.defowner)); - exit; - end; - - { protected symbols are visible in the module that defines them and - also visible to related objects } - if (visibility=vis_protected) and - ( - ( - assigned(owner.defowner) and - (owner.defowner.owner.symtabletype in [globalsymtable,staticsymtable]) and - (not owner.defowner.owner.iscurrentunit) - ) and - not( - assigned(currobjdef) and - (currobjdef.owner.symtabletype in [globalsymtable,staticsymtable]) and - (currobjdef.owner.iscurrentunit) and - currobjdef.is_related(tdef(owner.defowner)) - ) - ) then - exit; - - is_visible_for_object:=true; - end; - - procedure tsym.ChangeOwner(st:TSymtable); begin -// if assigned(Owner) then -// Owner.SymList.List.List^[i].Data:=nil; Owner:=st; inherited ChangeOwner(Owner.SymList); end;