Delphi – Using FastMM4 part 2: TDataModule descendants exposing interfaces, or the introduction of a TInterfacedDataModule

This is the second post of a series of posts around using FastMM4.
The start of the series contains a listing of other posts as well and will be updated when new posts become available.

One of the larger projects I’ve becoming involved in, uses a pattern that uses TDataModule descendants exposing interfaces.
Interfaces in Delphi are nice: if used properly, you have reference counting that will automatically free the underlying objects if there are no references left to them.

When you do not do interfaces in Delphi properly, you are bound to have a lot of memory leaks, and this is one of the cases where we did.
The client choose to do testing and QA very late in the product cycle, and we choose to use FastMM to do memory debugging.
Lo and behold: a truckload of memory leaks appeared all having to do with those datamodules.

As a side node:
Another thing we bumped into at an earlier stage was lifetime management in general: (both interface and object) references were kept to objects long after they were disposed.
That caused a lot of EAccessViolation pain.
It is best not to mix the “interface reference” pattern with the “owned component” pattern: you usually end up with many more EAccessViolation exceptions.

This article is about finding the memory leaks caused by the way the interfaces were exposed from the TDataModule descendants, and a solution for preventing them by introducing the concept of TInterfacedDataModule.

First lets start with describing the pattern used in this application.
Later on you will find a fully compiling version of all sources, the next few listings are to describe the concept.

The basic idea of the pattern is that you have a global factory that creates the instances, but that you only keep reference to those objects instances through interface references.
Then the reference counting of the interface references should automatically free the underlying datamodule instances.

We will find out that just exposing an interface from a TDataModule descendant will do almost fine: it works but the Destroy desctructor never gets called automatically.

The exposed interface declaration (note that all interfaces should have a GUID, if you don’t you cannot cast them with the ‘as’ operator!), see the error E2015 below.

unit MyDataModuleInterfaceUnit;

interface

type
  IMyDataModuleInterface = interface
    ['{3826BA17-C246-44CD-A148-8BE124B39724}']
    procedure MyMethod;
  end;

implementation

end.

If you forget the interface GUID, then you get an error like this:

unit MyDataModuleInterfaceUnit;

interface

type
  IMyDataModuleInterface = interface
//    ['{3826BA17-C246-44CD-A148-8BE124B39724}']
    procedure MyMethod;
  end;

implementation

var
  Reference: IUnknown = nil;
  MyDataModuleInterface: IMyDataModuleInterface;

initialization
  MyDataModuleInterface := Reference as IMyDataModuleInterface;
  // [DCC Error] MyDataModuleInterfaceUnit.pas(18): E2015 Operator not applicable to this operand type
end.

All datamodules used to expose the interfaces like TFaultyDataModule does: directly descend from TDataModule and just implement the interface member(s):

unit FaultyDataModuleUnit;

interface

uses
  SysUtils, Classes, MyDataModuleInterfaceUnit;

type
  TFaultyDataModule = class(TDataModule, IMyDataModuleInterface)
  strict private
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure MyMethod;
  end;

implementation

{$R *.dfm}

constructor TFaultyDataModule.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
end;

destructor TFaultyDataModule.Destroy;
begin
  inherited; // this is never called when you only have interface references to the TFaultyDataModule instances.
end;

procedure TFaultyDataModule.MyMethod;
begin
  Beep();
end;

end.

Then the instances of the datamodules were exposed through interface references by a central TMyDataModuleFactory that does delayed creation of each instance:

unit MyDataModuleFactoryUnit;

interface

uses
  MyDataModuleInterfaceUnit;

type
  TMyDataModuleFactory = class(TInterfacedObject, IUnknown)
  strict private
    FFaultyDataModuleInterface: IMyDataModuleInterface;
  strict protected
    function GetFaultyDataModuleInterface: IMyDataModuleInterface;
  public
    destructor Destroy; override;
    property FaultyDataModuleInterface: IMyDataModuleInterface read GetFaultyDataModuleInterface;
  end;

implementation

uses
  FaultyDataModuleUnit;

destructor TMyDataModuleFactory.Destroy;
begin
  FFaultyDataModuleInterface := nil;
  inherited;
end;

function TMyDataModuleFactory.GetFaultyDataModuleInterface: IMyDataModuleInterface;
begin
  if not Assigned(FFaultyDataModuleInterface) then
    FFaultyDataModuleInterface := TFaultyDataModule.Create(nil);
  Result := FFaultyDataModuleInterface;
