compiler: fix ppu read/write of property parameters symtable (bug #0020454)

  - add new property option ppo_overrides for property which overrides parent class properties
  - write overriddenpropsymderef only in case if property has ppo_overrides flag
  - save/load parameters symtable only in case if property has ppo_parameters flag and has not ppo_overrides flag
  - in case if property is overrides and has parameters copy original symtable

git-svn-id: trunk@19615 -

compiler/pdecvar.pas

@@ -513,7 +513,7 @@ implementation
                   p.propdef:=tpropertysym(overridden).propdef;
                   p.index:=tpropertysym(overridden).index;
                   p.default:=tpropertysym(overridden).default;
-                  p.propoptions:=tpropertysym(overridden).propoptions;
+                  p.propoptions:=tpropertysym(overridden).propoptions + [ppo_overrides];
                   if ppo_hasparameters in p.propoptions then
                     begin
                       p.parast:=tpropertysym(overridden).parast.getcopy;

compiler/ppu.pas

@@ -43,7 +43,7 @@ type
 {$endif Test_Double_checksum}
 
 const
-  CurrentPPUVersion = 139;
+  CurrentPPUVersion = 140;
 
 { buffer sizes }
   maxentrysize = 1024;

compiler/symconst.pas

@@ -394,13 +394,13 @@ type
 
   { options for properties }
   tpropertyoption=(ppo_none,
-    ppo_indexed,
+    ppo_indexed,                  { delcared wwith "index" keyword }
     ppo_defaultproperty,
     ppo_stored,
-    ppo_hasparameters,
+    ppo_hasparameters,            { has parameters: prop[param1, param2: type] }
     ppo_implements,
-    ppo_enumerator_current,
-    ppo_dispid_read,              { no longer used }
+    ppo_enumerator_current,       { implements current property for enumerator }
+    ppo_overrides,                { overrides ancestor property }
     ppo_dispid_write              { no longer used }
   );
   tpropertyoptions=set of tpropertyoption;

compiler/symsym.pas

@@ -969,18 +969,21 @@ implementation
       begin
          inherited ppuload(propertysym,ppufile);
          ppufile.getsmallset(propoptions);
-         ppufile.getderef(overriddenpropsymderef);
+         if ppo_overrides in propoptions then
+           ppufile.getderef(overriddenpropsymderef);
          ppufile.getderef(propdefderef);
          index:=ppufile.getlongint;
          default:=ppufile.getlongint;
          ppufile.getderef(indexdefderef);
          for pap:=low(tpropaccesslisttypes) to high(tpropaccesslisttypes) do
            propaccesslist[pap]:=ppufile.getpropaccesslist;
-         if ppo_hasparameters in propoptions then
+         if [ppo_hasparameters,ppo_overrides]*propoptions=[ppo_hasparameters] then
            begin
              parast:=tparasymtable.create(nil,0);
              tparasymtable(parast).ppuload(ppufile);
-           end;
+           end
+         else
+           parast:=nil;
       end;
 
 
@@ -999,12 +1002,14 @@ implementation
       var
         pap : tpropaccesslisttypes;
       begin
-        overriddenpropsymderef.build(overriddenpropsym);
         propdefderef.build(propdef);
         indexdefderef.build(indexdef);
         for pap:=low(tpropaccesslisttypes) to high(tpropaccesslisttypes) do
           propaccesslist[pap].buildderef;
-        if assigned(parast) then
+        if ppo_overrides in propoptions then
+          overriddenpropsymderef.build(overriddenpropsym)
+        else
+        if ppo_hasparameters in propoptions then
           tparasymtable(parast).buildderef;
       end;
 
@@ -1013,13 +1018,20 @@ implementation
       var
         pap : tpropaccesslisttypes;
       begin
-        overriddenpropsym:=tpropertysym(overriddenpropsymderef.resolve);
         indexdef:=tdef(indexdefderef.resolve);
         propdef:=tdef(propdefderef.resolve);
         for pap:=low(tpropaccesslisttypes) to high(tpropaccesslisttypes) do
           propaccesslist[pap].resolve;
-        if assigned(parast) then
-          tparasymtable(parast).deref;
+
+        if ppo_overrides in propoptions then
+          begin
+            overriddenpropsym:=tpropertysym(overriddenpropsymderef.resolve);
+            if ppo_hasparameters in propoptions then
+              parast:=overriddenpropsym.parast.getcopy;
+          end
+        else
+        if ppo_hasparameters in propoptions then
+          tparasymtable(parast).deref
       end;
 
 
@@ -1035,7 +1047,8 @@ implementation
       begin
         inherited ppuwrite(ppufile);
         ppufile.putsmallset(propoptions);
-        ppufile.putderef(overriddenpropsymderef);
+        if ppo_overrides in propoptions then
+          ppufile.putderef(overriddenpropsymderef);
         ppufile.putderef(propdefderef);
         ppufile.putlongint(index);
         ppufile.putlongint(default);
@@ -1043,7 +1056,7 @@ implementation
         for pap:=low(tpropaccesslisttypes) to high(tpropaccesslisttypes) do
           ppufile.putpropaccesslist(propaccesslist[pap]);
         ppufile.writeentry(ibpropertysym);
-        if ppo_hasparameters in propoptions then
+        if [ppo_hasparameters,ppo_overrides]*propoptions=[ppo_hasparameters] then
           tparasymtable(parast).ppuwrite(ppufile);
       end;
 

compiler/utils/ppudump.pp

@@ -519,6 +519,16 @@ begin
   writeln;
 end;
 
+procedure readdefinitions(const s:string); forward;
+procedure readsymbols(const s:string); forward;
+
+procedure readsymtable(const s: string);
+begin
+  readsymtableoptions(s);
+  readdefinitions(s);
+  readsymbols(s);
+end;
+
 Procedure ReadLinkContainer(const prefix:string);
 {
   Read a serie of strings and write to the screen starting every line
@@ -1697,12 +1707,12 @@ end;
     ppo_hasparameters,
     ppo_implements,
     ppo_enumerator_current,
-    ppo_dispid_read,              { no longer used }
+    ppo_overrides,              
     ppo_dispid_write              { no longer used }
   );
   tpropertyoptions=set of tpropertyoption;
 *)
