* fixed loading the vmt of TP-style objects when it's not at offset zero

(for virtual procvars of object, mantis #17521)

git-svn-id: trunk@16190 -

.gitattributes

@@ -10700,6 +10700,7 @@ tests/webtbs/tw1744.pp svneol=native#text/plain
 tests/webtbs/tw17458.pp svneol=native#text/plain
 tests/webtbs/tw17493.pp svneol=native#text/plain
 tests/webtbs/tw17514.pp svneol=native#text/plain
+tests/webtbs/tw17521.pp svneol=native#text/plain
 tests/webtbs/tw17546.pp svneol=native#text/plain
 tests/webtbs/tw1754c.pp svneol=native#text/plain
 tests/webtbs/tw1755.pp svneol=native#text/plain

compiler/ncgld.pas

@@ -512,7 +512,7 @@ implementation
                          if (left.resultdef.typ<>classrefdef) then
                            begin
                              { load vmt pointer }
-                             reference_reset_base(href,hregister,0,sizeof(pint));
+                             reference_reset_base(href,hregister,tobjectdef(left.resultdef).vmt_offset,sizeof(pint));
                              hregister:=cg.getaddressregister(current_asmdata.CurrAsmList);
                              cg.a_load_ref_reg(current_asmdata.CurrAsmList,OS_ADDR,OS_ADDR,href,hregister);
                            end;

tests/webtbs/tw17521.pp

@@ -0,0 +1,33 @@
+{$mode objfpc}
+{$h+}
+
+
+type tx = object
+       a,b,c: longint; // remove these => no crash
+       constructor init;
+       function v: longint; virtual;
+       end;
+     px = ^tx;
+     
+constructor tx.init;
+  begin
+  end;
+
+function tx.v: longint;
+  begin
+    v:=b;
+  end;
+  
+var t : function:longint of object;
+    p : px;
+    
+begin
+  new( p, init );
+  p^.a:=3;
+  p^.b:=4;
+  p^.c:=5;
+  p^.v; // ok
+  t := @p^.v; // sigsegv
+  if t()<>4 then
+    halt(1);
+end.