* fix rtti for overriden properties

git-svn-id: trunk@5079 -

compiler/pdecvar.pas

@@ -392,10 +392,10 @@ implementation
            begin
              if try_to_consume(_READ) then
                begin
-                 p.readaccess.clear;
-                 if parse_symlist(p.readaccess,def) then
+                 p.propaccesslist[palt_read].clear;
+                 if parse_symlist(p.propaccesslist[palt_read],def) then
                   begin
-                    sym:=p.readaccess.firstsym^.sym;
+                    sym:=p.propaccesslist[palt_read].firstsym^.sym;
                     case sym.typ of
                       procsym :
                         begin
@@ -407,8 +407,8 @@ implementation
                           { we ignore hidden stuff here because the property access symbol might have
                             non default calling conventions which might change the hidden stuff;
                             see tw3216.pp (FK) }
-                          p.readaccess.procdef:=Tprocsym(sym).search_procdef_bypara(readprocdef.paras,p.propdef,[cpo_allowdefaults,cpo_ignorehidden]);
-                          if not assigned(p.readaccess.procdef) then
+                          p.propaccesslist[palt_read].procdef:=Tprocsym(sym).search_procdef_bypara(readprocdef.paras,p.propdef,[cpo_allowdefaults,cpo_ignorehidden]);
+                          if not assigned(p.propaccesslist[palt_read].procdef) then
                             Message(parser_e_ill_property_access_sym);
                         end;
                       fieldvarsym :
@@ -435,10 +435,10 @@ implementation
                end;
              if try_to_consume(_WRITE) then
                begin
-                 p.writeaccess.clear;
-                 if parse_symlist(p.writeaccess,def) then
+                 p.propaccesslist[palt_write].clear;
+                 if parse_symlist(p.propaccesslist[palt_write],def) then
                   begin
-                    sym:=p.writeaccess.firstsym^.sym;
+                    sym:=p.propaccesslist[palt_write].firstsym^.sym;
                     case sym.typ of
                       procsym :
                         begin
@@ -451,8 +451,8 @@ implementation
                           { Insert hidden parameters }
                           handle_calling_convention(writeprocdef);
                           { search procdefs matching writeprocdef }
-                          p.writeaccess.procdef:=Tprocsym(sym).search_procdef_bypara(writeprocdef.paras,writeprocdef.returndef,[cpo_allowdefaults]);
-                          if not assigned(p.writeaccess.procdef) then
+                          p.propaccesslist[palt_write].procdef:=Tprocsym(sym).search_procdef_bypara(writeprocdef.paras,writeprocdef.returndef,[cpo_allowdefaults]);
+                          if not assigned(p.propaccesslist[palt_write].procdef) then
                             Message(parser_e_ill_property_access_sym);
                         end;
                       fieldvarsym :
@@ -505,7 +505,7 @@ implementation
              if try_to_consume(_STORED) then
               begin
                 include(p.propoptions,ppo_stored);
-                p.storedaccess.clear;
+                p.propaccesslist[palt_stored].clear;
                 case token of
                   _ID:
                     begin
@@ -515,16 +515,16 @@ implementation
                       { as stored true                    }
                       if idtoken<>_DEFAULT then
                        begin
-                         if parse_symlist(p.storedaccess,def) then
+                         if parse_symlist(p.propaccesslist[palt_stored],def) then
                           begin
-                            sym:=p.storedaccess.firstsym^.sym;
+                            sym:=p.propaccesslist[palt_stored].firstsym^.sym;
                             case sym.typ of
                               procsym :
                                 begin
                                    { Insert hidden parameters }
                                    handle_calling_convention(storedprocdef);
