使用Delphi中的Generics与属性接口

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问题,用于具有类型化接口通用参数的通用类,该参数在声明http://qc.embarcadero.com/wc/qcmain.aspx?d=90738中传递实现类

这是测试项目:

// http://stackoverflow.com/questions/4625543/interface-with-property-using-generics-in-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