Initial support of parametrized dispinterface properties:

* When parsing dispinterface properties, pass parameter/index nodes to translate_disp_call() instead of dropping them.
* Distinguish property getters from regular method calls and generate appropriate call descriptors.

git-svn-id: trunk@16753 -

compiler/ncal.pas

@@ -220,8 +220,14 @@ interface
        end;
        tcallparanodeclass = class of tcallparanode;
 
+       tdispcalltype = (
+         dct_method,
+         dct_propget,
+         dct_propput
+       );
+
     function reverseparameters(p: tcallparanode): tcallparanode;
-    function translate_disp_call(selfnode,parametersnode,putvalue : tnode;const methodname : ansistring;dispid : longint;resultdef : tdef) : tnode;
+    function translate_disp_call(selfnode,parametersnode: tnode; calltype: tdispcalltype; const methodname : ansistring;dispid : longint;resultdef : tdef) : tnode;
 
     var
       ccallnode : tcallnodeclass = tcallnode;
@@ -273,7 +279,7 @@ implementation
         reverseparameters:=hp1;
       end;
 
-    function translate_disp_call(selfnode,parametersnode,putvalue : tnode; const methodname : ansistring;dispid : longint;resultdef : tdef) : tnode;
+    function translate_disp_call(selfnode,parametersnode: tnode; calltype: tdispcalltype; const methodname : ansistring;dispid : longint;resultdef : tdef) : tnode;
       const
         DISPATCH_METHOD = $1;
         DISPATCH_PROPERTYGET = $2;
@@ -281,8 +287,8 @@ implementation
         DISPATCH_PROPERTYPUTREF = $8;
         DISPATCH_CONSTRUCT = $4000;
 
-        calltypes: array[Boolean] of byte = (
-          DISPATCH_METHOD, DISPATCH_PROPERTYPUT
+        calltypes: array[tdispcalltype] of byte = (
+          DISPATCH_METHOD, DISPATCH_PROPERTYGET, DISPATCH_PROPERTYPUT
         );
       var
         statements : tstatementnode;
@@ -421,7 +427,7 @@ implementation
           calldescnode.appendbyte(restype);
         end;
 
-        calldescnode.appendbyte(calltypes[assigned(putvalue)]);
+        calldescnode.appendbyte(calltypes[calltype]);
         calldescnode.appendbyte(paracount);
         calldescnode.appendbyte(namedparacount);
 
@@ -2991,13 +2997,13 @@ implementation
                  converted_result_data:=ctempcreatenode.create(procdefinition.returndef,sizeof(procdefinition.returndef),tt_persistent,true);
                  addstatement(statements,converted_result_data);
                  addstatement(statements,cassignmentnode.create(ctemprefnode.create(converted_result_data),
-                   ctypeconvnode.create_internal(translate_disp_call(methodpointer,parameters,nil,'',tprocdef(procdefinition).dispid,procdefinition.returndef),
+                   ctypeconvnode.create_internal(translate_disp_call(methodpointer,parameters,dct_method,'',tprocdef(procdefinition).dispid,procdefinition.returndef),
                    procdefinition.returndef)));
                  addstatement(statements,ctempdeletenode.create_normal_temp(converted_result_data));
                  addstatement(statements,ctemprefnode.create(converted_result_data));
                end
              else
-               result:=translate_disp_call(methodpointer,parameters,nil,'',tprocdef(procdefinition).dispid,voidtype);
+               result:=translate_disp_call(methodpointer,parameters,dct_method,'',tprocdef(procdefinition).dispid,voidtype);
 
              { don't free reused nodes }
              methodpointer:=nil;

compiler/pexpr.pas

@@ -1115,9 +1115,9 @@ implementation
                   consume(_ASSIGNMENT);
                   p2:=comp_expr(true,false);
                   { concat value parameter too }
-                  p2:=ccallparanode.create(p2,nil);
-                  { passing p3 here is only for information purposes }
-                  p1:=translate_disp_call(p1,p2,p2,'',propsym.dispid,voidtype);
+                  p2:=ccallparanode.create(p2,paras);
+                  paras:=nil;
+                  p1:=translate_disp_call(p1,p2,dct_propput,'',propsym.dispid,voidtype);
                 end
               else
                 begin
@@ -1177,11 +1177,12 @@ implementation
                   converted_result_data:=ctempcreatenode.create(propsym.propdef,sizeof(propsym.propdef),tt_persistent,true);
                   addstatement(statements,converted_result_data);
                   addstatement(statements,cassignmentnode.create(ctemprefnode.create(converted_result_data),
-                    ctypeconvnode.create_internal(translate_disp_call(p1,nil,nil,'',propsym.dispid,propsym.propdef),
+                    ctypeconvnode.create_internal(translate_disp_call(p1,paras,dct_propget,'',propsym.dispid,propsym.propdef),
                     propsym.propdef)));
                   addstatement(statements,ctempdeletenode.create_normal_temp(converted_result_data));
                   addstatement(statements,ctemprefnode.create(converted_result_data));
                   p1:=p2;
+                  paras:=nil;
                 end
               else
                 begin
@@ -2141,16 +2142,15 @@ implementation
                                    p3:=comp_expr(true,false);
                                    { concat value parameter too }
                                    p2:=ccallparanode.create(p3,p2);
-                                   { passing p3 here is only for information purposes }
-                                   p1:=translate_disp_call(p1,p2,p3,dispatchstring,0,voidtype);
+                                   p1:=translate_disp_call(p1,p2,dct_propput,dispatchstring,0,voidtype);
                                  end
                                else
                                { this is only an approximation
                                  setting useresult if not necessary is only a waste of time, no more, no less (FK) }
                                if afterassignment or in_args or (token<>_SEMICOLON) then
-                                 p1:=translate_disp_call(p1,p2,nil,dispatchstring,0,cvarianttype)
+                                 p1:=translate_disp_call(p1,p2,dct_method,dispatchstring,0,cvarianttype)
                                else
-                                 p1:=translate_disp_call(p1,p2,nil,dispatchstring,0,voidtype);
+                                 p1:=translate_disp_call(p1,p2,dct_method,dispatchstring,0,voidtype);
                              end
                            else { Error }
                              Consume(_ID);