Follow up to “peculiarities of Supports"

Original in Russian: http://programmingmindstream.blogspot.ru/2014/04/supports_4.html

The previous series was here – Briefly. Peculiarities of Supports (in Russian)

I was asked here:

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

Quote of the question: "Excuse me, but I do not understand why we expect С if it is a method of the TC class. We do not create an object, right?"

I’ll develop the theme.

So, we had an example:

type
 ISomeInterface = interface
  procedure SomeMethod;
 end;//ISomeInterface
 
 TA = class(TObject, ISomeInterface {IUnknown is omitted FOR PURPOSE here})
  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 is seen in console
 if not Supports(B, ISomeInterface, l_B) then
  Assert(false);
 l_B.SomeMethod; // - A is seen in console, and we need C
end;

Let us write in THIS way:

type
 ISomeInterface = interface
  procedure SomeMethod;
 end;//ISomeInterface
 
 TA = class(TObject, IUnknown {IUnknown APPEARS here}, 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 is seen in console
 if not Supports(B, ISomeInterface, l_B) then
  Assert(false);
 l_B.SomeMethod; // - NOW C is seen in the console
end;

Do you understand me?

I have change only ONE line and how GREAT IS THE DIFFERENCE!

Let’s move on.

Now we write in this way:

type
 ISomeFakeInterface = interface
 end;//ISomeFakeInterface
 
 ISomeInterface = interface
  procedure SomeMethod;
 end;//ISomeInterface
 
 TA = class(TObject, ISomeInterface {IUnknown is omitted FOR PURPOSE here}, 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 is seen in console
 if not Supports(B, ISomeInterface, l_B) then
  Assert(false);
 l_B.SomeMethod; // - A is seen in console, and we need C
 
 if not Supports(ISomeFakeInterface(B), ISomeInterface, l_B) then
  Assert(false);
 l_B.SomeMethod; // - C is seen in console, TA DA!!!
end;

AMAZING!

Isn’t it?

UNSYMMETRY of the Supports method is OBVIOUS.

In my opinion...

"A takeaway":

overload is "harmful", “in general” and, in THIS CASE, “in particular”.

overload with “covariant” types is very harmful.

Generally speaking, we could handle with the Supports(IUnknown) method ONLY (if Borland's stead) instead of creating another VERY UNOBVIOUS method Supports(TObject).

Is the idea clear?

Let me note, it is not “for everybody”.

That is why, do not rush to comment before you “grokk” the problem.

I hope I helped.

P.S. If such “exercises” of objects vs. interfaces are INTERESTING, let me know. I have some thoughts in store.

P.P.S. I also hope you understand that GUID in description to interfaces are OMITTED. They can be added at Crtl-Shift-G.

P.P.P.S. On the topic:
More about QueryInterface (in Russian)
Again about Supports
Oh yeah! Supports (in Russian)

P.P.P.P.S. One of my readers kindly provided me with a compilable example - https://bitbucket.org/ingword/temp/src