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

Answer 2

~~在使用之前，您必须初始化ref。例如，在构造函数中：~~

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

<击>

问题是您存储了声明为
的变量
var john : Person;
接口INamed中的
。 Delphi中的接口是引用计数的，只有在您专门使用接口类型或类类型时，引用计数才有效。在您的情况下，对象“john”在您使用之前被销毁。尝试做：

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;

使用Delphi中的Generics与属性接口

2 个答案: