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

* fixed changing the visibility of a property with a fixed index in a child

Browse Source 
class (mantis #15610)

git-svn-id: trunk@15223 -
This commit is contained in:
Jonas Maebe 2010-05-04 14:41:22 +00:00
parent 3f280c34cb
commit c60bcf8699
3 changed files with 71 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -10313,6 +10313,7 @@ tests/webtbs/tw15504.pp svneol=native#text/plain
tests/webtbs/tw15530.pp svneol=native#text/pascal
tests/webtbs/tw15592.pp svneol=native#text/plain
tests/webtbs/tw15607.pp svneol=native#text/plain
tests/webtbs/tw15610.pp svneol=native#text/plain
tests/webtbs/tw15619.pp svneol=native#text/plain
tests/webtbs/tw15668.pp svneol=native#text/pascal
tests/webtbs/tw1567.pp svneol=native#text/plain

23
compiler/pdecvar.pas
View File

@ -282,6 +282,19 @@ implementation
p.dispid:=aclass.get_next_dispid;
end;
procedure add_index_parameter(var paranr: word; p: tpropertysym; readprocdef, writeprocdef, storedprocdef: tprocvardef);
var
hparavs: tparavarsym;
begin
inc(paranr);
hparavs:=tparavarsym.create('$index',10*paranr,vs_value,p.indexdef,[]);
readprocdef.parast.insert(hparavs);
hparavs:=tparavarsym.create('$index',10*paranr,vs_value,p.indexdef,[]);
writeprocdef.parast.insert(hparavs);
hparavs:=tparavarsym.create('$index',10*paranr,vs_value,p.indexdef,[]);
storedprocdef.parast.insert(hparavs);
end;
var
sym : tsym;
srsymtable: tsymtable;
@ -431,13 +444,7 @@ implementation
p.indexdef:=pt.resultdef;
include(p.propoptions,ppo_indexed);
{ concat a longint to the para templates }
inc(paranr);
hparavs:=tparavarsym.create('$index',10*paranr,vs_value,p.indexdef,[]);
readprocdef.parast.insert(hparavs);
hparavs:=tparavarsym.create('$index',10*paranr,vs_value,p.indexdef,[]);
writeprocdef.parast.insert(hparavs);
hparavs:=tparavarsym.create('$index',10*paranr,vs_value,p.indexdef,[]);
storedprocdef.parast.insert(hparavs);
add_index_parameter(paranr,p,readprocdef,writeprocdef,storedprocdef);
pt.free;
end;
end
@ -456,6 +463,8 @@ implementation
p.index:=tpropertysym(overriden).index;
p.default:=tpropertysym(overriden).default;
p.propoptions:=tpropertysym(overriden).propoptions;
if ppo_indexed in p.propoptions then
add_index_parameter(paranr,p,readprocdef,writeprocdef,storedprocdef);
end
else
begin

54
tests/webtbs/tw15610.pp Normal file
View File

@ -0,0 +1,54 @@
{ %norun }
program a;
{$ifdef FPC}
{$mode delphi}
{$endif}
type
TBase=class
private
fData:string;
procedure Setdata(ndx:integer;const s:string);
function GetData(ndx:integer):string;
function OldIsStored(ndx:integer):boolean;
public
property Data:string index 0 read GetData write SetData stored OldIsStored;
end;
TDerived=class(TBase)
private
function IsDataStored(ndx:integer):boolean;
published
property Data stored IsDataStored;
end;
procedure TBase.Setdata(ndx:integer;const s:string);
begin
if ndx=0 then fData:=s;
end;
function TBase.GetData(ndx:integer):string;
begin
if ndx=0 then
Result:=fData
else
Result:='';
end;
function TBase.OldIsStored(ndx:integer):boolean;
begin
Result:=ndx>1;
end;
function TDerived.IsDataStored(ndx:integer):boolean;
begin
Result:=ndx=0;
end;
begin
end.