end;

end.

Well, the above pattern leaks memory, even if TMyDataModuleFactory.Destroy will set FFaultyDataModuleInterface to nil:

A memory block has been leaked. The size is: 100

This block was allocated by thread 0x864, and the stack trace (return addresses) at the time was:
40305E [sys\system.pas][System][@GetMem][2654]
403C1B [sys\system.pas][System][TObject.NewInstance][8807]
403F8A [sys\system.pas][System][@ClassCreate][9472]
45BAD6 [..\src\FaultyDataModuleUnit.pas][FaultyDataModuleUnit][TFaultyDataModule.Create]
4062BF [sys\system.pas][System][TInterfacedObject._AddRef][17972]
406200 [sys\system.pas][System][@IntfCopy][17866]
45BD23 [..\src\MyDataModuleFactoryUnit.pas][MyDataModuleFactoryUnit][TMyDataModuleFactory.GetFaultyDataModuleInterface][61]
45C1CC [..\src\MainFormUnit.pas][MainFormUnit][TMainForm.GetFaultyDataModuleButtonClick][55]
44B11A [Controls.pas][Controls][TControl.Click][5229]
45B373 [StdCtrls.pas][StdCtrls][TButton.Click][3745]
45B471 [StdCtrls.pas][StdCtrls][TButton.CNCommand][3797]

The block is currently used for an object of class: TFaultyDataModule

So: why does TFaultyDataModule.Destroy not get called?

The reason is that the reference counting mechanism is declared by IInterface, and only partially implemented in TComponent.
The actual implementation is in TComponent._AddRef and TComponent._Release. What you see is that they defer the behaviour to FVCLComObject which is only used by ActiveX components and COM/ActiveX automation servers.
If there is no assigned FVCLComObject, then there is no reference counting taking place at all.

// unit System:

type
  IInterface = interface
    ['{00000000-0000-0000-C000-000000000046}']
    function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
    function _AddRef: Integer; stdcall;
    function _Release: Integer; stdcall;
  end;

// unit Classes:

type
  TComponent = class(TPersistent, IInterface, IInterfaceComponentReference)
  private
    //...
    FVCLComObject: Pointer;
    //...
  protected
    //...
    { IInterface }
    function QueryInterface(const IID: TGUID; out Obj): HResult; virtual; stdcall;
    function _AddRef: Integer; stdcall;
    function _Release: Integer; stdcall;
    //...
  end;

//...

function TComponent.QueryInterface(const IID: TGUID; out Obj): HResult;
begin
  if FVCLComObject = nil then
  begin
    if GetInterface(IID, Obj) then
      Result := S_OK
    else
      Result := E_NOINTERFACE
  end
  else
    Result := IVCLComObject(FVCLComObject).QueryInterface(IID, Obj);
end;

function TComponent._AddRef: Integer;
begin
  if FVCLComObject = nil then
    Result := -1   // -1 indicates no reference counting is taking place
  else
    Result := IVCLComObject(FVCLComObject)._AddRef;
end;

function TComponent._Release: Integer;
begin
  if FVCLComObject = nil then
    Result := -1   // -1 indicates no reference counting is taking place
  else
    Result := IVCLComObject(FVCLComObject)._Release;
end;

So what we must do is properly implement at least _AddRef and _Release. Luckily, we can look at TXMLDocument for that: it is a TComponent descendant that exposes IInterface/IUnknown.
We could also have used THTTPReqResp, TSOAPDOMProcessor, TSoapDataModule or TRIO for it: they have an almost identical implementation.
The source code listing below is the interesting part of TXMLDocument.
What you see is that in addition to _AddRef and _Release, also NewInstance, Destroy and AfterConstruction are implemented. Those rely heavily on how the inner workings, so I’ll explain a bit on them in a moment.
They enable you to use the component with both the interface reference pattern, as well as the (well known) owned component pattern.
But let me repeat the warning I already stated above:
When you mix the two, you must be really careful with your references: when the owner of the components makes the component to destroy, and there are still interface or component references left, you get EAccessViolation exceptions all over the place.

unit XMLDoc;

interface

uses
  Classes;

type
  TXMLDocument = class(TComponent, IInterface)
  private
    FOwnerIsComponent: Boolean;
    FRefCount: Integer;
  protected
    { IInterface }
    function _AddRef: Integer; stdcall;
    function _Release: Integer; stdcall;
  public
    class function NewInstance: TObject; override;
    destructor Destroy; override;
    procedure AfterConstruction; override;
  end;

