From ea6715c20702b78aae0afd01e30976797c478749 Mon Sep 17 00:00:00 2001
From: peter <peter@freepascal.org>
Date: Sun, 24 Oct 2004 12:56:17 +0000
Subject: [PATCH]   * methodtable test

---
 tests/test/tclass8.pp | 58 +++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 58 insertions(+)
 create mode 100644 tests/test/tclass8.pp

diff --git a/tests/test/tclass8.pp b/tests/test/tclass8.pp
new file mode 100644
index 0000000000..ca49f4c931
--- /dev/null
+++ b/tests/test/tclass8.pp
@@ -0,0 +1,58 @@
+{ %version=1.1 }
+
+{$mode objfpc}
+
+uses
+  classes;
+
+type
+
+{$M+}
+  TTestCaseTest = class(TObject)
+  published
+    procedure TestSetUp;
+    procedure TestAsString;
+  end;
+
+procedure TTestCaseTest.TestSetup;
+begin
+  writeln('TestSetup');
+end;
+
+procedure TTestCaseTest.TestAsString;
+begin
+  writeln('TestAsString');
+end;
+
+function GetMethodNameTableAddress(AClass: TClass): Pointer;
+type
+  TMethodNameRec = packed record
+    name : pshortstring;
+    addr : pointer;
+  end;
+
+  TMethodNameTable = packed record
+    count : dword;
+    entries : packed array[0..0] of TMethodNameRec;
+  end;
+
+  pMethodNameTable =  ^TMethodNameTable;
+
+var
+  methodTable : pMethodNameTable;
+  vmt: TClass;
+begin
+  vmt := aClass;
+  if assigned(vmt) then
+  begin
+    methodTable := pMethodNameTable((Pointer(vmt) + vmtMethodTable)^);
+    Result := methodTable;
+  end;
+end;
+
+begin
+  writeln('Address of TestSetUp : ',ptrint(TTestCaseTest.MethodAddress('TestSetUp')));
+  writeln('Address of TestAsString : ',ptrint(TTestCaseTest.MethodAddress('TestAsString')));
+  if not (Assigned(GetMethodNameTableAddress(TTestCaseTest))) then
+    halt(1);
+end.