-procedure readpropertyoptions;
+function readpropertyoptions:tpropertyoptions;
 { type tarraydefoption is in unit symconst }
 type
   tpropopt=record
@@ -1717,20 +1727,19 @@ const
     (mask:ppo_hasparameters;str:'has parameters'),
     (mask:ppo_implements;str:'implements'),
     (mask:ppo_enumerator_current;str:'enumerator current'),
-    (mask:ppo_dispid_read;str:'dispid read'),   { no longer used }
+    (mask:ppo_overrides;str:'overrides'),  
     (mask:ppo_dispid_write;str:'dispid write')  { no longer used }
   );
 var
-  propoptions : tpropertyoptions;
   i      : longint;
   first  : boolean;
 begin
-  ppufile.getsmallset(propoptions);
-  if propoptions<>[] then
+  ppufile.getsmallset(result);
+  if result<>[] then
    begin
      first:=true;
      for i:=1 to high(symopt) do
-      if (symopt[i].mask in propoptions) then
+      if (symopt[i].mask in result) then
        begin
          if first then
            first:=false
@@ -1857,6 +1866,7 @@ var
   tempbuf : array[0..127] of char;
   pw : pcompilerwidestring;
   varoptions : tvaroptions;
+  propoptions : tpropertyoptions;
 begin
   with ppufile do
    begin
@@ -2137,9 +2147,12 @@ begin
          ibpropertysym :
            begin
              readcommonsym('Property ');
-             readpropertyoptions;
-             write  (space,' OverrideProp : ');
-             readderef('');
+             propoptions:=readpropertyoptions;
+             if ppo_overrides in propoptions then
+               begin
+                 write  (space,' OverrideProp : ');
+                 readderef('');
+               end;
              write  (space,'    Prop Type : ');
              readderef('');
              writeln(space,'        Index : ',getlongint);
@@ -2154,6 +2167,12 @@ begin
              readpropaccesslist(space+'         Sym: ');
              write  (space,' Storedaccess : ');
              readpropaccesslist(space+'         Sym: ');
+             if [ppo_hasparameters,ppo_overrides]*propoptions=[ppo_hasparameters] then
+               begin
+                 space:='    '+space;
+                 readsymtable('parast');
+                 delete(space,1,4);
+               end;
            end;
 
          iberror :
@@ -2263,9 +2282,7 @@ begin
              writeln(space,'            Range : ',getaint,' to ',getaint);
              write  (space,'          Options : ');
              readarraydefoptions;
-             readsymtableoptions('symbols');
-             readdefinitions('symbols');
-             readsymbols('symbols');
+             readsymtable('symbols');
            end;
 
          ibprocdef :
@@ -2324,16 +2341,10 @@ begin
                HasMoreInfos;
              space:='    '+space;
              { parast }
-             readsymtableoptions('parast');
-             readdefinitions('parast');
-             readsymbols('parast');
+             readsymtable('parast');
              { localst }
              if (po_has_inlininginfo in procoptions) then
-              begin
-                readsymtableoptions('localst');
-                readdefinitions('localst');
-                readsymbols('localst');
-              end;
+                readsymtable('localst');
              if (po_has_inlininginfo in procoptions) then
                readnodetree;
              delete(space,1,4);
@@ -2348,9 +2359,7 @@ begin
                HasMoreInfos;
              space:='    '+space;
              { parast }
-             readsymtableoptions('parast');
-             readdefinitions('parast');
-             readsymbols('parast');
+             readsymtable('parast');
              delete(space,1,4);
            end;
 
@@ -2409,9 +2418,7 @@ begin
                begin
                  space:='    '+space;
                  readrecsymtableoptions;
-                 readsymtableoptions('fields');
-                 readdefinitions('fields');
-                 readsymbols('fields');
+                 readsymtable('fields');
                  Delete(space,1,4);
                end;
            end;
@@ -2495,9 +2502,7 @@ begin
                  {read the record definitions and symbols}
                  space:='    '+space;
                  readrecsymtableoptions;
-                 readsymtableoptions('fields');
-                 readdefinitions('fields');
-                 readsymbols('fields');
+                 readsymtable('fields');
                  Delete(space,1,4);
               end;
            end;
@@ -2540,9 +2545,7 @@ begin
              else
                begin
                  space:='    '+space;
-                 readsymtableoptions('elements');
-                 readdefinitions('elements');
-                 readsymbols('elements');
+                 readsymtable('elements');
                  delete(space,1,4);
                end;
            end;