+ first test for implements through classes

git-svn-id: trunk@10416 -

.gitattributes

@@ -7269,6 +7269,7 @@ tests/test/thintdir.pp svneol=native#text/plain
 tests/test/timplements1.pp svneol=native#text/plain
 tests/test/timplements2.pp svneol=native#text/plain
 tests/test/timplements3.pp svneol=native#text/plain
+tests/test/timplements4.pp svneol=native#text/plain
 tests/test/timplprog.pp svneol=native#text/plain
 tests/test/tindex.pp svneol=native#text/plain
 tests/test/tinivar.pp svneol=native#text/plain

tests/test/timplements4.pp

@@ -0,0 +1,44 @@
+{ %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;
+{
+  writeln('o1.fi niled');
+  i1.QueryInterface(IInterface,i2);
+  writeln('i2 queried the second time');
+  if i2=nil then
+    halt(1);
+}
+  o1.free;
+{
+  writeln('o1 freed');
+  i1.QueryInterface(IInterface,i2);
+  if i2=nil then
+    halt(1);
+}
+  writeln('ok');
+end.
+