Расширенная RTTI информация классов

Как я упоминал ранее, Delphi (начиная с версии 7) поддерживает генерацию расширенной RTTI информации о методах класса - через компиляцию класса в режиме $METHODINFO ON. Эта RTTI информация включает в себя информацию о сигнатуре public и published методов. Delphi использует её для реализации поддержки скриптинга в фреймворке WebSnap - см. модуль ObjAuto и его друзей для более подробных сведений. Я сумел написать свои собственные определения и подпрограммы, которые выдёргивают и сохраняют расширенную RTTI информацию классов в формат, удобный для внешнего использования. Как обычно, моё тестовое приложение будет дампить тестовый класс, воссоздавая его псевдо-объявление.

Пока я писал модуль HVMethodInfoClasses, я подправил и улучшил некоторый старый код и структуры, так что я могу использовать больше общего кода с HVIntefaceMethods и HVMethodSignature. Мы уже привыкли раскапывать внутренние структуры RTTI, так что давайте лишь поверхностно пробежимся по новому коду. Итак, для начала у нас есть новые определения записей, описывающих приблизительную раскладку по памяти внутренних структур RTTI, генерируемых компилятором - выцарапанные из "официального" источника: ObjAuto:

type PReturnInfo = ^TReturnInfo; TReturnInfo = packed record Version: Byte; CallingConvention: TCallConv; ReturnType: PPTypeInfo; ParamSize: Word; end;  PParamInfo = ^TParamInfo; TParamInfo = packed record Flags: TParamFlags; ParamType: PPTypeInfo; Access: Word; Name: ShortString; end;

Как найти начала этих структур - это немного сложный вопрос. Помните статью Под капотом published методов? В то время я не знал про расширенную RTTI информацию и директиву $MethodInfo, поэтому написал:

Как вы можете видеть выше, таблица published методов теперь имеет тип PPmt. Это указатель на запись, которая содержит число published методов в классе, за которым следует массив из этого количества записей TPublishedMethod. Каждая запись содержит размер (используется для перехода к следующему элементу), указатель на точку входа метода и ShortString, содержащую имя метода. Заметьте, что поле Size избыточно: во всех случаях значение Size равно:

Size :=  SizeOf(Size) + SizeOf(Address) + SizeOf(Name[0]) + Length(Name);

Другими словами, следующая запись TPublishedMethod начинается прямо за последним байтом текущей записи (т.е. последним байтом имени метода). Я не уверен, почему Borland решила добавить поле Size, но возможной причиной может быть расширение записи TPublishedMethod в будущем. Естественное расширение - добавить информацию по количеству и типам параметров, а также соглашению вызова метода. Тогда поле Size было бы увеличено, а старый код, который не в курсе новых возможностей, продолжал работать бы дальше.

Как оказалось сейчас, поле Size в самом деле используется для вставки дополнительных записей (TReturnInfo и TParamInfo) прямо за полем Name записи TPublishedMethod:

type PPublishedMethod = ^TPublishedMethod; TPublishedMethod = packed record Size: Word; Address: Pointer; Name: {packed} ShortString; end;

Чтобы найти и декодировать сигнатуру метода, нам необходимо определить число дополнительных байт, указанных в поле Size. Мы скоро увидим код для этого. Далее у нас есть структуры, которые могут хранить декодированную RTTI информацию одного класса, включая информацию по методам секций public/published со всеми их параметрами и возвращаемыми типами:

type // Просто-используемые структуры фиксированного размера PClassInfo = ^TClassInfo; TClassInfo = record UnitName: string; Name: string; ClassType: TClass; ParentClass: TClass; MethodCount: Word; Methods: array of TMethodSignature; end;

Это определение должно быть в большой степени само-документирующимся. Как вы можете видеть, мы использовали ту же запись TMethodSignature, которую мы использовали для интерфейсов. Ладно, теперь мы более-менее готовы к написанию кода для конвертирования информации типа класса в наши структуры выше. Это подразумевает испачкать наши руки итерацией по всем public/published методам и дополнительной RTTI информации. После нескольких неудачных попыток и подсматриваний в ObjAuto, я пришёл к такому коду:

