[fpc-devel] Managed Types, Undefined Bhaviour

[Thorsten Engler]

> -----Original Message-----
> From: fpc-devel <fpc-devel-bounces at lists.freepascal.org> On Behalf Of
> Martok
> Sent: Friday, 29 June 2018 23:55
> To: fpc-devel at lists.freepascal.org

> Interface functions are always virtual and implemented by the
> actually instantiated class. The "override" keyword is neither
> allowed nor needed,

Without having looked the particular code this thread is about, that statement, at least how I interpret it, is wrong.

The specific functions that implement an interface get baked into the class at the moment when the interface is defined as part of the class. This results in important differences in behaviour, depending if methods (in the class) are defined as virtual or not, and if a derived class redeclares an interface already declared on an ancestor or not.

I've only tried the following code (which demonstrates this) in Delphi, but would assume FPC to produce the same result (otherwise there is bound to be a lot of Delphi code which produces subtly different outcomes when compiled with FPC).

program IntfImplDetails;

{$APPTYPE CONSOLE}

uses
  System.SysUtils;

type
  IFoo = interface(IInterface)
    ['{E9A12596-8F61-4CF1-A09A-266D56BD837D}']
    procedure Foo;
  end;

  IBar = interface(IFoo)
    ['{6782527D-431E-49F4-89D0-DCF871BE63A3}']
    procedure Bar;
  end;

  TFoo = class(TInterfacedObject, IFoo)
  protected
    procedure Foo;
  end;

  TFooBar = class(TFoo, IBar)
  protected
    procedure Bar;
    procedure Foo;
  end;

  TFooBarToo = class(TFooBar, IFoo)
  protected
    procedure Bar;
    procedure Foo;
  end;

  TVirtFoo = class(TInterfacedObject, IFoo)
  protected
    procedure Foo; virtual;
  end;

  TVirtFooBar = class(TVirtFoo, IBar)
  protected
    procedure Bar;
    procedure Foo; override;
  end;

{ TFoo }

procedure TFoo.Foo;
begin
  WriteLn('TFoo.Foo');
end;

procedure TFooBar.Bar;
begin
  WriteLn('TFooBar.Bar');
end;

procedure TFooBar.Foo;
begin
  WriteLn('TFooBar.Foo');
end;

procedure TFooBarToo.Bar;
begin
  WriteLn('TFooBarToo.Bar');
end;

procedure TFooBarToo.Foo;
begin
  WriteLn('TFooBarToo.Foo');
end;

procedure TVirtFoo.Foo;
begin
  WriteLn('TVirtFoo.Foo');
end;

procedure TVirtFooBar.Bar;
begin
  WriteLn('TVirtFooBar.Bar');
end;

procedure TVirtFooBar.Foo;
begin
  WriteLn('TVirtFooBar.Foo');
end;

var
  Intf : IInterface;

  IntfFoo : IFoo;
  IntfBar : IBar;

begin
  try
    {=== TFooBar ===}
    WriteLn('=== TFooBar ===');
    Intf := TFooBar.Create;

    Supports(Intf, IFoo, IntfFoo);
    IntfFoo.Foo; // TFoo.Foo

    Supports(Intf, IBar, IntfBar);

    IntfBar.Foo; // TFooBar.Foo
    IntfBar.Bar; // TFooBar.Bar

    IntfFoo := IntfBar;
    IntfFoo.Foo; // TFooBar.Foo

    {=== TFooBarToo ===}

    WriteLn('=== TFooBarToo ===');
    Intf := TFooBarToo.Create;

    Supports(Intf, IFoo, IntfFoo);
    IntfFoo.Foo; // TFooBarToo.Foo

    Supports(Intf, IBar, IntfBar);

    IntfBar.Foo; // TFooBar.Foo
    IntfBar.Bar; // TFooBar.Bar

    IntfFoo := IntfBar;
    IntfFoo.Foo; // TFooBar.Foo

    {=== TVirtFooBar ===}

    WriteLn('=== TVirtFooBar ===');
    Intf := TVirtFooBar.Create;

    Supports(Intf, IFoo, IntfFoo);
    IntfFoo.Foo; // TVirtFooBar.Foo

    Supports(Intf, IBar, IntfBar);

    IntfBar.Foo; // TVirtFooBar.Foo
    IntfBar.Bar; // TVirtFooBar.Bar

    IntfFoo := IntfBar;
    IntfFoo.Foo; // TVirtFooBar.Foo
  except
    on E: Exception do
      Writeln(E.ClassName, ': ', E.Message);
  end;
  if DebugHook <> 0 then
    ReadLn;
end.