+ add Delphi compatible TThread.ForceQueue() which enqueues the method also for the main thread (at least if the RTL is in multi threading mode, otherwise it's still executed right away - whether this is Delphi compatible needs to be tested as I only have a 10.1 currently which does not yet support TThread.ForceQueue())

+ added test

git-svn-id: trunk@37359 -

.gitattributes

@@ -11407,6 +11407,7 @@ tests/tbs/tb0628.pp svneol=native#text/pascal
 tests/tbs/tb0629.pp svneol=native#text/pascal
 tests/tbs/tb0630.pp svneol=native#text/pascal
 tests/tbs/tb0631.pp svneol=native#text/pascal
+tests/tbs/tb0632.pp svneol=native#text/pascal
 tests/tbs/tb205.pp svneol=native#text/plain
 tests/tbs/tb610.pp svneol=native#text/pascal
 tests/tbs/tb613.pp svneol=native#text/plain

rtl/objpas/classes/classes.inc

@@ -289,11 +289,11 @@ begin
 end;
 
 
-procedure ThreadQueueAppend(aEntry: TThread.PThreadQueueEntry);
+procedure ThreadQueueAppend(aEntry: TThread.PThreadQueueEntry; aQueueIfMain: Boolean);
 begin
   { do we really need a synchronized call? }
 {$ifdef FPC_HAS_FEATURE_THREADING}
-  if GetCurrentThreadID = MainThreadID then
+  if (GetCurrentThreadID = MainThreadID) and (not aQueueIfMain or not IsMultiThread) then
 {$endif}
   begin
     ExecuteThreadQueueEntry(aEntry);
@@ -383,7 +383,7 @@ class procedure TThread.Synchronize(AThread: TThread; AMethod: TThreadMethod);
 
     syncentry^.Exception := Nil;
     syncentry^.Method := AMethod;
-    ThreadQueueAppend(syncentry);
+    ThreadQueueAppend(syncentry, False);
 
     syncentry^.Method := Nil;
     syncentry^.Next := Nil;
@@ -502,6 +502,12 @@ end;
 
 
 class procedure TThread.Queue(aThread: TThread; aMethod: TThreadMethod); static;
+begin
+  InternalQueue(aThread, aMethod, False);
+end;
+
+
+class procedure TThread.InternalQueue(aThread: TThread; aMethod: TThreadMethod; aQueueIfMain: Boolean); static;
 var
   queueentry: PThreadQueueEntry;
 begin
@@ -516,10 +522,21 @@ begin
   queueentry^.Method := aMethod;
 
   { the queueentry is freed by CheckSynchronize (or by RemoveQueuedEvents) }
-  ThreadQueueAppend(queueentry);
+  ThreadQueueAppend(queueentry, aQueueIfMain);
 end;
 
 
+procedure TThread.ForceQueue(aMethod: TThreadMethod);
+begin
+  ForceQueue(Self, aMethod);
+end;
+
+
+class procedure TThread.ForceQueue(aThread: TThread; aMethod: TThreadMethod); static;
+begin
+  InternalQueue(aThread, aMethod, True);
+end;
+
 class procedure TThread.RemoveQueuedEvents(aThread: TThread; aMethod: TThreadMethod);
 var
   entry, tmpentry, lastentry: PThreadQueueEntry;

rtl/objpas/classes/classesh.inc

@@ -1649,6 +1649,7 @@ type
     FSynchronizeEntry: PThreadQueueEntry;
     class function GetCurrentThread: TThread; static;
     class function GetIsSingleProcessor: Boolean; static; inline;
+    class procedure InternalQueue(aThread: TThread; aMethod: TThreadMethod; aQueueIfMain: Boolean); static;
     procedure CallOnTerminate;
     function GetPriority: TThreadPriority;
     procedure SetPriority(Value: TThreadPriority);
@@ -1666,6 +1667,7 @@ type
     procedure Execute; virtual; abstract;
     procedure Synchronize(AMethod: TThreadMethod);
     procedure Queue(aMethod: TThreadMethod);
+    procedure ForceQueue(aMethod: TThreadMethod); inline;
     property ReturnValue: Integer read FReturnValue write FReturnValue;
     property Terminated: Boolean read FTerminated;
 {$if defined(windows) or defined(OS2)}
@@ -1714,6 +1716,7 @@ type
     class function CheckTerminated: Boolean; static;
     class procedure Synchronize(AThread: TThread; AMethod: TThreadMethod);
     class procedure Queue(aThread: TThread; aMethod: TThreadMethod); static;
+    class procedure ForceQueue(aThread: TThread; aMethod: TThreadMethod); inline; static;
     class procedure RemoveQueuedEvents(aThread: TThread; aMethod: TThreadMethod); static;
     class procedure RemoveQueuedEvents(aMethod: TThreadMethod); static;
     class procedure RemoveQueuedEvents(aThread: TThread); static;

tests/tbs/tb0632.pp

@@ -0,0 +1,77 @@
+{ Note: needs multi threading }
+program tb0632;
+
+{$mode objfpc}
+
+uses
+{$ifdef unix}
+  cthreads,
+{$endif}
+  classes;
+
+type
+  TTest = class
+  private
+    fValue: LongInt;
+    procedure DoTest;
+  public
+    procedure Test;
+  end;
+
+  TDummyThread = class(TThread)
+  public
+    constructor Create;
+  protected
+    procedure Execute; override;
+  end;
+
+{ TDummyThread }
+
+constructor TDummyThread.Create;
+begin
+  inherited Create(True);
+  FreeOnTerminate := True;
+end;
+
+procedure TDummyThread.Execute;
+begin
+  { empty }
+end;
+
+{ TTest }
+
+procedure TTest.DoTest;
+begin
+  Inc(fValue);
+end;
+
+procedure TTest.Test;
+begin
+  TThread.Queue(Nil, @DoTest);
+  if fValue <> 1 then
+    Halt(1);
+  TThread.ForceQueue(Nil, @DoTest);
+  if fValue <> 1 then
+    Halt(2);
+  CheckSynchronize;
+  if fValue <> 2 then
+    Halt(3);
+  Writeln('Ok');
+end;
+
+var
+  t: TTest;
+begin
+{$ifdef FPC_HAS_FEATURE_THREADING}
+  { ensure that the RTL is in multi threading mode, otherwise CheckSynchronize
+    ignores the queue }
+  TDummyThread.Create.Start;
+
+  t := TTest.Create;
+  try
+    t.Test;
+  finally
+    t.Free;
+  end;
+{$endif}
+end.