Delphi: overridden method not called for objects instantiated using RTTI

Question

I'm trying to clone objects using RTTI in D2010. Here's my attempt so far:

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.

A little disappointingly, I don't see more than one occurrence of "A TPerson was freed.' to the output (which is confirmed by stepping through the program) - only the original is destroyed using the overridden destructor.

Can anyone please help me having the overridden destructor called? (And perhaps explain why it isn't called in the first place.) Thanks!

Answer 1

Couple of problems with your code.

You do not initialize the Clone variable to nil. Which on my machine led to access violations in the upper CloneInstance method, as no clone was created because the passed in value was non-nil.

You do not have the DestinationInstance parameter declared as var. This means that the instantiation in the upper CloneInstance method doesn't get back to the caller. Adding var to the parameter solves the problem. You do need to use TObject(Clone) in the call to CloneInstance from the main method of the program, or Delphi will complain about 'there is no overloaded method that can be called with these parameters'. This is because var parameters want their exact declared type passed into them.

I changed your code to:

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.

I added a constructor to see both instances being created as well and a couple of lines to check the names after the cloning. The output reads:

A TPerson was created
A TPerson was created
Original name: Original
Clone name: Marjan
A TPerson was freed.
A TPerson was freed.