Продолжаем про "особенности Supports"

Предыдущая серия была тут - http://programmingmindstream.blogspot.ru/2014/04/supports.html

Поступил тут вопрос:

http://programmingmindstream.blogspot.ru/2014/04/supports.html?showComment=1396620657041#c4522417805967527391

"Извините но я не понимаю как мы ожидаем С. Если это метод класса TC. Мы же даже объект не создаем ?"

Разовью тему.

Итак был пример:

type
 ISomeInterface = interface
  procedure SomeMethod;
 end;//ISomeInterface

 TA = class(TObject, ISomeInterface {IUnknown тут СПЕЦИАЛЬНО опущен})
  function _AddRef: Integer;
  function _Release: Integer;
  function QueryInterface(const anID: TGUID; out anObj): hResult; virtual; 
  procedure SomeMethod;
 end;//TA

 TB = class(TA)
  function QueryInterface(const anID: TGUID; out anObj): hResult; override;
 end;//TB

 TC = class(TIntefacedObject, ISomeInterface)
  procedure SomeMethod;
 end;//TC

...

function TA._AddRef: Integer;
begin
 Result := -1;
end;

function TA._Release: Integer;
begin
 Result := -1;
end;

function TA.QueryInterface(const anID: TGUID; out anObj): hResult;
begin
 if Self.GetInterface(anID, anObj) then
  Result := S_Ok
 else
  Result := E_NoInterface;
end;

procedure TA.SomeMethod;
begin
 Write('A');
end;

function TB.QueryInterface(const anID: TGUID; out anObj): hResult;
begin
 if IsEqualGUID(anID, ISomeInterface) then
 begin
  Result := S_Ok;
  ISomeInterface(Obj) := TC.Create;
 end//IsEqualGUID(anID, ISomeInterface)
 else
  Result := inherited QueryInterface(anID, Obj);  
end;

procedure TC.SomeMethod;
begin
 Write('C');
end;

...
var
 l_A : ISomeInterface;
 l_B : ISomeInterface;
 A : TA;
 B : TB;
begin
 A := TA.Create;
 B := TB.Create;
 if not Supports(A, ISomeInterface, l_A) then
  Assert(false);
 l_A.SomeMethod; // - в консоли видим A
 if not Supports(B, ISomeInterface, l_B) then
  Assert(false);
 l_B.SomeMethod; // - в консоли видим A, а "хотелось бы" - C
end;

Теперь напишем ТАК:

type
 ISomeInterface = interface
  procedure SomeMethod;
 end;//ISomeInterface

 TA = class(TObject, IUnknown {тут ПОЯВИЛСЯ IUnknown}, ISomeInterface)
  function _AddRef: Integer;
  function _Release: Integer;
  function QueryInterface(const anID: TGUID; out anObj): hResult; virtual; 
  procedure SomeMethod;
 end;//TA

 TB = class(TA)
  function QueryInterface(const anID: TGUID; out anObj): hResult; override;
 end;//TB

 TC = class(TIntefacedObject, ISomeInterface)
  procedure SomeMethod;
 end;//TC

...

function TA._AddRef: Integer;
begin
 Result := -1;
end;

function TA._Release: Integer;
begin
 Result := -1;
end;

function TA.QueryInterface(const anID: TGUID; out anObj): hResult;
begin
 if Self.GetInterface(anID, anObj) then
  Result := S_Ok
 else
  Result := E_NoInterface;
end;

procedure TA.SomeMethod;
begin
 Write('A');
end;

function TB.QueryInterface(const anID: TGUID; out anObj): hResult;
begin
 if IsEqualGUID(anID, ISomeInterface) then
 begin
  Result := S_Ok;
  ISomeInterface(Obj) := TC.Create;
 end//IsEqualGUID(anID, ISomeInterface)
 else
  Result := inherited QueryInterface(anID, Obj);  
end;

procedure TC.SomeMethod;
begin
 Write('C');
end;

...
var
 l_A : ISomeInterface;
 l_B : ISomeInterface;
 A : TA;
 B : TB;