-                                   p.storedaccess.procdef:=Tprocsym(sym).search_procdef_bypara(storedprocdef.paras,storedprocdef.returndef,[cpo_allowdefaults,cpo_ignorehidden]);
-                                   if not assigned(p.storedaccess.procdef) then
+                                   p.propaccesslist[palt_stored].procdef:=Tprocsym(sym).search_procdef_bypara(storedprocdef.paras,storedprocdef.returndef,[cpo_allowdefaults,cpo_ignorehidden]);
+                                   if not assigned(p.propaccesslist[palt_stored].procdef) then
                                      message(parser_e_ill_property_storage_sym);
                                 end;
                               fieldvarsym :
@@ -633,7 +633,7 @@ implementation
              if intfidx > 0 then
              begin
                interfaces(intfidx).iitype := etFieldValue;
-               interfaces(intfidx).iioffset := tfieldvarsym(p.readaccess.firstsym^.sym).fieldoffset;
+               interfaces(intfidx).iioffset := tfieldvarsym(p.propaccesslist[palt_read].firstsym^.sym).fieldoffset;
              end else
              begin
                writeln('Implements-property used on unimplemented interface');

compiler/pexpr.pas

@@ -1076,8 +1076,26 @@ implementation
          p2    : tnode;
          membercall : boolean;
          callflags  : tcallnodeflags;
-         hpropsym : tpropertysym;
          propaccesslist : tpropaccesslist;
+      
+         function getpropaccesslist(pap:tpropaccesslisttypes):boolean;
+         var
+           hpropsym : tpropertysym;
+         begin
+           result:=false;
+           { find property in the overriden list }
+           hpropsym:=propsym;
+           repeat
+             propaccesslist:=hpropsym.propaccesslist[pap];
+             if not propaccesslist.empty then
+               begin
+                 result:=true;
+                 exit;
+               end;
+             hpropsym:=hpropsym.overridenpropsym;
+           until not assigned(hpropsym);
+         end;
+
       begin
          { property parameters? read them only if the property really }
          { has parameters                                             }
@@ -1100,15 +1118,7 @@ implementation
          { if not(afterassignment) and not(in_args) then }
          if token=_ASSIGNMENT then
            begin
-              { write property, find property in the overriden list }
-              hpropsym:=propsym;
-              repeat
-                propaccesslist:=hpropsym.writeaccess;
-                if not propaccesslist.empty then
-                   break;
-                hpropsym:=hpropsym.overridenpropsym;
-              until not assigned(hpropsym);
-              if not propaccesslist.empty then
+              if getpropaccesslist(palt_write) then
                 begin
                    case propaccesslist.firstsym^.sym.typ of
                      procsym :
@@ -1158,15 +1168,7 @@ implementation
            end
          else
            begin
-              { read property, find property in the overriden list }
-              hpropsym:=propsym;
-              repeat
-                propaccesslist:=hpropsym.readaccess;
-                if not propaccesslist.empty then
-                   break;
-                hpropsym:=hpropsym.overridenpropsym;
-              until not assigned(hpropsym);
-              if not propaccesslist.empty then
+              if getpropaccesslist(palt_read) then
                 begin
                    case propaccesslist.firstsym^.sym.typ of
                      fieldvarsym :

compiler/symdef.pas

@@ -4828,23 +4828,31 @@ implementation
          proctypesinfo : byte;
          propnameitem  : tpropnamelistitem;
 
-      procedure writeproc(proc : tpropaccesslist; shiftvalue : byte; unsetvalue: byte);
-
+        procedure writeaccessproc(pap:tpropaccesslisttypes; shiftvalue : byte; unsetvalue: byte);
         var
            typvalue : byte;
            hp : ppropaccesslistitem;
            address : longint;
            def : tdef;
+           hpropsym : tpropertysym;
+           propaccesslist : tpropaccesslist;
         begin
-           if not(assigned(proc) and assigned(proc.firstsym))  then
+           hpropsym:=tpropertysym(sym);
+           repeat
+             propaccesslist:=hpropsym.propaccesslist[pap];
+             if not propaccesslist.empty then
+               break;
+             hpropsym:=hpropsym.overridenpropsym;
+           until not assigned(hpropsym);
+           if not(assigned(propaccesslist) and assigned(propaccesslist.firstsym))  then
              begin
                 current_asmdata.asmlists[al_rtti].concat(Tai_const.create(aitconst_ptr,unsetvalue));
                 typvalue:=3;
              end
