implements directive does not work in 64 bit version

157 views Asked by At

In Delphi, you can delegate the implementation of an interface to a class property. In the example, the TImplementator class implements the IImplementsInterface contract, aggregating the class - its real implementer (TImplementsForm), also monitoring its lifetime. The ButtonTestClick method shows that this works (for a long time, with dozens of interfaces) under Win32. Under Win64, calling procedures works, when calling functions we get an exception (AV)

  IImplementsInterface = interface
    ['{8E978167-9C0C-414F-BBE8-037D6D865575}']
    function GetResultAV: Integer;
    procedure TestOk;
  end;

  TImplementsForm = class(TForm, IImplementsInterface)
    ButtonTest: TButton;
    procedure ButtonTestClick(Sender: TObject);
  protected
    { IImplementsInterface }
    function GetResultAV: Integer;
    procedure TestOk;
  public
  end;

  TComponentAggregator<T: TComponent> = class(TInterfacedObject)
  private
    FComponent: T;
  public
    constructor Create;
    destructor Destroy; override;
  end;

  TCustomImplementator<T: TComponent> = class(TComponentAggregator<T>, IImplementsInterface)
  private
    function GetImplementator: IImplementsInterface;
  protected
    property Implementator: IImplementsInterface read GetImplementator implements IImplementsInterface;
  end;

  TImplementator = class(TCustomImplementator<TImplementsForm>, IImplementsInterface);

var
  ImplementsForm: TImplementsForm;

implementation

{$R *.dfm}

{ TComponentAggregator<T> }

constructor TComponentAggregator<T>.Create;
begin
  inherited Create;
  FComponent := T.Create(nil);
end;

destructor TComponentAggregator<T>.Destroy;
begin
  FComponent.Free;
  inherited Destroy;
end;

{ TImplementator }

function TCustomImplementator<T>.GetImplementator: IImplementsInterface;
begin
  Supports(FComponent, IImplementsInterface, Result);
end;

{ TImplementsForm }

procedure TImplementsForm.ButtonTestClick(Sender: TObject);
begin
  var LImplementsInterface: IImplementsInterface := TImplementator.Create; // LImplementsInterface - TImplementator as IImplementsInterface
  LImplementsInterface.TestOk;     // Ok x32, ok x64
  var LResult := LImplementsInterface.GetResultAV; // Ok x32, ACCESS_VIOLATION x64
end;

function TImplementsForm.GetResultAV: Integer;
begin
  Result := -1;
end;

procedure TImplementsForm.TestOk;
begin
  ShowMessage('TImplementsForm.Test');
end

How to achieve results under Win64

2

There are 2 answers

0
Stefan Glienke On

To be precise: the AV does not happen in the line you marked but after it during the epilogue of the method when the LImplementsInterface variable is about to get cleared.

Stepping through the code makes me believe this is some compiler glitch but I am not completely certain.

Anyhow: the implementation of IImplementsInterface in this line is superfluous and leads to this issue:

TImplementator = class(TCustomImplementator<TImplementsForm>, IImplementsInterface);

The interface was already implemented in the generic TCustomImplementator<T> class and the code will just work (*) when you remove it from TImplementator.

(*) as in there won't be an AV - you still have a memory leak because by using interface delegation you are also delegating the _AddRef/_Release calls and you are delegating them to a TComponent instance - that means you are leaking the TComponentAggregator instance that wraps your TComponent.

1
Виталий Биньковский On

Here the re-declaration of the interface is done in order to get the correct link on the left side, and not the TComponent. This works in Win32. And yes, I think you're right, it's a compiler error. Maybe with your authority we can reach out and fix it?