Browse Source

+ 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

git-svn-id: trunk@42701 -
svenbarth 6 years ago
parent
commit
0e79bd2c70
2 changed files with 60 additions and 0 deletions
  1. 1 0
      .gitattributes
  2. 59 0
      tests/test/tarray21.pp

+ 1 - 0
.gitattributes

@@ -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 - 0
tests/test/tarray21.pp

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