Interfaced object being dumped from memory

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

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.

Answer 2

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.