开发者

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;
0

上一篇:

下一篇:

精彩评论

暂无评论...
验证码 换一张
取 消

最新问答

问答排行榜