mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-15 20:29:17 +02:00
* fixed changing the visibility of a property with a fixed index in a child
class (mantis #15610) git-svn-id: trunk@15223 -
This commit is contained in:
parent
3f280c34cb
commit
c60bcf8699
1
.gitattributes
vendored
1
.gitattributes
vendored
@ -10313,6 +10313,7 @@ tests/webtbs/tw15504.pp svneol=native#text/plain
|
|||||||
tests/webtbs/tw15530.pp svneol=native#text/pascal
|
tests/webtbs/tw15530.pp svneol=native#text/pascal
|
||||||
tests/webtbs/tw15592.pp svneol=native#text/plain
|
tests/webtbs/tw15592.pp svneol=native#text/plain
|
||||||
tests/webtbs/tw15607.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/tw15619.pp svneol=native#text/plain
|
||||||
tests/webtbs/tw15668.pp svneol=native#text/pascal
|
tests/webtbs/tw15668.pp svneol=native#text/pascal
|
||||||
tests/webtbs/tw1567.pp svneol=native#text/plain
|
tests/webtbs/tw1567.pp svneol=native#text/plain
|
||||||
|
@ -282,6 +282,19 @@ implementation
|
|||||||
p.dispid:=aclass.get_next_dispid;
|
p.dispid:=aclass.get_next_dispid;
|
||||||
end;
|
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
|
var
|
||||||
sym : tsym;
|
sym : tsym;
|
||||||
srsymtable: tsymtable;
|
srsymtable: tsymtable;
|
||||||
@ -431,13 +444,7 @@ implementation
|
|||||||
p.indexdef:=pt.resultdef;
|
p.indexdef:=pt.resultdef;
|
||||||
include(p.propoptions,ppo_indexed);
|
include(p.propoptions,ppo_indexed);
|
||||||
{ concat a longint to the para templates }
|
{ concat a longint to the para templates }
|
||||||
inc(paranr);
|
add_index_parameter(paranr,p,readprocdef,writeprocdef,storedprocdef);
|
||||||
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);
|
|
||||||
pt.free;
|
pt.free;
|
||||||
end;
|
end;
|
||||||
end
|
end
|
||||||
@ -456,6 +463,8 @@ implementation
|
|||||||
p.index:=tpropertysym(overriden).index;
|
p.index:=tpropertysym(overriden).index;
|
||||||
p.default:=tpropertysym(overriden).default;
|
p.default:=tpropertysym(overriden).default;
|
||||||
p.propoptions:=tpropertysym(overriden).propoptions;
|
p.propoptions:=tpropertysym(overriden).propoptions;
|
||||||
|
if ppo_indexed in p.propoptions then
|
||||||
|
add_index_parameter(paranr,p,readprocdef,writeprocdef,storedprocdef);
|
||||||
end
|
end
|
||||||
else
|
else
|
||||||
begin
|
begin
|
||||||
|
54
tests/webtbs/tw15610.pp
Normal file
54
tests/webtbs/tw15610.pp
Normal 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.
|
Loading…
Reference in New Issue
Block a user