* hack to support property with record fields

compiler/pdecl.pas

@@ -879,6 +879,26 @@ unit pdecl;
              get_procdef:=p;
           end;
 
+          procedure addpropsymlist(var root:ppropsymlist;s:psym);
+          var
+            last,hp : ppropsymlist;
+          begin
+            if not assigned(s) then
+             exit;
+            last:=root;
+            new(hp);
+            hp^.sym:=s;
+            hp^.next:=nil;
+            if assigned(last) then
+             begin
+               while assigned(last^.next) do
+                last:=last^.next;
+               last^.next:=hp;
+             end
+            else
+             root:=hp;
+          end;
+
         var
            hp2,datacoll : pdefcoll;
            p,p2 : ppropertysym;
@@ -1042,9 +1062,11 @@ unit pdecl;
                      else
                        begin
                           consume(_ID);
-                          if (token=_POINT) and
-                             ((sym^.typ=varsym) and (pvarsym(sym)^.definition^.deftype=recorddef)) then
+                          while (token=_POINT) and
+                                ((sym^.typ=varsym) and
+                                 (pvarsym(sym)^.definition^.deftype=recorddef)) do
                            begin
+                             addpropsymlist(p^.readaccesssym,sym);
                              consume(_POINT);
                              getsymonlyin(precorddef(pvarsym(sym)^.definition)^.symtable,pattern);
                              if not assigned(srsym) then
@@ -1067,21 +1089,22 @@ unit pdecl;
                              not(sym^.typ in [varsym,procsym]) then
                             Message(parser_e_ill_property_access_sym);
                           { search the matching definition }
-                          if sym^.typ=procsym then
-                            begin
-                               pp:=get_procdef;
-                               if not(assigned(pp)) or
-                                 not(is_equal(pp^.retdef,p^.proptype)) then
-                                 Message(parser_e_ill_property_access_sym);
-                               p^.readaccessdef:=pp;
-                            end
-                          else if sym^.typ=varsym then
-                            begin
-                               if not(is_equal(pvarsym(sym)^.definition,
-                                 p^.proptype)) then
-                                 Message(parser_e_ill_property_access_sym);
-                            end;
-                          p^.readaccesssym:=sym;
+                          case sym^.typ of
+                            procsym :
+                              begin
+                                 pp:=get_procdef;
+                                 if not(assigned(pp)) or
+                                    not(is_equal(pp^.retdef,p^.proptype)) then
+                                   Message(parser_e_ill_property_access_sym);
+                                 p^.readaccessdef:=pp;
+                              end;
+                            varsym :
+                              begin
+                                if not(is_equal(pvarsym(sym)^.definition,p^.proptype)) then
+                                  Message(parser_e_ill_property_access_sym);
+                              end;
+                          end;
+                          addpropsymlist(p^.readaccesssym,sym);
                        end;
                   end;
                 if (idtoken=_WRITE) then
@@ -1096,9 +1119,11 @@ unit pdecl;
                      else
                        begin
                           consume(_ID);
-                          if (token=_POINT) and
-                             ((sym^.typ=varsym) and (pvarsym(sym)^.definition^.deftype=recorddef)) then
+                          while (token=_POINT) and
+                                ((sym^.typ=varsym) and
+                                 (pvarsym(sym)^.definition^.deftype=recorddef)) do
                            begin
+                             addpropsymlist(p^.writeaccesssym,sym);
                              consume(_POINT);
                              getsymonlyin(precorddef(pvarsym(sym)^.definition)^.symtable,pattern);
                              if not assigned(srsym) then
@@ -1134,7 +1159,7 @@ unit pdecl;
                                  p^.proptype)) then
                                  Message(parser_e_ill_property_access_sym);
                             end;
-                          p^.writeaccesssym:=sym;
+                          addpropsymlist(p^.writeaccesssym,sym);
                        end;
                   end;
                 if (idtoken=_STORED) then
