[fpc-devel] Interfaced Object leak in inherited Object

[Michael Van Canneyt]

On Mon, 13 Jun 2005, alphax wrote:

> It seems a bug in FPC 2.0.0.(Delphi 7.1 also has this bug)
> 
> Assumes there is an object(not class) declaration, the object has a IInterface field. 
> If we declare another object derive from it, in the cleanup procedure of that decendant 
> leak to clear the IInterface references.

This is normal behviour (although maybe not desirable behaviour). 
You *must* call the destructor of your object, that is why it is there: 
to clean up. 

Michael.

> 
> The test program is follow:
> //===================================================================
> 
> program test_obj_inherit;
> {
>   bug: Interfaced Object leak in inherited Object
>   environment: win2k fpc2.0.0
>   date: 2005.06.13
> }
> 
> {$mode objfpc}
> 
> uses
>   SysUtils, Variants;
> 
> type
>   TInterfacedObj = class(TInterfacedObject)
>     destructor Destroy; override;
>   end;
> 
>   TObj1 = object
>     I: IInterface;
>     constructor Create;
>     procedure Which; virtual;
>   end;
>   PObj1 = ^TObj1;
> 
>   TObj2 = object(TObj1)
>     constructor Create;
>     procedure Which; virtual;
>   end;
>   PObj2 = ^TObj2;
> 
>   TObj3 = object(TObj1)
>     //object keep a Variant
>     V: Variant;
>     constructor Create;
>     procedure Which; virtual;
>   end;
>   PObj3 = ^TObj3;
> 
> var
>   //used to check the interfaced object is whether or not released
>   InterfacedObjReleased: Boolean;
> 
> destructor TInterfacedObj.Destroy;
>   begin
>     InterfacedObjReleased := True;
>   end;
> 
> constructor TObj1.Create;
>   begin
>   end;
> 
> procedure TObj1.Which;
>   begin
>     WriteLn('  This is TObj1');
>   end;
> 
> constructor TObj2.Create;
>   begin
>   end;
> 
> procedure TObj2.Which;
>   begin
>     WriteLn('  This is TObj2');
>   end;
> 
> constructor TObj3.Create;
>   begin
>   end;
> 
> procedure TObj3.Which;
>   begin
>     WriteLn('  This is TObj3');
>   end;
> 
> {==Test TObj1==}
> 
> procedure Test1_1;
>   var
>     Obj: PObj1;
>   begin
>     WriteLn('Use Object Pointer');
>     New(Obj, Create);
>     Obj^.I := TInterfacedObj.Create();
>     Obj^.Which();
>     Dispose(Obj);
>   end;
> 
> procedure Test1_2;
>   var
>     Obj: TObj1;
>   begin
>     WriteLn('Use Object directly');
>     Obj.Create();
>     Obj.I := TInterfacedObj.Create();
>     Obj.Which();
>   end;
> 
> {==Test TObj2==}
> 
> procedure Test2_1;
>   var
>     Obj: PObj2;
>   begin
>     WriteLn('Use Object Pointer');
>     Obj := New(PObj2, Create);
>     Obj^.I := TInterfacedObj.Create();
>     Obj^.Which();
>     Dispose(Obj); //here, the I should be release
>   end;
> 
> procedure Test2_2;
>   var
>     Obj: TObj2;
>   begin
>     WriteLn('Use Object directly');
>     Obj.Create();
>     Obj.I := TInterfacedObj.Create();
>     Obj.Which();
>   end; //afetr Test2_2 return the I should be release
> 
> {==Test TObj3==}
> 
> operator := (const I: IInterface): Variant;
>   begin
>     VarClear(Result);
> 
>     with TVarData(Result) do
>     begin
>       vtype := varunknown;
>       IInterface(vunknown) := I;
>     end;
>   end;
> 
> procedure Test3_1;
>   var
>     Obj: PObj3;
>   begin
>     WriteLn('Use Object Pointer');
>     Obj := New(PObj3, Create);
>     Obj^.V := TInterfacedObj.Create();
>     Obj^.Which();
>     Dispose(Obj); //here, the V should be cleanup
>   end;
> 
> procedure Test3_2;
>   var
>     Obj: TObj3;
>   begin
>     WriteLn('Use Object directly');
>     Obj.Create();
>     Obj.V := TInterfacedObj.Create();
>     Obj.Which();
>   end; //afetr Test3_2 return the V should be cleanup
> 
> 
> 
> procedure CheckReleased;
>   begin
>     if InterfacedObjReleased then
>       WriteLn('  InterfacedObject Release, OK')
>     else
>       WriteLn('  InterfacedObject is *NOT* Released, Failure');
> 
>     WriteLn;
> 
>     InterfacedObjReleased := False;
>   end;
> 
> 
> begin
>   WriteLn;
> 
>   Test1_1();
>   CheckReleased();
>   Test1_2();
>   CheckReleased();
> 
>   Test2_1();  //<- The InterfacedObject leak in this call
>   CheckReleased();
>   Test2_2();  //<- The InterfacedObject leak in this call
>   CheckReleased();
> 
>   Test3_1();
>   CheckReleased();
>   Test3_2();
>   CheckReleased();
> 
>   WriteLn;
> end.
> //===================================================================
>