* turned getpropaccesslist, add_parameters and add_index_parameter into

    methods of tpropertysym (refactoring)
  * turned code to copy the contents of a property into another one
    into a method of tpropertysym (refactoring)

git-svn-id: trunk@22955 -

compiler/nflw.pas

@@ -749,7 +749,7 @@ implementation
 
         loopbody:=internalstatements(loopbodystatement);
         { for-in loop variable := enumerator.current }
-        if getpropaccesslist(enumerator_current,palt_read,propaccesslist) then
+        if enumerator_current.getpropaccesslist(palt_read,propaccesslist) then
           begin
              case propaccesslist.firstsym^.sym.typ of
                fieldvarsym :

compiler/nutils.pas

@@ -94,7 +94,6 @@ interface
       containing no code }
     function has_no_code(n : tnode) : boolean;
 
-    function getpropaccesslist(propsym:tpropertysym; pap:tpropaccesslisttypes;out propaccesslist:tpropaccesslist):boolean;
     procedure propaccesslist_to_node(var p1:tnode;st:TSymtable;pl:tpropaccesslist);
     function node_to_propaccesslist(p1:tnode):tpropaccesslist;
 
@@ -886,25 +885,6 @@ implementation
       end;
 
 
-    function getpropaccesslist(propsym:tpropertysym; pap:tpropaccesslisttypes;out propaccesslist:tpropaccesslist):boolean;
-    var
-      hpropsym : tpropertysym;
-    begin
-      result:=false;
-      { find property in the overridden list }
-      hpropsym:=propsym;
-      repeat
-        propaccesslist:=hpropsym.propaccesslist[pap];
-        if not propaccesslist.empty then
-          begin
-            result:=true;
-            exit;
-          end;
-        hpropsym:=hpropsym.overriddenpropsym;
-      until not assigned(hpropsym);
-    end;
-
-
     procedure propaccesslist_to_node(var p1:tnode;st:TSymtable;pl:tpropaccesslist);
       var
         plist : ppropaccesslistitem;

compiler/pdecvar.pas

@@ -325,32 +325,6 @@ implementation
                 end;
             end;
 
-          procedure add_parameters(p: tpropertysym; readprocdef, writeprocdef: tprocdef);
-            var
-              i: integer;
-              orig, hparavs: tparavarsym;
-            begin
-              for i := 0 to p.parast.SymList.Count - 1 do
-                begin
-                  orig:=tparavarsym(p.parast.SymList[i]);
-                  hparavs:=tparavarsym.create(orig.RealName,orig.paranr,orig.varspez,orig.vardef,[]);
-                  readprocdef.parast.insert(hparavs);
-                  hparavs:=tparavarsym.create(orig.RealName,orig.paranr,orig.varspez,orig.vardef,[]);
-                  writeprocdef.parast.insert(hparavs);
-                end;
-            end;
-
-          procedure add_index_parameter(var paranr: word; p: tpropertysym; readprocdef, writeprocdef: tprocdef);
-            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);
-            end;
-
       var
          sym : tsym;
          srsymtable: tsymtable;
@@ -457,7 +431,7 @@ implementation
                 index parameter doesn't count (PFV) }
               if paranr>0 then
                 begin
-                  add_parameters(p,readprocdef,writeprocdef);
+                  p.add_accessor_parameters(readprocdef,writeprocdef);
                   include(p.propoptions,ppo_hasparameters);
                 end;
            end;
@@ -499,7 +473,7 @@ implementation
                    p.indexdef:=pt.resultdef;
                    include(p.propoptions,ppo_indexed);
                    { concat a longint to the para templates }
-                   add_index_parameter(paranr,p,readprocdef,writeprocdef);
+                   p.add_index_parameter(paranr,readprocdef,writeprocdef);
                    pt.free;
                 end;
            end
@@ -514,21 +488,9 @@ implementation
                  (overridden.typ=propertysym) and
                  not(is_dispinterface(astruct)) then
                 begin
+                  tpropertysym(overridden).makeduplicate(p,readprocdef,writeprocdef,paranr);
                   p.overriddenpropsym:=tpropertysym(overridden);
-                  { inherit all type related entries }
-                  p.indexdef:=tpropertysym(overridden).indexdef;
-                  p.propdef:=tpropertysym(overridden).propdef;
-                  p.index:=tpropertysym(overridden).index;
-                  p.default:=tpropertysym(overridden).default;
-                  p.propoptions:=tpropertysym(overridden).propoptions + [ppo_overrides];
-                  if ppo_hasparameters in p.propoptions then
-                    begin
-                      p.parast:=tpropertysym(overridden).parast.getcopy;
-                      add_parameters(p,readprocdef,writeprocdef);
-                      paranr:=p.parast.SymList.Count;
-                    end;
-                  if ppo_indexed in p.propoptions then
-                    add_index_parameter(paranr,p,readprocdef,writeprocdef);
+                  include(p.propoptions,ppo_overrides);
                 end
               else
                 begin

compiler/pexpr.pas

@@ -1090,7 +1090,7 @@ implementation
          { if not(afterassignment) and not(in_args) then }
          if token=_ASSIGNMENT then
            begin
