* increase/decrease refcount of interface value parameters on procedure

    entry/exit (mantis #10897)
  * fixed tinterface2 which crashed after this change. It also crashed under
    Kylix: you cannot assign the result of an interfaced class to a class
    instance variable and then use it both as an interface (refcounted) and
    as class (non-refcounted)

git-svn-id: trunk@10405 -

.gitattributes

@@ -7991,6 +7991,7 @@ tests/webtbs/tw10815.pp svneol=native#text/plain
 tests/webtbs/tw10825.pp svneol=native#text/plain
 tests/webtbs/tw10833.pp svneol=native#text/plain
 tests/webtbs/tw10890.pp svneol=native#text/plain
+tests/webtbs/tw10897.pp svneol=native#text/plain
 tests/webtbs/tw1090.pp svneol=native#text/plain
 tests/webtbs/tw1092.pp svneol=native#text/plain
 tests/webtbs/tw1096.pp svneol=native#text/plain

compiler/ncgutil.pas

@@ -1140,13 +1140,12 @@ implementation
         if (tsym(p).typ=paravarsym) then
          begin
            needs_inittable :=
-             not is_class_or_interface(tparavarsym(p).vardef) and
+             not is_class(tparavarsym(p).vardef) and
              tparavarsym(p).vardef.needs_inittable;
            do_trashing :=
              (localvartrashing <> -1) and
              (not assigned(tparavarsym(p).defaultconstsym)) and
-             (not tparavarsym(p).vardef.needs_inittable or
-              is_class(tparavarsym(p).vardef));
+             not needs_inittable;
            case tparavarsym(p).varspez of
              vs_value :
                if needs_inittable then
@@ -1202,7 +1201,7 @@ implementation
         if not(tsym(p).typ=paravarsym) then
           exit;
         list:=TAsmList(arg);
-        if not is_class_or_interface(tparavarsym(p).vardef) and
+        if not is_class(tparavarsym(p).vardef) and
            tparavarsym(p).vardef.needs_inittable then
          begin
            if (tparavarsym(p).varspez=vs_value) then

tests/test/tinterface2.pp

@@ -1,6 +1,9 @@
 { %VERSION=1.1 }
 
+{$ifdef fpc}
 {$mode objfpc}
+{$endif}
+
 type
   ITest = interface(IUnknown)
     procedure DoSomething;
@@ -33,13 +36,12 @@ end;
 
 
 var
-  c: TMyClass;
+  c: ITest;
 begin
   i:=0;
   c := TMyClass.Create;
   DoTest(c);
   DoTest2(c);
-  c.Free;
   if i<>2 then
     begin
        writeln('Problem with passing interfaces as parameters');

tests/webtbs/tw10897.pp

@@ -0,0 +1,82 @@
+{ %opt=-gh }
+
+program aIntfTest;
+
+{$ifdef fpc}
+{$mode delphi}
+{$endif}
+{$APPTYPE CONSOLE}
+uses
+  SysUtils, Classes;
+ 
+ 
+type
+  IMyIntf = interface
+  ['{34326401-7B67-40FF-8E92-4587F65C8E24}']
+    function GetOwner: IMyIntf;
+    procedure Poing;
+  end;
+
+type
+  TMYClass = clasS(TinterfacedObject, IMyIntf)
+    fRef: Integer;
+  public
+    function GetOwner: IMyIntf;
+    function QueryInterface(const IID: TGUID; out Obj): HRESULT; stdcall;
+    function _AddRef: Integer; stdcall;
+    function _Release: Integer; stdcall;
+    procedure Poing;
+  end;
+ 
+{ TMYClass }
+ 
+function TMYClass._AddRef: Integer;
+begin
+  inc(fRef);
+  result := fRef;
+  Writeln('AddRef:'+inttostr(result));
+end;
+ 
+function TMYClass._Release: Integer;
+begin
+  Dec(fRef);
+  result := FRef;
+  Writeln('Release:'+inttostr(result));
+  if result = 0 then Free;
+end;
+ 
+function TMYClass.GetOwner: IMyIntf;
+begin
+  Writeln('GetOwner1');
+  result := nil;
+  Writeln('GetOwner2');
+end;
+ 
+function TMYClass.QueryInterface(const IID: TGUID; out Obj): HRESULT;
+begin
+  if GetInterface(IID, Obj) then
+    result := S_OK else result := -1;
+end;
+ 
+var
+  r: IMyIntf;
+
+procedure Test(x: IMyIntf);
+begin
+  if x <> nil then x.Poing;
+  x := x.GetOwner;
+  if x <> nil then x.Poing;
+end;
+
+procedure TMYClass.Poing;
+begin
+  writeln('poing');
+end;
+
+begin
+  HaltOnNotReleased := true;
+  r := TMYClass.Create;
+  Test(r);
+  Writeln('nil');
+  r := nil; 
+end.