* 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

@@ -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

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

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.