From f64556c125d88ea3c6c7c79189bb6bf2005f9efc Mon Sep 17 00:00:00 2001
From: Jonas Maebe <jonas@freepascal.org>
Date: Tue, 30 Aug 2016 07:25:16 +0000
Subject: [PATCH]   * when taking the address of a class method via an
 instance, create a procvar     with the VMT of the instance as self instead
 of the self instance pointer     (mantis #29491)

git-svn-id: trunk@34395 -
---
 .gitattributes          |  1 +
 compiler/nld.pas        | 10 +++++++++-
 tests/webtbs/tw29491.pp | 28 ++++++++++++++++++++++++++++
 3 files changed, 38 insertions(+), 1 deletion(-)
 create mode 100644 tests/webtbs/tw29491.pp

diff --git a/.gitattributes b/.gitattributes
index 6c03691e8b..265ad892fb 100644
--- a/.gitattributes
+++ b/.gitattributes
@@ -15151,6 +15151,7 @@ tests/webtbs/tw29444.pp svneol=native#text/pascal
 tests/webtbs/tw2946.pp svneol=native#text/plain
 tests/webtbs/tw29471.pp svneol=native#text/plain
 tests/webtbs/tw2949.pp svneol=native#text/plain
+tests/webtbs/tw29491.pp svneol=native#text/plain
 tests/webtbs/tw2953.pp svneol=native#text/plain
 tests/webtbs/tw29546.pp svneol=native#text/pascal
 tests/webtbs/tw29547.pp svneol=native#text/plain
diff --git a/compiler/nld.pas b/compiler/nld.pas
index 0ab69f6853..5f656e1cd0 100644
--- a/compiler/nld.pas
+++ b/compiler/nld.pas
@@ -365,7 +365,15 @@ implementation
 
                { process methodpointer/framepointer }
                if assigned(left) then
-                 typecheckpass(left);
+                 begin
+                   typecheckpass(left);
+                   if (po_classmethod in fprocdef.procoptions) and
+                      is_class(left.resultdef) then
+                     begin
+                       left:=cloadvmtaddrnode.create(left);
+                       typecheckpass(left);
+                     end
+                 end;
              end;
            labelsym:
              begin
diff --git a/tests/webtbs/tw29491.pp b/tests/webtbs/tw29491.pp
new file mode 100644
index 0000000000..78991a349d
--- /dev/null
+++ b/tests/webtbs/tw29491.pp
@@ -0,0 +1,28 @@
+program test;
+
+{$mode objfpc}{$H+}
+
+type
+  TCallback = procedure of object;
+
+  TTestObject = class (TObject)
+  public
+    class procedure Test;
+  end;
+
+class procedure TTestObject.Test;
+begin
+  writeln(Self.ClassName); // Self should point to TTestObject (class)
+  if Self.ClassName<>'TTestObject' then
+    halt(1);
+end;
+
+var
+  Callback: TCallback;
+  O: TTestObject;
+begin
+  O := TTestObject.Create;
+  Callback := @O.Test;
+  Callback();
+  O.Free;
+end.