implementation

uses
  Windows;

destructor TXMLDocument.Destroy;
begin
  Destroying; // make everyone release references they have towards us
  if FOwnerIsComponent and (FRefCount > 1) then
  begin
    // perform cleanup of interface references that we refer to.
  end;
//...
  inherited;
end;

procedure TXMLDocument.AfterConstruction;
begin
  inherited;
//...
  FOwnerIsComponent := Assigned(Owner) and (Owner is TComponent);
//...
  InterlockedDecrement(FRefCount);
end;

class function TXMLDocument.NewInstance: TObject;
begin
  Result := inherited NewInstance;
  TXMLDocument(Result).FRefCount := 1;
end;

{ IInterface }

function TXMLDocument._AddRef: Integer;
begin
  Result := InterlockedIncrement(FRefCount)
end;

function TXMLDocument._Release: Integer;
begin
  Result := InterlockedDecrement(FRefCount);
  { If we are not being used as a TComponent, then use refcount to manage our
    lifetime as with TInterfacedObject. }
  if (Result = 0) and not FOwnerIsComponent then
    Destroy;
end;

end.

A bit more explanation about the methods above:
_AddRef and _Release implement the reference counting: _AddRef gets called when you assign the interface instance to a variable or field; _Release gets called when such a variable or field goes out of scope.
Out of scope is quite broad: for a local variable it means the function is terminated, for a global variable it means the unit is unloaded from memory, for a field it means the encompassing object is being released.
The NewInstance method is being called right before the Create constructor is being called (so it gets called even if someone introduces a new constructor and forgets to call the inherited Create). Together with AfterConstruction it ensures that there is a reference during the whole construction process. This guarantees the interface reference mechanism does not start to free the instance while it is still being constructed.
Destroy allows for internal cleanup.
AfterConstruction undoes what NewInstance does. After that, the reference counting mechanism does its work.
Note that it is not needed to have a QueryInterface method: TComponent.QueryInterface performs works fine for us.

Based on the above example, I have created a TInterfacedDataModule below.
It adds one extra check that is not in the TXMLDocument implementation: BeforeDestruction.
BeforeDestruction makes sure the object only gets destroyed when the reference count is zero, or when its lifetime is managed by an owning component. It makes debugging easier: because it fails at the earliest opportunity in stead of later generating EAccessViolation exceptions.

First the .dfm since it it very small,

object InterfacedDataModule: TInterfacedDataModule
  OldCreateOrder = False
  Height = 150
  Width = 215
end

then the unit itself:

unit InterfacedDataModuleUnit;

interface

uses
  SysUtils, Classes;

type
  TInterfacedDataModule = class(TDataModule, IInterface, IInterfaceComponentReference)
  strict protected
    FOwnerIsComponent: Boolean;
    FRefCount: Integer;
  protected
    function _AddRef: Integer; stdcall;
    function _Release: Integer; stdcall;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure AfterConstruction; override;
    procedure BeforeDestruction; override;
    class function NewInstance: TObject; override;
    property OwnerIsComponent: Boolean read FOwnerIsComponent;
    property RefCount: Integer read FRefCount;
  end;

implementation

uses
  Windows;

{$R *.dfm}

constructor TInterfacedDataModule.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
end;

destructor TInterfacedDataModule.Destroy;
begin
  Destroying; // make everyone release references they have towards us
  if FOwnerIsComponent and (FRefCount > 1) then
  begin
    // perform cleanup of interface references that we refer to.
  end;
//...
  inherited Destroy;
end;

procedure TInterfacedDataModule.AfterConstruction;
begin
  FOwnerIsComponent := Assigned(Owner) and (Owner is TComponent);
  // Release the NewInstance/constructor's implicit refcount
  InterlockedDecrement(FRefCount);
  inherited AfterConstruction;
end;

procedure TInterfacedDataModule.BeforeDestruction;
{$ifdef DEBUG}
var
  WarningMessage: string;
{$endif DEBUG}
begin
  if (RefCount <> 0) then
  begin
    if not OwnerIsComponent then
      System.Error(reInvalidPtr)
{$ifdef DEBUG}
    else
    begin
      WarningMessage := Format(
        'Trying to destroy an Owned TInterfacedDataModule of class %s named %s that still has %d interface references left',
        [ClassName, Name, RefCount]);
      OutputDebugString(PChar(WarningMessage));
    end;
{$endif DEBUG}
  end;
  inherited BeforeDestruction;
