paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-06-05 13:38:44 +02:00
Code Issues Packages Projects Releases Wiki Activity

* fix rtti for overriden properties

Browse Source 
git-svn-id: trunk@5079 -
This commit is contained in:
peter 2006-10-29 23:20:00 +00:00
parent 7bff3a4981
commit d27fda4b01
4 changed files with 90 additions and 70 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

32
compiler/pdecvar.pas
View File

@ -392,10 +392,10 @@ implementation
begin
if try_to_consume(_READ) then
begin
p.readaccess.clear;
if parse_symlist(p.readaccess,def) then
p.propaccesslist[palt_read].clear;
if parse_symlist(p.propaccesslist[palt_read],def) then
begin
sym:=p.readaccess.firstsym^.sym;
sym:=p.propaccesslist[palt_read].firstsym^.sym;
case sym.typ of
procsym :
begin
@ -407,8 +407,8 @@ implementation
{ we ignore hidden stuff here because the property access symbol might have
non default calling conventions which might change the hidden stuff;
see tw3216.pp (FK) }
p.readaccess.procdef:=Tprocsym(sym).search_procdef_bypara(readprocdef.paras,p.propdef,[cpo_allowdefaults,cpo_ignorehidden]);
if not assigned(p.readaccess.procdef) then
p.propaccesslist[palt_read].procdef:=Tprocsym(sym).search_procdef_bypara(readprocdef.paras,p.propdef,[cpo_allowdefaults,cpo_ignorehidden]);
if not assigned(p.propaccesslist[palt_read].procdef) then
Message(parser_e_ill_property_access_sym);
end;
fieldvarsym :
@ -435,10 +435,10 @@ implementation
end;
if try_to_consume(_WRITE) then
begin
p.writeaccess.clear;
if parse_symlist(p.writeaccess,def) then
p.propaccesslist[palt_write].clear;
if parse_symlist(p.propaccesslist[palt_write],def) then
begin
sym:=p.writeaccess.firstsym^.sym;
sym:=p.propaccesslist[palt_write].firstsym^.sym;
case sym.typ of
procsym :
begin
@ -451,8 +451,8 @@ implementation
{ Insert hidden parameters }
handle_calling_convention(writeprocdef);
{ search procdefs matching writeprocdef }
p.writeaccess.procdef:=Tprocsym(sym).search_procdef_bypara(writeprocdef.paras,writeprocdef.returndef,[cpo_allowdefaults]);
if not assigned(p.writeaccess.procdef) then
p.propaccesslist[palt_write].procdef:=Tprocsym(sym).search_procdef_bypara(writeprocdef.paras,writeprocdef.returndef,[cpo_allowdefaults]);
if not assigned(p.propaccesslist[palt_write].procdef) then
Message(parser_e_ill_property_access_sym);
end;
fieldvarsym :
@ -505,7 +505,7 @@ implementation
if try_to_consume(_STORED) then
begin
include(p.propoptions,ppo_stored);
p.storedaccess.clear;
p.propaccesslist[palt_stored].clear;
case token of
_ID:
begin
@ -515,16 +515,16 @@ implementation
{ as stored true }
if idtoken<>_DEFAULT then
begin
if parse_symlist(p.storedaccess,def) then
if parse_symlist(p.propaccesslist[palt_stored],def) then
begin
sym:=p.storedaccess.firstsym^.sym;
sym:=p.propaccesslist[palt_stored].firstsym^.sym;
case sym.typ of
procsym :
begin
{ Insert hidden parameters }
handle_calling_convention(storedprocdef);
p.storedaccess.procdef:=Tprocsym(sym).search_procdef_bypara(storedprocdef.paras,storedprocdef.returndef,[cpo_allowdefaults,cpo_ignorehidden]);
if not assigned(p.storedaccess.procdef) then
p.propaccesslist[palt_stored].procdef:=Tprocsym(sym).search_procdef_bypara(storedprocdef.paras,storedprocdef.returndef,[cpo_allowdefaults,cpo_ignorehidden]);
if not assigned(p.propaccesslist[palt_stored].procdef) then
message(parser_e_ill_property_storage_sym);
end;
fieldvarsym :
@ -633,7 +633,7 @@ implementation
if intfidx > 0 then
begin
interfaces(intfidx).iitype := etFieldValue;
interfaces(intfidx).iioffset := tfieldvarsym(p.readaccess.firstsym^.sym).fieldoffset;
interfaces(intfidx).iioffset := tfieldvarsym(p.propaccesslist[palt_read].firstsym^.sym).fieldoffset;
end else
begin
writeln('Implements-property used on unimplemented interface');

40
compiler/pexpr.pas
View File