@@ -2383,7 +2408,10 @@ unit pdecl;
 end.
 {
   $Log$
-  Revision 1.143  1999-08-09 22:19:53  peter
+  Revision 1.144  1999-08-14 00:38:53  peter
+    * hack to support property with record fields
+
+  Revision 1.143  1999/08/09 22:19:53  peter
     * classes vmt changed to only positive addresses
     * sharedlib creation is working
 

compiler/pexpr.pas

@@ -595,6 +595,7 @@ unit pexpr;
       var
          paras : ptree;
          p2 : ptree;
+         plist : ppropsymlist;
 
       begin
          paras:=nil;
@@ -620,7 +621,7 @@ unit pexpr;
               pd:=voiddef;
               if assigned(ppropertysym(sym)^.writeaccesssym) then
                 begin
-                   if ppropertysym(sym)^.writeaccesssym^.typ=procsym then
+                   if ppropertysym(sym)^.writeaccesssym^.sym^.typ=procsym then
                      begin
                         { generate the method call }
                         p1:=genmethodcallnode(pprocsym(
@@ -645,7 +646,7 @@ unit pexpr;
                         p1^.left:=gencallparanode(p2,p1^.left);
                         getprocvar:=false;
                      end
-                   else if ppropertysym(sym)^.writeaccesssym^.typ=varsym then
+                   else if ppropertysym(sym)^.writeaccesssym^.sym^.typ=varsym then
                      begin
                         if assigned(paras) then
                           message(parser_e_no_paras_allowed);
@@ -677,31 +678,38 @@ unit pexpr;
               pd:=ppropertysym(sym)^.proptype;
               if assigned(ppropertysym(sym)^.readaccesssym) then
                 begin
-                   if ppropertysym(sym)^.readaccesssym^.typ=varsym then
-                     begin
-                        if assigned(paras) then
-                          message(parser_e_no_paras_allowed);
-                        { subscribed access? }
-                        if p1=nil then
-                          p1:=genloadnode(pvarsym(ppropertysym(sym)^.readaccesssym),st)
-                        else
-                          p1:=gensubscriptnode(pvarsym(ppropertysym(sym)^.readaccesssym),p1);
-                     end
-                   else if ppropertysym(sym)^.readaccesssym^.typ=procsym then
-                     begin
-                        { generate the method call }
-                        p1:=genmethodcallnode(pprocsym(ppropertysym(sym)^.readaccesssym),st,p1);
-                        { we know the procedure to call, so
-                          force the usage of that procedure }
-                        p1^.procdefinition:=pprocdef(ppropertysym(sym)^.readaccessdef);
-                        { insert paras }
-                        p1^.left:=paras;
-                     end
-                   else
-                     begin
-                        p1:=genzeronode(errorn);
-                        Message(type_e_mismatch);
-                     end;
+                   case ppropertysym(sym)^.readaccesssym^.sym^.typ of
+                     varsym :
+                       begin
+                          if assigned(paras) then
+                            message(parser_e_no_paras_allowed);
+                          { subscribed access? }
+                          plist:=ppropertysym(sym)^.readaccesssym;
+                          while assigned(plist) do
+                           begin
+                             if p1=nil then
+                               p1:=genloadnode(pvarsym(plist^.sym),st)
+                             else
+                               p1:=gensubscriptnode(pvarsym(plist^.sym),p1);
+                             plist:=plist^.next;
+                           end;
+                       end;
+                     procsym :
+                       begin
+                          { generate the method call }
+                          p1:=genmethodcallnode(pprocsym(ppropertysym(sym)^.readaccesssym^.sym),st,p1);
+                          { we know the procedure to call, so
+                            force the usage of that procedure }
+                          p1^.procdefinition:=pprocdef(ppropertysym(sym)^.readaccessdef);
+                          { insert paras }
+                          p1^.left:=paras;
+                       end
+                     else
+                       begin
+                          p1:=genzeronode(errorn);
+                          Message(type_e_mismatch);
+                       end;
+                  end;
                 end
               else
                 begin
@@ -2062,7 +2070,10 @@ _LECKKLAMMER : begin
 end.
 {
   $Log$
-  Revision 1.134  1999-08-09 22:16:29  peter
+  Revision 1.135  1999-08-14 00:38:56  peter
+    * hack to support property with record fields
+
+  Revision 1.134  1999/08/09 22:16:29  peter
     * fixed crash after wrong para's with class contrustor
 
   Revision 1.133  1999/08/05 16:53:04  peter

compiler/symdef.inc

@@ -3561,8 +3561,8 @@ Const local_symtable_index : longint = $8001;
             (sp_published in psym(sym)^.symoptions) then
            begin
               rttilist^.concat(new(pai_const_symbol,initname(ppropertysym(sym)^.proptype^.get_rtti_label)));
-              writeproc(ppropertysym(sym)^.readaccesssym,ppropertysym(sym)^.readaccessdef,0);
-              writeproc(ppropertysym(sym)^.writeaccesssym,ppropertysym(sym)^.writeaccessdef,2);
+              writeproc(ppropertysym(sym)^.readaccesssym^.sym,ppropertysym(sym)^.readaccessdef,0);
+              writeproc(ppropertysym(sym)^.writeaccesssym^.sym,ppropertysym(sym)^.writeaccessdef,2);
               { isn't it stored ? }
               if not(ppo_stored in ppropertysym(sym)^.propoptions) then
                 begin
@@ -3570,7 +3570,7 @@ Const local_symtable_index : longint = $8001;
                    proctypesinfo:=proctypesinfo or (3 shl 4);
                 end
               else
-                writeproc(ppropertysym(sym)^.storedsym,ppropertysym(sym)^.storeddef,4);
+                writeproc(ppropertysym(sym)^.storedsym^.sym,ppropertysym(sym)^.storeddef,4);
               rttilist^.concat(new(pai_const,init_32bit(ppropertysym(sym)^.index)));
               rttilist^.concat(new(pai_const,init_32bit(ppropertysym(sym)^.default)));
               rttilist^.concat(new(pai_const,init_16bit(count)));
@@ -3715,7 +3715,10 @@ Const local_symtable_index : longint = $8001;
 
 {
   $Log$
-  Revision 1.153  1999-08-13 21:33:11  peter
+  Revision 1.154  1999-08-14 00:38:58  peter
+    * hack to support property with record fields
+
+  Revision 1.153  1999/08/13 21:33:11  peter
     * support for array constructors extended and more error checking
 
   Revision 1.152  1999/08/13 14:24:18  pierre

compiler/symsym.inc

@@ -587,12 +587,50 @@
 
     destructor tpropertysym.done;
 
+        procedure disposepropsymlist(p:ppropsymlist);
+        var
+          hp : ppropsymlist;
+        begin
+          while assigned(p) do
+           begin
+             hp:=p;
+             p:=p^.next;
+             dispose(hp);
+           end;
+        end;
+
       begin
+         disposepropsymlist(readaccesssym);
+         disposepropsymlist(writeaccesssym);
+         disposepropsymlist(storedsym);
          inherited done;
       end;
 
     constructor tpropertysym.load;
 
+        function readpropsymlist:ppropsymlist;
+        var
+          root,last,p : ppropsymlist;
+          sym : psym;
+        begin
+          root:=nil;
+          last:=nil;
+          repeat
+            sym:=readsymref;
+            if sym=nil then
+             break;
+            new(p);
+            p^.sym:=sym;
+            p^.next:=nil;
+            if assigned(last) then
+             last^.next:=p
+            else
+             root:=p;
+            last:=p;
+          until false;
+          readpropsymlist:=root;
+        end;
+
       begin
          inherited load;
          typ:=propertysym;
@@ -600,11 +638,11 @@
          readsmallset(propoptions);
          index:=readlong;
          default:=readlong;
-         { it's hack ... }
-         readaccesssym:=readsymref;
-         writeaccesssym:=readsymref;
-         storedsym:=readsymref;
-         { now the defs: }
+         { the syms }
+         readaccesssym:=readpropsymlist;
+         writeaccesssym:=readpropsymlist;
+         storedsym:=readpropsymlist;
+         { now the defs }
          readaccessdef:=readdefref;
          writeaccessdef:=readdefref;
          storeddef:=readdefref;
@@ -612,14 +650,23 @@
 
     procedure tpropertysym.deref;
 
+        procedure resolvepropsymlist(p:ppropsymlist);
+        begin
+          while assigned(p) do
+           begin
+             resolvesym(p^.sym);
+             p:=p^.next;
+           end;
+        end;
+
       begin
          resolvedef(proptype);
          resolvedef(readaccessdef);
          resolvedef(writeaccessdef);
          resolvedef(storeddef);
-         resolvesym(readaccesssym);
-         resolvesym(writeaccesssym);
-         resolvesym(storedsym);
+         resolvepropsymlist(readaccesssym);
+         resolvepropsymlist(writeaccesssym);
+         resolvepropsymlist(storedsym);
       end;
 
     function tpropertysym.getsize : longint;
@@ -630,15 +677,25 @@
 
     procedure tpropertysym.write;
 
+        procedure writepropsymlist(p:ppropsymlist);
+        begin
+          while assigned(p) do
+           begin
+             writesymref(p^.sym);
+             p:=p^.next;
+           end;
+          writesymref(nil);
+        end;
+
       begin
          tsym.write;
          writedefref(proptype);
          writesmallset(propoptions);
          writelong(index);
          writelong(default);
-         writesymref(readaccesssym);
-         writesymref(writeaccesssym);
-         writesymref(storedsym);
+         writepropsymlist(readaccesssym);
+         writepropsymlist(writeaccesssym);
+         writepropsymlist(storedsym);
          writedefref(readaccessdef);
          writedefref(writeaccessdef);
          writedefref(storeddef);
@@ -1052,7 +1109,7 @@
 
     function tvarsym.getsize : longint;
       begin
-        if assigned(definition) and (varspez=vs_value) and 
+        if assigned(definition) and (varspez=vs_value) and
           ((definition^.deftype<>arraydef) or (Parraydef(definition)^.highrange>=
           Parraydef(definition)^.lowrange)) then
               getsize:=definition^.size
@@ -2104,7 +2161,10 @@
 
 {
   $Log$
-  Revision 1.112  1999-08-13 14:24:20  pierre
+  Revision 1.113  1999-08-14 00:39:00  peter
+    * hack to support property with record fields
+
+  Revision 1.112  1999/08/13 14:24:20  pierre
     + stabs for classes and classref working,
       a class still needs an ^ to get that content of it,
       but the class fields inside a class don't result into an

compiler/symsymh.inc

@@ -199,11 +199,17 @@
           _mangledname  : pchar;
        end;
 
+       ppropsymlist = ^tpropsymlist;
+       tpropsymlist = record
+         sym  : psym;
+         next : ppropsymlist;
+       end;
+
        ppropertysym = ^tpropertysym;
        tpropertysym = object(tsym)
           propoptions : tpropertyoptions;
           proptype    : pdef;
-          readaccesssym,writeaccesssym,storedsym : psym;
+          readaccesssym,writeaccesssym,storedsym : ppropsymlist;
           readaccessdef,writeaccessdef,storeddef : pdef;
           index,default : longint;
           constructor init(const n : string);
@@ -330,7 +336,10 @@
 
 {
   $Log$
-  Revision 1.31  1999-08-10 12:33:38  pierre
+  Revision 1.32  1999-08-14 00:39:01  peter
+    * hack to support property with record fields
+
+  Revision 1.31  1999/08/10 12:33:38  pierre
    * pprocsym defined earlier for use in tprocdef
 
   Revision 1.30  1999/08/03 22:03:21  peter