end;

class function TInterfacedDataModule.NewInstance: TObject;
begin
  // Set an implicit refcount so that refcounting
  // during construction won't destroy the object.
  Result := inherited NewInstance;
  TInterfacedDataModule(Result).FRefCount := 1;
end;

{ IInterface }

function TInterfacedDataModule._AddRef: Integer;
begin
  Result := InterlockedIncrement(FRefCount);
end;

function TInterfacedDataModule._Release: Integer;
begin
  Result := InterlockedDecrement(FRefCount);
  { If we are not being used as a TComponent, then use refcount to manage our
    lifetime as with TInterfacedObject. }
  if (Result = 0) and not FOwnerIsComponent then
    Destroy;
end;

end.

With the TInterfacedDataModule it becomes dead easy to expose an interface from a data module:

1. Add the InterfacedDataModuleUnit unit to your project.
2. Create a new data module based on TInterfacedDataModule.

For instance this is MyDataModuleUnit, containing TMyDataModule that exposes the IMyDataModuleInterface interface:

unit MyDataModuleUnit;

interface

uses
  SysUtils, Classes,
  InterfacedDataModuleUnit,
  MyDataModuleInterfaceUnit;

type
  TMyDataModule = class(TInterfacedDataModule, IMyDataModuleInterface)
  protected
    function GetComponent: TComponent; stdcall;
    function GetInstance: TObject; stdcall;
    procedure MyMethod;
  end;

implementation

uses
  Windows;

{$R *.dfm}

function TMyDataModule.GetComponent: TComponent;
begin
  Result := Self;
end;

function TMyDataModule.GetInstance: TObject;
begin
  Result := Self;
end;

procedure TMyDataModule.MyMethod;
begin
  SysUtils.Beep();
end;

end.

And then the full factory, which – in addition to being a factory – also implements the singleton pattern, is in the final source:

unit MyDataModuleFactoryUnit;

interface

uses
  MyDataModuleInterfaceUnit, Classes;

type
  TMyDataModuleFactory = class(TInterfacedObject, IUnknown)
  strict private
    FMyDataModuleInterface: IMyDataModuleInterface;
    FFaultyDataModuleInterface: IMyDataModuleInterface;
  class var
    FInstance: TMyDataModuleFactory;
    FReference: IUnknown;
  strict protected
    class function GetInstance: TMyDataModuleFactory; static;
    function GetMyDataModuleInterface: IMyDataModuleInterface;
    function GetFaultyDataModuleInterface: IMyDataModuleInterface;
  public
    destructor Destroy; override;
    class property Instance: TMyDataModuleFactory read GetInstance;
    property MyDataModuleInterface: IMyDataModuleInterface read GetMyDataModuleInterface;
    property FaultyDataModuleInterface: IMyDataModuleInterface read GetFaultyDataModuleInterface;
  end;

implementation

uses
  FaultyDataModuleUnit, MyDataModuleUnit;

destructor TMyDataModuleFactory.Destroy;
begin
  FFaultyDataModuleInterface := nil;
  FMyDataModuleInterface := nil;
  inherited Destroy;
  FInstance := nil;
  FReference := nil;
end;

function TMyDataModuleFactory.GetMyDataModuleInterface: IMyDataModuleInterface;
begin
  if not Assigned(FMyDataModuleInterface) then
    FMyDataModuleInterface := TMyDataModule.Create(nil);
  Result := FMyDataModuleInterface;
end;

class function TMyDataModuleFactory.GetInstance: TMyDataModuleFactory;
begin
  if not Assigned(FInstance) then
  begin
    FInstance := TMyDataModuleFactory.Create();
    FReference := FInstance;
  end;
  Result := FInstance;
end;

function TMyDataModuleFactory.GetFaultyDataModuleInterface: IMyDataModuleInterface;
begin
  if not Assigned(FFaultyDataModuleInterface) then
    FFaultyDataModuleInterface := TFaultyDataModule.Create(nil);
  Result := FFaultyDataModuleInterface;
end;

end.

Note that of course you can write a TInterfacedComponent in the same way.

Have fun with it!

–jeroen

Edit 200908101830 UTC: bugfix in TInterfacedDataModule.Destroy
Edit 200908130900 UTC: changed procedure TInterfacedDataModule.BeforeDestruction because of a comment that user Torbins made
Edit 200912261000 UTC: fixed implementation of TMyDataModule.GetComponent and TMyDataModule.GetInstance, added the .dfm for InterfacedDataModule