En Delphi, ¿por qué pasar una variable de interfaz a veces requiere que sea un parámetro constante?
Primero la pregunta: ¿Por qué la eliminación de const enUnregisterNode()
causa falla, pero no enRegisterNode()
.
Ahora, en el fondo: estoy trabajando en Delphi XE con Interfaces y me encontré con un artefacto que me detuvo y llegué a la conclusión de que realmente no entiendo por qué.
Un objeto al que se accede como una interfaz no necesita ser liberado explícitamente. Cuando la última referencia queda fuera de alcance, se destruye. Eso parece bastante simple. He escrito un caso de prueba para mostrar variaciones que se ejecutan como se esperaba y dos que fallan. Los seis casos de prueba están limitados a variaciones en el parámetro Node de los métodos Registrar y Anular registro.
Presionando el botón solitario en el formulario crea el contenedor y tres nodos. Se realizan operaciones sobre ellos para demostrar el procedimiento
El programa crea algunos nodos simples que se vinculan a un contenedor simple. El problema ocurrió en los casos 1 y 6. Cuando se libera el nodo, llama a los contenedoresUnregister()
método. El método elimina una copia del puntero al nodo en un TList. Al dejar el método en los dos casos fallidos, llama al nodo delDestroy()
método inicia el proceso de forma recursiva nuevamente hasta que se produce un desbordamiento de la pila.
En los cuatro casos que funcionan elDestroy()
l método @ se reanuda normalmente y el programa continuará y saldrá normalmente.
Falla n. ° 1 (Caso 1)
procedure RegisterNode(Node:INode);
procedure UnregisterNode(Node:INode);
Calling theUnregister()
nodo de laTNode.Destroy()
l método @ parece afectar el recuento de referencia del INode causando múltiples llamadas aDestroy().
Por qué sucede esto no lo entiendo. No sucede cuando yoRegister()
el nodo con el mismo estilo de parámetros.
Falla # 2 (Caso 6)
procedure RegisterNode(const Node:INode);
procedure UnregisterNode(Node:INode);
El mismo patrón de falla sucede aquí. Agregar const a la lista de parámetros como en el caso 5 evita las llamadas recursivas aDestroy()
.
El código
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.