Delphi OOP 强制从继承类重新实现方法

Question

我有一个子类 TChildClass，它继承自 TBaseClass。 TBaseClass 有一个方法 function foo: string;，TChildClass 必须始终实现！

IMyInterface = Interface(IInterface)
    function foo: string;
end;

TBaseClass = class(TInterfacedObject, IMyInterface)
  public
    function foo: string;
end;

TChildClass = class(TBaseClass , IMyInterface)
  public
    function foo: string;
end;

我希望TChildClass 始终实现function foo 并调用从TBaseClass 继承：

function TBaseClass.foo: string
begin
    Result := 'Hello';
end;

function TChildClass.foo: string
begin
    Result := inherited;

    Result := Result + ' world!';
end;

如何制作？

Answer 1

您不能强制编译器在编译时要求覆盖。

为了让TChildClass 覆盖foo()，foo() 需要在TBaseClass 中声明为virtual（但不是abstract，因为您希望TBaseClass.foo() 具有默认实现，否则编译器会抱怨！）。而且，与 C++ 不同的是，Delphi 不要求重写抽象方法，它允许代码在运行时创建抽象类的实例（即使 调用未被覆盖会导致运行时错误）。

但是，您可以在运行时验证 TBaseClass.foo() 是否已在后代中被覆盖，例如：

type
  IMyInterface = Interface(IInterface)
    function foo: string;
  end;

  TBaseClass = class(TInterfacedObject, IMyInterface)
  public
    function foo: string; virtual;
  end;

  TChildClass = class(TBaseClass, IMyInterface)
  public
    function foo: string; override;
  end;

function TBaseClass.foo: string;
type
  TFoo = function: string of object;
var
  Impl, Base: TFoo;
  ClassTBase: TClass;
begin
  Impl := foo;
  ClassTBase := TBaseClass;
  Base := TBaseClass(@ClassTBase).foo;
  if TMethod(Impl).Code = TMethod(Base).Code then
    raise Exception.CreateFmt('foo() not implemented in class ''%s''', [ClassName]);
  Result := 'Hello';
end;

function TChildClass.foo: string;
begin
  Result := inherited foo;
  Result := Result + ' world!';
end;

但是，您无法强制TChildClass.foo()调用inherited，这完全由TChildClass自行决定。

Answer 2

你本身不能。但是，您可以通过稍微不同的方式实现您想要的。

type
IMyInterface = Interface(IInterface)
    function foo: string;
end;

TBaseClass = class(TInterfacedObject, IMyInterface)
  protected
    function fooForced : string; virtual; abstract;
  public
    function foo: string;
end;

TChildClass = class(TBaseClass , IMyInterface)
  protected
    function fooForced: string; override;
end;

function TBaseClass.foo: string;
begin
    Result := 'Hello' + FooForced;
end;

function TChildClass.fooForced: string;
begin
    Result := ' world!';
end;

注意 - 您必须注意“创建抽象类”警告！

Answer 3

我认为以一种或另一种方式使用abstract 方法可能是最干净的方法。就像 Dsm 已经提到的那样，您无法完全按您的意愿获得它，因为抽象方法没有实现，因此您无法在基类中调用该方法。

这个替代方案非常接近，但它需要深入研究 RTTI。这取决于你是否值得为你的目的。基本上是做什么的：深入研究类的方法列表。对于具有给定名称的方法，检查其实现者的类名是什么。如果是TBaseClass，则抛出异常，否则继续。

我很确定如果你实现 foo 方法的重载，他会失败，但是，所以它不是防水的。也许有办法检查找到的方法是否确实是一个覆盖，但 TRttiMethod 似乎没有提供任何开箱即用的东西。

代码示例深受RRUZ's answer, here 的启发。

TBaseClass = class(TInterfacedObject, IMyInterface)
  private
    procedure ValidateDescendantImplements(MethodName: string);
  public
    function foo: string;
end;

function TBaseClass.foo: string;
begin
    ValidateDescendantImplements('foo');

    Result := 'Hello';
end;

procedure TBaseClass.ValidateDescendantImplements(MethodName: string);
var
  m: TRttiMethod;
begin
  for m in TRttiContext.Create.GetType(Self.ClassType).GetDeclaredMethods do
  begin
   if SameText(m.Name, MethodName) then
     if m.Parent.Name <> TBaseClass.ClassName then
       Exit
  end;
  raise Exception.CreateFmt('%s needs to be overridden', [MethodName]);
end;

用法：

TChildClass.Create.foo; // Works
TBaseClass.Create.foo; // Throws exception