WaitForSingleObject的返回WAIT_OBJECT_0但SetEvent的不叫

在這種不斷的創建和銷燬許多線程的程序，有時回報WaitForSingleObject()WAIT_OBJECT_0，但對於SetEvent()預期的事件沒有被調用。我試圖在互聯網上查找信息，但無法找到類似的WaitForSingleObject()錯誤。WaitForSingleObject的返回WAIT_OBJECT_0但SetEvent的不叫

我寫了一個小測試應用程序，其中發生此錯誤。

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：

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：

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：

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.

在這個應用程序中，我創建了許多用於循環處理的線程以及不斷創建和銷燬的多個線程。所有線程都使用回調模擬來設置它們的事件。當應用程序檢測到該錯誤時，它會將"WaitForSingleObject error"寫入控制檯。

在WorkThread.pas中描述了使用WaitForSingleObject()和SetEvent()的線程。在CallBack.pas中描述了一個簡單的回調模擬器。 MainThread.pas管理線程。

在這個應用程序中，該錯誤很少發生，有時我需要等待1個小時。但是在一個真正的應用程序中有許多勝利手柄，錯誤發生很快。

如果我使用簡單的布爾標誌而不是事件，一切正常。我得出結論，這是一個系統錯誤。我對嗎？

PS：OS - 64應用程序 - 32位

更新

Remy Lebeau pointed out my mistake

我更換所有CreateEvent(nil, False, False, '')到CreateEvent(nil, False, False, nil)，但漏洞仍然存在。

來源

2015-04-06 Vasek

「我的結論是，這是一個系統錯誤，如果我是對的。？「你是不對的。這是100％你的bug :) 停止在調試器下，什麼時候沒有等待WAIT_OBJECT_0。尋找句柄屬性。更快的你等待不是爲了事件，而是爲了線程處理。 – sutol 2015-04-06 14:22:46

你的意思是Context.Event = Self.Handle？當發生錯誤時，它們不是相等。 – Vasek 2015-04-06 14:58:50

我的意思是 - 將句柄轉換爲對象指針。看 - 這是處理什麼？爲事件或線程對象？我不看src – sutol 2015-04-06 15:07:38

您錯用了CreateEvent()，特別是其lpName參數。

該參數被定義爲PChar而不是String。將''文字傳遞給PChar不會像指望的那樣爲其指定nil指針。它代之以分配空終止符Char的地址。

當您使用非nillpName值調用CreateEvent()時，即使是它自己的空終止符，也會在內核中創建一個命名事件。您的線程因此在內核中共享命名事件對象，然後您在其上等待多次。撥打SetEvent()設置信號狀態爲全部打開句柄至相同內核事件對象。這就是爲什麼你的WaitForSingleObject()電話沒有像你期待的那樣等待 - 他們正在等待已經發信號的。

當您撥打CreateEvent()時，您需要將''更改爲nil，以便您的事件對象不再被命名，因此不再共享。

這非常相同的錯誤存在於德爾福自己TEvent班達，幷包括XE7：

QC#100175: SyncObjs.TEvent invalid construction

RSP-9999: SyncObjs.TEvent invalid construction

來源

2015-04-06 17:19:37

非常有幫助，謝謝！ – Vasek 2015-04-07 08:35:43

WaitForSingleObject的返回WAIT_OBJECT_0但SetEvent的不叫

回答

相關問題