paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-19 18:51:31 +02:00
Code Issues Packages Projects Releases Wiki Activity

* protected visibility fixes

Browse Source
This commit is contained in:
peter 2003-10-02 21:13:46 +00:00
parent 2bec6b14fc
commit 00801693bb
5 changed files with 98 additions and 43 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

43
compiler/ncal.pas
View File

@ -55,6 +55,7 @@ interface
tcallnode = class(tbinarynode)
private
paravisible : boolean;
paralength : smallint;
function candidates_find:pcandidate;
procedure candidates_free(procs:pcandidate);
@ -1192,6 +1193,7 @@ type
procs,hp : pcandidate;
found,
has_overload_directive : boolean;
topclassh : tobjectdef;
srsymtable : tsymtable;
srprocsym : tprocsym;
@ -1226,7 +1228,25 @@ type
(symtableprocentry.owner.symtabletype=objectsymtable) then
search_class_overloads(symtableprocentry);
{ when the class passed is defined in this unit we
need to use the scope of that class. This is a trick
that can be used to access protected members in other
units. At least kylix supports it this way (PFV) }
if assigned(symtableproc) and
(symtableproc.symtabletype=objectsymtable) and
(symtableproc.defowner.owner.symtabletype in [globalsymtable,staticsymtable]) and
(symtableproc.defowner.owner.unitid=0) then
topclassh:=tobjectdef(symtableproc.defowner)
else
begin
if assigned(current_procinfo) then
topclassh:=current_procinfo.procdef._class
else
topclassh:=nil;
end;
{ link all procedures which have the same # of parameters }
paravisible:=false;
for j:=1 to symtableprocentry.procdef_count do
begin
pd:=symtableprocentry.procdef[j];
@ -1236,8 +1256,10 @@ type
when the callnode is generated by a property }
if (nf_isproperty in flags) or
(pd.owner.symtabletype<>objectsymtable) or
pd.is_visible_for_proc(current_procinfo.procdef) then
pd.is_visible_for_object(topclassh) then
begin
{ we have at least one procedure that is visible }
paravisible:=false;
{ only when the # of parameter are supported by the
procedure }
if (paralength>=pd.minparacount) and
@ -1267,7 +1289,7 @@ type
{ process only visible procsyms }
if assigned(srprocsym) and
(srprocsym.typ=procsym) and
srprocsym.is_visible_for_proc(current_procinfo.procdef) then
srprocsym.is_visible_for_object(topclassh) then
begin
{ if this procedure doesn't have overload we can stop
searching }
@ -1960,7 +1982,8 @@ type
procs:=candidates_find;
{ no procedures found? then there is something wrong
with the parameter size }
with the parameter size or the procedures are
not accessible }
if not assigned(procs) then
begin
{ when it's an auto inherited call and there
@ -1997,8 +2020,13 @@ type
begin
if assigned(left) then
aktfilepos:=left.fileinfo;
CGMessage(parser_e_wrong_parameter_size);
symtableprocentry.write_parameter_lists(nil);
if paravisible then
begin
CGMessage(parser_e_wrong_parameter_size);
symtableprocentry.write_parameter_lists(nil);
end
else
CGMessage(parser_e_cant_access_private_member);
end;
end;
goto errorexit;
@ -2516,7 +2544,10 @@ begin
end.
{
$Log$
Revision 1.185 2003-10-01 20:34:48 peter
Revision 1.186 2003-10-02 21:13:46 peter
* protected visibility fixes
Revision 1.185 2003/10/01 20:34:48 peter
* procinfo unit contains tprocinfo
* cginfo renamed to cgbase
* moved cgmessage to verbose

42
compiler/pexpr.pas
View File

@ -27,7 +27,7 @@ unit pexpr;
interface
uses
symtype,
symtype,symdef,
node,
globals,
cpuinfo;
@ -46,7 +46,7 @@ interface
function parse_paras(__colon,in_prop_paras : boolean) : tnode;
{ the ID token has to be consumed before calling this function }
procedure do_member_read(getaddr : boolean;sym : tsym;var p1 : tnode;var again : boolean;callnflags:tnodeflags);
procedure do_member_read(classh:tobjectdef;getaddr : boolean;sym : tsym;var p1 : tnode;var again : boolean;callnflags:tnodeflags);
{$ifdef int64funcresok}
function get_intconst:TConstExprInt;
@ -68,7 +68,7 @@ implementation
globtype,tokens,verbose,
systems,widestr,
{ symtable }
symconst,symbase,symdef,symsym,symtable,defutil,defcmp,
symconst,symbase,symsym,symtable,defutil,defcmp,
{ pass 1 }
pass_1,htypechk,
nutils,nmat,nadd,ncal,nmem,nset,ncnv,ninl,ncon,nld,nflw,nbas,
@ -660,7 +660,7 @@ implementation
{ reads the parameter for a subroutine call }
procedure do_proc_call(sym:tsym;st:tsymtable;getaddr:boolean;var again : boolean;var p1:tnode);
procedure do_proc_call(sym:tsym;st:tsymtable;obj:tobjectdef;getaddr:boolean;var again : boolean;var p1:tnode);
var
membercall,
prevafterassn : boolean;
@ -747,7 +747,14 @@ implementation
consume(_RKLAMMER);
end;
end;
p1:=ccallnode.create(para,tprocsym(sym),st,p1);
if assigned(obj) then
begin
if (st.symtabletype<>objectsymtable) then
internalerror(200310031);
p1:=ccallnode.create(para,tprocsym(sym),obj.symtable,p1);
end
else
p1:=ccallnode.create(para,tprocsym(sym),st,p1);
{ indicate if this call was generated by a member and
no explicit self is used, this is needed to determine
how to handle a destructor call (PFV) }
@ -953,7 +960,7 @@ implementation
{ the ID token has to be consumed before calling this function }
procedure do_member_read(getaddr : boolean;sym : tsym;var p1 : tnode;var again : boolean;callnflags:tnodeflags);
procedure do_member_read(classh:tobjectdef;getaddr : boolean;sym : tsym;var p1 : tnode;var again : boolean;callnflags:tnodeflags);
var
static_name : string;
@ -990,7 +997,7 @@ implementation
case sym.typ of
procsym:
begin
do_proc_call(sym,sym.owner,
do_proc_call(sym,sym.owner,classh,
(getaddr and not(token in [_CARET,_POINT])),
again,p1);
{ add provided flags }
@ -1236,7 +1243,7 @@ implementation
srsym:=searchsym_in_class(tobjectdef(htype.def),pattern);
check_hints(srsym);
consume(_ID);
do_member_read(false,srsym,p1,again,[]);
do_member_read(tobjectdef(htype.def),false,srsym,p1,again,[]);
end
else
begin
@ -1260,7 +1267,7 @@ implementation
else
begin
consume(_ID);
do_member_read(getaddr,srsym,p1,again,[]);
do_member_read(tobjectdef(htype.def),getaddr,srsym,p1,again,[]);
end;
end;
end
@ -1284,7 +1291,7 @@ implementation
else
begin
consume(_ID);
do_member_read(getaddr,srsym,p1,again,[]);
do_member_read(tobjectdef(htype.def),getaddr,srsym,p1,again,[]);
end;
end
else
@ -1366,7 +1373,7 @@ implementation
not(is_interface(tdef(srsym.owner.defowner))) and
assigned(current_procinfo) and
(po_classmethod in current_procinfo.procdef.procoptions);
do_proc_call(srsym,srsymtable,
do_proc_call(srsym,srsymtable,nil,
(getaddr and not(token in [_CARET,_POINT])),
again,p1);
{ we need to know which procedure is called }
@ -1681,7 +1688,7 @@ implementation
else
begin
consume(_ID);
do_member_read(getaddr,hsym,p1,again,[]);
do_member_read(classh,getaddr,hsym,p1,again,[]);
end;
end;
@ -1704,7 +1711,7 @@ implementation
else
begin
consume(_ID);
do_member_read(getaddr,hsym,p1,again,[]);
do_member_read(classh,getaddr,hsym,p1,again,[]);
end;
end;
@ -1886,7 +1893,7 @@ implementation
htype.setdef(classh);
p1:=ctypenode.create(htype);
end;
do_member_read(false,sym,p1,again,[nf_inherited,nf_anon_inherited]);
do_member_read(classh,false,sym,p1,again,[nf_inherited,nf_anon_inherited]);
end
else
begin
@ -1901,7 +1908,7 @@ implementation
(sym.typ<>procsym) then
internalerror(200303171);
p1:=nil;
do_proc_call(sym,sym.owner,false,again,p1);
do_proc_call(sym,sym.owner,classh,false,again,p1);
end
else
begin
@ -2416,7 +2423,10 @@ implementation
end.
{
$Log$
Revision 1.130 2003-10-01 20:34:49 peter
Revision 1.131 2003-10-02 21:15:31 peter
* protected visibility fixes
Revision 1.130 2003/10/01 20:34:49 peter
* procinfo unit contains tprocinfo
* cginfo renamed to cgbase
* moved cgmessage to verbose

11
compiler/pinline.pas
View File

@ -148,11 +148,11 @@ implementation
else
callflag:=nf_dispose_call;
if is_new then
do_member_read(false,sym,p2,again,[callflag])
do_member_read(classh,false,sym,p2,again,[callflag])
else
begin
if not(m_fpc in aktmodeswitches) then
do_member_read(false,sym,p2,again,[callflag])
do_member_read(classh,false,sym,p2,again,[callflag])
else
begin
p2:=ccallnode.create(nil,tprocsym(sym),sym.owner,p2);
@ -364,7 +364,7 @@ implementation
afterassignment:=false;
sym:=searchsym_in_class(classh,pattern);
consume(_ID);
do_member_read(false,sym,p1,again,[nf_new_call]);
do_member_read(classh,false,sym,p1,again,[nf_new_call]);
{ we need to know which procedure is called }
do_resulttypepass(p1);
if not(
@ -685,7 +685,10 @@ implementation
end.
{
$Log$
Revision 1.19 2003-10-01 20:34:49 peter
Revision 1.20 2003-10-02 21:15:31 peter
* protected visibility fixes
Revision 1.19 2003/10/01 20:34:49 peter
* procinfo unit contains tprocinfo
* cginfo renamed to cgbase
* moved cgmessage to verbose

14
compiler/symdef.pas
View File

@ -554,7 +554,7 @@ interface
function cplusplusmangledname : string;
function is_methodpointer:boolean;override;
function is_addressonly:boolean;override;
function is_visible_for_proc(currprocdef:tprocdef):boolean;
// function is_visible_for_proc(currprocdef:tprocdef):boolean;
function is_visible_for_object(currobjdef:tobjectdef):boolean;
{ debug }
{$ifdef GDB}
@ -3709,6 +3709,7 @@ implementation
end;
(*
function tprocdef.is_visible_for_proc(currprocdef:tprocdef):boolean;
begin
is_visible_for_proc:=false;
@ -3739,7 +3740,7 @@ implementation
is_visible_for_proc:=true;
end;
*)
function tprocdef.is_visible_for_object(currobjdef:tobjectdef):boolean;
begin
@ -3753,7 +3754,8 @@ implementation
exit;
{ protected symbols are vissible in the module that defines them and
also visible to related objects }
also visible to related objects. The related object must be defined
in the current module }
if (sp_protected in symoptions) and
(
(
@ -3762,6 +3764,7 @@ implementation
) and
not(
assigned(currobjdef) and
(currobjdef.owner.unitid=0) and
currobjdef.is_related(tobjectdef(owner.defowner))
)
) then
@ -5897,7 +5900,10 @@ implementation
end.
{
$Log$
Revision 1.168 2003-10-01 20:34:49 peter
Revision 1.169 2003-10-02 21:19:42 peter
* protected visibility fixes
Revision 1.168 2003/10/01 20:34:49 peter
* procinfo unit contains tprocinfo
* cginfo renamed to cgbase
* moved cgmessage to verbose

31
compiler/symtable.pas
View File

@ -1910,7 +1910,12 @@ implementation
(classh.owner.unitid=0) then
topclassh:=classh
else
topclassh:=nil;
begin
if assigned(current_procinfo) then
topclassh:=current_procinfo.procdef._class
else
topclassh:=nil;
end;
sym:=nil;
def:=nil;
while assigned(classh) do
@ -1929,11 +1934,7 @@ implementation
break;
end
else
begin
if (not assigned(current_procinfo) or
tprocdef(def).is_visible_for_proc(current_procinfo.procdef)) then
break;
end;
break;
end;
def:=tdef(def.indexnext);
end;
@ -1960,7 +1961,12 @@ implementation
(classh.owner.unitid=0) then
topclassh:=classh
else
topclassh:=nil;
begin
if assigned(current_procinfo) then
topclassh:=current_procinfo.procdef._class
else
topclassh:=nil;
end;
sym:=nil;
def:=nil;
while assigned(classh) do
@ -1979,11 +1985,7 @@ implementation
break;
end
else
begin
if (not assigned(current_procinfo) or
tprocdef(def).is_visible_for_proc(current_procinfo.procdef)) then
break;
end;
break;
end;
def:=tdef(def.indexnext);
end;
@ -2259,7 +2261,10 @@ implementation
end.
{
$Log$
Revision 1.111 2003-10-01 19:05:33 peter
Revision 1.112 2003-10-02 21:13:46 peter
* protected visibility fixes
Revision 1.111 2003/10/01 19:05:33 peter
* searchsym_type to search for type definitions. It ignores
records,objects and parameters