summaryrefslogtreecommitdiff
path: root/fpcsrc/tests/test/timplements4b.pp
blob: 0a291d2fc82bffa1f2265f23d23c33d5c97c9508 (plain)
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
{ %OPT=-gh }
{$ifdef fpc}
{$mode objfpc}
{$endif fpc}
uses
  classes;

type
  to1 = class(TObject,IInterface)
    fi : TInterfacedObject;
    property i : TInterfacedObject read fi implements IInterface;
  end;

var
  o1 : to1;
  i1,i2 : IInterface;
begin
  o1:=to1.create;
  o1.fi:=TInterfacedObject.Create;
  writeln('o1 and o1.fi created');
  i1:=o1;
  i1.QueryInterface(IInterface,i2);
  writeln('i2 queried the first time');
  if i2=nil then
    halt(1);
  writeln('setting o1.fi to nil');
  o1.fi:=nil;
  o1.free;
  try
    i1.QueryInterface(IInterface,i2);
    if i2=nil then
      halt(1);
  except
    writeln('ok');
    halt(0);
  end;
  halt(1)
end.