VPF::Supports убивает объект - Форум программистов

skyboy

Дата 22.5.2007, 09:10 (ссылка)

(нет голосов)

Загрузка ...

неОпытный

Профиль
Группа: Модератор
Сообщений: 9820
Регистрация: 18.5.2006
Где: Днепропетровск

Репутация: 4
Всего: 260

есть код:

Код


program Project2;

{$APPTYPE CONSOLE}

uses
  SysUtils,Classes,Contnrs;

type

  TinterfacedObjectEx = class(TInterfacedObject)
  protected
    function _addRef: Integer; stdcall;
    function _release: Integer; stdcall;
  end;

  IFoo = interface(IInterface)['{0F08CAC6-21C2-4265-8510-5F52E6296A0E}']
    procedure Foo; stdcall;
  end;

  TBar = class(TinterfacedObjectEx, IFoo)
  protected
    procedure Foo; stdcall;
  public
    destructor Destroy; override;
  end;

destructor TBar.Destroy;
begin
  inherited;
end;

procedure TBar.Foo;
begin
 Writeln('FooBar');
end;

function TinterfacedObjectEx._addRef: Integer;
begin
  Result := -1;
end;

function TinterfacedObjectEx._release: Integer;
begin
  Result := -1;
end;

const N= 5;
var lst: TObjectList;
    i: integer;
begin
 lst := TObjectList.Create;
 try
  for i:=1 to N do
   lst.Add(TBar.Create);
  for i:=1 to lst.Count do
   if Supports(lst.Items[i - 1]{.ClassType -- если это раскомментировать, то все работает как надо},IFoo)
    then
     ((lst.Items[i - 1] as TInterfacedObject) as IFoo).Foo; // тут выскакивает "invalid class cast", хотя на самом деле проблема в том, что объект был удален двумя строчками выше сразу после отработки supports
 finally
   lst.Free;
 end;  // try
 readln;
end.

Проблема в том, что применение supports(функция, применяемая для определения, поддерживает ли объект указанный интерфейс) вызывается деструктор объекта. Решил было, что это каким-то боком связано с управляемым временем жизни интерфейсов(я про тот механизм подсчета ссылок, который позволяет удалить объект, когда никто на него не ссылается), потому создал свой класс TInterfacedObjectEx, где перекрыл метод подсчета ссылок, чтоб объект не удалялся в зависимости от количества ссылок. Но это не помогло.
Объясните, пожалуйста, почему удаляется объект.

pseud

Дата 22.5.2007, 09:28 (ссылка)

(нет голосов)

Загрузка ...

Экспёрт Тыдыщ

Профиль
Группа: Завсегдатай
Сообщений: 1175
Регистрация: 18.5.2007
Где: Минск, Беларусь

Репутация: 10
Всего: 40

Цитата(skyboy @ 22.5.2007, 09:10

)

if Supports(lst.Items[i - 1]{.ClassType -- если это раскомментировать, то все работает как надо},IFoo)

Код


function Supports(const Instance: IInterface; const IID: TGUID; out Intf): Boolean; overload;
function Supports(const Instance: TObject; const IID: TGUID; out Intf): Boolean; overload;
function Supports(const AClass: TClass; const IID: TGUID): Boolean; overload;

В твоем случае используется 3й перегруженный метод. Соответственно ему нужен параметр TClass. А ты подсовываешь TObject.
Раз с (.ClassType) все работает ОК. То и пусть работает.

Может я чего не допонял...

--------------------

Испытание чужого терпения можно считать успешным, если оно лопнуло...

MetalFan

Дата 22.5.2007, 11:52 (ссылка)

(голосов:1)

Загрузка ...

Аццкий Сотона

Профиль
Группа: Комодератор
Сообщений: 3815
Регистрация: 2.10.2006
Где: Moscow

Репутация: 62
Всего: 128

хм... а не проще:
1) вместо TObjectList - TInterfaceList
1) вместо Supports и кучи as'ов вызывать QueryInterface

--------------------

There are always someone smarter than you...

skyboy

Дата 22.5.2007, 21:26 (ссылка)

(нет голосов)

Загрузка ...

неОпытный

Профиль
Группа: Модератор
Сообщений: 9820
Регистрация: 18.5.2006
Где: Днепропетровск

Репутация: 4
Всего: 260

Цитата(pseud @ 22.5.2007, 08:28

)

В твоем случае используется 3й перегруженный метод.

а вот и не угадал. полный список:

Код


function Supports(const Instance: IInterface; const IID: TGUID; out Intf): Boolean; overload;
function Supports(const Instance: TObject; const IID: TGUID; out Intf): Boolean; overload;
function Supports(const Instance: IInterface; const IID: TGUID): Boolean; overload;
function Supports(const Instance: TObject; const IID: TGUID): Boolean; overload;
function Supports(const AClass: TClass; const IID: TGUID): Boolean; overload;

