मुझे एक निजी रिकॉर्ड विधि के लिए RTTIMethod.Visibility = mvPublic मिलता है। - बग?

Question

मुझे डेल्फी 10.2 का उपयोग करके एक (सख्त) निजी रिकॉर्ड विधि के लिए RTTIMethod.Visibility = mvPublic मिलता है। क्या यह एक बग है?

---

अद्यतन 2017-07-12: जारी किया गया समस्या: RSP-18587।

---

कार्यक्रम आउटपुट रिकॉर्ड और कक्षा के लिए सभी इंस्टेंस सदस्य प्रकारों और दृश्यताएं दिखा रहा है; आरटीटीआई से लौटने की दृश्यता;

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

बग है GetVisibilit:

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.dprTSomeRec में PrivateProcedure के लिए एक नजर है y TRttiRecordMethod में ओवरराइड नहीं है। मैंने कोड में थोड़ा सा देखा और दृश्यता के बारे में जानकारी वास्तव में ध्वज क्षेत्र के अंदर है।

तो अन्य GetVisibility ओवरराइड के समान जैसे TRttiRecordField में इसे लागू करने की आवश्यकता है। मैंने इसे RSP-18588 के रूप में रिपोर्ट किया।

मैंने एक छोटा पैच लिखा है जिसे ठीक करना चाहिए यदि आपको वास्तव में इसे ठीक करने की आवश्यकता है (केवल विंडोज़)।

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.