* anonymous method overloads for synchronize/queue.

rtl/amicommon/classes.pp

@@ -14,6 +14,9 @@
  **********************************************************************}
 
 {$mode objfpc}
+{$modeswitch FUNCTIONREFERENCES}
+{$define FPC_HAS_REFERENCE_PROCEDURE}
+{$endif}
 
 { determine the type of the resource/form file }
 {$define Win16Res}

rtl/atari/classes.pp

@@ -14,6 +14,9 @@
  **********************************************************************}
 
 {$mode objfpc}
+{$modeswitch FUNCTIONREFERENCES}
+{$define FPC_HAS_REFERENCE_PROCEDURE}
+{$endif}
 
 { determine the type of the resource/form file }
 {$define Win16Res}

rtl/beos/classes.pp

@@ -14,6 +14,9 @@
  **********************************************************************}
 
 {$mode objfpc}
+{$modeswitch FUNCTIONREFERENCES}
+{$define FPC_HAS_REFERENCE_PROCEDURE}
+{$endif}
 
 { determine the type of the resource/form file }
 {$define Win16Res}

rtl/embedded/classes.pp

@@ -14,6 +14,9 @@
  **********************************************************************}
 
 {$mode objfpc}
+{$modeswitch FUNCTIONREFERENCES}
+{$define FPC_HAS_REFERENCE_PROCEDURE}
+{$endif}
 
 unit Classes;
 

rtl/freertos/classes.pp

@@ -14,6 +14,9 @@
  **********************************************************************}
 
 {$mode objfpc}
+{$modeswitch FUNCTIONREFERENCES}
+{$define FPC_HAS_REFERENCE_PROCEDURE}
+{$endif}
 
 unit Classes;
 

rtl/gba/classes.pp

@@ -15,6 +15,9 @@
  **********************************************************************}
 
 {$mode objfpc}
+{$modeswitch FUNCTIONREFERENCES}
+{$define FPC_HAS_REFERENCE_PROCEDURE}
+{$endif}
 
 unit Classes;
 

rtl/go32v2/classes.pp

@@ -14,6 +14,10 @@
  **********************************************************************}
 
 {$mode objfpc}
+{$modeswitch FUNCTIONREFERENCES}
+{$define FPC_HAS_REFERENCE_PROCEDURE}
+{$endif}
+
 
 { determine the type of the resource/form file }
 {$define Win16Res}

rtl/haiku/classes.pp

@@ -14,6 +14,9 @@
  **********************************************************************}
 
 {$mode objfpc}
+{$modeswitch FUNCTIONREFERENCES}
+{$define FPC_HAS_REFERENCE_PROCEDURE}
+{$endif}
 
 { determine the type of the resource/form file }
 {$define Win16Res}

rtl/macos/classes.pp

@@ -14,6 +14,10 @@
  **********************************************************************}
 
 {$mode objfpc}
+{$modeswitch FUNCTIONREFERENCES}
+{$define FPC_HAS_REFERENCE_PROCEDURE}
+{$endif}
+
 
 { determine the type of the resource/form file }
 {$define Win16Res}

rtl/msdos/classes.pp

@@ -14,6 +14,9 @@
  **********************************************************************}
 
 {$mode objfpc}
+{$modeswitch FUNCTIONREFERENCES}
+{$define FPC_HAS_REFERENCE_PROCEDURE}
+{$endif}
 
 { determine the type of the resource/form file }
 {$define Win16Res}

rtl/nativent/classes.pp

@@ -14,6 +14,9 @@
  **********************************************************************}
 
 {$mode objfpc}
+{$modeswitch FUNCTIONREFERENCES}
+{$define FPC_HAS_REFERENCE_PROCEDURE}
+{$endif}
 
 { determine the type of the resource/form file }
 {$define Win16Res}

rtl/nds/classes.pp

@@ -15,6 +15,9 @@
  **********************************************************************}
 
 {$mode objfpc}
+{$modeswitch FUNCTIONREFERENCES}
+{$define FPC_HAS_REFERENCE_PROCEDURE}
+{$endif}
 
 unit Classes;
 

rtl/netware/classes.pp

@@ -14,6 +14,9 @@
  **********************************************************************}
 
 {$mode objfpc}