-           else if proc.firstsym^.sym.typ=fieldvarsym then
+           else if propaccesslist.firstsym^.sym.typ=fieldvarsym then
              begin
                 address:=0;
-                hp:=proc.firstsym;
+                hp:=propaccesslist.firstsym;
                 def:=nil;
                 while assigned(hp) do
                   begin
@@ -4877,18 +4885,18 @@ implementation
            else
              begin
                 { When there was an error then procdef is not assigned }
-                if not assigned(proc.procdef) then
+                if not assigned(propaccesslist.procdef) then
                   exit;
-                if not(po_virtualmethod in tprocdef(proc.procdef).procoptions) then
+                if not(po_virtualmethod in tprocdef(propaccesslist.procdef).procoptions) then
                   begin
-                     current_asmdata.asmlists[al_rtti].concat(Tai_const.createname(tprocdef(proc.procdef).mangledname,0));
+                     current_asmdata.asmlists[al_rtti].concat(Tai_const.createname(tprocdef(propaccesslist.procdef).mangledname,0));
                      typvalue:=1;
                   end
                 else
                   begin
                      { virtual method, write vmt offset }
                      current_asmdata.asmlists[al_rtti].concat(Tai_const.create(aitconst_ptr,
-                       tprocdef(proc.procdef)._class.vmtmethodoffset(tprocdef(proc.procdef).extnumber)));
+                       tprocdef(propaccesslist.procdef)._class.vmtmethodoffset(tprocdef(propaccesslist.procdef).extnumber)));
                      typvalue:=2;
                   end;
              end;
@@ -4904,13 +4912,17 @@ implementation
              else
                proctypesinfo:=0;
              current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_sym(tstoreddef(tpropertysym(sym).propdef).get_rtti_label(fullrtti)));
-             writeproc(tpropertysym(sym).readaccess,0,0);
-             writeproc(tpropertysym(sym).writeaccess,2,0);
+             writeaccessproc(palt_read,0,0);
+             writeaccessproc(palt_write,2,0);
              { is it stored ? }
              if not(ppo_stored in tpropertysym(sym).propoptions) then
-               writeproc(nil,4,0) { no, so put a constant zero }
+               begin
+                 { no, so put a constant zero }
+                 current_asmdata.asmlists[al_rtti].concat(Tai_const.create(aitconst_ptr,0));
+                 proctypesinfo:=proctypesinfo or (3 shl 4);
+               end
              else
-               writeproc(tpropertysym(sym).storedaccess,4,1); { maybe; if no procedure put a constant 1 (=true) }
+               writeaccessproc(palt_stored,4,1); { maybe; if no procedure put a constant 1 (=true) }
              current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_32bit(tpropertysym(sym).index));
              current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_32bit(tpropertysym(sym).default));
              propnameitem:=searchpropnamelist(tpropertysym(sym).name);

compiler/symsym.pas

@@ -231,6 +231,8 @@ interface
          procedure ppuwrite(ppufile:tcompilerppufile);override;
       end;
 
+       tpropaccesslisttypes=(palt_none,palt_read,palt_write,palt_stored);
+       
        tpropertysym = class(Tstoredsym)
           propoptions   : tpropertyoptions;
           overridenpropsym : tpropertysym;
@@ -240,10 +242,8 @@ interface
           indexdef      : tdef;
           indexdefderef : tderef;
           index,
-          default       : longint;
-          readaccess,
-          writeaccess,
-          storedaccess  : tpropaccesslist;
+          default        : longint;
+          propaccesslist : array[tpropaccesslisttypes] of tpropaccesslist;
           constructor create(const n : string);
           destructor  destroy;override;
           constructor ppuload(ppufile:tcompilerppufile);
