4

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;
4
  • 1
    You need to show the code for TIn.GetChild. I am guessing that returns TIn.FChild and that was never created and is nil. There seems to be a lot of confusing parts of this code. You may want to describe what you are trying to do to get a better answer. Putting an interface in a record with the same functions is just asking for trouble.
    – Mark Elder
    Aug 11, 2013 at 4:35
  • function TIn.GetChild() : IIn; begin if FChild = nil then FChild := TIn.Create(); Result := FChild; end; <== ? I Wrote this code.... Aug 11, 2013 at 5:39
  • 1
    Looks like Delphi 2009 bug; probably buggy finalization code in test1. Can't say more, need time to debug.
    – kludg
    Aug 11, 2013 at 5:52
  • 1
    Code works in Delphi-XE2.
    – LU RD
    Aug 11, 2013 at 6:38

1 Answer 1

7

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

Bug2009

The same test on Delphi XE outputs

No bug Delphi XE

See different reference counter values

3
  • +1. I think this is a manifestation of qc.embarcadero.com/wc/qcmain.aspx?d=90482 Did you verify your code to work in Delphi versions younger than Delphi 2009? Please let us know. Aug 11, 2013 at 9:29
  • @JeroenWiertPluimers - have no more Delphi versions at hand, anyone can run the test in my answer and see if it outputs buggy 0 refcounter.
    – kludg
    Aug 11, 2013 at 14:49
  • In Delphi XE, XE2 and XE4 it works fine. Now hopefully someone with Delphi 2010 can check it. Aug 11, 2013 at 17:22

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.