在Delphi中使用线程队列时,如何确保释放线程?

时间:2014-08-06 15:43:20

标签: multithreading delphi

我再次,希望有更具体的线程问题。

我注意到如果我运行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.

1 个答案:

答案 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