Watch, Follow, &
Connect with Us
Public Report
Report From: Delphi-BCB/RTL/Delphi/Thread support    [ Add a report in this area ]  
Report #:  99324   Status: Open
Process hangs on shutdown after using TMonitor to wait on an object that isn't freed
Project:  Delphi Build #:  15.0.3953.35171
Version:    15.1 Submitted By:   David McCammond-Watts
Report Type:  Basic functionality failure Date Reported:  9/26/2011 6:13:12 AM
Severity:    Serious / Highly visible problem Last Updated: 8/14/2014 6:22:38 PM
Platform:    All versions Internal Tracking #:   23832
Resolution: None (Resolution Comments) Resolved in Build: : None
Duplicate of:  None
Voting and Rating
Overall Rating: (5 Total Ratings)
5.00 out of 5
Total Votes: 34
Description
If a program waits on an object using TMonitor.Enter/TMonitor.Exit and there was contention for the monitor (i.e. an underlying OS Event handle is allocated) but the object that was waited on is not freed, the program hangs on shutdown in SysUtils. The process busy-waits for the OS event to be freed but it never is and the unit-finalization thread hangs on the repeat-loop in SysUtils.DoneMonitorSupport.CleanEventList.
Steps to Reproduce:
program TestMonitor;

{$APPTYPE CONSOLE}

uses
  Windows,
  SysUtils,
  Classes;

var
  GObj: TObject;

procedure Log(const s: string);
begin
  TMonitor.Enter(GObj);
  try
    Writeln(s);
  finally
    TMonitor.Exit(GObj);
  end;
end;

type
  TTestThread = class(TThread)
  private
    FObj: TObject;
  protected
    procedure Execute; override;
  public
    constructor Create;
    destructor Destroy; override;
  end;

{ TTestThread }

constructor TTestThread.Create;
begin
  inherited Create(False);
  FObj := TObject.Create;
end;

destructor TTestThread.Destroy;
begin
  FObj.Free;
  inherited;
end;

procedure TTestThread.Execute;
begin
  inherited;
  TMonitor.Enter(FObj);
  try
    Log('TTestThread.Execute');
  finally
    TMonitor.Exit(FObj);
  end;
end;

var
  i: Integer;
  Threads: array[0..9] of TTestThread;
begin
  GObj := TObject.Create;

  Log('Starting');
  for i := 0 to High(Threads) do
    Threads[i] := TTestThread.Create;
  for i := 0 to High(Threads) do
    Threads[i].WaitFor;
  for i := 0 to High(Threads) do
    Threads[i].Free;
  Log('Done');

//      GObj.Free;   // commenting out this line prevents from ternimating application.
end.
Workarounds
None
Attachment
None
Comments

Marco van de Voort at 8/30/2012 4:20:21 AM -
Relation to QC 101114 ?

Leif Uneus at 1/31/2013 3:02:08 PM -
No, that problem is resolved, but this seems to be the same error: QC 111795 "Race-condition in TMonitor code causing application to hang on exit"

David McCammond-Watts at 4/23/2014 6:15:10 AM -
This appears to be fixed in XE6. I reran the test program and it hangs in XE3 and not XE6. I have not tested XE4 or XE5.

Server Response from: ETNACODE01