Interfaced object being dumped from memory - delphi

Question

We have a funny one.
program Project1;
{$APPTYPE CONSOLE}
uses
SysUtils;
type
ITestInterface = interface(IInvokable)
['{4059D1CD-A342-48EE-B796-84B8B5589AED}']
function GetPort: string;
function GetRoot: string;
end;
TTestInterface = class(TInterfacedObject, ITestInterface)
private
FPort: string;
FRoot: string;
public
constructor Create(FileName: TFileName);
destructor Destroy; override;
function GetPort: string;
function GetRoot: string;
end;
{ TTestInterface }
constructor TTestInterface.Create(FileName: TFileName);
begin
FPort := '8080';
FRoot := 'top';
end;
destructor TTestInterface.Destroy;
begin
// ^ Place Breakpoint here
inherited;
end;
function TTestInterface.GetPort: string;
begin
Result := FPort;
end;
function TTestInterface.GetRoot: string;
begin
Result := FRoot;
end;
type
TTestService = class
protected
FTest : TTestInterface;
public
constructor Create;
destructor Destroy; override;
procedure Process;
end;
{ TTestService }
constructor TTestService.Create;
begin
FTest := TTestInterface.Create('');
(FTest as IInterface)._AddRef;
end;
destructor TTestService.Destroy;
begin
FTest.Free;
inherited;
end;
procedure TTestService.Process;
begin
writeln( 'Config Root: ', FTest.GetRoot );
writeln( 'Config Port: ', FTest.GetPort );
end;
var
TS : TTestService;
begin
TS := TTestService.Create;
try
TS.Process;
finally
TS.Free;
end;
end.
When this application finishes it generates an Invalid Pointer Operation.
The really strange part is that setting a break point on the destructor, you can see that it generates the error the first time it gets called, which rules out it being freed twice. It is almost as if the object is dumped from memory without calling the destructor at all.
By removing the _AddRef everything works as expected.
We managed to produce this on Delphi 6. Can anyone confirm this behavior on any other version?

Answer 1

Use two variables: one for the class, and one for the interface.
Use the interface variable to manage the instance lifetime. Don't call free, but set the interface variable to nil (or out of scope) to let the instance running.
Use the class variable to have direct raw access to the instance, if needed - but it shouldn't be the case, or at least let the class be accessible only from protected/private members of the owner class.
So your code becomes:
type
TTestService = class
protected
FTest: ITestInterface;
FTestInstance : TTestInterface;
public
constructor Create;
procedure Process;
end;
{ TTestService }
constructor TTestService.Create;
begin
FTestInstance := TTestInterface.Create('');
FTest := FTestInstance;
end;
procedure TTestService.Process;
begin
writeln( 'Config Root: ', FTest.GetRoot );
writeln( 'Config Port: ', FTest.GetPort );
end;
var
TS : TTestService;
begin
TS := TTestService.Create;
try
TS.Process;
finally
TS.Free;
end;
end.

Answer 2

The problem is that you are manually freeing an interfaced object that has a reference count greater than zero. The exception is raised here :
procedure TInterfacedObject.BeforeDestruction;
begin
if RefCount <> 0 then {!! RefCount is still 1 - you made it that way!}
Error(reInvalidPtr);
end;
So... you could just call (FTest as IInterface)._Release; in the destructor in place of FTest.Free, but this feels like fixing one mistake by making another. Either you want reference counting or you don't - if you do, then you should work with the object in that way (using interface variables and letting scope and variable lifetime manage the object lifetime). If you don't want reference counting then disable it. Either way you should pick a lifetime management model and work with it in the normal way.
Case 1 : Disable Reference Counting
If you want to disable automatic reference counting and you're using Delphi 2009 or higher you can simply do this by inheriting from TSingletonImplementation instead of TInterfacedObject :
TTestInterface = class(TSingletonImplementation, ITestInterface)
private
FPort: string;
FRoot: string;
public
constructor Create(FileName: TFileName);
destructor Destroy; override;
function GetPort: string;
function GetRoot: string;
end;
Otherwise, you can implement this yourself by adding the required methods :
TTestInterface = class(TObject, ITestInterface)
private
FPort: string;
FRoot: string;
{ ** Add interface handling methods ** }
protected
function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
function _AddRef: Integer; stdcall;
function _Release: Integer; stdcall;
{ ** ---------------------- ** }
public
constructor Create(FileName: TFileName);
destructor Destroy; override;
function GetPort: string;
function GetRoot: string;
end;
which you implement as :
function TTestInterface.QueryInterface(const IID: TGUID; out Obj): HResult;
begin
if GetInterface(IID, Obj) then
Result := S_OK
else
Result := E_NOINTERFACE;
end;
function TTestInterface._AddRef: Integer;
begin
Result := -1;
end;
function TTestInterface._Release: Integer;
begin
Result := -1;
end;
Case 2 : Use Interface References Normally
If you absolutely need reference counting and you still need to access the concrete class members then the simplest solution is to strictly use interface variables, let your container class pin the object lifetime, and cast to the concrete type when needed. Lets introduce some state to the class :
TTestInterface = class(TInterfacedObject, ITestInterface)
private
FPort: string;
FRoot: string;
public
Foo : integer; { not an interface member...}
constructor Create(FileName: TFileName);
destructor Destroy; override;
function GetPort: string;
function GetRoot: string;
end;
Your container class then becomes :
type
TTestService = class
protected
FTest : ITestInterface;
public
constructor Create;
procedure Process;
end;
{ TTestService }
constructor TTestService.Create;
begin
FTest := TTestInterface.Create('');
end;
procedure TTestService.Process;
begin
writeln( 'Config Root: ', FTest.GetRoot );
writeln( 'Config Port: ', FTest.GetPort );
WriteLn( 'Foo : ', TTestInterface(FTest).Foo); {Cast to access class members}
end;
Note that the above cast of TTestInterface(FTest) only works in Delphi 2010 and higher. For versions older than this you must keep a separate object reference as in #ArnaudBouchez's answer. In either case, the point is to use interface references in the normal way to manage the object lifetime and to not rely on hacking the reference count manually.