* Get method by address. Patch by Lipinast Lekrisov

packages/rtl-objpas/src/inc/rtti.pp

@@ -394,6 +394,7 @@ type
     function GetMethods: TRttiMethodArray; virtual; overload;
     function GetMethods(const aName: string): TRttiMethodArray; overload; virtual;
     function GetMethod(const aName: String): TRttiMethod; virtual;
+    function GetMethod(aCodeAddress: CodePointer): TRttiMethod; overload; virtual;
     function ToString : RTLString; override;
     property IsInstance: boolean read GetIsInstance;
     property IsManaged: boolean read GetIsManaged;
@@ -7507,7 +7508,7 @@ end;
 
 function TRttiType.GetMethod(const aName: String): TRttiMethod;
 var
-  methods: specialize TArray<TRttiMethod>;
+  methods: TRttiMethodArray;
   method: TRttiMethod;
 begin
   methods := GetMethods;
@@ -7517,6 +7518,18 @@ begin
   Result := Nil;
 end;
 
+function TRttiType.GetMethod(aCodeAddress: CodePointer): TRttiMethod;
+var
+  methods: TRttiMethodArray;
+  method: TRttiMethod;
+begin
+  methods := GetMethods;
+  for method in methods do
+    if method.CodeAddress = aCodeAddress then
+      Exit(method);
+  Result := Nil;
+end;
+
 function TRttiType.ToString: RTLString;
 begin
   Result:=Name;

packages/rtl-objpas/tests/tests.rtti.pas

@@ -109,6 +109,7 @@ type
     Procedure TestProperties;
     Procedure TestDeclaredMethods;
     Procedure TestMethods;
+    Procedure TestMethodByAddress;
     Procedure TestMethodsInherited;
     Procedure TestPrivateFieldAttributes;
     Procedure TestProtectedFieldAttributes;
@@ -1822,6 +1823,20 @@ begin
   CheckMethod('Full declared',1, A[0],'PublicAdditionalMethod',mvPublic);
 end;
 
+procedure TTestClassExtendedRTTI.TestMethodByAddress;
+
+var
+  Obj : TRttiObject;
+  RttiData : TRttiInstanceType absolute obj;
+  M1,M2 : TRttiMethod;
+begin
+  Obj:=FCtx.GetType(TAdditionalMethodClassRTTI.ClassInfo);
+  M1:=RttiData.GetMethod('PublicAdditionalMethod');
+  AssertNotNull('have method',m1);
+  M2:=RttiData.GetMethod(@TAdditionalMethodClassRTTI.PublicAdditionalMethod);
+  AssertSame('Correct method ',M1,M2);
+end;
+
 procedure TTestClassExtendedRTTI.TestMethodsInherited;
 Var
   A : TRttiMethodArray;