* call FreeInstance after fail if vmt<>nil rather than if vmt=1

(mantis #10790)

git-svn-id: trunk@10249 -

.gitattributes

@@ -7965,6 +7965,7 @@ tests/webtbs/tw10736.pp svneol=native#text/plain
 tests/webtbs/tw10753.pp svneol=native#text/plain
 tests/webtbs/tw10753a.pp svneol=native#text/plain
 tests/webtbs/tw10757.pp svneol=native#text/plain
+tests/webtbs/tw10790.pp svneol=native#text/plain
 tests/webtbs/tw1081.pp svneol=native#text/plain
 tests/webtbs/tw1090.pp svneol=native#text/plain
 tests/webtbs/tw1092.pp svneol=native#text/plain

compiler/nutils.pas

@@ -471,17 +471,15 @@ implementation
             if assigned(srsym) and
                (srsym.typ=procsym) then
               begin
-                { if self<>0 and vmt=1 then freeinstance }
+                { if self<>0 and vmt<>0 then freeinstance }
                 addstatement(newstatement,cifnode.create(
                     caddnode.create(andn,
                         caddnode.create(unequaln,
                             load_self_pointer_node,
                             cnilnode.create),
-                        caddnode.create(equaln,
+                        caddnode.create(unequaln,
-                            ctypeconvnode.create(
+                            load_vmt_pointer_node,
-                                load_vmt_pointer_node,
+                            cnilnode.create)),
-                                voidpointertype),
-                            cpointerconstnode.create(1,voidpointertype))),
                     ccallnode.create(nil,tprocsym(srsym),srsym.owner,load_self_node,[]),
                     nil));
               end

tests/webtbs/tw10790.pp

@@ -0,0 +1,25 @@
+{ %OPT=-gh }
+
+{$ifdef fpc}
+{$mode delphi}
+{$endif}
+
+program failtest;
+
+type
+   TMyClass = class
+      constructor Create;
+   end;
+    
+constructor TMyClass.Create;
+begin
+   Fail;
+end;
+
+var
+   MyClass : TMyClass;
+
+begin
+   HaltOnNotReleased := true;
+   MyClass := TMyClass.Create;
+end.