@@ -1067,6 +1067,8 @@ implementation
 ****************************************************************************}
 
     constructor tpropertysym.create(const n : string);
+      var
+        pap : tpropaccesslisttypes;
       begin
          inherited create(propertysym,n);
          propoptions:=[];
@@ -1074,13 +1076,14 @@ implementation
          default:=0;
          propdef:=nil;
          indexdef:=nil;
-         readaccess:=tpropaccesslist.create;
-         writeaccess:=tpropaccesslist.create;
-         storedaccess:=tpropaccesslist.create;
+         for pap:=low(tpropaccesslisttypes) to high(tpropaccesslisttypes) do
+           propaccesslist[pap]:=tpropaccesslist.create;
       end;
 
 
     constructor tpropertysym.ppuload(ppufile:tcompilerppufile);
+      var
+        pap : tpropaccesslisttypes;
       begin
          inherited ppuload(propertysym,ppufile);
          ppufile.getsmallset(propoptions);
@@ -1089,17 +1092,17 @@ implementation
          index:=ppufile.getlongint;
          default:=ppufile.getlongint;
          ppufile.getderef(indexdefderef);
-         readaccess:=ppufile.getpropaccesslist;
-         writeaccess:=ppufile.getpropaccesslist;
-         storedaccess:=ppufile.getpropaccesslist;
+         for pap:=low(tpropaccesslisttypes) to high(tpropaccesslisttypes) do
+           propaccesslist[pap]:=ppufile.getpropaccesslist;
       end;
 
 
     destructor tpropertysym.destroy;
+      var
+        pap : tpropaccesslisttypes;
       begin
-         readaccess.free;
-         writeaccess.free;
-         storedaccess.free;
+         for pap:=low(tpropaccesslisttypes) to high(tpropaccesslisttypes) do
+           propaccesslist[pap].free;
          inherited destroy;
       end;
 
@@ -1111,24 +1114,26 @@ implementation
 
 
     procedure tpropertysym.buildderef;
+      var
+        pap : tpropaccesslisttypes;
       begin
         overridenpropsymderef.build(overridenpropsym);
         propdefderef.build(propdef);
         indexdefderef.build(indexdef);
-        readaccess.buildderef;
-        writeaccess.buildderef;
-        storedaccess.buildderef;
+        for pap:=low(tpropaccesslisttypes) to high(tpropaccesslisttypes) do
+          propaccesslist[pap].buildderef;
       end;
 
 
     procedure tpropertysym.deref;
+      var
+        pap : tpropaccesslisttypes;
       begin
         overridenpropsym:=tpropertysym(overridenpropsymderef.resolve);
         indexdef:=tdef(indexdefderef.resolve);
         propdef:=tdef(propdefderef.resolve);
-        readaccess.resolve;
-        writeaccess.resolve;
-        storedaccess.resolve;
+        for pap:=low(tpropaccesslisttypes) to high(tpropaccesslisttypes) do
+          propaccesslist[pap].resolve;
       end;
 
 
@@ -1139,6 +1144,8 @@ implementation
 
 
     procedure tpropertysym.ppuwrite(ppufile:tcompilerppufile);
+      var
+        pap : tpropaccesslisttypes;
       begin
         inherited ppuwrite(ppufile);
         ppufile.putsmallset(propoptions);
@@ -1147,9 +1154,8 @@ implementation
         ppufile.putlongint(index);
         ppufile.putlongint(default);
         ppufile.putderef(indexdefderef);
-        ppufile.putpropaccesslist(readaccess);
-        ppufile.putpropaccesslist(writeaccess);
-        ppufile.putpropaccesslist(storedaccess);
+        for pap:=low(tpropaccesslisttypes) to high(tpropaccesslisttypes) do
+          ppufile.putpropaccesslist(propaccesslist[pap]);
         ppufile.writeentry(ibpropertysym);
       end;