Автоматическое создание объектных полей с помощью RTTI в Delphi

Вольный перевод поста Automagically Creating Object Fields with RTTIopen in new window

На работе возникла задача создания иерархии классов, причём классы почти не содержали реализации, только объявление классов, с одним исключением — каждый класс отвечал за создание и уничтожение внутренних объектов. Я задумался, может быть, я могу использовать атрибуты и RTTI чтобы реализовать это поведение в одном месте, вместо того чтобы реализовывать в каждом классе.

Проблема

Мне нужны классы следующего вида

type
  TObjectB = class
    FData1: integer;
    FData2: string;
    FData3: boolean;
  end; 

  TObjectA = class
  strict private
    FObjectB: TObjectB;
  public
    constructor Create;
    destructor Destroy; override;
  end;

{ TObjectA }

constructor TObjectA.Create;
begin
  inherited Create;
  FObjectB := TObjectB.Create;
end;

destructor TObjectA.Destroy;
begin
  FreeAndNil(FObjectB);
  inherited;
end;

Но я слишком ленив чтобы писать в каждом классе раз примерно одинаковый конструктор и деструктор. Что мне делать?

Результат

Используя надлежащую инфраструктуру, код выше может быть переписан следующим образом

type
  TObjectB = class
    FData1: integer;
    FData2: string;
    FData3: boolean;
  end;

  TObjectA = class(TGpManaged)
  strict private
    [GpManaged]
    FObjectB: TObjectB;
  end;

Вся реализация скрыта в классе TGpManaged, который описан ниже. Он реализован в модуле GpAutoCreateopen in new window, который является частью моего open-source проекта GpDelphiUnitsopen in new window, вместе с тестовой программой TestGpAutoCreate.

Решение

Класс TGpManaged реализует только конструктор и деструктор. Конструктор автоматически создаёт поля в классах-потомках, а деструктор автоматически уничтожает их.

type
  TGpManaged = class
  public
    constructor Create;
    destructor  Destroy; override;
  end;

Не всегда хорошая идея автоматически создавать и уничтожать все поля. Поля, управление которыми будет проходить в автоматическом режиме, должны быть помечены атрибутом [GpManaged], который реализован в этом же модуле.

type
  GpManagedAttribute = class(TCustomAttribute)
  public type
    TConstructorType = (ctNoParam, ctParBoolean);
   strict private
    FBoolParam      : boolean;
    FConstructorType: TConstructorType;
  public
    class function  IsManaged(const obj: TRttiNamedObject): boolean; static;
    class function GetAttr(const obj: TRttiNamedObject;
      var ma: GpManagedAttribute): boolean; static;
    constructor Create; overload;
    constructor Create(boolParam: boolean); overload;
    property BoolParam: boolean read FBoolParam;
    property ConstructorType: TConstructorType read FConstructorType;
  end;

Атрибут может быть указан в двух формах:

Первая форма [GpManaged] которая будет вызывать конструктор без параметров для создания объекта помеченного атрибутом.

Вторая форма [GpManaged(false)] или [GpManaged(true)] которая будет вызывать конструктор с одним параметром с типом Boolean для создания объекта помеченного атрибутом.

Поддержка конструкторов с другими типами параметров может быть добавлена в дальнейшем.

Вторая форма с параметром конструктора была добавлена специально для создания TObjectList. Вызывая TObjectList.Create будет создан список объектов, который будет отвечать за их уничтожение. Это удобно в большинстве случаев. Тем не менее, если вы хотите чтобы список не отвечал за уничтожение объектов вы можете создать его следующим образом

  [GpManaged(false)]
  FList2: TObjectList;

Более детально реализацию GpManagedAttribute вы можете посмотреть в исходном коде.

Создание объектов

Поля помеченные любой версией атрибута [GpManaged] создаются в конструкторе TGpManaged.Create.

Код сначала обращается к расширенному контексту RTTI и ищет информацию об объекте который создаётся (ctx.GetType(Self.ClassType)). Потом происходит перебор всех полей объявленный в этом объекте.

Для каждого поля проверяется помечено ли оно атрибутом [GpManaged]. Если поле не отмечено то происходит переход к следующему полю.

Если же поле помечено [GpManaged], то происходит цикл по всем методам с именем Create (я намеренно отказался от поддержки конструкторов с другими именами). Для каждого найденного метода происходит проверка, содержит ли он соответствующее число параметров и их типы.

Если соответствие найдено то используется ctor.Invoke(f.FieldType.AsInstance.MetaclassType) для вызова найденного конструктора. Подходящие параметры конструктора передаются вторым аргументом Invoke. Результат вызова конструктора помещается поле методом f.SetValue.

Затем вся процедура повторяется для следующего поля.

constructor TGpManaged.Create;
var
  ctor  : TRttiMethod;
  ctx   : TRttiContext;
  f     : TRttiField;
  ma    : GpManagedAttribute;
  params: TArray<TRttiParameter>;
  t     : TRttiType;
begin
  ctx := TRttiContext.Create;
  t := ctx.GetType(Self.ClassType);
  for f in t.GetFields do begin
    if not GpManagedAttribute.GetAttr(f, ma) then
      continue; //for f
    for ctor in f.FieldType.GetMethods('Create') do begin
      if ctor.IsConstructor then begin
        params := ctor.GetParameters;
        if (ma.ConstructorType = GpManagedAttribute.TConstructorType.ctNoParam) and
           (Length(params) = 0) then
        begin
          f.SetValue(Self, ctor.Invoke(f.FieldType.AsInstance.MetaclassType, []));
          break; //for ctor
        end
        else 
        if (ma.ConstructorType = 
             GpManagedAttribute.TConstructorType.ctParBoolean) and
           (Length(params) = 1) and
           (params[0].ParamType.TypeKind = tkEnumeration) and
           SameText(params[0].paramtype.name, 'Boolean') then
        begin
          f.SetValue(Self, 
            ctor.Invoke(f.FieldType.AsInstance.MetaclassType, [ma.BoolParam]));
          break; //for ctor
        end;
      end;
    end; //for ctor
  end; //for f
end;

Уничтожение полей

Поля очищаются похожим образом, только взамен конструктора вызывается деструктор Destroy. Код проще потому что не требуется проверять каком именно деструктор вызывать.

destructor TGpManaged.Destroy;
var
  ctx : TRttiContext;
  dtor: TRttiMethod;
  f   : TRttiField;
  t   : TRttiType;
begin
  ctx := TRttiContext.Create;
  t := ctx.GetType(Self.ClassType);
  for f in t.GetFields do begin
    if not GpManagedAttribute.IsManaged(f) then
      continue; //for f
    for dtor in f.FieldType.GetMethods('Destroy') do begin
      if dtor.IsDestructor then begin
        dtor.Invoke(f.GetValue(Self), []);
        f.SetValue(Self, nil);
        break; //for dtor
      end;
    end; //for dtor
  end; //for f
end;

Потенциальные проблемы

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

Другая проблема заключается в том, что вы должны изменить предок своих классов на TGpManaged. Если это не подходит для вашей ситуации, но вы всё равно хотите использовать автоматическое управление жизненным циклом объектов, то вы должны скопировать мой код в ваши базовые классы.