paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-07 02:48:07 +02:00
Code Issues Packages Projects Releases Wiki Activity

+ add a test that ensures that the introduction of fullscale array constructors didn't mess with array constructors passed to an open array of Variant

Browse Source 
git-svn-id: trunk@42701 -
This commit is contained in:
svenbarth 2019-08-15 14:33:03 +00:00
parent 44bfa98a30
commit 0e79bd2c70
2 changed files with 60 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -13942,6 +13942,7 @@ tests/test/tarray18.pp svneol=native#text/pascal
tests/test/tarray19.pp svneol=native#text/pascal
tests/test/tarray2.pp svneol=native#text/plain
tests/test/tarray20.pp svneol=native#text/pascal
tests/test/tarray21.pp svneol=native#text/pascal
tests/test/tarray3.pp svneol=native#text/plain
tests/test/tarray4.pp svneol=native#text/plain
tests/test/tarray5.pp svneol=native#text/plain

59
tests/test/tarray21.pp Normal file
View File

@ -0,0 +1,59 @@
program tarray21;
{$mode objfpc}{$H+}
uses
Variants;
var
foobar: IDispatch;
type
TTest = class(TInterfacedObject, IDispatch)
function GetTypeInfoCount(out count : longint) : HResult;stdcall;
function GetTypeInfo(Index,LocaleID : longint;
out TypeInfo): HResult;stdcall;
function GetIDsOfNames(const iid: TGUID; names: Pointer;
NameCount, LocaleID: LongInt; DispIDs: Pointer) : HResult;stdcall;
function Invoke(DispID: LongInt;const iid : TGUID;
LocaleID : longint; Flags: Word;var params;
VarResult,ExcepInfo,ArgErr : pointer) : HResult;stdcall;
end;
function TTest.GetTypeInfoCount(out count : longint) : HResult;stdcall;
begin
end;
function TTest.GetTypeInfo(Index,LocaleID : longint;
out TypeInfo): HResult;stdcall;
begin
end;
function TTest.GetIDsOfNames(const iid: TGUID; names: Pointer;
NameCount, LocaleID: LongInt; DispIDs: Pointer) : HResult;stdcall;
begin
end;
function TTest.Invoke(DispID: LongInt;const iid : TGUID;
LocaleID : longint; Flags: Word;var params;
VarResult,ExcepInfo,ArgErr : pointer) : HResult;stdcall;
begin
end;
procedure Test(aArr: array of Variant);
begin
if Length(aArr) <> 3 then
Halt(1);
if aArr[0] <> 42 then
Halt(2);
if aArr[1] <> 'Test' then
Halt(3);
if IDispatch(aArr[2]) <> foobar then
Halt(4);
end;
begin
foobar := TTest.Create;
Test([42, 'Test', foobar]);
foobar := Nil;
end.