+{$modeswitch FUNCTIONREFERENCES}
+{$define FPC_HAS_REFERENCE_PROCEDURE}
+{$endif}
 
 { determine the type of the resource/form file }
 {$define Win16Res}

rtl/netwlibc/classes.pp

@@ -14,6 +14,9 @@
  **********************************************************************}
 
 {$mode objfpc}
+{$modeswitch FUNCTIONREFERENCES}
+{$define FPC_HAS_REFERENCE_PROCEDURE}
+{$endif}
 
 { determine the type of the resource/form file }
 {$define Win16Res}

rtl/objpas/classes/classes.inc

@@ -305,9 +305,11 @@ procedure ExecuteThreadQueueEntry(aEntry: TThread.PThreadQueueEntry);
 begin
   if Assigned(aEntry^.Method) then
     aEntry^.Method()
-  // enable once closures are supported
-  {else
-    aEntry^.ThreadProc();}
+{$ifdef FPC_HAS_REFERENCE_PROCEDURE}
+  else
+    if Assigned(aEntry^.ThreadProc) then
+      aEntry^.ThreadProc
+{$endif}
 end;
 
 
@@ -448,11 +450,74 @@ class procedure TThread.Synchronize(AThread: TThread; AMethod: TThreadMethod);
   end;
 
 
+{$ifdef FPC_HAS_REFERENCE_PROCEDURE}
+class procedure TThread.Synchronize(AThread: TThread; AProcedure: TThreadProcedure);
+  var
+    syncentry: PThreadQueueEntry;
+    thread: TThread;
+  begin
+{$ifdef FPC_HAS_FEATURE_THREADING}
+    if Assigned(AThread) and (AThread.ThreadID = GetCurrentThreadID) then
+{$else}
+    if Assigned(AThread) then
+{$endif}
+      thread := AThread
+    else if Assigned(CurrentThreadVar) then
+      thread := CurrentThreadVar
+    else begin
+      thread := Nil;
+      { use a local synchronize event }
+      New(syncentry);
+      FillChar(syncentry^, SizeOf(TThreadQueueEntry), 0);
+{$ifdef FPC_HAS_FEATURE_THREADING}
+      syncentry^.ThreadID := GetCurrentThreadID;
+      syncentry^.SyncEvent := RtlEventCreate;
+{$else}
+      syncentry^.ThreadID := 0{GetCurrentThreadID};
+      syncentry^.SyncEvent := nil{RtlEventCreate};
+{$endif}
+    end;
+
+    if Assigned(thread) then begin
+      { the Synchronize event is instantiated on demand }
+      thread.InitSynchronizeEvent;
+
+      syncentry := thread.FSynchronizeEntry;
+    end;
+
+    syncentry^.Exception := Nil;
+    syncentry^.ThreadProc := AProcedure;
+    try
+      ThreadQueueAppend(syncentry, False);
+    finally
+      syncentry^.ThreadProc := Nil;
+      syncentry^.Next := Nil;
+
+      if not Assigned(thread) then begin
+        { clean up again }
+{$ifdef FPC_HAS_FEATURE_THREADING}
+        RtlEventDestroy(syncentry^.SyncEvent);
+{$endif}
+        Dispose(syncentry);
+      end;
+    end;
+  end;
+{$endif}
+
+
 procedure TThread.Synchronize(AMethod: TThreadMethod);
   begin
     TThread.Synchronize(self,AMethod);
   end;
 
+
+{$ifdef FPC_HAS_REFERENCE_PROCEDURE}
+procedure TThread.Synchronize(AProcedure: TThreadProcedure);
+  begin
+    TThread.Synchronize(self,AProcedure);
+  end;
+{$endif}
+
 Function PopThreadQueueHead : TThread.PThreadQueueEntry;
 
 begin
@@ -550,12 +615,24 @@ begin
   Queue(Self, aMethod);
 end;
 
+{$ifdef FPC_HAS_REFERENCE_PROCEDURE}
+procedure TThread.Queue(aProcedure: TThreadProcedure);
+begin
+  Queue(Self, aProcedure);
+end;
+{$endif}
 
 class procedure TThread.Queue(aThread: TThread; aMethod: TThreadMethod); static;
 begin
   InternalQueue(aThread, aMethod, False);
 end;
 