в моем случае используется способ №5.
а ошибка возникает при обращении к уже удаленному объекту(о чем я писал); если бы не совпадал тип аргументов - была бы ошибка времени компиляции ;)

Цитата(MetalFan @ 22.5.2007, 10:52

)

хм... а не проще:

нуууу.... Мне не надо решение "чтоб только работало". я прошу объяснить причины столь непонятного для меня поведения программы smile

Цитата(MetalFan @ 22.5.2007, 10:52

)

вместо Supports и кучи as'ов вызывать QueryInterface

Цитата(Borland Help)

Do not call the protected QueryInterface method directly.

Я не буквоед. Но такое предупреждение с чем-то связано ведь, правда? smile

Да и потом - кода будет столько же. Просто проверка будет не результат вызова supports, а результат отработки queryinterface. На одно приведение "as" будет меньше, но и только smile

Учитывая, что в реализации supports напрямую используется queryInterface, не думаю, что замена "шила на мыло" радикально изменит ситуацию.
но все равно спасибо.

Shaggy

Дата 23.5.2007, 00:27 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 37
Регистрация: 2.5.2007
Где: г.Ижевск

Репутация: 3
Всего: 5

Цитата(skyboy @ 22.5.2007, 23:26

)

в моем случае используется способ №5.

нет, используется 4 вариант

Код


function Supports(const Instance: TObject; const IID: TGUID): Boolean;
var
  Temp: IInterface;
begin
  Result := Supports(Instance, IID, Temp);// _AddRef - RefCount=1
end; // _Release, RefCount=0 и соответственно Destroy

если раскомментировать ClassType, 5 вариант

Код


function Supports(const AClass: TClass; const IID: TGUID): Boolean;
begin
  Result := AClass.GetInterfaceEntry(IID) <> nil; // RefCount не меняется
end;

Добавлено через 14 минут и 19 секунд
в твоём случае, или дописать так:

Код


TBar = class(TinterfacedObject, IFoo)
  protected
    procedure Foo; stdcall;
  public
    destructor Destroy; override;
    constructor Create;
  end;

...

constructor TBar.create;
Begin
  Inherited;
  _AddRef;
End;

или

Код


Var
  Intf:IFoo;
...
for i:=1 to lst.Count do
   if Supports(lst.Items[i - 1],IFoo,Intf) // TInterfacedObject(lst.Items[i - 1]).GetInterface(IFoo,Intf)
    then
     Intf.Foo;

skyboy

Дата 23.5.2007, 09:01 (ссылка)

(нет голосов)

Загрузка ...

неОпытный

Профиль
Группа: Модератор
Сообщений: 9820
Регистрация: 18.5.2006
Где: Днепропетровск

Репутация: 4
Всего: 260

Цитата(Shaggy @ 22.5.2007, 23:27

)

нет, используется 4 вариант

да. ошибся. мне показалось, что их всего шесть.

Цитата(Shaggy @ 22.5.2007, 23:27

)

// _Release, RefCount=0 и соответственно Destroy

странно. я же описал класс TInterfacedObjectEx...
A, понятно, я сделал перекрывающие методы _addRef и _release не-динамическими.
Ок. Объявляем эти методы виртуальными - и все работает.
вот немного доработанный вариант:

Код


program Project2;
{$APPTYPE CONSOLE}
uses
  SysUtils,Classes,Contnrs;
type
  TinterfacedObjectEx = class(TInterfacedObject)
  protected
    function _addRef: Integer; virtual; stdcall;
    function _release: Integer; virtual; stdcall;
  end;
  IFoo = interface(IInterface)['{0F08CAC6-21C2-4265-8510-5F52E6296A0E}']
    procedure Foo; stdcall;
  end;
  TBar = class(TinterfacedObjectEx, IFoo)
  protected
    procedure Foo; stdcall;
  public
    destructor Destroy; override;
  end;
destructor TBar.Destroy;
begin
  inherited;
end;
procedure TBar.Foo;
begin
 Writeln('FooBar');
end;
function TinterfacedObjectEx._addRef: Integer;
begin
  Result := -1;
end;
function TinterfacedObjectEx._release: Integer;
begin
  Result := -1;
end;
const N= 5;
var lst: TObjectList;
    i: integer;
begin
 lst := TObjectList.Create(true);
 try
  for i:=1 to N do
   lst.Add(TBar.Create);
  for i:=1 to lst.Count do
   if Supports(lst.Items[i - 1]{.ClassType -- если это раскомментировать, то все работает как надо},IFoo)
    then
     ((lst.Items[i - 1] as TInterfacedObject) as IFoo).Foo; // но объект по-прежнему уничтожается здесь
   Readln;
 finally
   lst.Free;
 end;  // try
 readln;
end.

проблема осталась, хотя, судя по breakpoint'ам, выполняются мой _addRef, а _release выполняется от TINterfacedObject. Почему, подскажите, пожалуйста smile

Добавлено через 5 минут и 52 секунды

