* fixed and cleanup of overriding non-visible methods

This commit is contained in:
peter 2004-09-13 20:31:07 +00:00
parent c1d4e0c3d3
commit 29207e007a

View File

@ -33,7 +33,7 @@ interface
{$endif}
cutils,cclasses,
globtype,
symdef,
symdef,symsym,
aasmbase,aasmtai,
cpuinfo
;
@ -50,15 +50,16 @@ interface
tprocdefcoll = record
data : tprocdef;
hidden : boolean;
visible : boolean;
next : pprocdefcoll;
end;
psymcoll = ^tsymcoll;
tsymcoll = record
pvmtentry = ^tvmtentry;
tvmtentry = record
speedvalue : cardinal;
name : pstring;
data : pprocdefcoll;
next : psymcoll;
firstprocdef : pprocdefcoll;
next : pvmtentry;
end;
tclassheader=class
@ -89,10 +90,12 @@ interface
procedure genpubmethodtableentry(p : tnamedindexitem;arg:pointer);
private
{ vmt }
wurzel : psymcoll;
firstvmtentry : pvmtentry;
nextvirtnumber : integer;
has_constructor,
has_virtual_method : boolean;
procedure newdefentry(vmtentry:pvmtentry;pd:tprocdef;is_visible:boolean);
procedure newvmtentry(sym:tprocsym;is_visible:boolean);
procedure eachsym(sym : tnamedindexitem;arg:pointer);
procedure disposevmttree;
procedure writevirtualmethods(List:TAAsmoutput);
@ -148,7 +151,7 @@ implementation
strings,
{$endif}
globals,verbose,systems,
symtable,symconst,symtype,symsym,defcmp,paramgr,
symtable,symconst,symtype,defcmp,paramgr,
{$ifdef GDB}
gdb,
{$endif GDB}
@ -520,60 +523,52 @@ implementation
VMT
**************************************}
procedure tclassheader.eachsym(sym : tnamedindexitem;arg:pointer);
procedure tclassheader.newdefentry(vmtentry:pvmtentry;pd:tprocdef;is_visible:boolean);
var
procdefcoll : pprocdefcoll;
symcoll : psymcoll;
_name : string;
_speed : cardinal;
procedure newdefentry(pd:tprocdef);
begin
{ generate new entry }
new(procdefcoll);
procdefcoll^.data:=pd;
procdefcoll^.hidden:=false;
procdefcoll^.next:=symcoll^.data;
symcoll^.data:=procdefcoll;
procdefcoll^.visible:=is_visible;
procdefcoll^.next:=vmtentry^.firstprocdef;
vmtentry^.firstprocdef:=procdefcoll;
{ if it's a virtual method }
{ give virtual method a number }
if (po_virtualmethod in pd.procoptions) then
begin
{ then it gets a number ... }
pd.extnumber:=nextvirtnumber;
{ and we inc the number }
inc(nextvirtnumber);
has_virtual_method:=true;
end;
if (pd.proctypeoption=potype_constructor) then
has_constructor:=true;
{ check, if a method should be overridden }
if (pd._class=_class) and
(po_overridingmethod in pd.procoptions) then
MessagePos1(pd.fileinfo,parser_e_nothing_to_be_overridden,pd.fullprocname(false));
end;
{ creates a new entry in the procsym list }
procedure newentry;
var i:cardinal;
procedure tclassheader.newvmtentry(sym:tprocsym;is_visible:boolean);
var
i : cardinal;
vmtentry : pvmtentry;
begin
{ if not, generate a new symbol item }
new(symcoll);
symcoll^.speedvalue:=sym.speedvalue;
symcoll^.name:=stringdup(sym.name);
symcoll^.next:=wurzel;
symcoll^.data:=nil;
wurzel:=symcoll;
{ generate new vmtentry }
new(vmtentry);
vmtentry^.speedvalue:=sym.speedvalue;
vmtentry^.name:=stringdup(sym.name);
vmtentry^.next:=firstvmtentry;
vmtentry^.firstprocdef:=nil;
firstvmtentry:=vmtentry;
{ inserts all definitions }
for i:=1 to Tprocsym(sym).procdef_count do
newdefentry(Tprocsym(sym).procdef[i]);
for i:=1 to sym.procdef_count do
newdefentry(vmtentry,sym.procdef[i],is_visible);
end;
procedure tclassheader.eachsym(sym : tnamedindexitem;arg:pointer);
label
handlenextdef;
var
@ -582,12 +577,14 @@ implementation
is_visible,
hasoverloads,
pdoverload : boolean;
procdefcoll : pprocdefcoll;
vmtentry : pvmtentry;
_name : string;
_speed : cardinal;
begin
{ put only sub routines into the VMT, and routines
that are visible to the current class. Skip private
methods in other classes }
if (tsym(sym).typ=procsym) then
begin
if (tsym(sym).typ<>procsym) then
exit;
{ is this symbol visible from the class that we are
generating. This will be used to hide the other procdefs.
When the symbol is not visible we don't hide the other
@ -598,14 +595,14 @@ implementation
{ check the current list of symbols }
_name:=sym.name;
_speed:=sym.speedvalue;
symcoll:=wurzel;
while assigned(symcoll) do
vmtentry:=firstvmtentry;
while assigned(vmtentry) do
begin
{ does the symbol already exist in the list? First
compare speedvalue before doing the string compare to
speed it up a little }
if (_speed=symcoll^.speedvalue) and
(_name=symcoll^.name^) then
if (_speed=vmtentry^.speedvalue) and
(_name=vmtentry^.name^) then
begin
hasoverloads:=(Tprocsym(sym).procdef_count>1);
{ walk through all defs of the symbol }
@ -617,7 +614,7 @@ implementation
pdoverload:=(po_overload in pd.procoptions);
{ compare with all stored definitions }
procdefcoll:=symcoll^.data;
procdefcoll:=vmtentry^.firstprocdef;
while assigned(procdefcoll) do
begin
{ compare only if the definition is not hidden }
@ -644,7 +641,7 @@ implementation
when it has no overload directive and no overloads }
if not(po_virtualmethod in pd.procoptions) then
begin
if tstoredsym(procdefcoll^.data.procsym).is_visible_for_object(pd._class) and
if procdefcoll^.visible and
(not(pdoverload or hasoverloads) or
(compare_paras(procdefcoll^.data.para,pd.para,cp_all,[])>=te_equal)) then
begin
@ -665,7 +662,7 @@ implementation
{ we start a new virtual tree, hide the old }
if (not(pdoverload or hasoverloads) or
(compare_paras(procdefcoll^.data.para,pd.para,cp_all,[])>=te_equal)) and
(tstoredsym(procdefcoll^.data.procsym).is_visible_for_object(pd._class)) then
(procdefcoll^.visible) then
begin
if is_visible then
procdefcoll^.hidden:=true;
@ -673,16 +670,6 @@ implementation
MessagePos1(pd.fileinfo,parser_w_should_use_override,pd.fullprocname(false));
end;
end
{ check if the method to override is visible, check is only needed
for the current parsed class. Parent classes are already validated and
need to include all virtual methods including the ones not visible in the
current class }
else if (_class=pd._class) and
(po_overridingmethod in pd.procoptions) and
(not tstoredsym(procdefcoll^.data.procsym).is_visible_for_object(pd._class)) then
begin
{ do nothing, the error will follow when adding the entry }
end
{ same parameters }
else if (compare_paras(procdefcoll^.data.para,pd.para,cp_all,[])>=te_equal) then
begin
@ -722,10 +709,21 @@ implementation
Message2(parser_e_overridden_methods_not_same_ret,pd.fullprocname(false),
procdefcoll^.data.fullprocname(false));
{ now set the number }
{ check if the method to override is visible, check is only needed
for the current parsed class. Parent classes are already validated and
need to include all virtual methods including the ones not visible in the
current class }
if (_class=pd._class) and
(po_overridingmethod in pd.procoptions) and
(not procdefcoll^.visible) then
MessagePos1(pd.fileinfo,parser_e_nothing_to_be_overridden,pd.fullprocname(false));
{ override old virtual method in VMT }
pd.extnumber:=procdefcoll^.data.extnumber;
{ and exchange }
procdefcoll^.data:=pd;
if is_visible then
procdefcoll^.visible:=true;
goto handlenextdef;
end
{ different parameters }
@ -767,41 +765,44 @@ implementation
procdefcoll:=procdefcoll^.next;
end;
{ new entry is needed, override was not possible }
if (_class=pd._class) and
(po_overridingmethod in pd.procoptions) then
MessagePos1(pd.fileinfo,parser_e_nothing_to_be_overridden,pd.fullprocname(false));
{ if it isn't saved in the list we create a new entry }
newdefentry(pd);
newdefentry(vmtentry,pd,is_visible);
end;
handlenextdef:
end;
exit;
end;
symcoll:=symcoll^.next;
end;
newentry;
vmtentry:=vmtentry^.next;
end;
newvmtentry(tprocsym(sym),is_visible);
end;
procedure tclassheader.disposevmttree;
var
symcoll : psymcoll;
vmtentry : pvmtentry;
procdefcoll : pprocdefcoll;
begin
{ disposes the above generated tree }
symcoll:=wurzel;
while assigned(symcoll) do
vmtentry:=firstvmtentry;
while assigned(vmtentry) do
begin
wurzel:=symcoll^.next;
stringdispose(symcoll^.name);
procdefcoll:=symcoll^.data;
firstvmtentry:=vmtentry^.next;
stringdispose(vmtentry^.name);
procdefcoll:=vmtentry^.firstprocdef;
while assigned(procdefcoll) do
begin
symcoll^.data:=procdefcoll^.next;
vmtentry^.firstprocdef:=procdefcoll^.next;
dispose(procdefcoll);
procdefcoll:=symcoll^.data;
procdefcoll:=vmtentry^.firstprocdef;
end;
dispose(symcoll);
symcoll:=wurzel;
dispose(vmtentry);
vmtentry:=firstvmtentry;
end;
end;
@ -820,7 +821,7 @@ implementation
end;
begin
wurzel:=nil;
firstvmtentry:=nil;
nextvirtnumber:=0;
has_constructor:=false;
@ -1180,7 +1181,7 @@ implementation
procedure tclassheader.writevirtualmethods(List:TAAsmoutput);
var
symcoll : psymcoll;
vmtentry : pvmtentry;
procdefcoll : pprocdefcoll;
i : longint;
begin
@ -1188,14 +1189,12 @@ implementation
{ the method }
for i:=0 to nextvirtnumber-1 do
begin
symcoll:=wurzel;
{ walk trough all symbols }
while assigned(symcoll) do
vmtentry:=firstvmtentry;
while assigned(vmtentry) do
begin
{ walk trough all methods }
procdefcoll:=symcoll^.data;
procdefcoll:=vmtentry^.firstprocdef;
while assigned(procdefcoll) do
begin
{ writes the addresses to the VMT }
@ -1215,7 +1214,7 @@ implementation
end;
procdefcoll:=procdefcoll^.next;
end;
symcoll:=symcoll^.next;
vmtentry:=vmtentry^.next;
end;
end;
end;
@ -1382,7 +1381,10 @@ initialization
end.
{
$Log$
Revision 1.74 2004-07-09 22:17:32 peter
Revision 1.75 2004-09-13 20:31:07 peter
* fixed and cleanup of overriding non-visible methods
Revision 1.74 2004/07/09 22:17:32 peter
* revert has_localst patch
* replace aktstaticsymtable/aktglobalsymtable with current_module