From 072cb55315f8c79baf9561cb6218f6fbb77e5057 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Micha=C3=ABl=20Van=20Canneyt?= <michael@freepascal.org>
Date: Tue, 17 Dec 2024 17:57:17 +0100
Subject: [PATCH] * Get method by address. Patch by Lipinast Lekrisov

---
 packages/rtl-objpas/src/inc/rtti.pp      | 15 ++++++++++++++-
 packages/rtl-objpas/tests/tests.rtti.pas | 15 +++++++++++++++
 2 files changed, 29 insertions(+), 1 deletion(-)

diff --git a/packages/rtl-objpas/src/inc/rtti.pp b/packages/rtl-objpas/src/inc/rtti.pp
index aee1da41c0..f528658b3d 100644
--- a/packages/rtl-objpas/src/inc/rtti.pp
+++ b/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;
diff --git a/packages/rtl-objpas/tests/tests.rtti.pas b/packages/rtl-objpas/tests/tests.rtti.pas
index c6d3b4d489..0cac4d9337 100644
--- a/packages/rtl-objpas/tests/tests.rtti.pas
+++ b/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;