Цитата(skyboy @ 23.5.2007, 08:01

)

Объявляем эти методы виртуальными - и все работает.

в смысле - не валится с криками об ошибке. но объекты все равно уничтожаются до завершения работы программы.

MetalFan

Дата 23.5.2007, 13:29 (ссылка)

(нет голосов)

Загрузка ...

Аццкий Сотона

Профиль
Группа: Комодератор
Сообщений: 3815
Регистрация: 2.10.2006
Где: Moscow

Репутация: 62
Всего: 128

в классе TInterfacedObject методы _AddRef и _Release не виртуальные, а соответственно не могут быть перекрыты в потомках...
в нем жестко зашит механизм подсчета ссылок.
соотв. для реализации своего механизма необходимо реализовать в своем классе методы интерфейса IInterface (aka IUnknown).
но в этом случае память придется освобождать ручками....

Это сообщение отредактировал(а) MetalFan - 23.5.2007, 13:33

--------------------

There are always someone smarter than you...

skyboy

Дата 23.5.2007, 22:28 (ссылка)

(нет голосов)

Загрузка ...

неОпытный

Профиль
Группа: Модератор
Сообщений: 9820
Регистрация: 18.5.2006
Где: Днепропетровск

Репутация: 4
Всего: 260

Цитата(MetalFan @ 23.5.2007, 12:29

)

соотв. для реализации своего механизма необходимо реализовать в своем классе методы интерфейса IInterface (aka IUnknown).

реализовал smile

у меня в коде этот класс называется TInterfacedObjectEx ;)
Вот только:
1. Методы и прям невиртуальные :(
но
2. В коде supports не нашел приведения к TInterfacedObject. Наверное, просто плохо смотрел.
Ладно, я думал, тут я какое-то очевидное упущение допустил, а, видимо, просто "так оно реализовано". Ну, что же, обойдусь костылями.

MetalFan

Дата 23.5.2007, 23:09 (ссылка)

(нет голосов)

Загрузка ...

Аццкий Сотона

Профиль
Группа: Комодератор
Сообщений: 3815
Регистрация: 2.10.2006
Где: Moscow

Репутация: 62
Всего: 128

Цитата(skyboy @ 23.5.2007, 22:28

)

реализовал smile у меня в коде этот класс называется TInterfacedObjectEx ;)

мда...
ладно, подойду с другой стороны:
тебе необходимо реализовать АНАЛОГ TInterfacedObject, но со своим механизмом подсчета ссылок.
так понятно? не наследника от TInterfacedObject, а именно аналог.
p.s.

Код


  TInterfacedObjectEx = class(TObject, IInterface)
....
//и далее по тексту

Цитата(skyboy @ 23.5.2007, 22:28

)

2. В коде supports не нашел приведения к TInterfacedObject.

а зачем оно нужно? там идет работа с интерфейсами...

Это сообщение отредактировал(а) MetalFan - 23.5.2007, 23:12

--------------------

There are always someone smarter than you...

skyboy

Дата 23.5.2007, 23:56 (ссылка)

(нет голосов)

Загрузка ...

неОпытный

Профиль
Группа: Модератор
Сообщений: 9820
Регистрация: 18.5.2006
Где: Днепропетровск

Репутация: 4
Всего: 260

Цитата(MetalFan @ 23.5.2007, 22:09

)

а зачем оно нужно? там идет работа с интерфейсами...

я думал, что если необходимо привести к типу - интерфейсу объект, то делается так:
1. определяются сигнатуры методов, которые декларирует интерфейс.
2. ищутся виртуальные методы с такими сигнатурами(в queryInterface VMTOffset понатыкано - думал для этого)
3. в случае "ненахождения" виртуальных ищутся не-виртуальные методы начиная с класса объекта и вверх по иерархии наследования.
но, видимо, механизм работает так:
1. ищет по иерархии наследования класс, который непосредственно объявлен реализатором интерфейса.
2. использует методы этого класса - и, если методы виртуальные в нем, то будет-таки обращение к VMT, если же не-виртуальные, то возьмутся методы этого самого класса...
Так, что ли?

Добавлено через 5 минут и 6 секунд
да. кажется, я прав. по крайней мере, если в моем первом примере "TBar = class(TinterfacedObjectEx, IFoo)" изменить на "TBar = class(TinterfacedObjectEx, IFoo, IInterface)" - т.е. указать явную реализацию интерфейса классом, то все работает. Больше ничего не менял - так и оставил наследование от TInterfacedObject(чесно говоря, лень писать QueryInterface, а copy-paste'ить религия не позволяет smile

)
Вот только неясна мотивация к ТАКОЙ "религии" работы с интерфейсами(я имею в виду свою гипотезу, если она не абсурдна) - почему бы не искать методы, начиная с класса объекта и вверх по предкам?

1 Пользователей читают эту тему (1 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: Общие вопросы \| Следующая тема »