WaitForSingleObject返回WAIT_OBJECT_0但未调用SetEvent

Question

WaitForSingleObject返回WAIT_OBJECT_0但未调用SetEvent

Vas*_*sek 0 delphi winapi multithreading waitforsingleobject

在一个不断创建和销毁许多线程的程序中,有时WaitForSingleObject()返回WAIT_OBJECT_0,但是SetEvent()没有调用预期的事件.我试图在互联网上找到信息,但找不到类似的WaitForSingleObject()bug.

我写了一个小测试应用程序,其中发生此错误.

EventsTest.dpr:

program EventsTest;

{$APPTYPE CONSOLE}
{$R *.res}

uses
  System.SysUtils,
  Windows,
  CallBack in 'CallBack.pas',
  MainThread in 'MainThread.pas',
  WorkThread in 'WorkThread.pas';

procedure Init;
var
  HStdin: THandle;
  OldMode: Cardinal;
begin
  HStdin := GetStdHandle(STD_INPUT_HANDLE);
  GetConsoleMode(HStdin, OldMode);
  SetConsoleMode(HStdin, OldMode and not (ENABLE_ECHO_INPUT));

  InitCallBacks;
  InitMainThread;
end;

procedure Done;
begin
  DoneMainThread;
  DoneCallBacks;
end;

procedure Main;
var
  Command: Char;
begin
  repeat
    Readln(Command);
    case Command of
      'q': Exit;
      'a': IncWorkThreadCount;
      'd': DecWorkThreadCount;
    end;
  until False;
end;

begin
  try
    Init;
    try
      Main;
    finally
      Done;
    end;
  except
    on E: Exception do Writeln(E.ClassName, ': ', E.Message);
  end;
end.

Run Code Online (Sandbox Code Playgroud)

MainThread.pas:

unit MainThread;

interface

procedure InitMainThread;
procedure DoneMainThread;
procedure IncWorkThreadCount;
procedure DecWorkThreadCount;

implementation

uses
  SysUtils, Classes, Generics.Collections,
  Windows,
  WorkThread;

type

{ TMainThread }

  TMainThread = class(TThread)
  private
    FThreadCount: Integer;
  protected
    procedure Execute; override;
  public
    constructor Create;
    destructor  Destroy; override;
  end;

constructor TMainThread.Create;
begin
  inherited Create(False);
  FThreadCount := 100;
end;

destructor TMainThread.Destroy;
begin
  inherited;
end;

procedure TMainThread.Execute;
var
  I: Integer;
  ThreadList: TList<TWorkThread>;
  ThreadLoopList: TList<TWorkLoopThread>;
begin
  NameThreadForDebugging('MainThread');

  ThreadLoopList := TList<TWorkLoopThread>.Create;
  try
    ThreadLoopList.Count := 200;
    for I := 0 to ThreadLoopList.Count - 1 do
      ThreadLoopList[I] := TWorkLoopThread.Create;

    ThreadList := TList<TWorkThread>.Create;
    try
      while not Terminated do
      begin
        ThreadList.Count := FThreadCount;

        for I := 0 to ThreadList.Count - 1 do
          ThreadList[I] := TWorkThread.Create;

        Sleep(1000);

        for I := 0 to ThreadList.Count - 1 do
          ThreadList[I].Terminate;

        for I := 0 to ThreadList.Count - 1 do
        begin
          ThreadList[I].WaitFor;
          ThreadList[I].Free;
          ThreadList[I] := nil;
        end;
      end;
    finally
      ThreadList.Free;
    end;

    for I := 0 to ThreadLoopList.Count - 1 do
    begin
      ThreadLoopList[I].Terminate;
      ThreadLoopList[I].WaitFor;
      ThreadLoopList[I].Free;
    end;
  finally
    ThreadLoopList.Free;
  end;
end;

var
  Thread: TMainThread;

procedure InitMainThread;
begin
  Thread := TMainThread.Create;
end;

procedure DoneMainThread;
begin
  Thread.Terminate;
  Thread.WaitFor;
  Thread.Free;
end;

procedure IncWorkThreadCount;
begin
  InterlockedIncrement(Thread.FThreadCount);
  Writeln('IncWorkThreadCount');
end;

