Почему это назначение вызывает ошибку компилятора?

Question

Я пытаюсь отделить мой код от интерфейсов. Этот код в моем тесте работает:

procedure TTestCustomFrameViewModel.TCreateReturnsIPsFrameViewModel;
var
  LCUT : TInterfacedObject;
  LCreate : TCreateFrameViewModelFunction;
  ViewModel : IPsFrameViewModel;
begin
  //Arrange
  LCUT := nil;
  LCreate := CreateFrameTest1ViewModelFunction;
  //Act
  LCUT := LCreate(nil);
  ViewModel := CUT; //Added this assignment just to make sure

  //Assert
  Assert.Implements<IPsFrameViewModel>(ViewModel);
end;

, и это не удается (Ошибка в закомментированных строках)

Объявлено в классе

 FBaseViewModel: IPsFrameViewModel;
 FFrameTest1ViewModel : IFrameTest1ViewModel;

procedure TfrmTest1.SetViewModel(aViewModel: TInterfacedObject);
var
  LTest : TInterfacedObject;
begin
  LTest := aViewModel;  //This works
  FBaseViewModel := aViewModel;   //Error E2010 incompatible types IPSFrameViewModel and TInterfacedObject
  FFrameTest1ViewModel := aViewModel; //Error E2010 Incompatible types IFrameTest1ViewModel and TInterfacedObject
  FBaseViewModel.Attach(Self);
end;

Answer 1

Ошибка говорит вам точно, в чем проблема. Вы не можете назначить TInterfacedObject для IPsFrameViewModel или для любого другого интерфейса, который он не реализует (который является всеми из них, кроме IInterface для TInterfacedObject). Как определено:

TInterfacedObject = class(TObject, IInterface)

Таким образом, единственный тип интерфейса, который вы можете назначить, это IInterface.

Мы не можем видеть, что происходит с первым фрагментом, но мы можем предположить, CUT - это не TInterfacedObject, а скорее другой совместимый объект или тип интерфейса. Похоже, что это опечатка (вы пытались вместо этого назначить LCUT? Это также не помогло бы, если бы это было так).

Если вы хотите передать объект общего назначения этому методу, вам понадобится пользовательский базовый класс, который реализует по крайней мере интерфейсы, которые вам нужно назначить, ie:

procedure TfrmTest1.SetViewModel(aViewModel: TMyBaseViewModel);

Где вы можете определить TMyBaseViewModel как:

type
  IPSFrameViewModel = interface
    // ...
  end;
  IFrameTest1ViewModel = interface
    // ...
  end;

  TMyBaseViewModel = class(TInterfacedObject, IPSFrameViewModel, IFrameTest1ViewModel)
     //implement
  end;

---

В качестве альтернативы вы можете привести интерфейс во время выполнения, используя метод Supports, если вы этого хотите. Например:

procedure TfrmTest1.SetViewModel(aViewModel: TInterfacedObject);
var
  LTest : TInterfacedObject;
begin
  LTest := aViewModel;  //This works
  if not Supports(aViewModel, IPSFrameViewModel, FBaseViewModel) then
    raise Exception.Create('Object does not support IPSFrameViewModel');
  if not Supports(aViewModel, IFrameTest1ViewModel, FFrameTest1ViewModel) then
    raise Exception.Create('Object does not support IFrameTest1ViewModel');      
  FBaseViewModel.Attach(Self);
end;

Чтобы это работало, обратите внимание, что ваши интерфейсы должны быть украшены GUID, ie:

program program1;
{$APPTYPE CONSOLE}    
uses
  SysUtils;

type
  IMyCustomInterface = interface(IInterface)
  ['{665F462B-C66B-467C-970A-52CAE9C5F69A}']
    function Bar : string;
  end;
  IMyOtherInterface = interface(IInterface)
  ['{AEAF0D0B-4C6F-480C-A373-98145908B639}']
    function Foo : string;
  end;
  TMyBaseInterfaceObject = class(TInterfacedObject, IMyCustomInterface, IMyOtherInterface)
     function Foo : string;
     function Bar : string;
  end;

function TMyBaseInterfaceObject.Foo : string;
begin
  result := 'Hello World Foo.';
end;

function TMyBaseInterfaceObject.Bar : string;
begin
  result := 'Hello World Bar.';
end;

var
  LMyCustomInterface : IMyCustomInterface;
  LMyOtherInterface : IMyOtherInterface;
  tio : TInterfacedObject;
begin
  tio := TMyBaseInterfaceObject.Create;
  if Supports(tio, IMyCustomInterface, LMyCustomInterface) then
    WriteLn(LMyCustomInterface.Bar);
  if Supports(tio, IMyOtherInterface, LMyOtherInterface) then
    WriteLn(LMyOtherInterface.Foo);
  ReadLn;
end.