View Issue Details

IDProjectCategoryView StatusLast Update
0037524FPCRTLpublic2020-08-24 14:54
ReporterBi0T1N Assigned To 
PrioritynormalSeverityminorReproducibilityN/A
Status newResolutionopen 
Product Version3.3.1 
Summary0037524: [WIP] Implement WaitFor and WaitForMultiple for THandleObject
DescriptionThis THandleObject (http://docwiki.embarcadero.com/Libraries/Rio/en/System.SyncObjs.THandleObject) patch is work-in-progress but there are some problems:
1. COM is Windows specific so I enabled it on Windows only but I don't get why there is the UseCOMWait variable/parameter? For what is it needed? The API (https://docs.microsoft.com/en-us/windows/win32/api/synchapi/nf-synchapi-waitformultipleobjects) doesn't provide anything related to COM.
2. TEventObject.WaitFor already had the needed code thus I moved it to THandleObject.WaitFor but the FPC documentation of BasicEventWaitFor (https://www.freepascal.org/docs-html/rtl/system/basiceventwaitfor.html) says it's obsolete but the new RTLEventWaitFor doesn't return the the result of the API function. However, BasicEventWaitFor is still used in some parts of FPC.
3. Haven't created any tests yet. It's just a reference implementation of the documentation.
Additional InformationThe patch provided for https://bugs.freepascal.org/view.php?id=37495 needs to be applied first.
TagsNo tags attached.
Fixed in Revision
FPCOldBugId
FPCTarget
Attached Files

Activities

Bi0T1N

2020-08-08 22:02

reporter  

01-Implement_ThreadHandle_WaitFor_and_WaitForMultiple.patch (4,560 bytes)   
diff --git packages/fcl-base/src/syncobjs.pp packages/fcl-base/src/syncobjs.pp
index edd37784e2..2c09df73db 100644
--- packages/fcl-base/src/syncobjs.pp
+++ packages/fcl-base/src/syncobjs.pp
@@ -52,12 +52,26 @@ type
       destructor Destroy;override;
    end;
 
-   THandleObject = class abstract  (TSynchroObject)
+   THandleObject = class;
+   THandleObjectArray = array of THandleObject;
+
+   THandleObject = class abstract (TSynchroObject)
    protected
       FHandle : TEventHandle;
       FLastError : Integer;
+{$IFDEF MSWINDOWS}
+      // Component Object Model (COM) is Windows specific
+      FUseCOMWait: Boolean;
+{$ENDIF MSWINDOWS}
    public
-      destructor destroy;override;
+{$IFDEF MSWINDOWS}
+      constructor Create(UseCOMWait: Boolean = False);
+{$ENDIF MSWINDOWS}
+      destructor Destroy;override;
+      function WaitFor(Timeout: Cardinal): TWaitResult; {overload;} override;
+{$IFDEF MSWINDOWS}
+      class function WaitForMultiple(const HandleObjs: THandleObjectArray; Timeout: Cardinal; AAll: Boolean; out SignaledObj: THandleObject; UseCOMWait: Boolean = False; Len: Integer = 0): TWaitResult;
+{$ENDIF MSWINDOWS}
       property Handle : TEventHandle read FHandle;
       property LastError : Integer read FLastError;
    end;
@@ -71,7 +85,6 @@ type
       destructor destroy; override;
       procedure ResetEvent;
       procedure SetEvent;
-      function WaitFor(Timeout : Cardinal) : TWaitResult;
       Property ManualReset : Boolean read FManualReset;
    end;
 
@@ -83,6 +96,11 @@ type
 
 implementation
 
+{$IFDEF MSWINDOWS}
+uses
+  Windows;
+{$ENDIF MSWINDOWS}
+
 Resourcestring
   SErrEventCreateFailed = 'Failed to create OS basic event with name "%s"'; 
 
@@ -147,10 +165,78 @@ begin
   DoneCriticalSection(CriticalSection);
 end;
 
-destructor THandleObject.destroy;
+{$IFDEF MSWINDOWS}
+constructor THandleObject.Create(UseCOMWait: Boolean = False);
+begin
+  Inherited Create;
+  FUseCOMWait := UseCOMWait;
+end;
+{$ENDIF MSWINDOWS}
+
+destructor THandleObject.Destroy;
+begin
+end;
+
+function THandleObject.WaitFor(Timeout: Cardinal): TWaitResult;
+begin
+  // what about FUseCOMWait for Windows?
+  Result := TWaitResult(BasicEventWaitFor(Timeout, Handle));
+  if Result = wrError then
+{$IFDEF OS2}
+    FLastError := PLocalEventRec(Handle)^.FLastError;
+{$ELSE OS2}
+  {$if defined(getlastoserror)}
+    FLastError := GetLastOSError;
+  {$else}
+    FLastError := -1;
+  {$endif}
+{$ENDIF OS2}
+end;
 
+{$IFDEF MSWINDOWS}
+class function THandleObject.WaitForMultiple(const HandleObjs: THandleObjectArray; Timeout: Cardinal; AAll: Boolean; out SignaledObj: THandleObject; UseCOMWait: Boolean = False; Len: Integer = 0): TWaitResult;
+var
+  ret: Integer;
+  AmountHandles: Integer;
 begin
+  AmountHandles := Length(HandleObjs);
+  if AmountHandles = 0 then
+    raise ESyncObjectException.Create('Handle count of zero is not allowed.');
+
+  if AmountHandles > MAXIMUM_WAIT_OBJECTS then
+    raise ESyncObjectException.CreateFmt('The maximal amount of objects is %d.', [MAXIMUM_WAIT_OBJECTS]);
+
+  if AmountHandles <> Len then
+    raise ESyncObjectException.Create('Length of object handles and given Len does not match.');
+
+  // what about UseCOMWait?
+  ret := WaitForMultipleObjects(AmountHandles, @HandleObjs, AAll, Timeout);
+
+  if (ret >= WAIT_OBJECT_0) and (ret <= WAIT_OBJECT_0 + AmountHandles - 1) then
+  begin
+    if not AAll then
+      SignaledObj := HandleObjs[ret];
+
+    Exit(wrSignaled);
+  end;
+
+  if (ret >= WAIT_ABANDONED_0) and (ret <= WAIT_ABANDONED_0 + AmountHandles - 1) then
+  begin
+    Exit(wrAbandoned);
+  end;
+
+  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;
+  end;
 end;
+{$ENDIF MSWINDOWS}
 
 constructor TEventObject.Create(EventAttributes : PSecurityAttributes;
   AManualReset,InitialState : Boolean;const Name : string);
@@ -180,23 +266,6 @@ begin
   BasicEventSetEvent(Handle);
 end;
 
-
-function TEventObject.WaitFor(Timeout : Cardinal) : TWaitResult;
-
-begin
-  Result := TWaitResult(basiceventWaitFor(Timeout, Handle));
-  if Result = wrError then
-{$IFDEF OS2}
-    FLastError := PLocalEventRec (Handle)^.FLastError;
-{$ELSE OS2}
-  {$if defined(getlastoserror)}
-    FLastError := GetLastOSError;
-  {$else}
-    FLastError:=-1;
-  {$endif}
-{$ENDIF OS2}
-end;
-
 constructor TSimpleEvent.Create;
 
 begin

Bi0T1N

2020-08-09 10:49

reporter   ~0124687

The return type of WaitForMultipleObjects is unsigned - fixed.
But now the compiler complains: Warning: Comparison might be always true due to range of constant and expression
02-Implement_ThreadHandle_WaitFor_and_WaitForMultiple.patch (1,499 bytes)   
diff --git packages/fcl-base/src/syncobjs.pp packages/fcl-base/src/syncobjs.pp
index 2c09df73db..849339bf8b 100644
--- packages/fcl-base/src/syncobjs.pp
+++ packages/fcl-base/src/syncobjs.pp
@@ -196,7 +196,7 @@ end;
 {$IFDEF MSWINDOWS}
 class function THandleObject.WaitForMultiple(const HandleObjs: THandleObjectArray; Timeout: Cardinal; AAll: Boolean; out SignaledObj: THandleObject; UseCOMWait: Boolean = False; Len: Integer = 0): TWaitResult;
 var
-  ret: Integer;
+  ret: DWord;
   AmountHandles: Integer;
 begin
   AmountHandles := Length(HandleObjs);
@@ -212,7 +212,7 @@ begin
   // what about UseCOMWait?
   ret := WaitForMultipleObjects(AmountHandles, @HandleObjs, AAll, Timeout);
 
-  if (ret >= WAIT_OBJECT_0) and (ret <= WAIT_OBJECT_0 + AmountHandles - 1) then
+  if (ret >= WAIT_OBJECT_0) and (ret <= (WAIT_OBJECT_0 + AmountHandles - 1)) then
   begin
     if not AAll then
       SignaledObj := HandleObjs[ret];
@@ -220,7 +220,7 @@ begin
     Exit(wrSignaled);
   end;
 
-  if (ret >= WAIT_ABANDONED_0) and (ret <= WAIT_ABANDONED_0 + AmountHandles - 1) then
+  if (ret >= WAIT_ABANDONED_0) and (ret <= (WAIT_ABANDONED_0 + AmountHandles - 1)) then
   begin
     Exit(wrAbandoned);
   end;
@@ -230,7 +230,7 @@ begin
       begin
         Result := wrTimeout;
       end;
-    Integer(WAIT_FAILED): // w/o: Warning: Range check error while evaluating constants (4294967295 must be between -2147483648 and 2147483647)
+    WAIT_FAILED:
       begin
         Result := wrError;
       end;

Bi0T1N

2020-08-24 14:54

reporter   ~0125103

1. After a lot of research I've found out that there is CoWaitForMultipleObjects which has a flag to enable/disable reentrancy. That's probably what is indicated by the UseCOMWait parameter.
2. It would still be good to get feedback on RTLEventWaitFor and BasicEventWaitFor.
3. It would also be nice if someone familiar with COM could provide a few testcases I could use for testing.

Issue History

Date Modified Username Field Change
2020-08-08 22:02 Bi0T1N New Issue
2020-08-08 22:02 Bi0T1N File Added: 01-Implement_ThreadHandle_WaitFor_and_WaitForMultiple.patch
2020-08-09 10:49 Bi0T1N Note Added: 0124687
2020-08-09 10:49 Bi0T1N File Added: 02-Implement_ThreadHandle_WaitFor_and_WaitForMultiple.patch
2020-08-24 14:54 Bi0T1N Note Added: 0125103