Господа, можете подсказать, почему код ниже в Lazarus выдаёт ошибку а в Delphi (любой версии) нет ?
Вызов uTest3.Test;
В FPC на строке T.Free; будет Access violation (а точнее не сразу а после выхода из функции)
Соответственно если закоментить то всё работает но утечка...(
Код: Выделить всё
unit uTest3;
interface
uses
Classes, SysUtils;
type
IMyTable = interface
function GetTableName: String;
function GetImplementor: TObject;
end;
TMyXXXTable = class(TObject, IMyTable)
private
function GetTableName: String;
function GetImplementor: TObject;
protected
function QueryInterface({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} IID: TGUID; out Obj): Longint; virtual; stdcall;
function _AddRef: Integer; virtual; stdcall;
function _Release: Integer; virtual; stdcall;
end;
function Test: String;
implementation
{ TMyXXXTable }
function TMyXXXTable.GetTableName: String;
begin
Result := 'XXX';
end;
function TMyXXXTable.GetImplementor: TObject;
begin
Result := Self;
end;
function TMyXXXTable.QueryInterface({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} IID: TGUID; out Obj): Longint; stdcall;
begin
if GetInterface(IID, Obj) then
Result := S_OK
else
Result := E_NOINTERFACE;
end;
function TMyXXXTable._AddRef: Integer; stdcall;
begin
Result := -1;
end;
function TMyXXXTable._Release: Integer; stdcall;
begin
Result := -1;
end;
function GetTable: IMyTable;
begin
Result := TMyXXXTable.Create;
end;
procedure ReleaseTable(var Table: IMyTable);
var
T: TMyXXXTable;
begin
if Table.GetImplementor is TMyXXXTable then
begin
T := Table.GetImplementor as TMyXXXTable;
T.Free; // FPC ???
end;
end;
function Test: String;
var
TT: IMyTable;
begin
TT := GetTable;
Result := TT.GetTableName;
ReleaseTable(TT);
end;
end.