+{$ifdef FPC_HAS_REFERENCE_PROCEDURE}
+class procedure TThread.Queue(aThread: TThread; aProcedure: TThreadProcedure); static;
+begin
+  InternalQueue(aThread, aProcedure, False);
+end;
+{$endif}
 
 class procedure TThread.InternalQueue(aThread: TThread; aMethod: TThreadMethod; aQueueIfMain: Boolean); static;
 var
@@ -575,6 +652,25 @@ begin
   ThreadQueueAppend(queueentry, aQueueIfMain);
 end;
 
+{$ifdef FPC_HAS_REFERENCE_PROCEDURE}
+class procedure TThread.InternalQueue(aThread: TThread; aProcedure: TThreadProcedure; aQueueIfMain: Boolean); static;
+var
+  queueentry: PThreadQueueEntry;
+begin
+  New(queueentry);
+  FillChar(queueentry^, SizeOf(TThreadQueueEntry), 0);
+  queueentry^.Thread := aThread;
+{$ifdef FPC_HAS_FEATURE_THREADING}
+  queueentry^.ThreadID := GetCurrentThreadID;
+{$else}
+  queueentry^.ThreadID := 0{GetCurrentThreadID};
+{$endif}
+  queueentry^.ThreadProc := aProcedure;
+
+  { the queueentry is freed by CheckSynchronize (or by RemoveQueuedEvents) }
+  ThreadQueueAppend(queueentry, aQueueIfMain);
+end;
+{$endif}
 
 procedure TThread.ForceQueue(aMethod: TThreadMethod);
 begin

rtl/objpas/classes/classesh.inc

@@ -1848,6 +1848,9 @@ type
   EThreadDestroyCalled = class(EThread);
   TSynchronizeProcVar = procedure;
   TThreadMethod = procedure of object;
+{$ifdef FPC_HAS_REFERENCE_PROCEDURE}
+  TThreadProcedure = reference to procedure;
+{$endif}
 
   TThreadReportStatus = Procedure(Const status : String) of Object;
 
@@ -1870,8 +1873,9 @@ type
     PThreadQueueEntry = ^TThreadQueueEntry;
     TThreadQueueEntry = record
       Method: TThreadMethod;
-      // uncomment once closures are supported
-      //ThreadProc: TThreadProcedure;
+{$ifdef FPC_HAS_REFERENCE_PROCEDURE}
+      ThreadProc: TThreadProcedure;
+{$endif}
       Thread: TThread;
       ThreadID: TThreadID;
       Exception: TObject;
@@ -1901,6 +1905,9 @@ type
     class function GetCurrentThread: TThread; static;
     class function GetIsSingleProcessor: Boolean; static; inline;
     class procedure InternalQueue(aThread: TThread; aMethod: TThreadMethod; aQueueIfMain: Boolean); static;
+{$ifdef FPC_HAS_REFERENCE_PROCEDURE}
+    class procedure InternalQueue(aThread: TThread; aProcedure: TThreadProcedure; aQueueIfMain: Boolean); static;
+{$endif}
     procedure CallOnTerminate;
     function GetPriority: TThreadPriority;
     procedure SetPriority(Value: TThreadPriority);
@@ -1918,7 +1925,13 @@ type
     procedure TerminatedSet; virtual;
     procedure Execute; virtual; abstract;
     procedure Synchronize(AMethod: TThreadMethod);
+{$ifdef FPC_HAS_REFERENCE_PROCEDURE}
+    procedure Synchronize(AProcedure : TThreadProcedure);
+{$endif}
     procedure Queue(aMethod: TThreadMethod);
+{$ifdef FPC_HAS_REFERENCE_PROCEDURE}
+    procedure Queue(aProcedure: TThreadProcedure);
+{$endif}
     procedure ForceQueue(aMethod: TThreadMethod); inline;
     property ReturnValue: Integer read FReturnValue write FReturnValue;
     property Terminated: Boolean read FTerminated;
@@ -1961,7 +1974,13 @@ type
     class procedure SetReturnValue(aValue: Integer); static;
     class function CheckTerminated: Boolean; static;
     class procedure Synchronize(AThread: TThread; AMethod: TThreadMethod);
