Search code examples
delphidelphi-7

Interfaced object being dumped from memory


We have a funny one.

program Project1;

{$APPTYPE CONSOLE}

uses
  SysUtils;

type
  ITestInterface = interface(IInvokable)
    ['{4059D1CD-A342-48EE-B796-84B8B5589AED}']
    function GetPort: string;
    function GetRoot: string;
  end;

  TTestInterface = class(TInterfacedObject, ITestInterface)
  private
    FPort: string;
    FRoot: string;
  public
    constructor Create(FileName: TFileName);
    destructor Destroy; override;

    function GetPort: string;
    function GetRoot: string;
  end;

{ TTestInterface }

constructor TTestInterface.Create(FileName: TFileName);
begin
  FPort := '8080';
  FRoot := 'top';
end;

destructor TTestInterface.Destroy;
begin
  // ^ Place Breakpoint here
  inherited;
end;

function TTestInterface.GetPort: string;
begin
  Result := FPort;
end;

function TTestInterface.GetRoot: string;
begin
  Result := FRoot;
end;

type
  TTestService = class
  protected
    FTest : TTestInterface;
  public
    constructor Create;
    destructor Destroy; override;

    procedure Process;
  end;

{ TTestService }

constructor TTestService.Create;
begin
  FTest := TTestInterface.Create('');
  (FTest as IInterface)._AddRef;
end;

destructor TTestService.Destroy;
begin
  FTest.Free;
  inherited;
end;

procedure TTestService.Process;
begin
  writeln( 'Config Root: ', FTest.GetRoot );
  writeln( 'Config Port: ', FTest.GetPort );
end;

var
  TS : TTestService;
begin
  TS := TTestService.Create;
  try
    TS.Process;
  finally
    TS.Free;
  end;
end.

When this application finishes it generates an Invalid Pointer Operation. The really strange part is that setting a break point on the destructor, you can see that it generates the error the first time it gets called, which rules out it being freed twice. It is almost as if the object is dumped from memory without calling the destructor at all.

By removing the _AddRef everything works as expected.

We managed to produce this on Delphi 6. Can anyone confirm this behavior on any other version?


Solution

  • Use two variables: one for the class, and one for the interface.

    • Use the interface variable to manage the instance lifetime. Don't call free, but set the interface variable to nil (or out of scope) to let the instance running.
    • Use the class variable to have direct raw access to the instance, if needed - but it shouldn't be the case, or at least let the class be accessible only from protected/private members of the owner class.

    So your code becomes:

    type
      TTestService = class
      protected
        FTest: ITestInterface;
        FTestInstance : TTestInterface;
      public
        constructor Create;
    
        procedure Process;
      end;
    
    { TTestService }
    
    constructor TTestService.Create;
    begin
      FTestInstance := TTestInterface.Create('');
      FTest := FTestInstance;
    end;
    
    procedure TTestService.Process;
    begin
      writeln( 'Config Root: ', FTest.GetRoot );
      writeln( 'Config Port: ', FTest.GetPort );
    end;
    
    var
      TS : TTestService;
    begin
      TS := TTestService.Create;
      try
        TS.Process;
      finally
        TS.Free;
      end;
    end.