begin
 A := TA.Create;
 B := TB.Create;
 if not Supports(A, ISomeInterface, l_A) then
  Assert(false);
 l_A.SomeMethod; // - в консоли видим A
 if not Supports(B, ISomeInterface, l_B) then
  Assert(false);
 l_B.SomeMethod; // - ТЕПЕРЬ в консоли видим C
end;

Мысль понятна?

Изменилась ОДНА строчка. А КАКОВА РАЗНИЦА!

Продолжим.

Напишем теперь так:

type
 ISomeFakeInterface = interface
 end;//ISomeFakeInterface

 ISomeInterface = interface
  procedure SomeMethod;
 end;//ISomeInterface

 TA = class(TObject, ISomeInterface {IUnknown тут СПЕЦИАЛЬНО опущен}, ISomeFakeInterface)
  function _AddRef: Integer;
  function _Release: Integer;
  function QueryInterface(const anID: TGUID; out anObj): hResult; virtual; 
  procedure SomeMethod;
 end;//TA

 TB = class(TA)
  function QueryInterface(const anID: TGUID; out anObj): hResult; override;
 end;//TB

 TC = class(TIntefacedObject, ISomeInterface)
  procedure SomeMethod;
 end;//TC

...

function TA._AddRef: Integer;
begin
 Result := -1;
end;

function TA._Release: Integer;
begin
 Result := -1;
end;

function TA.QueryInterface(const anID: TGUID; out anObj): hResult;
begin
 if Self.GetInterface(anID, anObj) then
  Result := S_Ok
 else
  Result := E_NoInterface;
end;

procedure TA.SomeMethod;
begin
 Write('A');
end;

function TB.QueryInterface(const anID: TGUID; out anObj): hResult;
begin
 if IsEqualGUID(anID, ISomeInterface) then
 begin
  Result := S_Ok;
  ISomeInterface(Obj) := TC.Create;
 end//IsEqualGUID(anID, ISomeInterface)
 else
  Result := inherited QueryInterface(anID, Obj);  
end;

procedure TC.SomeMethod;
begin
 Write('C');
end;

...
var
 l_A : ISomeInterface;
 l_B : ISomeInterface;
 A : TA;
 B : TB;
begin
 A := TA.Create;
 B := TB.Create;
 if not Supports(A, ISomeInterface, l_A) then
  Assert(false);
 l_A.SomeMethod; // - в консоли видим A
 if not Supports(B, ISomeInterface, l_B) then
  Assert(false);
 l_B.SomeMethod; // - в консоли видим A, а "хотелось бы" - C

 if not Supports(ISomeFakeInterface(B), ISomeInterface, l_B) then
  Assert(false);
 l_B.SomeMethod; // - в консоли видим C, ВУАЛЯ!!!
end;

УДИВИТЕЛЬНО!

Не правда ли?

НЕСИММЕТРИЯ метода Supports - ОЧЕВИДНА.

По-моему...

"Сухой остаток":

overload - "вреден", "вообще" и в ДАННОМ случае "в частности".

Особенно вреден overload с "ковариантными" типами.

Да и вообще говоря, можно было бы обойтись (на месте Borland'а) ТОЛЬКО методом Supports(IUnknown), а не "ГОРОДИТЬ" ещё один КРАЙНЕ НЕОЧЕВИДНЫЙ метод Supports(TObject).

Мысль понятна?

Сразу оговорюсь - "тема далеко не для всех".

Посему не бросайтесь комментировать, а сначала - "вкурите" проблему.

Надеюсь, что помог кому-то.

P.S. Если подобные "экзерсисы" с объектами vs. интерфейсы - ИНТЕРЕСНЫ - пишите. У меня "в кармане" ещё есть "запасец".

P.P.S. Ну и я надеюсь понятно, что GUID'ы в описании интерфейсов - ОПУЩЕНЫ. Их можно вставить по Crtl-Shift-G.

P.P.P.S. Ну и "в тему":
http://18delphi.blogspot.ru/2013/11/queryinterface.html
http://18delphi.blogspot.ru/2013/11/supports.html
http://18delphi.blogspot.ru/2013/10/supports.html

P.P.P.P.S Один из читателей любезно предоставил компилируемый пример - https://bitbucket.org/ingword/temp/src