+    {$ifdef FPC_HAS_REFERENCE_PROCEDURE}
+    class procedure Synchronize(AThread: TThread; AProcedure : TThreadProcedure);
+    {$endif}
     class procedure Queue(aThread: TThread; aMethod: TThreadMethod); static;
+    {$ifdef FPC_HAS_REFERENCE_PROCEDURE}
+    class procedure Queue(aThread: TThread; AProcedure : TThreadProcedure); static;
+    {$endif}
     class procedure ForceQueue(aThread: TThread; aMethod: TThreadMethod); inline; static;
     class procedure RemoveQueuedEvents(aThread: TThread; aMethod: TThreadMethod); static;
     class procedure RemoveQueuedEvents(aMethod: TThreadMethod); static;

rtl/os2/classes.pp

@@ -14,6 +14,9 @@
  **********************************************************************}
 
 {$mode objfpc}
+{$modeswitch FUNCTIONREFERENCES}
+{$define FPC_HAS_REFERENCE_PROCEDURE}
+{$endif}
 
 { determine the type of the resource/form file }
 {$define Win16Res}

rtl/sinclairql/classes.pp

@@ -14,6 +14,9 @@
  **********************************************************************}
 
 {$mode objfpc}
+{$modeswitch FUNCTIONREFERENCES}
+{$define FPC_HAS_REFERENCE_PROCEDURE}
+{$endif}
 
 { determine the type of the resource/form file }
 {$define Win16Res}

rtl/symbian/classes.pp

@@ -14,6 +14,9 @@
  **********************************************************************}
 
 {$mode objfpc}
+{$modeswitch FUNCTIONREFERENCES}
+{$define FPC_HAS_REFERENCE_PROCEDURE}
+{$endif}
 
 unit Classes;
 

rtl/unix/classes.pp

@@ -14,6 +14,10 @@
  **********************************************************************}
 
 {$mode objfpc}
+{$IF FPC_FULLVERSION>=30301}
+{$modeswitch FUNCTIONREFERENCES}
+{$define FPC_HAS_REFERENCE_PROCEDURE}
+{$endif}
 
 { determine the type of the resource/form file }
 {$define Win16Res}

rtl/wasi/classes.pp

@@ -14,6 +14,10 @@
  **********************************************************************}
 
 {$mode objfpc}
+{$modeswitch FUNCTIONREFERENCES}
+{$define FPC_HAS_REFERENCE_PROCEDURE}
+{$endif}
+
 
 { determine the type of the resource/form file }
 {$define Win16Res}

rtl/wii/classes.pp

@@ -15,6 +15,9 @@
  **********************************************************************}
 
 {$mode objfpc}
+{$modeswitch FUNCTIONREFERENCES}
+{$define FPC_HAS_REFERENCE_PROCEDURE}
+{$endif}
 
 unit Classes;
 

rtl/win16/classes.pp

@@ -14,6 +14,10 @@
  **********************************************************************}
 
 {$mode objfpc}
+{$modeswitch FUNCTIONREFERENCES}
+{$define FPC_HAS_REFERENCE_PROCEDURE}
+{$endif}
+
 
 { determine the type of the resource/form file }
 {$define Win16Res}

rtl/win32/classes.pp

@@ -15,6 +15,11 @@
 
 {$mode objfpc}
 
+{$IF FPC_FULLVERSION>=30301}
+{$modeswitch FUNCTIONREFERENCES}
+{$define FPC_HAS_REFERENCE_PROCEDURE}
+{$endif}
+
 { determine the type of the resource/form file }
 {$define Win16Res}
 

rtl/win64/classes.pp

@@ -14,6 +14,10 @@
  **********************************************************************}
 
 {$mode objfpc}
+{$IF FPC_FULLVERSION>=30301}
+{$modeswitch FUNCTIONREFERENCES}
+{$define FPC_HAS_REFERENCE_PROCEDURE}
+{$endif}
 
 { determine the type of the resource/form file }
 { $define Win16Res}

rtl/wince/classes.pp

@@ -14,6 +14,10 @@
  **********************************************************************}
 
 {$mode objfpc}
+{$modeswitch FUNCTIONREFERENCES}
+{$define FPC_HAS_REFERENCE_PROCEDURE}
+{$endif}
+
 
 { determine the type of the resource/form file }
 {$define Win16Res}