Delphi XE2 RTTI сломан?

Недавно я перешел с D2010 на DXE2 и обнаружил ошибку showstopper (или функцию?) в XE2 и XE3 (протестировал мой друг XE3), связанный с генерацией RTTI для полей TBytes внутри классов.

Я обнаружил, что информация RTTI для переменной TBytes внутри класса никогда не генерируется.

Следующий код хорошо работает в D2010, но показывает сообщение "Ошибка" в XE2/XE3

У кого-нибудь есть ключ? Это полностью нарушит всю реализацию сериализации программных данных.

Чтобы проверить код, добавьте блок Rtti в декларацию использования

type

  TMyClass = class
  public
    Field1: Integer;
    Field2: TBytes;
  end;


procedure TForm2.Button1Click(Sender: TObject);
var
  i: Integer;
  Data: TMyClass;
  Rtti: TRttiContext;
  RttiClassType: TRttiInstanceType;
begin

  Data := TMyClass.Create;
  try

    // Get the context
    Rtti := TRttiContext.Create;
    try

      // Get the type for the class
      RttiClassType := TRttiInstanceType(Rtti.GetType(Data.ClassInfo));

      // Check the fields
      for i := 0 to High(RttiClassType.GetFields) do
      begin

        // Check the field type
        if not Assigned(RttiClassType.GetFields[i].FieldType) then
          ShowMessage('Error');

      end;

    finally
      Rtti.Free;
    end;

  finally
    Data.Free;
  end;

end;

Сообщение об ошибке будет отображаться при проверке Field2, который является TBytes, потому что FieldType всегда равен нулю.

Кто-нибудь знает, что изменилось в RTTI от D2010 до XE2? Может быть, потому, что тип TBytes был изменен из массива Byte в общий массив?

Ответ 1

Это известная проблема, исправленная в XE3. К сожалению, обновление - это единственный способ получить исправление; исправления ошибок обычно не переносятся обратно.

РЕДАКТИРОВАТЬ: Или нет. По-видимому, это фактически не исправлено, поскольку оно все еще встречается в XE3. Сообщать об этом как о новом случае и упомянуть о 103729, вероятно, будет лучшим способом действий.

Ответ 2

Вы можете исправить эту ошибку (на самом деле это не та же ошибка, что и упомянутый Мейсон).

type
  FixTypeInfoAttribute = class(TCustomAttribute)
  public
    FTypeInfo: PPTypeInfo;
    constructor Create(TypeInfo: PTypeInfo);
  end;

procedure FixFieldType(TypeInfo: PTypeInfo);
var
  ctx: TRttiContext;
  t: TRttiType;
  f: TRttiField;
  a: TCustomAttribute;
  n: Cardinal;
begin
  t := ctx.GetType(TypeInfo);
  for f in t.GetFields do
  begin
    for a in f.GetAttributes do
    begin
      if (a is FixTypeInfoAttribute) and f.ClassNameIs('TRttiInstanceFieldEx') then
      begin
        WriteProcessMemory(GetCurrentProcess, @PFieldExEntry(f.Handle).TypeRef,
          @FixTypeInfoAttribute(a).FTypeInfo, SizeOf(Pointer), n);
      end;
    end;
  end;
end;

constructor FixTypeInfoAttribute.Create(TypeInfo: PTypeInfo);
begin
  FTypeInfo := PPTypeInfo(PByte(TypeInfo) - SizeOf(Pointer));
end;

Затем вы добавляете атрибут в определение класса:

type
  TMyClass = class
  private
    Field1: Integer;
    [FixTypeInfo(TypeInfo(TBytes))]
    Field2: TBytes;
  end;

и убедитесь, что вызывается процедура FixFieldType:

initialization
  FixFieldType(TypeInfo(TMyClass));

Протестировано на XE