* fix for Mantis : 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 -
This commit is contained in:
svenbarth 2020-12-04 22:07:39 +00:00
parent 69e6f3dcbb
commit deaff6f7fe
3 changed files with 45 additions and 1 deletions
.gitattributes
packages/winunits-base/src
tests/webtbs

1
.gitattributes vendored
View File

@ -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

View File

@ -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
tests/webtbs/tw38151.pp Normal file
View File

@ -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.