procedure DecWorkThreadCount;
begin
  Writeln('DecWorkThreadCount');
  if Thread.FThreadCount > 0 then
    InterlockedDecrement(Thread.FThreadCount);
end;

end.

Run Code Online (Sandbox Code Playgroud)

WorkThread.pas:

unit WorkThread;

interface

uses
  SysUtils, Classes;

type

{ TContext }

  PContext = ^TContext;
  TContext = record
    Counter: Integer;
    Event: THandle;
    EndEvent: THandle;
  end;

{ TBaseWorkThread }

  TBaseWorkThread = class(TThread)
  protected
    procedure WaitEvent(Event: THandle; CheckTerminate: Boolean = False);
  public
    constructor Create;
  end;


{ TWorkThread }

  TWorkThread = class(TBaseWorkThread)
  private
    FContext: TContext;
  protected
    procedure Execute; override;
  end;

{ TWorkLoopThread }

  TWorkLoopThread = class(TBaseWorkThread)
  protected
    procedure Execute; override;
  end;

implementation

uses
  Windows, CallBack;

type
  ETerminate = class(Exception);

procedure CallBack(Flag: Integer; Context: NativeInt);
var
  Cntxt: PContext absolute Context;
begin
  if Flag = 1 then
  begin
    InterlockedIncrement(Cntxt.Counter);
    SetEvent(Cntxt.Event);
  end;

  if Flag = 2 then
  begin
    SetEvent(Cntxt.EndEvent);
  end;
end;

{ TBaseWorkThread }

constructor TBaseWorkThread.Create;
begin
  inherited Create(False);
end;

procedure TBaseWorkThread.WaitEvent(Event: THandle; CheckTerminate: Boolean);
begin
  while WaitForSingleObject(Event, 10) <> WAIT_OBJECT_0 do
  begin
    if CheckTerminate and Terminated then
      raise ETerminate.Create('');

    Sleep(10);
  end;
end;

{ TWorkThread }

procedure TWorkThread.Execute;
begin
  NameThreadForDebugging('WorkThread');

  try
    FContext.Counter  := 0;
    FContext.Event    := CreateEvent(nil, False, False, nil);
    FContext.EndEvent := CreateEvent(nil, False, False, nil);

    try
      try
        InvokeCallBack(CallBack, 1, NativeInt(@FContext));
        WaitEvent(FContext.Event, True);
        if FContext.Counter = 0 then
          Writeln('WaitForSingleObject error');
      finally
        CloseHandle(FContext.Event);
      end;
    finally
      InvokeCallBack(CallBack, 2, NativeInt(@FContext));
      WaitEvent(FContext.EndEvent);
      CloseHandle(FContext.EndEvent);
    end;
  except
    on E: Exception do
    begin
      if not (E is ETerminate) then
        Writeln('WorkThread error: ' + E.ClassName, ': ', E.Message);
    end;
  end;
end;

{ TWorkLoopThread }

procedure TWorkLoopThread.Execute;
var
  Context: TContext;
begin
  NameThreadForDebugging('WorkLoopThread');
  try
    while not Terminated do
    begin
      Context.Counter  := 0;
      Context.Event    := CreateEvent(nil, False, False, nil);
      Context.EndEvent := CreateEvent(nil, False, False, nil);

      try
        try
          InvokeCallBack(CallBack, 1, NativeInt(@Context));
          WaitEvent(Context.Event);
          if Context.Counter = 0 then
            Writeln('WaitForSingleObject error');
        finally
          CloseHandle(Context.Event);
        end;
      finally
        InvokeCallBack(CallBack, 2, NativeInt(@Context));
        WaitEvent(Context.EndEvent);
        CloseHandle(Context.EndEvent);
      end;
    end;
  except
    on E: Exception do
    begin
      if not (E is ETerminate) then
        Writeln('WorkLoopThread error: ' + E.ClassName, ': ', E.Message);
    end;
  end;
end;

end.

Run Code Online (Sandbox Code Playgroud)

CallBack.pas:

unit CallBack;

interface

type

  TCallBackProc   = procedure (Flag: Integer; Context: NativeInt);

procedure InitCallBacks;
procedure DoneCallBacks;
procedure InvokeCallBack(CallBack: TCallBackProc; Flag: Integer; Context: NativeInt);

