Интерфейс со свойством, используя Generics в Delphi

Question

что не так с этим кодом:

INamed = interface
    function GetName : String;
    property Name : String read GetName;
end;

Person = class(TInterfacedObject, INamed)
strict private
    name_ : String;
    function GetName : String;
public
    constructor Create(firstName : String); reintroduce;
    property Name : String read GetName;
end;
// trivial Person implementation...

Printer<T : INamed> = class
    ref : T;
    procedure Print;
end;

Printer2 = class
    ref : INamed;
    procedure Print;
end;

procedure Printer<T>.Print;
begin
    //WriteLn(ref.Name);  // <-- this line gives access violation
    WriteLn(ref.GetName); // <-- this is ok
end;

procedure Printer2.Print;
begin
    WriteLn(ref.Name);
end;

//////////////////////////////////////////////////////////////
var
    john : Person;
    print : Printer<Person>;
    print2 : Printer2;

begin
    john := Person.Create('John');
    print := Printer<Person>.Create;
    print2 := Printer2.Create;
    print.ref := john;
    print2.ref := john;
    print.Print;
    print2.Print;
    ReadLn;
end.

Класс Printer2 работает нормально. Общий принтер работает с вызовом GetName, но не использует свойство: нарушение прав доступа ... чтение адреса ...

Редактировать Пример, связанный с моим реальным кодом

INamed = interface
    function GetName : String;
    property Name : String read GetName;
end;

Person = class(TInterfacedPersistent, INamed)
strict private
    name_ : String;
    function GetName : String; inline;
public
    constructor Create(firstName : String); reintroduce;
    property Name : String read GetName;
end;

NameCompare = class(TComparer<Person>)
    function Compare(const l, r: Person): Integer; override;
end;

GenericNameCompare<T :INamed> = class(TComparer<T>)
    function Compare(const l, r: T): Integer; override;
end;

{ Person }
constructor Person.Create(firstName: String);
begin
    inherited Create;
    name_ := firstName;
end;

function Person.GetName: String;
begin
    Result := name_;
end;

{ NameCompare }
function NameCompare.Compare(const l, r: Person): Integer;
begin
    Result := AnsiCompareText(l.Name, r.Name);
end;

{ GenericNameCompare<T> }
function GenericNameCompare<T>.Compare(const l, r: T): Integer;
begin
    //Result := AnsiCompareText(l.Name, r.Name);    // <-- access violation
    Result := AnsiCompareText(l.GetName, r.GetName);
end;

var
    list : TObjectList<Person>;
    p : Person;

begin
    try
        list := TObjectList<Person>.Create;
        list.Add(Person.Create('John'));
        list.Add(Person.Create('Charly'));
        list.Sort(GenericNameCompare<Person>.Create);
        for p in list do
            WriteLn(p.Name);

        ReadLn;
    except
        on E: Exception do begin
            Writeln(E.ClassName, ': ', E.Message);
            ReadLn;
        end;
    end;
end.

Answer 1

Эта ошибка все еще присутствует в Delphi XE update 1.

Если вы создаете экземпляр TPrint<INamed> вместо TPrint<TPerson>, то он работает нормально.

Я сообщил об этом вQC:

Отчет №: 90738 Статус: Сообщено
Проблема CodeGen для универсального класса с типизированным универсальным параметром Interface, которому передается реализующий класс в объявлении
http://qc.embarcadero.com/wc/qcmain.aspx?d=90738

Это тестовый проект:

// /2757240/interfeis-so-svoistvom-ispolzuya-generics-v-delphi

program SO4625543;

{$APPTYPE CONSOLE}

uses
  SysUtils;

type
  INamed = interface
    function GetName : String;
    property Name : String read GetName;
  end;

  TPerson = class(TInterfacedObject, INamed)
  strict private
    name_ : String;
    function GetName: String;
  public
    constructor Create(firstName : String); reintroduce;
    property Name: String read GetName;
  end;

constructor TPerson.Create(firstName : String);
begin
  inherited Create();
  name_ := firstName;
end;

function TPerson.GetName: String;
begin
  Result := name_;
end;

type
  TPrinter<T : INamed> = class
    ref : T;
    procedure Print;
  end;

  TPrinter2 = class
    ref : INamed;
    procedure Print;
  end;

  procedure TPrinter<T>.Print;
  begin
    // order of the calls does not matter; Name will fail under certain circumstances
    WriteLn(ref.GetName); // <-- this is ok
    WriteLn(ref.Name);  // <-- this line gives access violation for TPrinter<TPerson>, but not for TPrinter<INamed>
  end;

  procedure TPrinter2.Print;
  begin
    WriteLn(ref.GetName);
    WriteLn(ref.Name);
  end;

//////////////////////////////////////////////////////////////

procedure Main;
var
  johnT : TPerson;
  printI : TPrinter<INamed>;
  printT : TPrinter<TPerson>;
  print2 : TPrinter2;

begin
  johnT := TPerson.Create('John');
  printI := TPrinter<INamed>.Create;
  printT := TPrinter<TPerson>.Create;
  print2 := TPrinter2.Create;
  printI.ref := johnT;
  printT.ref := johnT;
  print2.ref := johnT;
  printI.Print;
  printT.Print;
  print2.Print;
  ReadLn;
end;

begin
  try
    Main();
  except
    on E: Exception do
      Writeln(E.ClassName, ': ', E.Message);
  end;
end.

- jeroen

Answer 2

Вы должны инициализировать ref перед использованием. Например в конструкторе:

constructor Printer<T>.Create (Obj : T);
begin
ref := Obj;
end;

---

Проблема в том, что вы храните переменную, объявленную как

var
  john : Person;

в интерфейсе INamed. Интерфейсы в Delphi подсчитываются, и подсчет ссылок работает только в том случае, если вы используете исключительно типы интерфейсов или типы классов. В вашем случае объект "Джон" уничтожается, прежде чем использовать его. Попробуйте сделать:

john2 : INamed;
...
john2 := Person.Create('John');
Printer.ref := john2;
Printer.Print; 

Обратите внимание, что дженерики, вероятно, не то, что вы хотите здесь. Просто сохраните ссылку INamed и затем вызовите ref.GetName в методе Print. Или вы могли бы сделать

TPrinter = class
public
  procedure Print (Obj : INamed);
end;

procedure TPrinter.Print (Obj : INamed);
begin
WriteLn (Obj.GetName);
end;