Delphi – Using FastMM4 part 2: TDataModule descendants exposing interfaces, or the introduction of a TInterfacedDataModule
Posted by jpluimers on 2009/08/10
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:
- Add the InterfacedDataModuleUnit unit to your project.
- 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
PS: Someone doing the same for forms on G+: Help! I need input! :) How can I make a TForm “interface-able”? :) It’ll only….
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| program Test003; | |
| uses | |
| FastMM4 in '..\..\..\VCL\FastMM4\FastMM4.pas', | |
| FastMM4Messages in '..\..\..\VCL\FastMM4\FastMM4Messages.pas', | |
| Vcl.Forms, | |
| Unit1 in 'Unit1.pas' {Form1}, | |
| Unit2 in 'Unit2.pas' {Form2}, | |
| Unit3 in 'Unit3.pas'; | |
| {$R *.res} | |
| begin | |
| Application.Initialize; | |
| Application.MainFormOnTaskbar := True; | |
| Application.CreateForm(TForm1, Form1); | |
| Application.Run; | |
| end. |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| object Form1: TForm1 | |
| Left = 0 | |
| Top = 0 | |
| Caption = 'Form1' | |
| ClientHeight = 290 | |
| ClientWidth = 554 | |
| Color = clBtnFace | |
| Font.Charset = DEFAULT_CHARSET | |
| Font.Color = clWindowText | |
| Font.Height = -11 | |
| Font.Name = 'Tahoma' | |
| Font.Style = [] | |
| OldCreateOrder = False | |
| PixelsPerInch = 96 | |
| TextHeight = 13 | |
| object Button1: TButton | |
| Left = 124 | |
| Top = 64 | |
| Width = 75 | |
| Height = 25 | |
| Caption = 'Button1' | |
| TabOrder = 0 | |
| OnClick = Button1Click | |
| end | |
| end |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| unit Unit1; | |
| interface | |
| uses | |
| Unit3, | |
| // | |
| Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, | |
| Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls; | |
| type | |
| TForm1 = class(TForm) | |
| Button1: TButton; | |
| procedure Button1Click(Sender: TObject); | |
| private | |
| public | |
| end; | |
| var | |
| Form1: TForm1; | |
| implementation | |
| {$R *.dfm} | |
| uses | |
| Unit2; | |
| procedure TForm1.Button1Click(Sender: TObject); | |
| var | |
| LForm2: IForm2; | |
| begin | |
| LForm2 := CreateForm2(Self); | |
| try | |
| LForm2.CallbackProc; | |
| finally | |
| LForm2 := nil; | |
| end; | |
| end; | |
| end. |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| object Form2: TForm2 | |
| Left = 0 | |
| Top = 0 | |
| Caption = 'Form2' | |
| ClientHeight = 290 | |
| ClientWidth = 554 | |
| Color = clBtnFace | |
| Font.Charset = DEFAULT_CHARSET | |
| Font.Color = clWindowText | |
| Font.Height = -11 | |
| Font.Name = 'Tahoma' | |
| Font.Style = [] | |
| OldCreateOrder = False | |
| PixelsPerInch = 96 | |
| TextHeight = 13 | |
| end |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| unit Unit2; | |
| interface | |
| uses | |
| Unit3, | |
| // | |
| Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, | |
| Vcl.Controls, Vcl.Forms, Vcl.Dialogs; | |
| type | |
| IForm2 = interface(ICallbackForm) | |
| ['{D0204F6D-3F49-4B48-9105-0FB291CD72B3}'] | |
| end; | |
| TForm2 = class(TForm, IInterface, IForm2) | |
| strict private | |
| FOwnerIsComponent: Boolean; | |
| FRefCount: Integer; | |
| protected | |
| function _AddRef: Integer; stdcall; | |
| function _Release: Integer; stdcall; | |
| public | |
| class function NewInstance: TObject; override; | |
| destructor Destroy; override; | |
| public | |
| procedure AfterConstruction; override; | |
| procedure BeforeDestruction; override; | |
| public | |
| procedure CallbackProc; | |
| end; | |
| function CreateForm2(AOwner: TComponent): IForm2; | |
| implementation | |
| {$R *.dfm} | |
| function CreateForm2(AOwner: TComponent): IForm2; | |
| begin | |
| Result := TForm2.Create(AOwner); | |
| end; | |
| { TForm2 } | |
| destructor TForm2.Destroy; | |
| begin | |
| ShowMessage('TForm2.Destroy'); | |
| Destroying; | |
| if FOwnerIsComponent and (FRefCount > 1) then | |
| begin | |
| // | |
| end; | |
| inherited; | |
| end; | |
| function TForm2._AddRef: Integer; | |
| begin | |
| Result := InterlockedIncrement(FRefCount) | |
| end; | |
| function TForm2._Release: Integer; | |
| begin | |
| Result := InterlockedDecrement(FRefCount); | |
| if (Result = 0) then | |
| begin | |
| if FOwnerIsComponent then | |
| Owner.RemoveComponent(Self); | |
| Destroy; | |
| end; | |
| end; | |
| class function TForm2.NewInstance: TObject; | |
| begin | |
| Result := inherited NewInstance; | |
| TForm2(Result).FRefCount := 1; | |
| end; | |
| procedure TForm2.AfterConstruction; | |
| begin | |
| FOwnerIsComponent := Assigned(Owner) and (Owner is TComponent); | |
| InterlockedDecrement(FRefCount); | |
| inherited; | |
| end; | |
| procedure TForm2.BeforeDestruction; | |
| {$ifdef DEBUG} | |
| var | |
| WarningMessage: string; | |
| {$endif DEBUG} | |
| begin | |
| if (FRefCount <> 0) then | |
| begin | |
| if not FOwnerIsComponent then | |
| System.Error(reInvalidPtr) | |
| {$ifdef DEBUG} | |
| else | |
| begin | |
| WarningMessage := Format( | |
| 'Trying to destroy an Owned TForm2 of class %s named %s that still has %d interface references left', | |
| [ClassName, Name, FRefCount]); | |
| OutputDebugString(PChar(WarningMessage)); | |
| end; | |
| {$endif DEBUG} | |
| end; | |
| inherited; | |
| end; | |
| procedure TForm2.CallbackProc; | |
| begin | |
| ShowMessage('CallbackProc'); | |
| end; | |
| end. |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| unit Unit3; | |
| interface | |
| uses | |
| System.Classes, | |
| Vcl.Forms; | |
| type | |
| ICallbackForm = interface(IInterfaceComponentReference) | |
| ['{59080B84-94C6-4572-9120-6722FC78758A}'] | |
| procedure CallbackProc; | |
| end; | |
| implementation | |
| end. |
The Wiert Corner - irregular stream of stuff 
Mike P said
Thanks Jeroen, you confirmed the cause of a problem I have been having right now! Good explanation!
jpluimers said
Glad it helped!
Delphi – TInterfacedDataModule revisted – inherited in your .dfm files when your datamodules look like forms in the designer « The Wiert Corner – Jeroen Pluimers’ irregular stream of Wiert stuff said
[…] allocations – part 1: IntroductionDelphi – Frames as visual Components – don't forget your Sprig!Delphi – Using FastMM4 part 2: TDataModule descendants exposing interfaces, or the introduction of a….NET/C# – converting UTF8 to ASCII (yes, you *can* loose information with this) using […]
Delphi – FastMM: Using FastMM4 for debugging your memory allocations – part 1: Introduction « The Wiert Corner – Jeroen Pluimers’ irregular stream of Wiert stuff said
[…] Comments Torbins on Delphi – Using FastMM4 p…jpluimers on Delphi – Using FastMM4 p…jpluimers on Delphi – Using FastMM4 […]
Torbins said
Maybe you can assume, that Owner has one reference? Something like that:
destructor TInterfacedDataModule.Destroy;begin
if FRefCount > 1 then
begin
InterlockedDecrement(FRefCount);
Exit;
end;
//...
inherited Destroy;
end;
procedure TInterfacedDataModule.AfterConstruction;
begin
if not (Assigned(Owner) and (Owner is TComponent)) then
InterlockedDecrement(FRefCount);
inherited AfterConstruction;
end;
class function TInterfacedDataModule.NewInstance: TObject;
begin
Result := inherited NewInstance;
TInterfacedDataModule(Result).FRefCount := 1;
end;
jpluimers said
I have thought about that, but my reason not to do it is “why be forgiving in a situation that is broken?”.
That’s how I write software in general: fail early, so it easier to find and repair bugs.
It’s not that your solution is bad, it’s just that we have two different opninions that both can be used.
–jeroen
Torbins said
Sorry, I had to write:
destructor TInterfacedDataModule.Destroy;begin
if FRefCount > 0 then
begin
Self._Release;
Exit;
end;
//...
inherited Destroy;
end;
This code assumes that Owner will call Destroy only once. If there will be no other references, then object will be freed.
P.S. Sorry for my english.
jpluimers said
Don’t worry about your English, I can get your idea from it, so it is good enough for me.
What you do here is mix the Interface reference counting mechanism inside the freeing mechanism. That is dangerous because you now fool the system into thinking that one of the external interface references is gone while in fact it is still there.
You are right though that when Destroy gets called on an owned component, and the RefCount is not zero, there might be something wrong.
So for now, I have changed the BeforeDestruction to issue a warning in DEBUG mode:
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;I will get back on this in a later post, when I will explain some changes that I made to FastMM4 (which hopefully will end up at sourceforge).
Thanks for your comment!
–jeroen
Stebi said
There is one problem in this implementation. You reimplement “IInterface” as it is already implemented in TComponent. The problem is that you don’t override the implementation completely. If you pass the object reference as a TDataModule or TComponent (anything before it became TInterfacedDataModule) and someone gets the IInterface-Reference out of this reference (using QueryInterface) he gets the default non reference counting implementation and not you new one. I think you could override QueryInterface to return the correct TInterfacedDataModule-IInterface.
jpluimers said
The problem is that QueryInterface is not always called: only when you cast with the as operator , see below for the different combinations.
So there is nothing you can do to completely work around your cast (from TInterfacedDataModule to any of its parent classes).
It is one of the reasons that you should not mix object references with interface references in one application.
Regards,
–jeroen