Pārlūkot izejas kodu

* fixed changing the visibility of a property with a fixed index in a child
class (mantis #15610)

git-svn-id: trunk@15223 -

Jonas Maebe 15 gadi atpakaļ
vecāks
revīzija
c60bcf8699
3 mainītis faili ar 71 papildinājumiem un 7 dzēšanām
  1. 1 0
      .gitattributes
  2. 16 7
      compiler/pdecvar.pas
  3. 54 0
      tests/webtbs/tw15610.pp

+ 1 - 0
.gitattributes

@@ -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

+ 16 - 7
compiler/pdecvar.pas

@@ -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 - 0
tests/webtbs/tw15610.pp

@@ -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.