Question

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.

Answer 1

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.