implementation

uses
  SysUtils, Classes, Generics.Collections;

type

  TCallBackInfo = record
    Proc: TCallBackProc;
    Flag: Integer;
    Context: NativeInt;
  end;

  TCallBackProcTable = TThreadList<TCallBackInfo>;
  TCallBackQueue = TList<TCallBackInfo>;

{ TCallBackThread }

  TCallBackThread = class(TThread)
  private
    FCallBackTable: TCallBackProcTable;
  protected
    procedure Execute; override;
  public
    constructor Create;
    destructor  Destroy; override;
  end;

var
  Thread: TCallBackThread;

constructor TCallBackThread.Create;
begin
  FCallBackTable := TCallBackProcTable.Create;
  inherited Create(False);
end;

destructor TCallBackThread.Destroy;
begin
  FCallBackTable.Free;
  inherited;
end;

procedure TCallBackThread.Execute;
var
  Empty: Boolean;
  CallBackList: TCallBackQueue;
  CallBackInfo: TCallBackInfo;
begin
  NameThreadForDebugging('CallBack Thread');

  while not Terminated do
  begin
    Sleep(100);

    CallBackList := FCallBackTable.LockList;
    try
      if CallBackList.Count = 0 then Continue;

      CallBackInfo := CallBackList.First;
      CallBackList.Delete(0);
    finally
      FCallBackTable.UnlockList;
    end;

    //Sleep(200);
    CallBackInfo.Proc(CallBackInfo.Flag, CallBackInfo.Context);
  end;
end;

{ API }

procedure InitCallBacks;
begin
  Thread := TCallBackThread.Create;
end;

procedure DoneCallBacks;
begin
  Thread.Terminate;
  Thread.WaitFor;
  Thread.Free;
end;

procedure InvokeCallBack(CallBack: TCallBackProc; Flag: Integer; Context: NativeInt);
var
  CallBackInfo: TCallBackInfo;
begin
  CallBackInfo.Proc    := CallBack;
  CallBackInfo.Flag    := Flag;
  CallBackInfo.Context := Context;
  Thread.FCallBackTable.Add(CallBackInfo);
end;

end.

Run Code Online (Sandbox Code Playgroud)

在这个应用程序中,我创建了许多用于循环处理的线程,以及许多不断创建和销毁的线程.所有线程都使用回调模拟来设置其事件.当应用程序检测到错误时,它会写入"WaitForSingleObject error"控制台.

正在使用WaitForSingleObject()和SetEvent()描述的线程WorkThread.pas.In CallBack.pas描述了一个简单的回调模拟器.并MainThread.pas管理线程.

在这个应用程序中,错误很少发生,有时我必须等待1小时.但是在具有许多win句柄的实际应用程序中,bug很快发生.

如果我使用简单的布尔标志而不是事件,一切正常.我得出结论,这是一个系统错误.我对吗？

PS:OS - 64位应用程序 - 32位

更新

Remy Lebeau指出了我的错误

我将所有替换CreateEvent(nil, False, False, '')为CreateEvent(nil, False, False, nil),但仍然会发生错误.

Answer 1

Rem*_*eau 9

你是滥用CreateEvent(),特别是它的lpName参数.

该参数定义为a PChar,而不是a String.将''文字传递给PCharDOES不会nil像你期望的那样指定一个指向它的指针.它Char改为指定空终止符的地址.

当您CreateEvent()使用非nil lpName值(甚至是空终结符)进行调用时,您将在内核中创建命名事件.因此,您的线程在内核中共享命名的事件对象,然后您在它们上多次等待.调用将所有打开句柄SetEvent()的信号状态设置为同一内核事件对象.这就是为什么你的电话没有像你期望的那样等待 - 他们正在等待已经发出信号的事件句柄.WaitForSingleObject()

您需要在调用时更改''为,以便不再命名事件对象,因此不再共享.nilCreateEvent()

这个同样的错误存在于Delphi自己的TEvent类中,包括XE7:

QC#100175:SyncObjs.TEvent无效构造

RSP-9999:SyncObjs.TEvent无效构造

归档时间：	10 年，7 月前
查看次数：	1731 次
最近记录：	10 年，7 月前