Watch, Follow, &
Connect with Us
Public Report
Report From: Delphi-BCB/RTL/Delphi/Thread support    [ Add a report in this area ]  
Report #:  76329   Status: Open
Exception in TThread descendant can cause double destruction of object if FreeOnTreminate is true
Project:  Delphi Build #:  12.0.3210.17555
Version:    12.1 Submitted By:   Alexey Beloborodov
Report Type:  Crash / Data loss / Total failure Date Reported:  8/3/2009 3:42:51 AM
Severity:    Infrequently encountered problem Last Updated: 3/20/2012 2:24:39 AM
Platform:    All platforms Internal Tracking #:   271992
Resolution: None (Resolution Comments) Resolved in Build: : None
Duplicate of:  None
Voting and Rating
Overall Rating: No Ratings Yet
0.00 out of 5
Total Votes: 5
Description
constructor TMyThread.Create;
begin
    FreeOnTerminate:=True;
    inherited Create(True);  // suspended

    raise Exception.create('Dummy');

    Resume;
end;

Destructor of this object will be called twice.
----
Initially discovered by "An Pham", see
https://forums.embarcadero.com/thread.jspa?messageID=142514&tstart=0#142514
Steps to Reproduce:
Create new VCL application, drop a button on form.

type
   TMyThread=class(TThread)
      public
        constructor Create;
        destructor Destroy; override;
         procedure Execute; override;
    end;

  constructor TMyThread .Create;
  begin
     FreeOnTerminate:=True;
     inherited Create(True);  // suspended

     raise Exception.create('Dummy');
{
Exception in constructor calls destructor.
}
     Resume;
  end;

destructor TMyThread .Destroy;
begin
   MessageBox(0, 'Destroy', 'Destroy', MB_OK);
   inherited Destroy;

{
Inherited TThread.Destroy sets 'Terminated' flag, starts the thread and waits for its finish.

Started thread (in ThreadProc) sees 'Terminated' flag and doesn't call Execute. It sees 'FreeOnTerminate' flag and destroys class instance and Windows thread.

The main thread detects end of thread (WaitFor exits successfully) and continue destruction of already destroyed object instance.
}

end;

procedure TMyThread.Execute;
begin
end;

procedure TfrmMain.Button1Click(Sender: TObject);
var
  t: TMyThread;
begin
  t:=TMyThread.Create;
end;

---------------------------

Workaround:
To avoid this set FreeOnterminate right befor Resume:

constructor TMyThread .Create;
begin
  inherited Create(True);   // suspended
   raise Exception.create('Dummy');
   FreeOnTerminate:=True;
   Resume;
end;
Workarounds
To avoid this set FreeOnterminate right befor Resume:

constructor TMyThread .Create;
begin
   inherited Create(True);   // suspended

   raise Exception.create('Dummy');

   FreeOnTerminate:=True;
   Resume;
end;
Attachment
None
Comments

None

Server Response from: ETNACODE01