Interface with property using Generics in Delphi
what is going wrong with this code:
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;
begi开发者_开发百科n
//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.
The Printer2 class works fine. The generic Printer works with the call to GetName but not using the property: Access violation ... read of address...
Edit Example more related to my real code
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.
This is a bug still present in Delphi XE update 1.
If you instantiate TPrint<INamed>
in stead of TPrint<TPerson>
, then it works fine.
I have reported it in QC:
Report No: 90738 Status: Reported
CodeGen issue for Generic class of with typed Interface generic parameter that is passed an implementing class in the declaration
http://qc.embarcadero.com/wc/qcmain.aspx?d=90738
This is the test project:
// 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
You have to initialize ref
before using it. For example in the constructor:
constructor Printer<T>.Create (Obj : T);
begin
ref := Obj;
end;
The problem is that you store a variable declared as
var
john : Person;
in an interface INamed
. Interfaces in Delphi are reference-counted and reference-counting only works if you exclusively use interface types or class types. In your case the object "john" is destroyed before you use it. Try to do:
john2 : INamed;
...
john2 := Person.Create('John');
Printer.ref := john2;
Printer.Print;
Note that generics are probably not what you want here. Just store an INamed
reference and then call ref.GetName
in the Print
method. Or you could do
TPrinter = class
public
procedure Print (Obj : INamed);
end;
procedure TPrinter.Print (Obj : INamed);
begin
WriteLn (Obj.GetName);
end;
精彩评论