mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-13 00:29:48 +02:00
* 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 -
This commit is contained in:
parent
69e6f3dcbb
commit
deaff6f7fe
1
.gitattributes
vendored
1
.gitattributes
vendored
@ -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
|
||||
|
@ -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
37
tests/webtbs/tw38151.pp
Normal 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.
|
Loading…
Reference in New Issue
Block a user