* also free memory when a destructor is called without an explicit

instance reference (mantis 11896)
  * fixed double destructor call in tests/test/cg/tcalcla1.pp which
    caused an error after this change

git-svn-id: trunk@11599 -

.gitattributes

@@ -8545,6 +8545,7 @@ tests/webtbs/tw11848.pp svneol=native#text/plain
 tests/webtbs/tw11852.pp svneol=native#text/plain
 tests/webtbs/tw11861.pp svneol=native#text/plain
 tests/webtbs/tw11862.pp svneol=native#text/plain
+tests/webtbs/tw11896.pp svneol=native#text/plain
 tests/webtbs/tw1203.pp svneol=native#text/plain
 tests/webtbs/tw1204.pp svneol=native#text/plain
 tests/webtbs/tw1207.pp svneol=native#text/plain

compiler/ncal.pas

@@ -1575,14 +1575,21 @@ implementation
                 without specifying self explicit }
               if (cnf_member_call in callnodeflags) then
                 begin
-                  { destructor: don't release instance, vmt=0
-                    constructor:
-                      if called from a constructor in the same class then
+                  { destructor (in the same class, since cnf_member_call):
+                    if not called from a destructor then
+                      call beforedestruction and release instance, vmt=1
+                    else
+                      don't release instance, vmt=0
+                    constructor (in the same class, since cnf_member_call):
+                      if called from a constructor then
                         don't call afterconstruction, vmt=0
                       else
                         call afterconstrution, vmt=1 }
                   if (procdefinition.proctypeoption=potype_destructor) then
-                    vmttree:=cpointerconstnode.create(0,voidpointertype)
+                    if (current_procinfo.procdef.proctypeoption<>potype_constructor) then
+                      vmttree:=cpointerconstnode.create(1,voidpointertype)
+                    else
+                      vmttree:=cpointerconstnode.create(0,voidpointertype)
                   else if (current_procinfo.procdef.proctypeoption=potype_constructor) and
                           (procdefinition.proctypeoption=potype_constructor) then
                     vmttree:=cpointerconstnode.create(0,voidpointertype)
@@ -1601,7 +1608,7 @@ implementation
                     if called from a constructor in the same class using self.create then
                       don't call afterconstruction, vmt=0
                     else
-                      call afterconstrution, vmt=1 }
+                      call afterconstruction, vmt=1 }
                 if (procdefinition.proctypeoption=potype_destructor) then
                   if not(cnf_create_failed in callnodeflags) then
                     vmttree:=cpointerconstnode.create(1,voidpointertype)

tests/test/cg/tcalcla1.pp

@@ -2175,7 +2175,9 @@ var
       failed := true;
     if global_bigstring <> RESULT_BIGSTRING then
       failed := true;
+{ already called by method_virtual_call_destructor above
     vmtclass.destructor_params_done;
+}
 
     if failed then
       fail
@@ -3650,7 +3652,9 @@ procedure testwith;
       failed := true;
     if global_bigstring <> RESULT_BIGSTRING then
       failed := true;
+{ already called by method_virtual_call_destructor above
     destructor_params_done;
+}
 
     if failed then
       fail

tests/webtbs/tw11896.pp

@@ -0,0 +1,51 @@
+program destroytest;
+
+{$mode delphi}
+
+type
+  TTest = class(TObject)
+    a: array[0..32767] of Integer;
+    procedure x;
+    procedure y;
+    procedure beforedestruction;override;
+  end;
+
+var
+  testobj: TTest;
+  destroyed: boolean;
+
+procedure TTest.beforedestruction;
+begin
+  destroyed:=true;
+  inherited beforedestruction;
+end;
+
+procedure TTest.x;
+begin
+  Destroy;
+end;
+
+procedure TTest.y;
+begin
+  Self.Destroy;
+end;
+
+function GetUsedMemory: Integer;
+begin
+  Result := GetHeapStatus.TotalAllocated;
+end;
+
+begin
+  testobj := TTest.create;
+  destroyed:=false;
+  testobj.x;
+  if not destroyed then
+    halt(1);
+
+  destroyed:=false;
+  testobj := TTest.create;
+  testobj.y;
+  if not destroyed then
+    halt(2);
+end.
+