function ClassOfTypeInfo(P: PPTypeInfo): TClass; begin Result := nil; if Assigned(P) and (P^.Kind = tkClass) then Result := GetTypeData(P^).ClassType; end;    procedure GetClassInfo(ClassTypeInfo: PTypeInfo; var ClassInfo: TClassInfo); // Конвертирует raw структуры RTTI в наши user-friendly структуры var TypeData: PTypeData; i, j: integer; MethodInfo: PMethodSignature; PublishedMethod: PPublishedMethod; MethodParam: PMethodParam; ReturnRTTI: PReturnInfo; ParameterRTTI: PParamInfo; SignatureEnd: Pointer; begin Assert(Assigned(ClassTypeInfo)); Assert(ClassTypeInfo.Kind = tkClass);  // Класс TypeData  := GetTypeData(ClassTypeInfo); ClassInfo.UnitName        := TypeData.UnitName; ClassInfo.ClassType       := TypeData.ClassType; ClassInfo.Name            := TypeData.ClassType.ClassName; ClassInfo.ParentClass     := ClassOfTypeInfo(TypeData.ParentInfo); ClassInfo.MethodCount     := GetPublishedMethodCount(ClassInfo.ClassType); SetLength(ClassInfo.Methods, ClassInfo.MethodCount);  // Методы PublishedMethod := GetFirstPublishedMethod(ClassInfo.ClassType); for i := Low(ClassInfo.Methods) to High(ClassInfo.Methods) do begin // Метод MethodInfo := @ClassInfo.Methods[i]; MethodInfo.Name       := PublishedMethod.Name; MethodInfo.Address    := PublishedMethod.Address; MethodInfo.MethodKind := mkProcedure; // Предположим процедуру по умолчанию      // Возвращаемое значение и соглашение вызова ReturnRTTI := Skip(@PublishedMethod.Name); SignatureEnd := Pointer(Cardinal(PublishedMethod) + PublishedMethod.Size); if Cardinal(ReturnRTTI) >= Cardinal(SignatureEnd) then begin MethodInfo.CallConv := ccReg; // Предположим register MethodInfo.HasSignatureRTTI := False; end else begin MethodInfo.ResultTypeInfo := Dereference(ReturnRTTI.ReturnType); if Assigned(MethodInfo.ResultTypeInfo) then begin MethodInfo.MethodKind := mkFunction; MethodInfo.ResultTypeName := MethodInfo.ResultTypeInfo.Name; end else MethodInfo.MethodKind := mkProcedure; MethodInfo.CallConv := ReturnRTTI.CallingConvention; MethodInfo.HasSignatureRTTI := True;  // Считаем параметры ParameterRTTI := Pointer(Cardinal(ReturnRTTI) + SizeOf(ReturnRTTI^)); MethodInfo.ParamCount := 0; while Cardinal(ParameterRTTI) < Cardinal(SignatureEnd) do begin Inc(MethodInfo.ParamCount); // Предполагаем, что будет менее 255 параметров! ;) ParameterRTTI := Skip(@ParameterRTTI.Name); end;  // Читаем информацию о параметрах ParameterRTTI := Pointer(Cardinal(ReturnRTTI) + SizeOf(ReturnRTTI^)); SetLength(MethodInfo.Parameters, MethodInfo.ParamCount); for j := Low(MethodInfo.Parameters) to High(MethodInfo.Parameters) do begin MethodParam := @MethodInfo.Parameters[j];  MethodParam.Flags       := ParameterRTTI.Flags; if pfResult in MethodParam.Flags then MethodParam.ParamName := 'Result' else MethodParam.ParamName := ParameterRTTI.Name; MethodParam.TypeInfo    := Dereference(ParameterRTTI.ParamType); if Assigned(MethodParam.TypeInfo) then MethodParam.TypeName  := MethodParam.TypeInfo.Name; MethodParam.Location    := TParamLocation(ParameterRTTI.Access);  ParameterRTTI := Skip(@ParameterRTTI.Name); end; end; PublishedMethod := GetNextPublishedMethod(ClassInfo.ClassType, PublishedMethod); end; end;

