program rtti_test;

{$IFDEF FPC}
  {$mode objfpc}{$H+}
{$ELSE}
  {$IFDEF VER200}
    {$DEFINE DELPHI_2009}
  {$ENDIF}
  {$IFDEF VER210}
    {$DEFINE DELPHI_2009}
    {$DEFINE DELPHI_2010}
  {$ENDIF}
{$ENDIF}
{$APPTYPE CONSOLE}

uses
  TypInfo;

type
  TRegisterMethod = procedure(Sender: TObject; Something: LongInt) of object; register;
  TCdeclMethod = procedure(Sender: TObject; Something: LongInt) of object; cdecl;
  TPascalMethod = procedure(Sender: TObject; Something: LongInt) of object; pascal;
  TStdcallMethod = procedure(Sender: TObject; Something: LongInt) of object; stdcall;
  TSafeCallMethod = procedure(Sender: TObject; Something: LongInt) of object; safecall;

// from d2010
type
  TCallConv = (ccReg, ccCdecl, ccPascal, ccStdCall, ccSafeCall);

function GetMethodDescription(Data: PTypeData): AnsiString;
const
  MethodKindToStr: array[TMethodKind] of AnsiString =
  (
     'procedure'
    ,'function'
    ,'constructor'
    ,'destructor'
    ,'class procedure'
    ,'class function'
{$IFNDEF FPC}
  {$IFDEF DELPHI_2009}
    ,'class constructor'
  {$IFDEF DELPHI_2010}
    ,'class destructor' // d2010 only
  {$ENDIF}  
    ,'operator overload'
  {$ENDIF}
    ,'safe procedure'
    ,'safe function'
{$ENDIF}
  );
  ParamFlagToStr: array[TParamFlag] of AnsiString =
  (
   'var',
   'const',
   'array',
   'address',
   'reference',
   'out'
{$IFDEF DELPHI_2010}
   ,'result' // d2010 only
{$ENDIF}
  );
  CallConvToStr: array[TCallConv] of AnsiString =
  (
    'register',
    'cdecl',
    'pascal',
    'stdcall',
    'safecall'
  );
var
  b: byte;
  i, p: integer;
  s: AnsiString;
  ParamFlags: TParamFlags;
  ParamFlag: TParamFlag;
begin
  Result := MethodKindToStr[Data^.MethodKind];
  if Data^.ParamCount > 0 then
  begin
    Result := Result + '(';
    i := 0;
    p := 0;
    while i < Data^.ParamCount do
    begin
      // read ParamFlags
      ParamFlags := TParamFlags(Data^.ParamList[p]);
      for ParamFlag := Low(ParamFlag) to High(ParamFlag) do
        if ParamFlag in ParamFlags then
          Result := Result + ParamFlagToStr[ParamFlag] + ' ';
      inc(p);
      // read argument name
      b := byte(Data^.ParamList[p]);
      inc(p);
      SetLength(s, b);
      Move(Data^.ParamList[p], s[1], b);
      Result := Result + s + ': ';
      inc(p, b);
      // read argument type
      b := byte(Data^.ParamList[p]);
      inc(p);
      SetLength(s, b);
      Move(Data^.ParamList[p], s[1], b);
      Result := Result + s;
      inc(p, b);
      if i < Data^.ParamCount - 1 then
        Result := Result + '; ';

      inc(i);
    end;
    Result := Result + ')';
    if Data^.MethodKind = mkFunction then
    begin
      // read result type
      b := byte(Data^.ParamList[p]);
      inc(p);
      SetLength(s, b);
      Move(Data^.ParamList[p], s[1], b);
      Result := Result + ': ' + s;
      inc(p, b);
      // skip result PTypeInfo
      inc(p, SizeOf(PTypeInfo));
    end;
    Result := Result + ';';
    {$IFNDEF FPC}
    // read calling convention
    b := byte(Data^.ParamList[p]);
    Result := Result + ' ' + CallConvToStr[TCallConv(b)] + ';';
    {$ENDIF}
    //inc(p);
  end;
end;

var
  Data: PTypeData;

begin
  Data := GetTypeData(TypeInfo(TRegisterMethod));
  WriteLn(GetMethodDescription(Data));
  Data := GetTypeData(TypeInfo(TCdeclMethod));
  WriteLn(GetMethodDescription(Data));
  Data := GetTypeData(TypeInfo(TPascalMethod));
  WriteLn(GetMethodDescription(Data));
  Data := GetTypeData(TypeInfo(TStdCallMethod));
  WriteLn(GetMethodDescription(Data));
  Data := GetTypeData(TypeInfo(TSafeCallMethod));
  WriteLn(GetMethodDescription(Data));
end.

