Bläddra i källkod

* handle stored false properly when overriding properties

git-svn-id: trunk@3509 -
florian 19 år sedan
förälder
incheckning
d1bfba1c4d
3 ändrade filer med 59 tillägg och 1 borttagningar
  1. 1 0
      .gitattributes
  2. 4 1
      compiler/pdecvar.pas
  3. 54 0
      tests/webtbs/tw5082.pp

+ 1 - 0
.gitattributes

@@ -6809,6 +6809,7 @@ tests/webtbs/tw5001.pp svneol=native#text/plain
 tests/webtbs/tw5015.pp svneol=native#text/plain
 tests/webtbs/tw5023.pp svneol=native#text/plain
 tests/webtbs/tw5036.pp svneol=native#text/plain
+tests/webtbs/tw5082.pp -text svneol=unset#text/plain
 tests/webtbs/ub1873.pp svneol=native#text/plain
 tests/webtbs/ub1883.pp svneol=native#text/plain
 tests/webtbs/uw0555.pp svneol=native#text/plain

+ 4 - 1
compiler/pdecvar.pas

@@ -477,9 +477,12 @@ implementation
 
          if assigned(aclass) and not(is_dispinterface(aclass)) then
            begin
-             include(p.propoptions,ppo_stored);
+             { ppo_stored might be not set by an overridden property }
+             if not(ppo_is_override in p.propoptions) then
+               include(p.propoptions,ppo_stored);
              if try_to_consume(_STORED) then
               begin
+                include(p.propoptions,ppo_stored);
                 p.storedaccess.clear;
                 case token of
                   _ID:

+ 54 - 0
tests/webtbs/tw5082.pp

@@ -0,0 +1,54 @@
+{ Source provided for Free Pascal Bug Report 5082 }
+{ Submitted by "Martin Schreiber" on  2006-05-01 }
+{ e-mail:  }
+program storedfalse;
+{$ifdef FPC}{$mode objfpc}{$h+}{$INTERFACES CORBA}{$endif}
+{$ifdef mswindows}{$apptype console}{$endif}
+uses
+ {$ifdef FPC}{$ifdef linux}cthreads,{$endif}{$endif}
+ sysutils,classes;
+
+type
+ ttestclass1 = class(tcomponent)
+  private
+   fprop1: real;
+  public
+   property prop1: real read fprop1 write fprop1 stored false;
+ end;
+
+ ttestclass2 = class(ttestclass1)
+  published
+   property prop1;
+ end;
+
+var
+ testclass2: ttestclass2;
+ stream1,stream2: tmemorystream;
+ str1: string;
+
+begin
+ testclass2:= ttestclass2.create(nil);
+ testclass2.prop1:= 1;
+ stream1:= tmemorystream.create;
+ try
+  stream1.writecomponent(testclass2);
+  stream2:= tmemorystream.create;
+  try
+   stream1.position:= 0;
+   objectbinarytotext(stream1,stream2);
+   stream2.position:= 0;
+   setlength(str1,stream2.size);
+   move(stream2.memory^,str1[1],length(str1));
+   write(str1);
+  finally
+   stream2.free;
+  end;
+ finally
+  stream1.free;
+ end;
+ if pos('prop1',str1)<>0 then
+   begin
+     writeln('error');
+     halt(1);
+   end;
+end.