* fixed implements for interfaces

+ tests for implements through interface

git-svn-id: trunk@10413 -

.gitattributes

@@ -7266,6 +7266,9 @@ tests/test/tgoto.pp svneol=native#text/plain
 tests/test/theap.pp svneol=native#text/plain
 tests/test/theapthread.pp svneol=native#text/plain
 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/timplprog.pp svneol=native#text/plain
 tests/test/tindex.pp svneol=native#text/plain
 tests/test/tinivar.pp svneol=native#text/plain

compiler/nobj.pas

@@ -1212,7 +1212,7 @@ implementation
           etFieldValue,
           etVirtualMethodResult,
           etStaticMethodResult:
-            ;
+            current_asmdata.asmlists[al_globals].concat(Tai_const.Create_pint(0));
           else
             internalerror(200802162);
         end;

tests/test/timplements1.pp

@@ -0,0 +1,33 @@
+{$ifdef fpc}
+{$mode objfpc}
+{$endif fpc}
+uses
+  classes;
+
+type
+  to1 = class(TObject,IInterface)
+    fi : IInterface;
+    property i : IInterface read fi implements IInterface;
+  end;
+
+var
+  o1 : to1;
+  i1,i2 : IInterface;
+begin
+  o1:=to1.create;
+  o1.fi:=TInterfacedObject.Create;
+  i1:=o1;
+  i1.QueryInterface(IInterface,i2);
+  if i2=nil then
+    halt(1);
+  o1.fi:=nil;
+  i1.QueryInterface(IInterface,i2);
+  if i2=nil then
+    halt(1);
+  o1.free;
+  i1.QueryInterface(IInterface,i2);
+  if i2=nil then
+    halt(1);
+  writeln('ok');
+end.
+

tests/test/timplements2.pp

@@ -0,0 +1,39 @@
+{$ifdef fpc}
+{$mode objfpc}
+{$endif fpc}
+uses
+  classes;
+
+type
+  to1 = class(TObject,IInterface)
+    fi : IInterface;
+    function getfi : IInterface;
+    property i : IInterface read getfi implements IInterface;
+  end;
+
+function to1.getfi : IInterface;
+  begin
+    result:=fi;
+  end;
+
+var
+  o1 : to1;
+  i1,i2 : IInterface;
+begin
+  o1:=to1.create;
+  o1.fi:=TInterfacedObject.Create;
+  i1:=o1;
+  i1.QueryInterface(IInterface,i2);
+  if i2=nil then
+    halt(1);
+  o1.fi:=nil;
+  i1.QueryInterface(IInterface,i2);
+  if i2=nil then
+    halt(1);
+  o1.free;
+  i1.QueryInterface(IInterface,i2);
+  if i2=nil then
+    halt(1);
+  writeln('ok');
+end.
+

tests/test/timplements3.pp

@@ -0,0 +1,39 @@
+{$ifdef fpc}
+{$mode objfpc}
+{$endif fpc}
+uses
+  classes;
+
+type
+  to1 = class(TObject,IInterface)
+    fi : IInterface;
+    function getfi : IInterface;virtual;
+    property i : IInterface read getfi implements IInterface;
+  end;
+
+function to1.getfi : IInterface;
+  begin
+    result:=fi;
+  end;
+
+var
+  o1 : to1;
+  i1,i2 : IInterface;
+begin
+  o1:=to1.create;
+  o1.fi:=TInterfacedObject.Create;
+  i1:=o1;
+  i1.QueryInterface(IInterface,i2);
+  if i2=nil then
+    halt(1);
+  o1.fi:=nil;
+  i1.QueryInterface(IInterface,i2);
+  if i2=nil then
+    halt(1);
+  o1.free;
+  i1.QueryInterface(IInterface,i2);
+  if i2=nil then
+    halt(1);
+  writeln('ok');
+end.
+