Program BadNews;
//This program is adapted from Barry Kelly's example
//from http://codeverge.com/embarcadero.delphi.win32/threads/1039644
// I made it cross platform
// It is a demonstration of why you should not use
// TThread.Suspend/TThread.Resume, unless you are writing a debugger.
//
// Op.Cit Barry Kelly:
// --- Folks, just don't use TThread.Suspend. If you still think you need it,
// you had better be implementing a debugger, GC,
// or something equivalently low-level.
// -- Barry
//
// Note the problem is universal and not limited to Delphi, as you will
// find out when you compile and run the program a few times ;)
// Thaddy
{$mode delphi}
{$ifdef mswindows}{$APPTYPE CONSOLE}{$endif}
Uses
{$ifdef unix}cthreads,{$else}
{$ifdef msWindows}
windows,
{$endif}
{$endif}
SysUtils, Classes, SyncObjs;
Type TMyThread = Class(TThread)
Private FCritSec: TCriticalSection;
FList: TList;
Protected Procedure Execute;
override;
Public constructor Create;
destructor Destroy;
override;
Procedure DoWork(Var x: Integer);
End;
Var IOCritSec: TCriticalSection;
// Thread-safe console output
Procedure TWrite(Const s: String);
Begin
IOCritSec.Acquire;
Try
Writeln(Output, s);
Flush(Output);
Finally
IOCritSec.Release;
End;
End;
{ TMyThread }
constructor TMyThread.Create;
Begin
inherited Create(False);
FCritSec := TCriticalSection.Create;
FList := TList.Create;
End;
destructor TMyThread.Destroy;
Begin
FCritSec.Free;
FList.Free;
inherited;
End;
Procedure TMyThread.DoWork(Var x: Integer);
Begin
FCritSec.Acquire;
Try
FList.Insert(0, @x)
Finally
FCritSec.Release;
End;
If Suspended Then Resume;
End;
Procedure TMyThread.Execute;
Var work: PInteger;
Begin
While Not Terminated Do
Begin
TWrite('W');
// heartbeat indicating OK
FCritSec.Acquire;
Try
If FList.Count > 0 Then
Begin
work :=
FList.Last;
FList.Delete(FList.Count - 1);
End
Else
work := Nil;
Finally
FCritSec.Release;
End;
If work = Nil Then
Begin
TWrite('-sleep-');
Suspend;
End
Else
Begin
Inc(work^);
End;
End;
End;
Procedure Produce;
Var worker: TMyThread;
Procedure SpinUntil(Var ref: Integer; val: Integer);
Var maxSpin: Integer;
Begin
maxSpin := High(Integer);
While ref <> val Do
Begin
Dec(maxSpin);
If maxSpin = 0 Then
Begin
If worker.Suspended Then
Begin
TWrite('Oh dear: we deadlocked.');
TWrite(IntToStr(worker.FList.Count) + ' missed work items.');
Halt;
End
Else
TWrite('Unexpected spin loop failure');
Exit;
End;
End;
End;
Var a, b, c: Integer;
Begin
worker := TMyThread.Create;
Try
While True Do
Begin
a := 10;
b := 20;
c := 30;
worker.DoWork(a);
worker.DoWork(b);
worker.DoWork(c);
SpinUntil(c, 31);
SpinUntil(a, 11);
SpinUntil(b, 21);
TWrite('P');
// heartbeat indicating OK
End;
Finally
worker.Free;
End;
End;
Begin
IOCritSec := TCriticalSection.Create;
Try
Try
Produce;
Except
on E: Exception Do Writeln(E.Classname, ': ', E.Message);
End;
Finally
IOCritSec.Free;
End;
End.