这段代码出了什么问题:
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.
最佳答案
这是Delphi XE更新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