tests/test/tarray21.pp


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
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.