* TP-style object destructors do not need actual VMT in hidden parameter, a constant flag indicating need to free memory is sufficient.

* Destructor called from exception block in constructor must have this flag set in order to free memory.
+ Test.

git-svn-id: trunk@26656 -

.gitattributes

@@ -11715,6 +11715,7 @@ tests/test/tobjcl2.pp svneol=native#text/plain
 tests/test/tobjcl3.pp svneol=native#text/plain
 tests/test/tobjcl4.pp svneol=native#text/plain
 tests/test/tobject1.pp svneol=native#text/plain
+tests/test/tobject10.pp svneol=native#text/plain
 tests/test/tobject2.pp svneol=native#text/plain
 tests/test/tobject3.pp svneol=native#text/plain
 tests/test/tobject4.pp svneol=native#text/plain

compiler/ncal.pas

@@ -2226,9 +2226,11 @@ implementation
             if (cnf_new_call in callnodeflags) then
                 vmttree:=cloadvmtaddrnode.create(ctypenode.create(methodpointer.resultdef))
             else
-              { destructor with extended syntax called from dispose }
-              if (cnf_dispose_call in callnodeflags) then
-                vmttree:=cloadvmtaddrnode.create(methodpointer.getcopy)
+              { destructor with extended syntax called from dispose
+                or destructor called from exception block in constructor }
+              if (cnf_dispose_call in callnodeflags) or
+                 (cnf_create_failed in callnodeflags) then
+                vmttree:=cpointerconstnode.create(1,voidpointertype)
             else
               { inherited call, no create/destroy }
               if (cnf_inherited in callnodeflags) then

tests/test/tobject10.pp

@@ -0,0 +1,32 @@
+{ %OPT=-gh }
+{$mode objfpc}{$h+}
+{ Test that exception in object constructor does not cause memory leak }
+
+uses sysutils;
+
+type
+  pobj=^obj;
+  obj=object
+    constructor init;
+    destructor done; virtual;
+  end;
+
+constructor obj.init;
+begin
+  raise exception.create('oops!');
+end;
+
+destructor obj.done;
+begin
+end;
+
+var
+  p: pobj;
+
+begin
+  HaltOnNotReleased:=true;
+  try
+    new(p,init);
+  except
+  end;
+end.