delphi - delphi 2009, interface already released

Question

I want special record that is have interface.

and, the interface has child interface and some class. so, need auto release. but, interface in record is already released.

need help, why reference count is missmatch ?

I try next code...

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

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;

Answer 1

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

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 输出的相同测试

查看不同的参考计数器值