paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-20 11:29:27 +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}
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}
@ -204,30 +204,51 @@ end;
{$IFDEF MSWINDOWS}
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
ret: Integer;
AmountHandles: Integer;
HandleIndex: SizeInt;
ret, CoWaitFlags, SignaledIndex: DWord;
WOHandles: TWOHandleArray;
begin
AmountHandles := Length(HandleObjs);
if AmountHandles = 0 then
if Len = 0 then
Len := Length(HandleObjs);
if Len = 0 then
raise ESyncObjectException.Create(SErrEventZeroNotAllowed);
if AmountHandles > MAXIMUM_WAIT_OBJECTS then
raise ESyncObjectException.CreateFmt(SErrEventMaxObjects, [MAXIMUM_WAIT_OBJECTS]);
if Len > AmountHandles then
if Len > Length(HandleObjs) then
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?
{$IFDEF MSWINDOWS}
if UseCOMWait Then
begin
SetLastError(ERROR_SUCCESS); // only for "alertable" objects
ret := CoWaitForMultipleObjects(Len, @HandleObjs, AAll, Timeout);
end
else
{$ENDIF}
ret := WaitForMultipleObjects(Len, @HandleObjs, AAll, Timeout);
SetLastError(ERROR_SUCCESS); // workaround for mutexes, see docs on CoWaitForMultipleHandles.
CoWaitFlags := COWAIT_DEFAULT;
if AAll then
CoWaitFlags := CoWaitFlags or COWAIT_WAITALL;
case CoWaitForMultipleHandles(CoWaitFlags, Timeout, Len, @WOHandles, SignaledIndex) of
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
begin
@ -245,13 +266,9 @@ begin
case ret of
WAIT_TIMEOUT:
begin
Result := wrTimeout;
end;
Integer(WAIT_FAILED): // w/o: Warning: Range check error while evaluating constants (4294967295 must be between -2147483648 and 2147483647)
begin
Result := wrError;
end;
Result := wrTimeout;
else
Result := wrError;
end;
end;
{$endif}

28
rtl/win/systhrd.inc
View File

@ -545,25 +545,25 @@ end;
type
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;
var ret : Integer;
const COWAIT_DEFAULT = 0;
RPC_S_CALLPENDING = HRESULT($80010115);
var SignaledIndex : DWORD;
begin
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
ret:=WaitForSingleObject(THandle(state), Timeout);
case ret of
WAIT_ABANDONED: Result := wrAbandoned;
WAIT_OBJECT_0: Result := wrSignaled;
WAIT_TIMEOUT: Result := wrTimeout;
WAIT_FAILED: Result := wrError;
else
Result := wrError;
end;
case WaitForSingleObject(THandle(state), Timeout) of
WAIT_OBJECT_0: Result := wrSignaled;
WAIT_TIMEOUT: Result := wrTimeout;
else result := wrError; { WAIT_FAILED or any other value. Note that only mutex waits can return WAIT_ABANDONED. }
end;
end;
function intRTLEventCreate: PRTLEvent;