-              if getpropaccesslist(propsym,palt_write,propaccesslist) then
+              if propsym.getpropaccesslist(palt_write,propaccesslist) then
                 begin
                    sym:=propaccesslist.firstsym^.sym;
                    case sym.typ of
@@ -1142,7 +1142,7 @@ implementation
            end
          else
            begin
-              if getpropaccesslist(propsym,palt_read,propaccesslist) then
+              if propsym.getpropaccesslist(palt_read,propaccesslist) then
                 begin
                    sym := propaccesslist.firstsym^.sym;
                    case sym.typ of

compiler/symsym.pas

@@ -286,6 +286,12 @@ interface
           procedure ppuwrite(ppufile:tcompilerppufile);override;
           procedure buildderef;override;
           procedure deref;override;
+          function getpropaccesslist(pap:tpropaccesslisttypes;out plist:tpropaccesslist):boolean;
+          { copies the settings of the current propertysym to p; a bit like
+            a form of getcopy, but without the name }
+          procedure makeduplicate(p: tpropertysym; readprocdef, writeprocdef: tprocdef; out paranr: word);
+          procedure add_accessor_parameters(readprocdef, writeprocdef: tprocdef);
+          procedure add_index_parameter(var paranr: word; readprocdef, writeprocdef: tprocdef);
        end;
 
        tconstvalue = record
@@ -1187,6 +1193,86 @@ implementation
       end;
 
 
+    function tpropertysym.getpropaccesslist(pap:tpropaccesslisttypes;out plist:tpropaccesslist):boolean;
+    var
+      hpropsym : tpropertysym;
+    begin
+      result:=false;
+      { find property in the overridden list }
+      hpropsym:=self;
+      repeat
+        plist:=hpropsym.propaccesslist[pap];
+        if not plist.empty then
+          begin
+            result:=true;
+            exit;
+          end;
+        hpropsym:=hpropsym.overriddenpropsym;
+      until not assigned(hpropsym);
+    end;
+
+
+    procedure tpropertysym.add_accessor_parameters(readprocdef, writeprocdef: tprocdef);
+      var
+        i: integer;
+        orig, hparavs: tparavarsym;
+      begin
+        for i := 0 to parast.SymList.Count - 1 do
+          begin
+            orig:=tparavarsym(parast.SymList[i]);
+            if assigned(readprocdef) then
+              begin
+                hparavs:=tparavarsym.create(orig.RealName,orig.paranr,orig.varspez,orig.vardef,[]);
+                readprocdef.parast.insert(hparavs);
+              end;
+            if assigned(writeprocdef) then
+              begin
+                hparavs:=tparavarsym.create(orig.RealName,orig.paranr,orig.varspez,orig.vardef,[]);
+                writeprocdef.parast.insert(hparavs);
+              end;
+          end;
+      end;
+
+
+    procedure tpropertysym.add_index_parameter(var paranr: word; readprocdef, writeprocdef: tprocdef);
+      var
+        hparavs: tparavarsym;
+      begin
+        inc(paranr);
+        if assigned(readprocdef) then
+          begin
+            hparavs:=tparavarsym.create('$index',10*paranr,vs_value,indexdef,[]);
+            readprocdef.parast.insert(hparavs);
+          end;
+        if assigned(writeprocdef) then
+          begin
+            hparavs:=tparavarsym.create('$index',10*paranr,vs_value,indexdef,[]);
+            writeprocdef.parast.insert(hparavs);
+          end;
+      end;
+
+
+
+    procedure tpropertysym.makeduplicate(p: tpropertysym; readprocdef, writeprocdef: tprocdef; out paranr: word);
+      begin
+        { inherit all type related entries }
+        p.indexdef:=indexdef;
+        p.propdef:=propdef;
+        p.index:=index;
+        p.default:=default;
+        p.propoptions:=propoptions;
+        paranr:=0;
+        if ppo_hasparameters in propoptions then
+          begin
+            p.parast:=parast.getcopy;
+            p.add_accessor_parameters(readprocdef,writeprocdef);
+            paranr:=p.parast.SymList.Count;
+          end;
+        if ppo_indexed in p.propoptions then
+          p.add_index_parameter(paranr,readprocdef,writeprocdef);
+      end;
+
+
     function tpropertysym.getsize : asizeint;
       begin
          getsize:=0;

compiler/utils/ppudump.pp

@@ -1590,10 +1590,10 @@ const
      (mask:vo_is_msgsel;str:'MsgSel'),
      (mask:vo_is_weak_external;str:'WeakExternal'),
      (mask:vo_is_first_field;str:'IsFirstField'),
-     (mask:vo_volatile;str:'Volatile'),
-     (mask:vo_has_section;str:'HasSection'),
-     (mask:vo_force_finalize;str:'ForceFinalize'),
-     (mask:vo_is_default_var;str:'DefaultIntrinsicVar')
+     (mask:vo_volatile;        str:'Volatile'),
+     (mask:vo_has_section;     str:'HasSection'),
+     (mask:vo_force_finalize;  str:'ForceFinalize'),
+     (mask:vo_is_default_var;  str:'DefaultIntrinsicVar')
   );
 var
   i : longint;