* allow the usage of symbolic constants to specify the "stored" attribute

    of properties (mantis #10492). Not really clean (and Delphi supports
    full expressions, e.g. also "(const1=const2)"), but cannot do better
    without rewriting the complete symlist parsing to use parse trees instead
    of parser tokens as input

git-svn-id: trunk@12696 -

.gitattributes

@@ -8596,6 +8596,7 @@ tests/webtbs/tw1044.pp svneol=native#text/plain
 tests/webtbs/tw10454.pp svneol=native#text/plain
 tests/webtbs/tw1046.pp svneol=native#text/plain
 tests/webtbs/tw10489.pp svneol=native#text/plain
+tests/webtbs/tw10492.pp svneol=native#text/plain
 tests/webtbs/tw10493.pp svneol=native#text/plain
 tests/webtbs/tw10495.pp svneol=native#text/plain
 tests/webtbs/tw1050.pp svneol=native#text/plain
@@ -9629,6 +9630,7 @@ tests/webtbs/uw0701c.pp svneol=native#text/plain
 tests/webtbs/uw0701d.pp svneol=native#text/plain
 tests/webtbs/uw0701e.pp svneol=native#text/plain
 tests/webtbs/uw0809.pp svneol=native#text/plain
+tests/webtbs/uw10492.pp svneol=native#text/plain
 tests/webtbs/uw11182.pp svneol=native#text/plain
 tests/webtbs/uw11762.pp svneol=native#text/plain
 tests/webtbs/uw1181.inc svneol=native#text/plain

compiler/pdecvar.pas

@@ -240,6 +240,7 @@ implementation
 
       var
          sym : tsym;
+         srsymtable: tsymtable;
          p : tpropertysym;
          overriden : tsym;
          varspez : tvarspez;
@@ -550,7 +551,37 @@ implementation
                       { as stored true                    }
                       if idtoken<>_DEFAULT then
                        begin
-                         if parse_symlist(p.propaccesslist[palt_stored],def) then
+                         { parse_symlist cannot deal with constsyms, and
+                           we also don't want to put constsyms in symlists
+                           since they have to be evaluated immediately rather
+                           than each time the property is accessed
+
+                           The proper fix would be to always create a parse tree
+                           and then convert that one, if appropriate, to a symlist.
+                           Currently, we e.g. don't support any constant expressions
+                           yet either here, while Delphi does.
+
+                         }
+                         { make sure we don't let constants mask class fields/
+                           methods
+                         }
+                         if (not assigned(aclass) or
+                             (search_class_member(aclass,pattern)=nil)) and
+                            searchsym(pattern,sym,srsymtable) and
+                            (sym.typ = constsym) then
+                           begin
+                              addsymref(sym);
+                              if not is_boolean(tconstsym(sym).constdef) then
+                                Message(parser_e_stored_property_must_be_boolean)
+                              else if (tconstsym(sym).value.valueord=0) then
+                                { same as for _FALSE }
+                                exclude(p.propoptions,ppo_stored)
+                              else
+                                { same as for _TRUE }
+                                p.default:=longint($80000000);
+                              consume(_ID);
+                            end
+                         else if parse_symlist(p.propaccesslist[palt_stored],def) then
                           begin
                             sym:=p.propaccesslist[palt_stored].firstsym^.sym;
                             case sym.typ of

tests/webtbs/tw10492.pp

@@ -0,0 +1,11 @@
+{ %recompile }
+{ %norun }
+
+uses
+  uw10492;
+
+{ main code in unit to also test whether there are no problems with the
+  symlists afterwards
+}
+begin
+end.

tests/webtbs/tw7391.pp

@@ -5,11 +5,12 @@ uses
 
 const
   ShowTheException = true; //set this to false for halt(128) instead of exception
+  StoredTrue = True;
 
 type
   TGLNode = class (TCollectionItem)
   private
-    FCoords : array[0..5] of double;
+    FCoords : array[0..6] of double;
     procedure SetCoordinate(aIndx: Integer; AValue: double);
   protected
     function StoreCoordinate(aIndx: Integer) : Boolean;
@@ -19,7 +20,7 @@ type
     property Z: double index 2 read FCoords[2] write SetCoordinate stored StoreCoordinate;
     property X2: double index 3 read FCoords[3] write SetCoordinate stored true;
     property Y2: double index 4 read FCoords[4] write SetCoordinate stored true;
-    property Z2: double index 5 read FCoords[5] write SetCoordinate stored true;
+    property Z2: double index 5 read FCoords[5] write SetCoordinate stored StoredTrue;
   end;
 
   { TNodeContainer }

tests/webtbs/uw10492.pp

@@ -0,0 +1,21 @@
+unit uw10492;
+
+{$mode objfpc}
+
+interface
+
+const
+  ISSTORED = false;
+
+type
+  TTest = class
+  private
+    Faaaa: String;
+  published
+    property AAAA: String read Faaaa write Faaaa stored ISSTORED;
+  end;
+
+implementation
+
+begin
+end.