Delphi: переопределенный метод не вызывается для объектов, созданных с использованием RTTI - PullRequest
Новая
       34

Delphi: переопределенный метод не вызывается для объектов, созданных с использованием RTTI

4 голосов
/ 28 декабря 2011

Я пытаюсь клонировать объекты, используя RTTI в D2010. Вот моя попытка: 

uses SysUtils, TypInfo, rtti;
type
  TPerson = class(TObject)
  public
    Name: string;
    destructor Destroy(); Override;
  end;
destructor TPerson.Destroy;
begin
  WriteLn('A TPerson was freed.');
  inherited;
end;
procedure CloneInstance(SourceInstance: TObject; DestinationInstance: TObject; Context: TRttiContext); Overload;
var
  rSourceType:      TRttiType;
  rDestinationType: TRttiType;
  rField:           TRttiField;
  rSourceValue:     TValue;
  Destination:      TObject;
  rMethod:          TRttiMethod;
begin
  rSourceType := Context.GetType(SourceInstance.ClassInfo);
  if (DestinationInstance = nil) then begin
    rMethod := rSourceType.GetMethod('Create');
    DestinationInstance := rMethod.Invoke(rSourceType.AsInstance.MetaclassType, []).AsObject;
  end;
  for rField in rSourceType.GetFields do begin
    if (rField.FieldType.TypeKind = tkClass) then begin
      // TODO: Recursive clone
    end else begin
      // Non-class values are copied (NOTE: will cause problems with records etc.)
      rField.SetValue(DestinationInstance, rField.GetValue(SourceInstance));
    end;
  end;
end;
procedure CloneInstance(SourceInstance: TObject; DestinationInstance: TObject); Overload;
var
  rContext:       TRttiContext;
begin
  rContext := TRttiContext.Create();
  CloneInstance(SourceInstance, DestinationInstance, rContext);
  rContext.Free();
end;
var
  Original:     TPerson;
  Clone:        TPerson;
begin
  ReportMemoryLeaksOnShutdown := true;
  Original := TPerson.Create();
  CloneInstance(Original, Clone);
  Clone.Free();
  Original.Free();
  ReadLn;
end.

Немного разочаровывающе, я не вижу более одного случая "TPerson был освобожден". к выводу (что подтверждается пошаговым выполнением программы) - уничтожается только оригинал с помощью переопределенного деструктора.

Может кто-нибудь помочь мне с вызовом переопределенного деструктора? (И, возможно, объясните, почему он не называется в первую очередь.) Спасибо!

Ответы [ 2 ]

5 голосов
/ 28 декабря 2011

Пара проблем с вашим кодом.

Вы не инициализируете переменную Clone равной nil. Что на моей машине привело к нарушениям доступа в верхнем методе CloneInstance, поскольку клон не был создан, поскольку переданное значение было не ноль.

У вас нет параметра DestinationInstance, объявленного как var. Это означает, что создание экземпляра в верхнем методе CloneInstance не возвращается к вызывающей стороне. Добавление var к параметру решает проблему. Вам нужно использовать TObject(Clone) при вызове CloneInstance из основного метода программы, иначе Delphi будет жаловаться на то, что «нет перегруженного метода, который можно вызывать с этими параметрами». Это потому, что параметры var хотят, чтобы их точный объявленный тип передавался в них.

Я изменил ваш код на: 

uses
  SysUtils,
  TypInfo,
  rtti;

type
  TPerson = class(TObject)
  public
    Name: string;
    constructor Create;
    destructor Destroy(); Override;
  end;

constructor TPerson.Create;
begin
  WriteLn('A TPerson was created');
end;

destructor TPerson.Destroy;
begin
  WriteLn('A TPerson was freed.');
  inherited;
end;

procedure CloneInstance(SourceInstance: TObject; var DestinationInstance: TObject; Context: TRttiContext); Overload;
var
  rSourceType:      TRttiType;
  rDestinationType: TRttiType;
  rField:           TRttiField;
  rSourceValue:     TValue;
  Destination:      TObject;
  rMethod:          TRttiMethod;
begin
  rSourceType := Context.GetType(SourceInstance.ClassInfo);
  if (DestinationInstance = nil) then begin
    rMethod := rSourceType.GetMethod('Create');
    DestinationInstance := rMethod.Invoke(rSourceType.AsInstance.MetaclassType, []).AsObject;
  end;
  for rField in rSourceType.GetFields do begin
    if (rField.FieldType.TypeKind = tkClass) then begin
      // TODO: Recursive clone
    end else begin
      // Non-class values are copied (NOTE: will cause problems with records etc.)
      rField.SetValue(DestinationInstance, rField.GetValue(SourceInstance));
    end;
  end;
end;

procedure CloneInstance(SourceInstance: TObject; var DestinationInstance: TObject); Overload;
var
  rContext:       TRttiContext;
begin
  rContext := TRttiContext.Create();
  CloneInstance(SourceInstance, DestinationInstance, rContext);
  rContext.Free();
end;

var
  Original:     TPerson;
  Clone:        TPerson;
begin
  Clone := nil;
  ReportMemoryLeaksOnShutdown := true;
  Original := TPerson.Create();
  Original.Name := 'Marjan';

  CloneInstance(Original, TObject(Clone));
  Original.Name := 'Original';
  WriteLn('Original name: ', Original.Name);
  WriteLn('Clone name: ', Clone.Name);

  Clone.Free();
  Original.Free();
  ReadLn;
end.

Я добавил конструктор, чтобы увидеть, как создаются экземпляры, а также пару строк для проверки имен после клонирования. Вывод гласит: 

A TPerson was created
A TPerson was created
Original name: Original
Clone name: Marjan
A TPerson was freed.
A TPerson was freed.
0 голосов
/ 28 декабря 2011

Пример решения (для конструктора, но в основном в этом случае также пригоден для использования):

Как я могу создать объект Delphi из ссылки на класс и обеспечить выполнение конструктора? в этот ответ

Однако ему нужно знать тип пункта назначения ... который не может быть вариантом

...