I get RTTIMethod.Visibility = mvPublic for a private record method. -- Bug?

Question

I get RTTIMethod.Visibility = mvPublic for a (strict) private record method, using Delphi 10.2. Is this a bug?

---

Update 2017-07-12: Issue created: RSP-18587.

---

Program output showing all instance member types and visibilities for a record and a class; visibility as returned from the RTTI; have a look for PrivateProcedure in TSomeRec:

Types:
  Unit1.TSomeRec
    Fields:
      PrivateField
        Visibility: mvPrivate
      PublicField
        Visibility: mvPublic
    Properties:
    Methods:
      PrivateProcedure
        Visibility: mvPublic
      PrivateFunction
        Visibility: mvPublic
      PublicProcedure
        Visibility: mvPublic
      PublicFunction
        Visibility: mvPublic
  Unit1.TSomeClass
    Fields:
      PrivateField
        Visibility: mvPrivate
      ProtectedField
        Visibility: mvProtected
      PublicField
        Visibility: mvPublic
    Properties:
      PrivateProperty
        Visibility: mvPrivate
      ProtectedProperty
        Visibility: mvProtected
      PublicProperty
        Visibility: mvPublic
      PublishedProperty
        Visibility: mvPublished
    Methods:
      PrivateProcedure
        Visibility: mvPrivate
      PrivateFunction
        Visibility: mvPrivate
      ProtectedProcedure
        Visibility: mvProtected
      ProtectedFunction
        Visibility: mvProtected
      PublicProcedure
        Visibility: mvPublic
      PublicFunction
        Visibility: mvPublic
      PublishedProcedure
        Visibility: mvPublished
      PublishedFunction
        Visibility: mvPublished

---

Unit1.pas:

unit Unit1;

interface

{$RTTI explicit
  Methods ([vcPrivate, vcProtected, vcPublic, vcPublished])
  Properties ([vcPrivate, vcProtected, vcPublic, vcPublished])
  Fields ([vcPrivate, vcProtected, vcPublic, vcPublished])
}

{$Region 'TSomeRec'}

type
  TSomeRec = record
  strict private
    PrivateField: Boolean;
    property PrivateProperty: Boolean read PrivateField;
    procedure PrivateProcedure;
    function PrivateFunction: Boolean;

  public
    PublicField: Boolean;
    property PublicProperty: Boolean read PublicField;
    procedure PublicProcedure;
    function PublicFunction: Boolean;
  end;

{$EndRegion}
{$Region 'TSomeClass'}

type
  TSomeClass = class
  strict private
    PrivateField: Boolean;
    property PrivateProperty: Boolean read PrivateField;
    procedure PrivateProcedure;
    function PrivateFunction: Boolean;

  strict protected
    ProtectedField: Boolean;
    property ProtectedProperty: Boolean read ProtectedField;
    procedure ProtectedProcedure;
    function ProtectedFunction: Boolean;

  public
    PublicField: Boolean;
    property PublicProperty: Boolean read PublicField;
    procedure PublicProcedure;
    function PublicFunction: Boolean;

  published
    property PublishedProperty: Boolean read PublicField;
    procedure PublishedProcedure;
    function PublishedFunction: Boolean;
  end;

{$EndRegion}

implementation

{$Region 'TSomeRec'}

{ TSomeRec }

function TSomeRec.PrivateFunction: Boolean;
begin
  Result := False;
end;

procedure TSomeRec.PrivateProcedure;
begin
end;

function TSomeRec.PublicFunction: Boolean;
begin
  Result := False;
end;

procedure TSomeRec.PublicProcedure;
begin
end;

{$EndRegion}
{$Region 'TSomeClass'}

{ TSomeClass }

function TSomeClass.PrivateFunction: Boolean;
begin
  Result := False;
end;

procedure TSomeClass.PrivateProcedure;
begin
end;

function TSomeClass.ProtectedFunction: Boolean;
begin
  Result := False;
end;

procedure TSomeClass.ProtectedProcedure;
begin
end;

function TSomeClass.PublicFunction: Boolean;
begin
  Result := False;
end;

procedure TSomeClass.PublicProcedure;
begin
end;

function TSomeClass.PublishedFunction: Boolean;
begin
  Result := False;
end;

procedure TSomeClass.PublishedProcedure;
begin
end;

{$EndRegion}

end.

Project1.dpr:

program Project1;

{$AppType Console}

{$R *.res}

uses
  System.RTTI,
  System.StrUtils,
  System.SysUtils,
  System.TypInfo,
  Unit1 in 'Unit1.pas';

{$Region 'IWriter, TWriter'}

type
  IWriter = interface
    procedure BeginSection(const Value: String = '');
    procedure EndSection;
    procedure WriteMemberSection(const Value: TRTTIMember);
  end;

  TWriter = class (TInterfacedObject, IWriter)
  strict private
    FIndentCount: NativeInt;

  strict protected
    procedure BeginSection(const Value: String);
    procedure EndSection;
    procedure WriteLn(const Value: String);
    procedure WriteMemberSection(const Value: TRTTIMember);

  public
  const
    IndentStr = '  ';
  end;

{ TWriter }

