paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-09 08:30:54 +02:00
Code Issues Packages Projects Releases Wiki Activity

* refactor is_visible_for_object

Browse Source 
git-svn-id: trunk@12152 -
This commit is contained in:
peter 2008-11-17 21:41:40 +00:00
parent 552e5fc66f
commit 36cad44923
7 changed files with 112 additions and 151 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
compiler/htypechk.pas
View File

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

4
compiler/nobj.pas
View File

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

2
compiler/pinline.pas
View File

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

55
compiler/symdef.pas
View File

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

24
compiler/symsym.pas
View File

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

121
compiler/symtable.pas
View File

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

55
compiler/symtype.pas
View File

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