Неприятная ситуация с самоуничтожающимеся интерфейсами

[Altera]

Всем привет!
Приведу прямо здесь небольшой код, который описывает проблемку с которой я вчера столкнулся.
Допустим имеет место следующая структура программы:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  IPrimaryObject = interface
    procedure SomeProcedure;
  end;

  TPrimaryObject = class(TInterfacedObject, IPrimaryObject)
  protected
    fList: tList;

    procedure SomeProcedure;
  private
    constructor create;
    destructor destroy; override;
  end;

  TSecondaryObject = class
  protected
    fPrimaryObject: IPrimaryObject;
  public
    procedure SetInterface(const aPrimaryObject: IPrimaryObject);

    procedure CallSomeProcedure;
  end;


  TForm1 = class(TForm)
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
    PrimaryObject: TPrimaryObject;
    SecondaryObject: TSecondaryObject;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
  SecondaryObject.CallSomeProcedure;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  SecondaryObject := TSecondaryObject.create;
  PrimaryObject := TPrimaryObject.create;

  SecondaryObject.SetInterface(PrimaryObject);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  PrimaryObject.Free;
  SecondaryObject.Free;
end;

{ TPrimaryObject }

constructor TPrimaryObject.create;
begin
  fList := tList.Create;
end;

destructor TPrimaryObject.destroy;
begin
  fList.Free;
  inherited;
end;

procedure TPrimaryObject.SomeProcedure;
begin
  ShowMessage('Hello World!');
end;

{ TSecondaryObject }

procedure TSecondaryObject.CallSomeProcedure;
begin
  fPrimaryObject.SomeProcedure;
end;

procedure TSecondaryObject.SetInterface(const aPrimaryObject: IPrimaryObject);
begin
  fPrimaryObject := aPrimaryObject;
end;

end.

Есть Первостепенный и Второстепенный объекты.
Первостепенный, он у нас главный, имеет свой интерфейс управления, который, который передаётся второстепенным объектам. (В роле второстепенного объекта может быть скажем GUI модуль, а в роли первостепенного - исполнительное ядро)
Короче, TSecondaryObject принимает ссылку на интерфейт aka экземпляр объекта и хранит её в себе. Вся суть в том, что Delphi, по чьей-то милости, ведёт подсчёт ссылок на экземпляры объектов интерфейсов и уничтожает те, на которые никто не ссылается. Но я и сам их уничтожаю неплохо, паричём мне нужно уничтожить их не в тот момент, когда этого Delphi захочется, а когда это нужно. Вообщем при закрытии программы получаес AV, т.к. дважды вызывается TPrimaryObject.destroy (первый раз я его сам вызываю, второй раз он вызывается при уничтожени второстепенного объекта)
Есть 2 выхода:
Прописать в TPrimaryObject пустые _AddRef и _Release, ну или просто _Release, или не вызывать вручную TPrimaryObject.free;
Лично я реализовал первое.

Внимание, вопрос! Нету там случай-но каких-0нить директив компилятора, что-бы Delphi не добавляла бы ненужный код там где он как-бы не нужен?

[mutabor]

С интерфейсами не работал почти. Но ты не путаешь? Для простых объектов в Дельфи нет сборки мусора, откуда она будет для интерфейсных? А при закрытии программы и обычные объекты (у к-рых есть Owner) автоматом уничтожаются, Owner вызывает по цепочке Destroy методы, и если объект до этого вручную уничтожишь, точно так же получишь AV.

p.s. Я мог тут ерунды написать, а может и нет, может идея какая появится.

[Altera]

Сообщение от mutabor

С интерфейсами не работал почти. Но ты не путаешь? Для простых объектов в Дельфи нет сборки мусора, откуда она будет для интерфейсных? А при закрытии программы и обычные объекты (у к-рых есть Owner) автоматом уничтожаются, Owner вызывает по цепочке Destroy методы, и если объект до этого вручную уничтожишь, точно так же получишь AV.

p.s. Я мог тут ерунды написать, а может и нет, может идея какая появится.

Есть такой класс: TInterfacedObject, который реализует IInterface