procedure TWriter.BeginSection(const Value: String);
begin
  WriteLn(Value);
  Inc(FIndentCount);
end;

procedure TWriter.EndSection;
begin
  Dec(FIndentCount);
end;

procedure TWriter.WriteLn(const Value: String);
begin
  System.WriteLn(DupeString(IndentStr, FIndentCount) + Value);
end;

procedure TWriter.WriteMemberSection(const Value: TRTTIMember);
begin
  BeginSection(Value.Name);
  try
    WriteLn('Visibility: ' + TValue.From<TMemberVisibility>(Value.Visibility).ToString);
  finally
    EndSection;
  end;
end;

{$EndRegion}

{$Region '...'}

procedure Run;
var
  Writer: IWriter;
  RTTIContext: TRTTIContext;
  RTTIType: TRTTIType;
  RTTIField: TRTTIField;
  RTTIProp: TRTTIProperty;
  RTTIMethod: TRTTIMethod;
begin
  Writer := TWriter.Create;
  RTTIContext := TRTTIContext.Create;
  try
    RTTIContext.GetType(TypeInfo(TSomeRec));
    RTTIContext.GetType(TypeInfo(TSomeClass));
    Writer.BeginSection('Types:');
    for RTTIType in RTTIContext.GetTypes do
    begin
      if not RTTIType.Name.Contains('ISome')
        and not RTTIType.Name.Contains('TSome') then
        Continue;
      Writer.BeginSection(RTTIType.QualifiedName);
      Writer.BeginSection('Fields:');
      for RTTIField in RTTIType.GetFields do
      begin
        if not RTTIField.Name.EndsWith('Field') then
          Continue;
        Writer.WriteMemberSection(RTTIField);
      end;
      Writer.EndSection;
      Writer.BeginSection('Properties:');
      for RTTIProp in RTTIType.GetProperties do
      begin
        if not RTTIProp.Name.EndsWith('Property') then
          Continue;
        Writer.WriteMemberSection(RTTIProp);
      end;
      Writer.EndSection;
      Writer.BeginSection('Methods:');
      for RTTIMethod in RTTIType.GetMethods do
      begin
        if not RTTIMethod.Name.Contains('Procedure')
          and not RTTIMethod.Name.Contains('Function') then
          Continue;
        Writer.WriteMemberSection(RTTIMethod);
      end;
      Writer.EndSection;
      Writer.EndSection;
    end;
    Writer.EndSection;
  finally
    RTTIContext.Free;
  end;
end;

{$EndRegion}

begin
  {$Region '...'}
  try
    Run;
  except
    on E: Exception do
      WriteLn(E.ClassName, ': ', E.Message);
  end;
  ReadLn;
  {$EndRegion}
end.

Answer 1

The bug is that GetVisibility is not overridden in TRttiRecordMethod. I looked a bit into the code and the information about the visibility is actually there inside the Flag field.

So similar to other GetVisibility overrides such as in TRttiRecordField it needs to be implemented. I reported this as RSP-18588.

I wrote a little patch that should fix that if you really need this to be fixed (windows only).

unit PatchRecordMethodGetVisibility;

interface

implementation

uses
  Rtti, SysUtils, TypInfo, Windows;

type
  TRec = record
    procedure Method;
  end;

procedure TRec.Method;
begin
end;

function GetVirtualMethod(AClass: TClass; const Index: Integer): Pointer;
begin
  Result := PPointer(UINT_PTR(AClass) + UINT_PTR(Index * SizeOf(Pointer)))^;
end;

procedure RedirectFunction(OrgProc, NewProc: Pointer);
type
  TJmpBuffer = packed record
    Jmp: Byte;
    Offset: Integer;
  end;
var
  n: UINT_PTR;
  JmpBuffer: TJmpBuffer;
begin
  JmpBuffer.Jmp := $E9;
  JmpBuffer.Offset := PByte(NewProc) - (PByte(OrgProc) + 5);
  if not WriteProcessMemory(GetCurrentProcess, OrgProc, @JmpBuffer, SizeOf(JmpBuffer), n) then
    RaiseLastOSError;
end;

type
  TRttiRecordMethodFix = class(TRttiMethod)
    function GetVisibility: TMemberVisibility;
  end;

procedure PatchIt;
var
  ctx: TRttiContext;
  recMethodCls: TClass;
begin
  recMethodCls := ctx.GetType(TypeInfo(TRec)).GetMethod('Method').ClassType;
  RedirectFunction(GetVirtualMethod(recMethodCls, 3), @TRttiRecordMethodFix.GetVisibility);
end;

{ TRttiRecordMethodFix }

function TRttiRecordMethodFix.GetVisibility: TMemberVisibility;

  function GetBitField(Value, Shift, Bits: Integer): Integer;
  begin
    Result := (Value shr Shift) and ((1 shl Bits) - 1);
  end;

const
  rmfVisibilityShift = 2;
  rmfVisibilityBits = 2;
begin
  Result := TMemberVisibility(GetBitField(PRecordTypeMethod(Handle)^.Flags, rmfVisibilityShift, rmfVisibilityBits))
end;

initialization
  PatchIt;

end.