@ -1076,8 +1076,26 @@ implementation
p2 : tnode;
membercall : boolean;
callflags : tcallnodeflags;
hpropsym : tpropertysym;
propaccesslist : tpropaccesslist;
function getpropaccesslist(pap:tpropaccesslisttypes):boolean;
var
hpropsym : tpropertysym;
begin
result:=false;
{ find property in the overriden list }
hpropsym:=propsym;
repeat
propaccesslist:=hpropsym.propaccesslist[pap];
if not propaccesslist.empty then
begin
result:=true;
exit;
end;
hpropsym:=hpropsym.overridenpropsym;
until not assigned(hpropsym);
end;
begin
{ property parameters? read them only if the property really }
{ has parameters }
@ -1100,15 +1118,7 @@ implementation
{ if not(afterassignment) and not(in_args) then }
if token=_ASSIGNMENT then
begin
{ write property, find property in the overriden list }
hpropsym:=propsym;
repeat
propaccesslist:=hpropsym.writeaccess;
if not propaccesslist.empty then
break;
hpropsym:=hpropsym.overridenpropsym;
until not assigned(hpropsym);
if not propaccesslist.empty then
if getpropaccesslist(palt_write) then
begin
case propaccesslist.firstsym^.sym.typ of
procsym :
@ -1158,15 +1168,7 @@ implementation
end
else
begin
{ read property, find property in the overriden list }
hpropsym:=propsym;
repeat
propaccesslist:=hpropsym.readaccess;
if not propaccesslist.empty then
break;
hpropsym:=hpropsym.overridenpropsym;
until not assigned(hpropsym);
if not propaccesslist.empty then
if getpropaccesslist(palt_read) then
begin
case propaccesslist.firstsym^.sym.typ of
fieldvarsym :

38
compiler/symdef.pas
View File

@ -4828,23 +4828,31 @@ implementation
proctypesinfo : byte;
propnameitem : tpropnamelistitem;
procedure writeproc(proc : tpropaccesslist; shiftvalue : byte; unsetvalue: byte);
procedure writeaccessproc(pap:tpropaccesslisttypes; shiftvalue : byte; unsetvalue: byte);
var
typvalue : byte;
hp : ppropaccesslistitem;
address : longint;
def : tdef;
hpropsym : tpropertysym;
propaccesslist : tpropaccesslist;
begin
if not(assigned(proc) and assigned(proc.firstsym)) then
hpropsym:=tpropertysym(sym);
repeat
propaccesslist:=hpropsym.propaccesslist[pap];
if not propaccesslist.empty then
break;
hpropsym:=hpropsym.overridenpropsym;
until not assigned(hpropsym);
if not(assigned(propaccesslist) and assigned(propaccesslist.firstsym)) then
begin
current_asmdata.asmlists[al_rtti].concat(Tai_const.create(aitconst_ptr,unsetvalue));
typvalue:=3;
end
else if proc.firstsym^.sym.typ=fieldvarsym then
else if propaccesslist.firstsym^.sym.typ=fieldvarsym then
begin
address:=0;
hp:=proc.firstsym;
hp:=propaccesslist.firstsym;
def:=nil;
while assigned(hp) do
begin
@ -4877,18 +4885,18 @@ implementation
else
begin
{ When there was an error then procdef is not assigned }
if not assigned(proc.procdef) then
if not assigned(propaccesslist.procdef) then
exit;
if not(po_virtualmethod in tprocdef(proc.procdef).procoptions) then
if not(po_virtualmethod in tprocdef(propaccesslist.procdef).procoptions) then
begin
current_asmdata.asmlists[al_rtti].concat(Tai_const.createname(tprocdef(proc.procdef).mangledname,0));
current_asmdata.asmlists[al_rtti].concat(Tai_const.createname(tprocdef(propaccesslist.procdef).mangledname,0));
typvalue:=1;
end
else
begin
{ virtual method, write vmt offset }
current_asmdata.asmlists[al_rtti].concat(Tai_const.create(aitconst_ptr,
tprocdef(proc.procdef)._class.vmtmethodoffset(tprocdef(proc.procdef).extnumber)));
tprocdef(propaccesslist.procdef)._class.vmtmethodoffset(tprocdef(propaccesslist.procdef).extnumber)));
typvalue:=2;
end;
end;
@ -4904,13 +4912,17 @@ implementation
else
proctypesinfo:=0;
current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_sym(tstoreddef(tpropertysym(sym).propdef).get_rtti_label(fullrtti)));
writeproc(tpropertysym(sym).readaccess,0,0);
writeproc(tpropertysym(sym).writeaccess,2,0);
writeaccessproc(palt_read,0,0);
writeaccessproc(palt_write,2,0);
{ is it stored ? }
if not(ppo_stored in tpropertysym(sym).propoptions) then
writeproc(nil,4,0) { no, so put a constant zero }
begin
{ no, so put a constant zero }
current_asmdata.asmlists[al_rtti].concat(Tai_const.create(aitconst_ptr,0));
proctypesinfo:=proctypesinfo or (3 shl 4);
end
else
writeproc(tpropertysym(sym).storedaccess,4,1); { maybe; if no procedure put a constant 1 (=true) }
writeaccessproc(palt_stored,4,1); { maybe; if no procedure put a constant 1 (=true) }
current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_32bit(tpropertysym(sym).index));
current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_32bit(tpropertysym(sym).default));
propnameitem:=searchpropnamelist(tpropertysym(sym).name);

