First the question: Why does the removal of const in UnregisterNode()
cause failure, but not in RegisterNode()
.
Now the background: I’m working in Delphi XE with Interfaces and I ran into an artifact that has given me some pause and I’ve come to the conclusion that I don’t really understand why.
An object that is accessed as an interface does not need to be explicitly freed. When the last reference goes out of scope, it is destroyed. That seems simple enough. I have written a test case to show variations that run as expected and two that fail. The six test cases are limited to variations on the Node parameter of the Register and Unregister methods.
Pressing the lone button on the form creates the container and three nodes. Operations are preformed on them to demonstrate the procedure
The program creates some simple nodes that link to a simple container. The problem happened in cases #1 and #6. When the node is being freed, it calls the containers Unregister()
method. The method deletes a copy of the pointer to the node in a TList. When leaving the method in the two failed cases it calls the node’s Destroy()
method recursively starting the process over again until a stack overflow occurs.
In the four cases that work the Destroy()
method is resumed as normal and the program will proceed and exit normally.
Failure #1 (Case 1)
procedure RegisterNode(Node:INode);
procedure UnregisterNode(Node:INode);
Calling the Unregister()
node from the TNode.Destroy()
method seems affect the reference count of the INode causing multiple calls to Destroy().
Why this happens I don’t understand. It does not happen when I Register()
the node with the same style of parameters.
Failure #2 (Case 6)
procedure RegisterNode(const Node:INode);
procedure UnregisterNode(Node:INode);
The same failure pattern happens here. Adding const to the parameter list as in Case 5 prevents the recursive calls to Destroy()
.
The code:
unit fMain;
{
Case 1 - Fails when a node is freed, after unregistering,
TNode.Destroy is called again
Case 2 - Passes
case 3 - Passes
Case 4 - Passes
Case 5 - Passes
Case 6 - Fails the same way as case 1
}
{$Define Case1}
{.$Define Case2}
{.$Define Case3}
{.$Define Case4}
{.$Define Case5}
{.$Define Case6}
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
INode = interface;
TNode = class;
IContainer = interface
['{E8B2290E-AF97-4ECC-9C4D-DEE7BA6A153C}']
{$ifDef Case1}
procedure RegisterNode(Node:INode);
procedure UnregisterNode(Node:INode);
{$endIf}
{$ifDef Case2}
procedure RegisterNode(Node:TNode);
procedure UnregisterNode(Node:TNode);
{$endIf}
{$ifDef Case3}
procedure RegisterNode(const Node:INode);
procedure UnregisterNode(const Node:INode);
{$endIf}
{$ifDef Case4}
procedure RegisterNode(const Node:TNode);
procedure UnregisterNode(const Node:TNode);
{$endIf}
{$ifDef Case5}
procedure RegisterNode(Node:INode);
procedure UnregisterNode(const Node:INode);
{$endIf}
{$ifDef Case6}
procedure RegisterNode(const Node:INode);
procedure UnregisterNode(Node:INode);
{$endIf}
end;
INode = interface
['{37923052-D6D1-4ED5-9AC0-F7FB0076FED8}']
procedure SetContainer(const Value:IContainer);
function GetContainer():IContainer;
procedure ReReg(const AContainer: IContainer);
procedure UnReg();
property Container : IContainer
read GetContainer write SetContainer;
end;
TContainer = class(TInterfacedObject, IContainer)
protected
NodeList: TList;
public
constructor Create(); virtual;
destructor Destroy(); override;
{$ifDef Case1}
procedure RegisterNode(Node:INode); virtual;
procedure UnregisterNode(Node:INode); virtual;
{$endIf}
{$ifDef Case2}
procedure RegisterNode(Node:TNode); virtual;
procedure UnregisterNode(Node:TNode); virtual;
{$endIf}
{$ifDef Case3}
procedure RegisterNode(const Node:INode); virtual;
procedure UnregisterNode(const Node:INode); virtual;
{$endIf}
{$ifDef Case4}
procedure RegisterNode(const Node:TNode); virtual;
procedure UnregisterNode(const Node:TNode); virtual;
{$endIf}
{$ifDef Case5}
procedure RegisterNode(Node:INode); virtual;
procedure UnregisterNode(const Node:INode); virtual;
{$endIf}
{$ifDef Case6}
procedure RegisterNode(const Node:INode); virtual;
procedure UnregisterNode(Node:INode); virtual;
{$endIf}
end;
TNode = class(TInterfacedObject, INode)
protected
FContainer : IContainer;
public
constructor Create(const AContainer: IContainer); virtual;
destructor Destroy(); override;
procedure SetContainer(const Value:IContainer); virtual;
function GetContainer():IContainer; virtual;
procedure ReReg(const AContainer: IContainer); virtual;
procedure UnReg(); virtual;
property Container : IContainer
read GetContainer write SetContainer;
end;
TForm1 = class(TForm)
btnMakeStuff: TButton;
procedure btnMakeStuffClick(Sender: TObject);
private
{ Private declarations }
MyContainer : IContainer;
MyNode1,
MyNode2,
MyNode3 : INode;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
{ TContainer }
constructor TContainer.Create();
begin
inherited;
NodeList := TList.Create();
end;
destructor TContainer.Destroy();
var
i : integer;
begin
for i := 0 to Pred(NodeList.Count) do
INode(NodeList.Items[i]).Container := nil; //Prevent future Node from contacting container
NodeList.Free();
inherited;
end;
{$ifDef Case1}
procedure TContainer.RegisterNode(Node:INode);
{$endIf}
{$ifDef Case2}
procedure TContainer.RegisterNode(Node:TNode);
{$endIf}
{$ifDef Case3}
procedure TContainer.RegisterNode(const Node:INode);
{$endIf}
{$ifDef Case4}
procedure TContainer.RegisterNode(const Node:TNode);
{$endIf}
{$ifDef Case5}
procedure TContainer.RegisterNode(Node:INode);
{$endIf}
{$ifDef Case6}
procedure TContainer.RegisterNode(const Node:INode);
{$endIf}
begin
NodeList.Add(pointer(Node));
end;
{$ifDef Case1}
procedure TContainer.UnregisterNode(Node:INode);
{$endIf}
{$ifDef Case2}
procedure TContainer.UnregisterNode(Node:TNode);
{$endIf}
{$ifDef Case3}
procedure TContainer.UnregisterNode(const Node:INode);
{$endIf}
{$ifDef Case4}
procedure TContainer.UnregisterNode(const Node:TNode);
{$endIf}
{$ifDef Case5}
procedure TContainer.UnregisterNode(const Node:INode);
{$endIf}
{$ifDef Case6}
procedure TContainer.UnregisterNode(Node:INode);
{$endIf}
var
i : integer;
begin
i := NodeList.IndexOf(pointer(Node));
if i >= 0 then
NodeList.Delete(i);
end;
{ INode }
constructor TNode.Create(const AContainer: IContainer);
begin
ReReg(AContainer);
end;
destructor TNode.Destroy();
begin {When failing, after unregistering, it returns here !!!!}
if Assigned(FContainer) then begin
FContainer.UnregisterNode(self);
end;
inherited;
end;
function TNode.GetContainer(): IContainer;
begin
Result := FContainer;
end;
procedure TNode.ReReg(const AContainer: IContainer);
begin
if Assigned(AContainer) then
AContainer.RegisterNode(Self);
FContainer := AContainer;
end;
procedure TNode.SetContainer(const Value: IContainer);
begin
if Assigned(FContainer) then
FContainer.UnregisterNode(self);
FContainer := Value;
FContainer.RegisterNode(self);
end;
procedure TNode.UnReg();
begin
if Assigned(FContainer) then
FContainer.UnregisterNode(self);
FContainer := nil;
end;
{ TForm1 }
procedure TForm1.btnMakeStuffClick(Sender: TObject);
begin
MyContainer := TContainer.Create();
MyNode1 := TNode.Create(MyContainer);
MyNode2 := TNode.Create(MyContainer);
MyNode3 := TNode.Create(MyContainer);
MyNode2.UnReg(); //Breakpoint here
MyNode2.ReReg(MyContainer); //Breakpoint here
MyNode3 := nil; //Case 1 & 6 cause a stackoverflow
MyNode2 := nil;
end;
end.
The const directive on a parameter indicates that the procedure/function will not modify the value supplied in that parameter. If the procedure or function wishes to manipulate any const parameter it will first have to copy that value to a local variable.
This allows the compiler to perform some optimisations on such parameters, particularly in the area of reference types such as strings and interfaces etc.
With interfaces specifically, since the parameter is declared const it is impossible for the value of the interface reference passed to be modified during the "lifetime" of the parameter (since the compiler will reject any code that tries to modify the value), thus the compiler is able to eliminate the calls to AddRef() and Release() that would other wise be generated as prolog and epilog in that procedure.
Note however that within the body of the procedure if the reference is assigned to other variables then the reference count could still change. The const optimisation simply eliminates the possible need for one AddRef/Release pair.
This difference in reference counting behaviour between const and non-const parameters is obviously having some side effect or other interaction with the other complexities in your code but now understanding the effect of const you might be able to determine how/where you may have gone wrong elsewhere.
In fact, I can tell you where you have gone wrong. :)
You should never directly cast an interface reference to/from any other type (interface or pointer or otherwise) unless you are very VERY sure of what you are doing. You should always use as or QueryInterface() to cast from one interface type to another:
otherRef := fooRef as IOther;
And you should always use IUnknown (or IInterface) as an 'untyped' interface reference, not a pointer. This ensures that your references are all property accounted for. (there are times when you want an uncounted reference and thus would use a type-cast pointer reference, but that is very advanced voodoo).
In your sample code, the casting to/from pointer type to maintain them in a TList is subverting the reference counting mechanism and in conjunction with the variations in const/non-const parameters is leading to the side effects you are seeing.
To maintain properly counted references to interfaces in a list, use an interface friendly list class such as TList<Interface Type> or TInterfaceList (if you don't like generics, don't have them available to you, or may need to share your code with someone that doesn't).
Footnote:
Also beware: The destruction of an object when the interface reference count drops to zero is not necessarily quite as automatic as you think.
It is an implementation detail of the particular interfaced object class. If you inspect the source of the _Release() implementation on TInterfacedObject you will see how this is possible.
Simply put, the object itself is responsible for destroying itself when it's own reference count reaches zero. In fact, the object is even responsible for implementing the reference count in the first place! It is perfectly possible therefore (and sometimes desirable) for a specialised class to override or replace this behaviour in which case how it responds to a zero reference count (or indeed whether it even bothers to maintain a reference count as such) is entirely up to its own needs.
Having said that, the overwhelming majority of objects that implement interfaces will almost certainly use this form of auto-destruction, but it should not simply be assumed.
What should be safe to assume is that if you are given an interface reference to an object, you would not normally be concerned with how that object will ultimately be destroyed. But that is not the same as saying you can assume it will be destroyed when the interface reference count reaches zero.
I mention this because being aware of how all this apparent "compiler magic" works can be critical to understanding problems such as those you have run into in this case.
Your original question and the follow up in the comments to this answer all hinge on Delphi's interface reference counting mechanism.
The compiler emits code to arrange that all references to an interface are counted. Whenever you take a new reference, the count is increased. Whenever a reference is released (set to nil
, goes out of scope etc.) the count is decreased. When the count reaches zero, the interface is released and in your case this is what calls Free
on your objects.
Your problem is that you are cheating the reference counting by putting interface references into and out of the TList
by casting to Pointer
and back. Somewhere along the way the references are miscounted. I'm sure your code's behaviour (i.e. the stack overflows) could be explained but I am disinclined to attempt to do so since the code uses such obviously incorrect constructs.
Simply put you should never cast an interface to an unmanaged type like Pointer
. Whenever you do so you also need to take control of the missing reference counting code. I can assure you this is something you do not want to take on!
You should use a proper type-safe container like TList<INode>
or even a dynamic array and then the reference counting will be handled correctly. Making this change to your code solves the problems you describe in the question.
However, there still remains one big problem, as you have discovered for yourself and detailed in the comments.
Once you follow the reference counting rules, you are faced with the problem of circular references. In this case a node holds a reference to the container which in turn holds a reference to the node. Circular references like this cannot be broken by the standard reference counting mechanism and you have to break them yourself. Once you break one of the two individual references that make up a circular reference, the framework can do the rest.
With your current design you must break the circular references by explicitly calling UnReg
on every INode
that you create.
The other problem with the code as it stands is that you are using data fields of the form to hold MyContainer
, MyNode
etc. Because you never set MyContainer
to nil
then two executions of your event handler will result in a leak.
In made the following changes to your code to prove that it will run without leaking:
TContainer = class(TInterfacedObject, IContainer)
protected
NodeList: TList<INode>;//switch to type-safe list
...
procedure TContainer.RegisterNode(Node:INode);
begin
//must ensure we don't add the node twice
if NodeList.IndexOf(Node) = -1 then
NodeList.Add(Node);
end;
...
procedure TForm1.btnMakeStuffClick(Sender: TObject);
//make the interfaces local variables although in production
//code they would likely be fields and construction would happen
//in the constructor of the owning object
var
MyContainer: IContainer;
MyNode1, MyNode2, MyNode3: INode;
begin
MyContainer := TContainer.Create;
MyNode1 := TNode.Create(MyContainer);
MyNode2 := TNode.Create(MyContainer);
MyNode3 := TNode.Create(MyContainer);
MyNode1.UnReg;
MyNode1.ReReg(MyContainer);
MyNode2.UnReg;
MyNode3.UnReg;
MyNode2.ReReg(MyContainer);
MyNode1.UnReg;
MyNode2.UnReg;
end;
With these changes the code runs without memory leaks – set ReportMemoryLeaksOnShutdown := True
at the start of the .dpr file to check.
It is going to be something of a bind to have to call UnReg
on every node so I suggest that you simply add a method to IContainer
to do that. Once you arrange that the container is capable of dropping its references then you will have a much more manageable system.
You will not be able to let reference counting do all the work for you. You will need to call IContainer.UnRegAllItems
explicitly.
You can implement this new method like this:
procedure TContainer.UnRegAllItems;
begin
while NodeList.Count>0 do
NodeList[0].UnReg;
end;
Although the Delphi reference counting mechanism is very well implemented in general, there is, to my knowledge, one long-standing and very well-known bug.
procedure Foo(const I: IInterface);
begin
I.DoSomething;
end;
...
Foo(TInterfacedObject.Create);
When Foo
called in this way no code is generated to add a reference to the interface. The interface is thus released as soon as it is created and Foo
acts on an invalid interface.
Because Foo
receives the parameter as const
, Foo
does not take a reference to the interface. The bug is in the codegen for the call to Foo
which mistakenly does not take a reference to the interface.
My preferred way to work around this particular problem is like this:
var
I: IInterface;
...
I := TInterfacedObject.Create;
Foo(I);
This succeeds because we explicitly take a reference.
Note that I have explained this for future reference – your current code does not fall foul of this problem.
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With