IInterface = interface
    ['{00000000-0000-0000-C000-000000000046}']
    function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
    function _AddRef: Integer; stdcall;
    function _Release: Integer; stdcall;
  end;

TInterfacedObject = class(TObject, IInterface)
  protected
    FRefCount: Integer;
    function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
    function _AddRef: Integer; stdcall;
    function _Release: Integer; stdcall;
  public
    procedure AfterConstruction; override;
    procedure BeforeDestruction; override;
    class function NewInstance: TObject; override;
    property RefCount: Integer read FRefCount;
  end;
...

function TInterfacedObject._AddRef: Integer;
begin
  Result := InterlockedIncrement(FRefCount);
end;

function TInterfacedObject._Release: Integer;
begin
  Result := InterlockedDecrement(FRefCount);
  if Result = 0 then
    Destroy;
end;

Как только появляется новая ссылка на на интерфейс, сразу-же вызывается _AddRef, а как только ссылка пропадает - _Release

Т.е. вот в таком коде утечек памяти не будет:

procedure DoSomthing;
var
  BaseInterface: IInterface;
begin
  BaseInterface := TInterfacedObject.create;
end;

Возможно такой финт нужен при работе с ActiveX и т.п. Там наверное интерфейсы самоуничтожающиеся, но в обычном приложении...

[Sanprof]

Если вы читали внимательно документацию по интерфейсам, то там написано, что категорически запрещено освобождать ссылки на интерфейс методом Free, только присвоением ссылке nil.

ComInter: Variant;
.....
ComInter := CreateComObJect(CLASS_ВашКоКласс) as IВашКласс;
ComInter.Free; //<- так нельзя
ComInter := nil; // а так корректно

[Altera]

Сообщение от Sanprof

Если вы читали внимательно документацию по интерфейсам, то там написано, что категорически запрещено освобождать ссылки на интерфейс методом Free, только присвоением ссылке nil.

ComInter: Variant;
.....
ComInter := CreateComObJect(CLASS_ВашКоКласс) as IВашКласс;
ComInter.Free; //<- так нельзя
ComInter := nil; // а так корректно

Это я видел. А ты чем тут клаву топтать, взял бы и поробовал. Я же сказал что имеет большое значение порядок уничтожения объектов. Твоим способом порядок нарушается.

Попробуй своим способом сначала уничтожить первый объект, а потом уже второй

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  IPrimaryObject = interface
    procedure SomeProcedure;
  end;

  TPrimaryObject = class(TInterfacedObject, IPrimaryObject)
  protected
    fList: tList;

    procedure SomeProcedure;
  private
    constructor create;
    destructor destroy; override;
  end;

  TSecondaryObject = class
  protected
    fPrimaryObject: IPrimaryObject;
  public
    destructor destroy; override;

    procedure SetInterface(const aPrimaryObject: IPrimaryObject);

    procedure CallSomeProcedure;
  end;

  TForm1 = class(TForm)
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
    PrimaryObject: TPrimaryObject;
    SecondaryObject: TSecondaryObject;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
  SecondaryObject.CallSomeProcedure;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  try

  PrimaryObject := nil;
  SecondaryObject.Free;

  finally
    halt;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  SecondaryObject := TSecondaryObject.create;
  PrimaryObject := TPrimaryObject.create;

  SecondaryObject.SetInterface(PrimaryObject);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin

end;

{ TPrimaryObject }

constructor TPrimaryObject.create;
begin
  fList := tList.Create;
end;

destructor TPrimaryObject.destroy;
begin
  showMessage('Скачало уничтожаем TPrimaryObject');
  fList.Free;
  inherited;
end;

procedure TPrimaryObject.SomeProcedure;
begin
  ShowMessage('Hello World!');
end;

{ TSecondaryObject }

procedure TSecondaryObject.CallSomeProcedure;
begin
  fPrimaryObject.SomeProcedure;
end;

destructor TSecondaryObject.destroy;
begin
  showMessage('А уже потом TSecondaryObject');
  inherited;
end;

