Merged revision(s) 47687 from trunk:

* 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: https://svn.freepascal.org/svn/fpc/branches/fixes_3_2@47846 3ad0048d-3df7-0310-abae-a5850022a9f2

2 files changed, 44 insertions, 1 deletions

diff --git a/packages/winunits-base/src/comobj.pp b/packages/winunits-base/src/comobj.pp
index fd17c6860f..e7cbfb7ec1 100644
--- a/packages/winunits-base/src/comobj.pp
+++ b/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;
diff --git a/tests/webtbs/tw38151.pp b/tests/webtbs/tw38151.pp
new file mode 100644
index 0000000000..f4ffb25ca6
--- /dev/null
+++ b/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.