Browse Source

* fix for Mantis #38151: when a Variant is passed by reference to a IDispatch property then invoke it using DISPATCH_PROPERTYPUTREF instead of DISPATCH_PROPERTYPUT
+ added test

git-svn-id: trunk@47687 -

svenbarth 4 years ago
parent
commit
deaff6f7fe
3 changed files with 45 additions and 1 deletions
  1. 1 0
      .gitattributes
  2. 7 1
      packages/winunits-base/src/comobj.pp
  3. 37 0
      tests/webtbs/tw38151.pp

+ 1 - 0
.gitattributes

@@ -18600,6 +18600,7 @@ tests/webtbs/tw38122.pp svneol=native#text/pascal
 tests/webtbs/tw3814.pp svneol=native#text/plain
 tests/webtbs/tw38145a.pp svneol=native#text/pascal
 tests/webtbs/tw38145b.pp svneol=native#text/pascal
+tests/webtbs/tw38151.pp svneol=native#text/pascal
 tests/webtbs/tw3827.pp svneol=native#text/plain
 tests/webtbs/tw3829.pp svneol=native#text/plain
 tests/webtbs/tw3833.pp svneol=native#text/plain

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

@@ -1381,7 +1381,13 @@ HKCR
           case InvokeKind of
             DISPATCH_PROPERTYPUT:
               begin
-                if (Arguments[0].VType and varTypeMask) = varDispatch then
+                if ((Arguments[0].VType and varTypeMask) in [varDispatch]) or
+                    { if we have a variant that's passed as a reference we pass it
+                      to the property as a reference as well }
+                    (
+                      ((Arguments[0].VType and varTypeMask) in [varVariant]) and
+                      ((CallDesc^.argtypes[0] and $80) <> 0)
+                    ) then
                   InvokeKind:=DISPATCH_PROPERTYPUTREF;
                 { first name is actually the name of the property to set }
                 DispIDs^[0]:=DISPID_PROPERTYPUT;

+ 37 - 0
tests/webtbs/tw38151.pp

@@ -0,0 +1,37 @@
+{ %TARGET = win32,win64,wince }
+
+program tw38151;
+
+{$mode objfpc}{$H+}
+
+uses
+  ActiveX, ComObj, Variants;
+
+procedure TestVoice;
+var
+  SpVoice, SpVoicesList, Voice: Variant;
+begin
+  CoInitialize(Nil);
+  try
+    SpVoice := CreateOleObject('SAPI.SpVoice');
+    if VarIsNull(SpVoice) or VarIsEmpty(SpVoice) then
+      Exit;
+    SpVoicesList := SpVoice.GetVoices();
+    if VarIsNull(SpVoicesList) or VarIsEmpty(SpVoicesList) then
+      Exit;
+    if SpVoicesList.Count = 0 then
+      Exit;
+    SpVoice.Voice := SpVoicesList.Item(0);
+    Voice := SpVoicesList.Item(0);
+    SpVoice.Voice := Voice;
+  finally
+    VarClear(Voice);
+    VarClear(SpVoicesList);
+    VarClear(SpVoice);
+    CoUninitialize;
+  end;
+end;
+
+begin
+  TestVoice;
+end.