Delphi 2009，接口已经被释放。

Question

我希望有一个带接口的特殊记录。

并且，该接口具有子接口和一些类。因此，需要自动释放。 但是，在记录中的接口已经被释放了。

需要帮助，为什么引用计数不匹配？

我尝试下面的代码...

//--------------------------------------------------------------------

type
  IIn = interface
    procedure SetValue(v : string);
    function AsString() : string;
    function GetChild() : IIn;
  end;

  RIn = record
    FIn : IIn;

    procedure SetInterface(intf : IIn);
    procedure SetValue(v : string);
    function AsString() : string;
    function GetChild() : RIn;
  end;

  TIn = class(TInterfacedObject, IIn)
  private
    FChild : IIn;
    FValue : string;
  public
    procedure SetValue(v : string);
    function AsString() : string;
    function GetChild() : IIn;
  end;

//--------------------------------------------------------------------

//这是一条分割线，用于表示以下内容与上面的内容无关。

procedure RIn.SetInterface(intf : IIn);
begin
  FIn := intf;
end;

function RIn.GetChild() : RIn;
var
  childInterface : IIn;
begin
  if FIn = nil then FIn := TIn.Create();
  childInterface := FIn.GetChild();

  Result.SetInterface( childInterface );
end;

procedure RIn.SetValue(v : string);
begin
  if FIn = nil then FIn := TIn.Create();
  FIn.SetValue(v);
end;

function RIn.AsString() : string;
begin
  if FIn = nil then FIn := TIn.Create();

  Result := FIn.AsString();
end;

function RIn.GetRefCnt() : integer;
begin
  if FIn = nil then FIn := TIn.Create();

  Result := FIn.GetRefCnt();
end;

procedure TIn.SetValue(v : string);
begin
  FValue := v;
end;

function TIn.AsString() : string;
begin
  Result := FValue;
end;

function TIn.GetChild() : IIn;
begin
  if FChild = nil then FChild := TIn.Create();

  Result := FChild;
end;

//--------------------------------------------------------------------

这是一条分割线，用于区分不同的代码段。

// global var
var
  test : RIn;

// test procedure 1
procedure test1;
begin
  test.GetChild().SetValue('test...');
end;

// test procedure 2
procedure test2;
begin
  ShowMessage(   test.GetChild().AsString    );    <----- Error!! child interface is already released..
end;

- user2671565

---

你需要展示TIn.GetChild的代码。我猜测它返回TIn.FChild，但是它从未被创建并且是nil。这段代码似乎有很多令人困惑的部分。你可能需要描述一下你想要做什么来得到更好的答案。在记录中放置一个具有相同函数的接口只会带来麻烦。 - Mark Elder

function TIn.GetChild() : IIn; begin if FChild = nil then FChild := TIn.Create(); Result := FChild; end; <== ? 我写了这段代码... - user2671565

看起来像是 Delphi 2009 的一个 bug；可能是 test1 中有错误的终结代码。无法提供更多信息，需要时间进行调试。 - kludg

代码在Delphi-XE2中运行正常。 - LU RD

Answer 1

这是 Delphi 2009 的引用计数 bug。我稍微修改了您的代码以输出引用计数器：

program Bug2009;

{$APPTYPE CONSOLE}

uses
  SysUtils;

type
  IIn = interface
    procedure SetValue(v : string);
    function AsString() : string;
    function GetChild() : IIn;
  end;

  RIn = record
    FIn : IIn;

    procedure SetInterface(intf : IIn);
    procedure SetValue(v : string);
    function AsString() : string;
    function GetChild() : RIn;
  end;

  TIn = class(TInterfacedObject, IIn)
  private
    FChild : IIn;
    FValue : string;
  public
    procedure SetValue(v : string);
    function AsString() : string;
    function GetChild() : IIn;
  end;

procedure RIn.SetInterface(intf : IIn);
begin
  FIn := intf;
end;

function RIn.GetChild() : RIn;
var
  childInterface : IIn;
begin
  if FIn = nil then FIn := TIn.Create();
  childInterface := FIn.GetChild();
  Result.SetInterface( childInterface );
end;

procedure RIn.SetValue(v : string);
begin
  if FIn = nil then FIn := TIn.Create();
  FIn.SetValue(v);
end;

function RIn.AsString() : string;
begin
  if FIn = nil then FIn := TIn.Create();

  Result := FIn.AsString();
end;

procedure TIn.SetValue(v : string);
begin
  FValue := v;
end;

function TIn.AsString() : string;
begin
  Result := FValue;
end;

function TIn.GetChild() : IIn;
begin
  if FChild = nil then FChild := TIn.Create();
    Writeln(FChild._AddRef - 1);
    FChild._Release;
  Result := FChild;
end;

// global var
var
  test : RIn;

// test procedure 1
procedure test1;
begin
  test.GetChild().SetValue('test...');
end;

// test procedure 2
procedure test2;
begin
  Writeln(   test.GetChild().AsString    );   // <----- Error!! child interface is already released..
end;

begin
  try
    test1;
    test2;
  except
    on E: Exception do
      Writeln(E.ClassName, ': ', E.Message);
  end;
  readln;
end.

输出结果（Delphi 2009）为

在Delphi XE上进行相同的测试，输出结果为

可以看到引用计数器值不同。

- kludg

---

+1. 我认为这是 http://qc.embarcadero.com/wc/qcmain.aspx?d=90482 的体现。你是否验证了你的代码在 Delphi 2009 以后的版本中能够正常工作？请告诉我们。 - Jeroen Wiert Pluimers

@JeroenWiertPluimers - 我手头没有更多的 Delphi 版本了，有人可以运行我的答案中的测试并查看是否输出错误的 0 引用计数器。 - kludg

在 Delphi XE、XE2 和 XE4 中它运行良好。现在希望有 Delphi 2010 的人可以检查一下。 - Jeroen Wiert Pluimers