procedure TSecondaryObject.SetInterface(const aPrimaryObject: IPrimaryObject);
begin
  fPrimaryObject := aPrimaryObject;
end;

end.

И это ещё простая ситуация. А представь, если несколько объектов обмениваются друг с другом своими интерфейсами?
+++++++++++++++++
Очень плохой способ. Вообще не годится. Хрен поймёшь когда он что уничтожает. Совершенно не в том порядке в котором нужно. Если ничего более существенное предложить не можете....

[Sanprof]

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  try

  SecondaryObject := nil;//не уверен но походу надо так
  PrimaryObject := nil;
  //SecondaryObject.Free; <-я так понимаю на этой строке AV
  
  finally
    halt;
  end;
end;

[Sibedir]

Во-первых, Altera, я категорически одобряю ваше негодование. Вообще, чем больше занимаюсь ООП, тем меньше оно мне нравится. И это не веяния моды или понты. Сам до этого дошел, а уж потом стали и статейки соответствующие в нэте попадаться.
Вот из-за таких "генеальных" разработчиков технологий программирования по настоящему толковых прогеров по пальцам пересчитать. Понапихают ненужого кода в мою же программу, а я мож и не хочу. Так нет же блин.
А еще после таких вот приколов и начинаешь замечать в диспетчере задачь давно закрытые Word'ы, AcrobatReader'ы и иже с ними...
Я чё это все вслух сказал?
Так с гневными мыслями покончено, к делу.

Во-вторых:
Не понял, чем вам не нравится := nil вместо .Free. Я в вашем первом коде, по совету Sanprof, всего одну строчку подправил

  PrimaryObject := nil;

и все заработало.

В-третьих:
Вы вроди не маленький уже. Я вас как форумчанина давно знаю, самого первого прихода (Ну да-да, каюсь. Были у меня приходы на форуме. Но я ж не один такой). А наступаете, мне так по крайней мере кажется, на грабли новичков (Надо будет, кстати, Alar'у сказать, чтоб он грабли подписал. А то бирут все подряд, скоро замутызгают). Расскажите нам, как на духу, в чем ваша проблема. Может она вкорни по другому решается.

[evg_m]

TSecondaryObject = class
  protected
    fPrimaryObject: IPrimaryObject;
  public
    procedure SetInterface(const aPrimaryObject: IPrimaryObject);

    procedure CallSomeProcedure;
  end;

если мы используем интерфейс

  fPrimaryObject: IPrimaryObject;
  public
    procedure SetInterface(const aPrimaryObject: IPrimaryObject);

то мы его должны и освободить (например при разрушении объекта)

procedure TSecondaryObject.Destroy;
begin 
  fPrimaryObject:=nil; 
end;

а уж TPrimary сам разрушится в СООТВЕТСТВИИ с логикой и правилами интерфейсных объектов

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  try

  PrimaryObject := nil; //освободили одну ссылку 
  SecondaryObject.Free; // освободили другую ссылку (см. Destoy);
// есои переставить ничего не изменииться 

  finally
    halt;
  end;
end;

[Altera]

У меня программа разделена на модули, которые общаются между собой по средствам интерфейсов. //Тут же всё понятно?
Т.к. модуль А пользуется интерфейсом модуля Б, поэтому надо сначала модуль А уничтожать, а потом уже Б. А тут получается, если nil присваивать, что сначала Б уничтожается, а потом уже А. При уничтожении А вызываются функции которые используют тот самый интерфейс модуля Б и там возникает AV //Что здесь не понятно. Да. в вышепреведённом коде AV не возникает, но это просто модель.

Вот попробуйте скомпилить код в посте #5. Увидете, что сообщения показываются не в нужном порядке.

Я рушил это проблему просто описав пустые методы _addRef и _Release. Меня и так устраивает потому что утечек памяти нету. Но я спрашиваю, более красивого способа нету?

[Sanprof]

Сообщение от Altera

Увидете, что сообщения показываются не в нужном порядке.

а по другому и не получится, так как сначала вызывается деструктор TSecondaryObject, а уже потом TPrimaryObject, а происходит это потому, что TPrimaryObject держит ссылку на интерфейс.