Как обычно, мы тестируем код, определяя какой-то глупый класс и используя RTTI для реконструирования его объявления. Вот упрощённый тестовый проект:

program TestHVMethodInfoClasses;   {$APPTYPE CONSOLE}   uses SysUtils, TypInfo, HVMethodSignature in 'HVMethodSignature.pas', HVMethodInfoClasses in 'HVMethodInfoClasses.pas';  procedure DumpClass(ClassTypeInfo: PTypeInfo); var ClassInfo: TClassInfo; i: integer; begin GetClassInfo(ClassTypeInfo, ClassInfo); WriteLn('unit ', ClassInfo.UnitName, ';'); WriteLn('type'); Write('  ', ClassInfo.Name, ' = '); Write('class'); if Assigned(ClassInfo.ParentClass) then Write(' (', ClassInfo.ParentClass.ClassName, ')'); WriteLn; for i := Low(ClassInfo.Methods) to High(ClassInfo.Methods) do WriteLn('    ', MethodSignatureToString(ClassInfo.Methods[i])); WriteLn('  end;'); WriteLn; end;  type {$METHODINFO OFF} TNormalClass = class end; TSetOfByte = set of byte; TEnum = (enOne, enTwo, enThree);  type {$METHODINFO ON} TMyClass = class public function Test1(const A: string): string; function Test2(const A: string): byte; procedure Test3(R: integer); procedure Test4(R: TObject); procedure Test5(R: TNormalClass); procedure Test6(R: TSetOfByte); procedure Test7(R: shortstring); procedure Test8(R: openstring); procedure Test9(R: TEnum); function Test10: TNormalClass; function Test11: integer; function Test18: shortstring; function Test19: TObject; function Test20: IInterface; function Test21: TSetOfByte; function Test22: TEnum; end;   // ... вырезаны реализации-пустышки методов класса TMyClass ...  procedure Test; begin DumpClass(TypeInfo(TMyClass)); end;  begin try Test; except on E: Exception do WriteLn(E.Message); end; readln; end.

И вывод тестового кода:

unit TestHVMethodInfoClasses; type TMyClass = class (TObject) function Test1(A: String): String; function Test2(A: String): Byte; procedure Test3(R: Integer); procedure Test4(R: TObject); procedure Test5(R: TNormalClass); procedure Test6(R: TSetOfByte); procedure Test7(R: ShortString); procedure Test8(R: ShortString); procedure Test9(R: TEnum); function Test10(): TNormalClass; function Test11(): Integer; function Test18(): ShortString; function Test19(): TObject; function Test20(): IInterface; function Test21(): TSetOfByte; function Test22(): TEnum; end;

Полный исходный код доступен на CodeCentral. Как отметил мой прилежный читатель, Ralf, вывод этой программы является дословной копией исходного кода. Помимо моей небрежности по не опусканию пустых скобок в функциях: строковые параметры пока не объявлены как const. Это потому, что RTTI для этих параметров не включает pfConst (duh!). Я думаю, что причина в том, что RTTI методов и параметров оптимизирована для получения возможности динамического вызова методов в run-time, а модификатор const на это не влияет (на вызывающего) - он влияет только на код метода, создаваемый компилятором (запрет изменения и опускание создания локальной копии). Фактически я пытался (до сих пор - не успешно) уговорить Borland DevCo CodeGear Embarcadero упростить компилятор и разрешить ставить const в секции implementation и не ставить - в interface. Это может звучать, как запрос ленивого программиста, но на деле это позволило бы менять "константность" параметра, не затрагивая (не изменяя) интерфейс - что является более чем логичным поведением. Ох, ну и ладно, в любом случае, это история для другого раза.