50
compiler/symsym.pas
View File

@ -231,6 +231,8 @@ interface
procedure ppuwrite(ppufile:tcompilerppufile);override;
end;
tpropaccesslisttypes=(palt_none,palt_read,palt_write,palt_stored);
tpropertysym = class(Tstoredsym)
propoptions : tpropertyoptions;
overridenpropsym : tpropertysym;
@ -240,10 +242,8 @@ interface
indexdef : tdef;
indexdefderef : tderef;
index,
default : longint;
readaccess,
writeaccess,
storedaccess : tpropaccesslist;
default : longint;
propaccesslist : array[tpropaccesslisttypes] of tpropaccesslist;
constructor create(const n : string);
destructor destroy;override;
constructor ppuload(ppufile:tcompilerppufile);
@ -1067,6 +1067,8 @@ implementation
****************************************************************************}
constructor tpropertysym.create(const n : string);
var
pap : tpropaccesslisttypes;
begin
inherited create(propertysym,n);
propoptions:=[];
@ -1074,13 +1076,14 @@ implementation
default:=0;
propdef:=nil;
indexdef:=nil;
readaccess:=tpropaccesslist.create;
writeaccess:=tpropaccesslist.create;
storedaccess:=tpropaccesslist.create;
for pap:=low(tpropaccesslisttypes) to high(tpropaccesslisttypes) do
propaccesslist[pap]:=tpropaccesslist.create;
end;
constructor tpropertysym.ppuload(ppufile:tcompilerppufile);
var
pap : tpropaccesslisttypes;
begin
inherited ppuload(propertysym,ppufile);
ppufile.getsmallset(propoptions);
@ -1089,17 +1092,17 @@ implementation
index:=ppufile.getlongint;
default:=ppufile.getlongint;
ppufile.getderef(indexdefderef);
readaccess:=ppufile.getpropaccesslist;
writeaccess:=ppufile.getpropaccesslist;
storedaccess:=ppufile.getpropaccesslist;
for pap:=low(tpropaccesslisttypes) to high(tpropaccesslisttypes) do
propaccesslist[pap]:=ppufile.getpropaccesslist;
end;
destructor tpropertysym.destroy;
var
pap : tpropaccesslisttypes;
begin
readaccess.free;
writeaccess.free;
storedaccess.free;
for pap:=low(tpropaccesslisttypes) to high(tpropaccesslisttypes) do
propaccesslist[pap].free;
inherited destroy;
end;
@ -1111,24 +1114,26 @@ implementation
procedure tpropertysym.buildderef;
var
pap : tpropaccesslisttypes;
begin
overridenpropsymderef.build(overridenpropsym);
propdefderef.build(propdef);
indexdefderef.build(indexdef);
readaccess.buildderef;
writeaccess.buildderef;
storedaccess.buildderef;
for pap:=low(tpropaccesslisttypes) to high(tpropaccesslisttypes) do
propaccesslist[pap].buildderef;
end;
procedure tpropertysym.deref;
var
pap : tpropaccesslisttypes;
begin
overridenpropsym:=tpropertysym(overridenpropsymderef.resolve);
indexdef:=tdef(indexdefderef.resolve);
propdef:=tdef(propdefderef.resolve);
readaccess.resolve;
writeaccess.resolve;
storedaccess.resolve;
for pap:=low(tpropaccesslisttypes) to high(tpropaccesslisttypes) do
propaccesslist[pap].resolve;
end;
@ -1139,6 +1144,8 @@ implementation
procedure tpropertysym.ppuwrite(ppufile:tcompilerppufile);
var
pap : tpropaccesslisttypes;
begin
inherited ppuwrite(ppufile);
ppufile.putsmallset(propoptions);
@ -1147,9 +1154,8 @@ implementation
ppufile.putlongint(index);
ppufile.putlongint(default);
ppufile.putderef(indexdefderef);
ppufile.putpropaccesslist(readaccess);
ppufile.putpropaccesslist(writeaccess);
ppufile.putpropaccesslist(storedaccess);
for pap:=low(tpropaccesslisttypes) to high(tpropaccesslisttypes) do
ppufile.putpropaccesslist(propaccesslist[pap]);
ppufile.writeentry(ibpropertysym);
end;