Это с RTTI в 3.х что-то не так, или я не умею ея готовить?

[Cheb]

Адаптировал под изменения RTTI в 3.2 простейшую задачку: по PTypeInfo массива получить PTypeInfo элемента.

Ужаснулся ктулхакам в своём коде и попытался переделать правильно (обезъянничая за исходниками RTL).

Падало страшно, пока я не догадался (слоупок), что крашится моя функция формата DieTypeFailed(T, CgeFormat(RuEn('Базовый тип %0 ещё не зарегистрирован.', 'The base type %0 is not registered.'), [BaseType^.Name])); , давясь ShortToUtf16(ShortString(V.VString^)), оттого, что в BaseType вместо нормального PTypeInfo попадал какой-то фтагн (ненулевой, самка собаки).

И вот я вспомнил, что мой фхтагнокод шёл с одинаковым успехом в 2.6.4 и в 3.0.4 без модификаций и адаптировал его к 3.2 тупо вставив ему в жопу ^ (а заодно добавив поддерживание выравниваний, ибо на малине без них упадёт).

И тогда мой движок, собранный 3.2, наконец, запустился и пошёл. То есть, проблема была в одном этом ктулхаке.
Всё работает

Но... Мои глаза!

Код: Выделить всё

  // Ктулхакус хорриблус.
  function GetArrayBaseTypePti(pai: PTypeInfo): PTypeInfo;
  var
    ti : pointer;
  begin
    ti:= pai;
    inc(PByte(ti), ord(pdynarraytypeinfo(ti)^.namelen) + 2);
    {$if (FPC_FULLVERSION<30000)}
    // fpc 2.6.4
      // NO alignment check because should only be used for legacy Win32
     
      Result:= PTypeInfo(pointer(pdynarraytypeinfo(
                                             pointer(ti) + sizeof(sizeint)))^);
    {$else}
      {$if (FPC_FULLVERSION<30200)}
      // fpc 3.0.4
        {$ifdef FPC_REQUIRES_PROPER_ALIGNMENT}
          ti:= aligntoptr(ti);
        {$endif}
       //Нихрена. Крашится. Result:= PTypeInfo(pdynarraytypedata(ti)^.elType);
       
        // the same as 2.6.4
        Result:= PTypeInfo(pointer(pdynarraytypeinfo(
                                             pointer(ti) + sizeof(sizeint)))^);
      {$else}
      // fpc 3.2+
        {$ifdef FPC_REQUIRES_PROPER_ALIGNMENT}
          ti:= aligntoqword(ti);
        {$endif}
        //А вот... фиг. Крашится:  Result:= PPTypeInfo(pdynarraytypedata(ti)^.elType)^;
        Result:= PPTypeInfo(pointer(pdynarraytypeinfo(
                                            pointer(ti) + sizeof(sizeint)))^)^;
        // Но это же ужас какой-то там tdynarraytypedata это запись
        //    с очень сложным условием упакованная/не упакованная!
        //  А если оно на 64-битном арме, когда доползу, опять начнёт падать?
      {$endif}
    {$endif}
    Result:= ResolveTypeInfoToAlias(Result); // это моя подставлялка typeinfo(double) для TDateTime и прочая
  end;

З.Ы. Продолжающаяся поддержка 2.6.4 нужна для возможности легаси сборок под Windows 98. Ибо ничто не демонстрирует твою шизанутость, как...

[runewalsh]

Крашится: Result:= PPTypeInfo(pdynarraytypedata(ti)^.elType)^;

Наверное, потому, что вместо elType нужно использовать elType2, до которого ты и добираешься по смещениям? elType занулён при неуправляемом типе элементов, иначе совпадает с elType2 (который всегда выставлен, в т. ч. для неуправляемых типов элементов), это всё есть в модулях typinfo и RTTI. Я в своём копипасте из этих модулей даже переименовал elType в elTypeManaged для очевидности.

[iskander]

Пользовался кодом

Код: Выделить всё

function GetArrayElemType(p: PTypeInfo): PTypeInfo;
begin
  if p <> nil then
    case p^.Kind of
      tkArray:    exit(GetTypeData(p)^.ArrayData.ElType);
      tkDynArray: exit(GetTypeData(p)^.ElType2);
    else
    end;
  Result := nil;
end;


вроде работает.

[Cheb]

Наверное, потому, что вместо elType нужно использовать elType2,

[рукалицо]

вроде работает.

Спасибо

Тогда результирующий код (проверил в 2.6.4, 3.0.4 и 3.2.0-rc1)

Код: Выделить всё

  // Dynamic arrays ONLY. Will crash happily on static ones
{$if (FPC_FULLVERSION>=30000)}
  function GetArrayBaseTypePti(pai: PTypeInfo): PTypeInfo;
  begin
    // fpc 3.x
    Result:= ResolveTypeInfoToAlias(GetTypeData(pai)^.ElType2);
  end; 
{$else} // fpc 2.6.4
  // Ктулхакус хорриблус.
  function GetArrayBaseTypePti(pai: PTypeInfo): PTypeInfo;
  var
    ti : pointer;
  begin
    // NO alignment check because 2.6.4 should only be used for legacy Win32
    ti:= pai;
    inc(PByte(ti), ord(pdynarraytypeinfo(ti)^.namelen) + 2);
    Result:= ResolveTypeInfoToAlias(PTypeInfo(pointer(pdynarraytypeinfo(
                                            pointer(ti) + sizeof(sizeint)))^));
  end;
{$endif}