* Fixed exception handling in constructors of TP-style objects to correctly handle cases of statically allocated objects (must call destructor but do not free memory) and objects without destructor (must free memory if it was allocated dynamically).

+ Test extended.

git-svn-id: trunk@26676 -

compiler/ncal.pas

@@ -2226,11 +2226,14 @@ implementation
             if (cnf_new_call in callnodeflags) then
                 vmttree:=cloadvmtaddrnode.create(ctypenode.create(methodpointer.resultdef))
             else
-              { 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)
+              { destructor with extended syntax called from dispose }
+              { value -1 is what fpc_help_constructor() changes VMT to when it allocates memory }
+              if (cnf_dispose_call in callnodeflags) then
+                vmttree:=cpointerconstnode.create(TConstPtrUInt(-1),voidpointertype)
+            else
+              { destructor called from exception block in constructor }
+              if (cnf_create_failed in callnodeflags) then
+                vmttree:=ctypeconvnode.create_internal(load_vmt_pointer_node,voidpointertype)
             else
               { inherited call, no create/destroy }
               if (cnf_inherited in callnodeflags) then

compiler/psub.pas

@@ -758,19 +758,37 @@ implementation
                 pd:=tobjectdef(procdef.struct).find_destructor;
                 { this will always be the case for classes, since tobject has
                   a destructor }
-                if assigned(pd) then
+                if assigned(pd) or is_object(procdef.struct) then
                   begin
                     current_filepos:=exitpos;
                     exceptblock:=internalstatements(newstatement);
                     { first free the instance if non-nil }
-                    { if vmt<>0 then call destructor }
-                    addstatement(newstatement,cifnode.create(
-                      caddnode.create(unequaln,
-                        load_vmt_pointer_node,
-                        cnilnode.create),
-                      { cnf_create_failed -> don't call BeforeDestruction }
-                      ccallnode.create(nil,tprocsym(pd.procsym),pd.procsym.owner,load_self_node,[cnf_create_failed]),
-                      nil));
+                    if assigned(pd) then
+                      { if vmt<>0 then call destructor }
+                      addstatement(newstatement,
+                        cifnode.create(
+                          caddnode.create(unequaln,
+                            load_vmt_pointer_node,
+                            cnilnode.create),
+                          { cnf_create_failed -> don't call BeforeDestruction }
+                          ccallnode.create(nil,tprocsym(pd.procsym),pd.procsym.owner,load_self_node,[cnf_create_failed]),
+                          nil))
+                    else
+                      { object without destructor, call 'fail' helper }
+                      addstatement(newstatement,
+                        ccallnode.createintern('fpc_help_fail',
+                          ccallparanode.create(
+                            cordconstnode.create(tobjectdef(procdef.struct).vmt_offset,s32inttype,false),
+                          ccallparanode.create(
+                            ctypeconvnode.create_internal(
+                              load_vmt_pointer_node,
+                              voidpointertype),
+                          ccallparanode.create(
+                            ctypeconvnode.create_internal(
+                              load_self_pointer_node,
+                              voidpointertype),
+                          nil))))
+                      );
                     { then re-raise the exception }
                     addstatement(newstatement,craisenode.create(nil,nil,nil));
                     current_filepos:=entrypos;

rtl/inc/generic.inc

@@ -782,7 +782,7 @@ procedure fpc_help_destructor(_self,_vmt:pointer;vmt_pos:cardinal);[public,alias
 begin
    { already released? }
    if (_self=nil) or
-      (_vmt=nil) or
+      (_vmt<>pointer(-1)) or
       (ppointer(_self+vmt_pos)^=nil) then
      exit;
    if (pobjectvmt(ppointer(_self+vmt_pos)^)^.size=0) or

tests/test/tobject10.pp

@@ -11,22 +11,62 @@ type
     destructor done; virtual;
   end;
 
+  pobjnodestructor=^objnodestructor;
+  objnodestructor=object
+    constructor init;
+  end;
+
 constructor obj.init;
 begin
-  raise exception.create('oops!');
+  Abort;
 end;
 
 destructor obj.done;
 begin
 end;
 
+constructor objnodestructor.init;
+begin
+  Abort;
+end;
+
 var
+  ps: obj;
+  ps2: objnodestructor;
   p: pobj;
+  p2: pobjnodestructor;
 
 begin
   HaltOnNotReleased:=true;
+  { Test 1: object with destructor, dynamically allocated. Must free memory. }
   try
     new(p,init);
   except
+    on EAbort do
+    else Halt(1);
+  end;
+
+  { Test 2: object with destructor, statically allocated. Must not try to free memory. }
+  try
+    ps.init;
+  except
+    on EAbort do
+    else Halt(2);
+  end;
+
+  { Test 3: object without destructor, dynamically allocated. }
+  try
+    new(p2,init);
+  except
+    on EAbort do
+    else Halt(3);
+  end;
+
+  { Test 4: object without desturtor, statically allocated. }
+  try
+    ps2.init;
+  except
+    on EAbort do
+    else Halt(4);
   end;
 end.