delphi 2009, interface already released

delphi, interface, memory-management, record

Solution

It is Delphi 2009 reference counting bug. I modified your code a little to output reference counters:

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.

The output (Delphi 2009) is

The same test on Delphi XE outputs

See different reference counter values

Problem

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; ```

Original source