paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-14 00:19:25 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Switched from waitformultiple objects to -handles for xp/w7 compat, closes 40297

Browse Source
This commit is contained in:
marcoonthegit 2023-06-14 14:22:08 +02:00
parent 90b7c8ace7
commit f1fcdcfbc3
2 changed files with 54 additions and 37 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

63
packages/fcl-base/src/syncobjs.pp
View File

@ -100,7 +100,7 @@ implementation
{$ifdef MSWindows} {$ifdef MSWindows}
uses Windows; uses Windows;
function CoWaitForMultipleObjects(nCount:DWORD; lpHandles : PWOHandleArray; bWaitAll:WINBOOL; dwMilliseconds:DWORD):DWORD; external 'kernel32' name 'CoWaitForMultipleObjects'; function CoWaitForMultipleHandles(dwFlags, dwTimeout: DWORD; cHandles: ULONG; pHandles: PWOHandleArray; out lpdwindex: DWORD): HRESULT; stdcall; external 'ole32.dll' name 'CoWaitForMultipleHandles';
{$endif} {$endif}
@ -204,30 +204,51 @@ end;
{$IFDEF MSWINDOWS} {$IFDEF MSWINDOWS}
class function THandleObject.WaitForMultiple(const HandleObjs: THandleObjectArray; Timeout: Cardinal; AAll: Boolean; out SignaledObj: THandleObject; UseCOMWait: Boolean = False; Len: Integer = 0): TWaitResult; class function THandleObject.WaitForMultiple(const HandleObjs: THandleObjectArray; Timeout: Cardinal; AAll: Boolean; out SignaledObj: THandleObject; UseCOMWait: Boolean = False; Len: Integer = 0): TWaitResult;
const COWAIT_DEFAULT = 0;
COWAIT_WAITALL = 1;
RPC_S_CALLPENDING = HRESULT($80010115);
var var
ret: Integer; HandleIndex: SizeInt;
AmountHandles: Integer; ret, CoWaitFlags, SignaledIndex: DWord;
WOHandles: TWOHandleArray;
begin begin
AmountHandles := Length(HandleObjs); if Len = 0 then
if AmountHandles = 0 then Len := Length(HandleObjs);
if Len = 0 then
raise ESyncObjectException.Create(SErrEventZeroNotAllowed); raise ESyncObjectException.Create(SErrEventZeroNotAllowed);
if AmountHandles > MAXIMUM_WAIT_OBJECTS then if Len > Length(HandleObjs) then
raise ESyncObjectException.CreateFmt(SErrEventMaxObjects, [MAXIMUM_WAIT_OBJECTS]);
if Len > AmountHandles then
raise ESyncObjectException.Create(SErrEventTooManyHandles); raise ESyncObjectException.Create(SErrEventTooManyHandles);
if Len > MAXIMUM_WAIT_OBJECTS then
raise ESyncObjectException.CreateFmt(SErrEventMaxObjects, [MAXIMUM_WAIT_OBJECTS]);
for HandleIndex := 0 to Len - 1 do
WOHandles[HandleIndex] := Windows.HANDLE(HandleObjs[HandleIndex].Handle);
// what about UseCOMWait? // what about UseCOMWait?
{$IFDEF MSWINDOWS}
if UseCOMWait Then if UseCOMWait Then
begin begin
SetLastError(ERROR_SUCCESS); // only for "alertable" objects SetLastError(ERROR_SUCCESS); // workaround for mutexes, see docs on CoWaitForMultipleHandles.
ret := CoWaitForMultipleObjects(Len, @HandleObjs, AAll, Timeout); CoWaitFlags := COWAIT_DEFAULT;
end if AAll then
else CoWaitFlags := CoWaitFlags or COWAIT_WAITALL;
{$ENDIF} case CoWaitForMultipleHandles(CoWaitFlags, Timeout, Len, @WOHandles, SignaledIndex) of
ret := WaitForMultipleObjects(Len, @HandleObjs, AAll, Timeout); S_OK:
begin
if not AAll then
SignaledObj := HandleObjs[SignaledIndex];
Exit(wrSignaled);
end;
RPC_S_CALLPENDING:
Exit(wrTimeout);
else
Exit(wrError);
end;
end;
ret := WaitForMultipleObjects(Len, @WOHandles, AAll, Timeout);
if (ret >= WAIT_OBJECT_0) and (ret < (WAIT_OBJECT_0 + Len)) then if (ret >= WAIT_OBJECT_0) and (ret < (WAIT_OBJECT_0 + Len)) then
begin begin
@ -245,13 +266,9 @@ begin
case ret of case ret of
WAIT_TIMEOUT: WAIT_TIMEOUT:
begin Result := wrTimeout;
Result := wrTimeout; else
end; Result := wrError;
Integer(WAIT_FAILED): // w/o: Warning: Range check error while evaluating constants (4294967295 must be between -2147483648 and 2147483647)
begin
Result := wrError;
end;
end; end;
end; end;
{$endif} {$endif}

28
rtl/win/systhrd.inc
View File

@ -545,25 +545,25 @@ end;
type type
PWOHandleArray = ^THandle; PWOHandleArray = ^THandle;
function CoWaitForMultipleObjects(nCount:DWORD; lpHandles : PWOHandleArray; bWaitAll:LONGBOOL; dwMilliseconds:DWORD):DWORD; external 'ole32.dll' name 'CoWaitForMultipleObjects'; function CoWaitForMultipleHandles(dwFlags, dwTimeout: DWORD; cHandles: uint32; pHandles: PWOHandleArray; out lpdwindex: DWORD): HRESULT; stdcall; external 'ole32.dll' name 'CoWaitForMultipleHandles';
function intbasiceventWaitFor(Timeout : Cardinal;state:peventstate;UseCOMWait: Boolean = False) : longint; function intbasiceventWaitFor(Timeout : Cardinal;state:peventstate;UseCOMWait: Boolean = False) : longint;
const COWAIT_DEFAULT = 0;
var ret : Integer; RPC_S_CALLPENDING = HRESULT($80010115);
var SignaledIndex : DWORD;
begin begin
if UseComWait Then if UseComWait Then
ret:=CoWaitForMultipleObjects(1,PWOHandleArray(@state), True, Timeout) case CoWaitForMultipleHandles(COWAIT_DEFAULT, Timeout, 1, PWOHandleArray(@state), SignaledIndex) of
S_OK: Result := wrSignaled;
RPC_S_CALLPENDING: Result := wrTimeout;
else Result := wrError;
end
else else
ret:=WaitForSingleObject(THandle(state), Timeout); case WaitForSingleObject(THandle(state), Timeout) of
WAIT_OBJECT_0: Result := wrSignaled;
case ret of WAIT_TIMEOUT: Result := wrTimeout;
WAIT_ABANDONED: Result := wrAbandoned; else result := wrError; { WAIT_FAILED or any other value. Note that only mutex waits can return WAIT_ABANDONED. }
WAIT_OBJECT_0: Result := wrSignaled; end;
WAIT_TIMEOUT: Result := wrTimeout;
WAIT_FAILED: Result := wrError;
else
Result := wrError;
end;
end; end;
function intRTLEventCreate: PRTLEvent; function intRTLEventCreate: PRTLEvent;