[英]WaitForSingleObject return WAIT_OBJECT_0 but SetEvent was not called
In a program that constantly creates and destroys many threads, sometimes WaitForSingleObject()
returns WAIT_OBJECT_0
, but SetEvent()
for an expected event was not called. 在不断创建和销毁许多线程的程序中,有时
WaitForSingleObject()
返回WAIT_OBJECT_0
,但未调用预期事件的SetEvent()
。 I tried to find information on the Internet, but can't find a similar WaitForSingleObject()
bug. 我试图在Internet上查找信息,但是找不到类似的
WaitForSingleObject()
错误。
I have written a small test application in which this bug occurs. 我编写了一个小型测试应用程序,其中发生了该错误。
EventsTest.dpr: 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.
MainThread.pas: 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.
WorkThread.pas: 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.
CallBack.pas: 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.
In this application, I create many threads for loop handling, and many threads which constantly create and destroy. 在此应用程序中,我创建了许多用于循环处理的线程,以及许多不断创建和销毁的线程。 All threads are using callback emulation to set their events.
所有线程都使用回调仿真来设置事件。 When the application detects the bug, it writes
"WaitForSingleObject error"
to the console. 当应用程序检测到错误时,它将
"WaitForSingleObject error"
写入控制台。
The threads which are using WaitForSingleObject()
and SetEvent()
are described in WorkThread.pas
. WorkThread.pas
中描述了使用WaitForSingleObject()
和SetEvent()
的WorkThread.pas
。 In CallBack.pas
is described a simple callback emulator. 在
CallBack.pas
中描述了一个简单的回调模拟器。 And MainThread.pas
manages the threads. MainThread.pas
管理线程。
In this application, the bug occurs infrequently, and sometimes I have to wait 1 hour. 在此应用程序中,错误很少发生,有时我不得不等待1个小时。 But in a real application with many win handles, bug occurs quickly.
但是,在具有多个胜利句柄的真实应用程序中,错误会很快发生。
If I use simple boolean flags instead of events, everything works fine. 如果我使用简单的布尔标志而不是事件,则一切正常。 I conclude that it is a system bug.
我得出结论,这是系统错误。 Am I right?
我对吗?
PS: OS - 64bit app - 32bit PS:操作系统-64位应用程序-32位
update 更新
Remy Lebeau pointed out my mistake 人头马(Remy Lebeau)指出了我的错误
I replace all CreateEvent(nil, False, False, '')
to CreateEvent(nil, False, False, nil)
, but bug still occurs. 我将所有
CreateEvent(nil, False, False, '')
替换为CreateEvent(nil, False, False, nil)
,但是仍然会发生错误。
You are misusing CreateEvent()
, specifically its lpName
parameter. 您正在滥用
CreateEvent()
,特别是其lpName
参数。
The parameter is defined as a PChar
, not a String
. 该参数定义为
PChar
而不是String
。 Passing a ''
literal to a PChar
DOES NOT assign a nil
pointer to it, like you are expecting. 像您期望的那样,将
''
文字传递给PChar
不会为其分配nil
指针。 It assigns the address of a null terminator Char
instead. 而是分配一个空终止符
Char
的地址。
When you call CreateEvent()
with a non- nil
lpName
value, even a null terminator by itself, you are creating a named event in the kernel. 当你调用
CreateEvent()
与非nil
lpName
值,甚至本身就是一个空终止,要创建在内核中一个指定的事件。 Your threads are thus sharing named event objects in the kernel, and then you are waiting multiple times on them. 因此,您的线程在内核中共享命名事件对象,然后您在它们上等待多次。 A call to
SetEvent()
sets the signaled state for all open handles to the same kernel event object. 调用
SetEvent()
所有打开的句柄的信号状态设置为同一内核事件对象。 That is why your WaitForSingleObject()
calls are not waiting like you are expecting - they are waiting on event handles that have already been signaled . 这就是为什么您的
WaitForSingleObject()
调用没有像您期望的那样等待的原因-它们正在等待已经发出信号的事件句柄。
You need to change ''
to nil
when calling CreateEvent()
, so that your event objects are no longer named, and thus no longer shared. 调用
CreateEvent()
,需要将''
更改为nil
,以使事件对象不再被命名,从而不再共享。
This very same bug exists in Delphi's own TEvent
class up to, and including, XE7: Delphi自己的
TEvent
类(包括XE7)中也存在此错误:
QC #100175: SyncObjs.TEvent invalid construction QC#100175:SyncObjs.TEvent无效的构造
RSP-9999: SyncObjs.TEvent invalid construction RSP-9999:SyncObjs.TEvent无效构造
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.