我再次,希望有更具体的线程问题。
我注意到如果我运行Chris Rolliston在这里提供的精彩演示:
http://delphihaven.wordpress.com/2011/05/06/using-tmonitor-2/
启用FastMM报告内存泄漏,线程本身泄露。
这对于一个小型演示来说没有问题,但是对于我的应用程序,使用该线程进行了数万次迭代,它运行了我的简单的32位应用程序内存。 (我无法编译为64位,因为我只使用32位的CrossTalk)。
如何在与线程队列一起使用时确保释放线程?
新增代码
program SimpleThreadQueueConsole;
{$APPTYPE CONSOLE}
{$R *.res}
uses
FastMM4,
System.SysUtils,
System.SyncObjs,
uPrimeThread in 'uPrimeThread.pas',
uPrimeThreadRunner in 'uPrimeThreadRunner.pas';
var
PR: TPrimeThreadRunner;
begin
Randomize;
ReportMemoryLeaksOnShutdown := True;
PR := TPrimeThreadRunner.Create;
try
PR.DoIt;
finally
PR.Free;
end;
end.
uPrimeThread.pas
unit uPrimeThread;
interface
uses
System.Classes
, Generics.Collections
;
type
TPrimeThread = class(TThread)
private
FOutQueue: TThreadedQueue<string>;
FInQueue: TThreadedQueue<string>;
function IsPrime(const NumberToCheck: integer): boolean;
public
constructor Create(aCreateSuspended: Boolean; aInQueue: TThreadedQueue<string>; aOutQueue: TThreadedQueue<string>);
procedure Execute; override;
end;
implementation
uses
System.SysUtils
, System.SyncObjs
;
const
MaxPrime = 999;
{ TPrimeThread }
constructor TPrimeThread.Create(aCreateSuspended: Boolean; aInQueue, aOutQueue: TThreadedQueue<string>);
begin
inherited Create(aCreateSuspended);
FOutQueue := aOutQueue;
FInQueue := aInQueue;
FreeOnTerminate := True;
end;
procedure TPrimeThread.Execute;
var
S: string;
ThreadID: TThreadID;
NumberToCheck: integer;
begin
ThreadID := TThread.CurrentThread.ThreadID;
FOutQueue.PushItem(Format('Thread %d started...', [ThreadID]));
while (FInQueue.PopItem(S) = wrSignaled) do
begin
NumberToCheck := Random(MaxPrime);
if IsPrime(NumberToCheck) then
begin
FOutQueue.PushItem(Format('%s using thread %d: %d is prime', [S, ThreadID, NumberToCheck]));
end else
begin
FOutQueue.PushItem(Format('%s using thread %d: %d is NOT prime', [S, ThreadID, NumberToCheck]));
end;
end;
end;
function TPrimeThread.IsPrime(const NumberToCheck: Integer): boolean;
// This is really bad on purpose to make the threads work a little harder
var
i: integer;
begin
Result := True;
if NumberToCheck in [0, 1] then
begin
Result := False;
Exit;
end;
for i := 2 to NumberToCheck - 1 do
begin
if NumberToCheck mod i = 0 then
begin
Result := False;
Exit;
end;
end;
end;
end.
uPrimeThreadRunner.pas
unit uPrimeThreadRunner;
interface
uses
System.SyncObjs
, Generics.Collections
, System.SysUtils
, uPrimeThread
;
const
ThreadCount = 4;
type
TPrimeThreadRunner = class
private
FTotalThreads: TCountdownEvent;
FInQueue, FOutQueue: TThreadedQueue<string>;
FCurrentEntry: integer;
procedure DrainTheQueue;
procedure AddEntry;
public
ThreadArray: array[1..ThreadCount] of TPrimeThread;
procedure DoIt;
end;
implementation
const
NumberOfEntries = 10;
procedure TPrimeThreadRunner.DrainTheQueue;
var
S: string;
begin
while FOutQueue.PopItem(S) = wrSignaled do
WriteLn(S);
end;
procedure TPrimeThreadRunner.AddEntry;
var
S: string;
begin
Inc(FCurrentEntry);
S := Format('Entry %d:', [FCurrentEntry]) ;
FInQueue.PushItem(S);
end;
procedure TPrimeThreadRunner.DoIt;
var
i: integer;
begin
FCurrentEntry := 0;
FTotalThreads := TCountdownEvent.Create(1);
FInQueue := TThreadedQueue<string>.Create(10, 1000, 1000);
FOutQueue := TThreadedQueue<string>.Create(10, 1000, 1000);
for i := 1 to ThreadCount do
begin
FTotalThreads.AddCount;
try
ThreadArray[i] := TPrimeThread.Create(True, FInQueue, FOutQueue);
ThreadArray[i].Start;
finally
FTotalThreads.Signal;
end;
end;
for I := 1 to NumberOfEntries do
begin
AddEntry;
end;
DrainTheQueue;
FTotalThreads.Signal;
FTotalThreads.WaitFor;
FTotalThreads.Free;
FInQueue.Free;
FOutQueue.Free;
Readln;
end;
end.
答案 0 :(得分:2)
您的代码中存在错误,我可以在XE3和XE6中复制它。
严重错误在于:
for I := 1 to NumberOfEntries do
begin
AddEntry;
end;
DrainTheQueue; // <-- All threads may not be ready when this call finish
FTotalThreads.Signal; // This makes nothing
FTotalThreads.WaitFor; // This makes nothing
FTotalThreads.Free; // This makes nothing
FInQueue.Free; // You may now free a queue in operation
FOutQueue.Free; // You may now free a queue in operation
在线程完成之前,您不能依赖DrainTheQueue
来收集所有项目。
在一个或多个primethreads运行时释放队列时,线程将对释放的对象进行操作。
同步线程结束的最简单方法是使用空字符串完成它们。
在DrainTheQueue
:
for i := 1 to ThreadCount do
FInQueue.PushItem('');
并像这样更改PrimeThread.Execute:
procedure TPrimeThread.Execute;
var
S: string;
ThreadID: TThreadID;
NumberToCheck: integer;
begin
ThreadID := TThread.CurrentThread.ThreadID;
FOutQueue.PushItem(Format('Thread %d started...', [ThreadID]));
try
while NOT Terminated do
begin
if (FInQueue.PopItem(S) = wrSignaled) then
begin
if (S = '') then // Stop executing
Exit;
NumberToCheck := Random(MaxPrime);
if IsPrime(NumberToCheck) then
begin
FOutQueue.PushItem(Format('%s using thread %d: %d is prime', [S, ThreadID, NumberToCheck]));
end else
begin
FOutQueue.PushItem(Format('%s using thread %d: %d is NOT prime', [S, ThreadID, NumberToCheck]));
end;
end;
end;
finally
FOutQueue.PushItem(Format('Thread %d ended ...', [ThreadID]));
end;
end;
您还应该将FTotalThreads
对象传递给工作线程,让它们在执行完毕后发出信号。
必须在DrainTheQueue
之后调用FTotalThreads.Waitfor
。