Browse Source

Fixes to dispatch calls:
* Pass dispinterfaces with correct type (varDispatch).
* Pass skipped parameters as EmptyParam (vType=varError, vError=DISP_E_PARAMNOTFOUND), as COM requires to preserve correct argument count and positions.
* Since ttempcreatenode.size can be set after creation, don't calculate parameter size in first pass, this simplifies things a bit.

git-svn-id: trunk@16863 -

sergei 14 years ago
parent
commit
4aeef5b150
3 changed files with 27 additions and 16 deletions
  1. 18 16
      compiler/ncal.pas
  2. 7 0
      packages/winunits-base/src/comobj.pp
  3. 2 0
      rtl/inc/variants.pp

+ 18 - 16
compiler/ncal.pas

@@ -335,7 +335,7 @@ implementation
           if is_unicodestring(sourcedef) then
             result:=varUStrArg
           else
-          if is_interface(sourcedef) then
+          if is_interfacecom_or_dispinterface(sourcedef) then
             begin
               { distinct IDispatch and IUnknown interfaces }
               if tobjectdef(sourcedef).is_related(tobjectdef(search_system_type('IDISPATCH').typedef)) then
@@ -363,17 +363,17 @@ implementation
         para:=tcallparanode(parametersnode);
         paracount:=0;
         namedparacount:=0;
-        paramssize:=0;
         while assigned(para) do
           begin
             typecheckpass(para.left);
 
-            { skip non parameters }
-            if para.left.nodetype=nothingn then
-            begin
-              para:=tcallparanode(para.nextpara);
-              continue;
-            end;
+            { skip hidden dispinterface parameters like $self, $result,
+              but count skipped variantdispatch parameters. }
+            if (not variantdispatch) and (para.left.nodetype=nothingn) then
+              begin
+                para:=tcallparanode(para.nextpara);
+                continue;
+              end;
             inc(paracount);
             if assigned(para.parametername) then
               inc(namedparacount);
@@ -395,18 +395,14 @@ implementation
               inserttypeconv_internal(para.left,cwidestringtype)
 
             { skip this check if we've already typecasted to automatable type }
-            else if not is_automatable(para.left.resultdef) then
+            else if (para.left.nodetype<>nothingn) and (not is_automatable(para.left.resultdef)) then
               CGMessagePos1(para.left.fileinfo,type_e_not_automatable,para.left.resultdef.typename);
 
-            { we've to know the parameter size to allocate the temp. space }
-            is_byref_para(assignmenttype);
-            inc(paramssize,max(voidpointertype.size,assignmenttype.size));
-
             para:=tcallparanode(para.nextpara);
           end;
 
-        { allocate space }
-        params:=ctempcreatenode.create(voidtype,paramssize,tt_persistent,true);
+        { create a temp to store parameter values }
+        params:=ctempcreatenode.create(voidtype,0,tt_persistent,true);
         addstatement(statements,params);
 
         calldescnode:=cdataconstnode.create;
@@ -433,9 +429,12 @@ implementation
         names := '';
         while assigned(para) do
           begin
-            { skip non parameters }
+            { Skipped parameters are actually (varType=varError, vError=DISP_E_PARAMNOTFOUND).
+              Generate only varType here, the value will be added by RTL. }
             if para.left.nodetype=nothingn then
             begin
+              if variantdispatch then
+                calldescnode.appendbyte(varError);
               para:=tcallparanode(para.nextpara);
               continue;
             end;
@@ -480,6 +479,9 @@ implementation
             para:=tcallparanode(para.nextpara);
           end;
 
+        { Set final size for parameter block }
+        params.size:=paramssize;
+
         { old argument list skeleton isn't needed anymore }
         parametersnode.free;
 

+ 7 - 0
packages/winunits-base/src/comobj.pp

@@ -1093,6 +1093,13 @@ HKCR
 {$endif DEBUG_COMDISPATCH}
               { get plain type }
               CurrType:=CallDesc^.ArgTypes[i] and $3f;
+              { a skipped parameter? Don't increment Params pointer if so. }
+              if CurrType=varError then
+                begin
+                  Arguments[i].vType:=varError;
+                  Arguments[i].vError:=DISP_E_PARAMNOTFOUND;
+                  continue;
+                end;
               { by reference? }
               if (CallDesc^.ArgTypes[i] and $80)<>0 then
                 begin

+ 2 - 0
rtl/inc/variants.pp

@@ -4029,6 +4029,8 @@ begin
       end
       else
         case arg_type of
+          varError:
+            arg_data^.vError:=VAR_PARAMNOTFOUND;
           varVariant:
             begin
               arg_data^ := PVarData(PPointer(arg_ptr)^)^;