QualityCentral

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: 3/20/2012 2:24:39 AM

Platform: All versions

Internal Tracking #: 287872

Resolution: None (Resolution Comments)

Resolved in Build: : None

Duplicate of: None

Voting and Rating

Overall Rating: (2 Total Ratings)

5.00 out of 5

Total Votes: 18

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"

Developer Tools

Database Tools