paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-15 12:49:45 +02:00
Code Issues Packages Projects Releases Wiki Activity

Merged revision(s) 47687 from trunk:

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: branches/fixes_3_2@47846 -
This commit is contained in:
svenbarth 2020-12-24 23:17:55 +00:00
parent 8e9f91ee79
commit cf6e6c3d92
3 changed files with 45 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -17814,6 +17814,7 @@ tests/webtbs/tw38058.pp svneol=native#text/pascal
tests/webtbs/tw38069.pp svneol=native#text/pascal tests/webtbs/tw38069.pp svneol=native#text/pascal
tests/webtbs/tw38083.pp svneol=native#text/pascal tests/webtbs/tw38083.pp svneol=native#text/pascal
tests/webtbs/tw3814.pp svneol=native#text/plain tests/webtbs/tw3814.pp svneol=native#text/plain
tests/webtbs/tw38151.pp svneol=native#text/pascal
tests/webtbs/tw3827.pp svneol=native#text/plain tests/webtbs/tw3827.pp svneol=native#text/plain
tests/webtbs/tw3829.pp svneol=native#text/plain tests/webtbs/tw3829.pp svneol=native#text/plain
tests/webtbs/tw3833.pp svneol=native#text/plain tests/webtbs/tw3833.pp svneol=native#text/plain

8
packages/winunits-base/src/comobj.pp
View File

@ -1381,7 +1381,13 @@ HKCR
case InvokeKind of case InvokeKind of
DISPATCH_PROPERTYPUT: DISPATCH_PROPERTYPUT:
begin 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; InvokeKind:=DISPATCH_PROPERTYPUTREF;
{ first name is actually the name of the property to set } { first name is actually the name of the property to set }
DispIDs^[0]:=DISPID_PROPERTYPUT; 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.