paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-07 01:48:00 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Add CreateAnonymousThread with anonymous procedure

Browse Source
This commit is contained in:
Michaël Van Canneyt 2023-12-18 16:51:39 +01:00
parent 3539b4a6f3
commit 29e2277d98
2 changed files with 65 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

70
rtl/objpas/classes/classes.inc
View File

@ -112,21 +112,38 @@ var
type
{ this type is used if a thread is created using
TThread.CreateAnonymousThread }
{ TAnonymousThread }
TAnonymousThread = class(TThread)
private
fProc: TProcedure;
{$ifdef FPC_HAS_REFERENCE_PROCEDURE}
fAnonProc : TThreadProcedure;
{$ENDIF}
FMethod : TThreadMethod;
protected
procedure Execute; override;
public
{ as in TThread aProc needs to be changed to TProc once closures are
supported }
constructor Create(aProc: TProcedure);
{$ifdef FPC_HAS_REFERENCE_PROCEDURE}
constructor Create(aProc: TThreadProcedure);
{$ENDIF}
constructor Create(aProc: TThreadMethod);
end;
procedure TAnonymousThread.Execute;
begin
fProc();
{$ifdef FPC_HAS_REFERENCE_PROCEDURE}
if assigned(fAnonProc) then
fAnonProc()
else
{$ENDIF}
if assigned(FMethod) then
FMethod()
else
fProc();
end;
@ -138,6 +155,22 @@ begin
fProc := aProc;
end;
{$ifdef FPC_HAS_REFERENCE_PROCEDURE}
constructor TAnonymousThread.Create(aProc: TThreadProcedure);
begin
inherited Create(True);
FreeOnTerminate := True;
fAnonProc := aProc;
end;
{$ENDIF}
constructor TAnonymousThread.Create(aProc: TThreadMethod);
begin
inherited Create(True);
FreeOnTerminate := True;
FMethod := aProc;
end;
type
{ this type is used by TThread.GetCurrentThread if the thread does not yet
@ -284,7 +317,7 @@ begin
TerminatedSet;
end;
Procedure TThread.TerminatedSet;
procedure TThread.TerminatedSet;
begin
// Empty, must be overridden.
@ -634,7 +667,7 @@ begin
end;
{$ifdef FPC_HAS_REFERENCE_PROCEDURE}
class procedure TThread.Queue(aThread: TThread; aProcedure: TThreadProcedure); static;
class procedure TThread.Queue(aThread: TThread; AProcedure: TThreadProcedure);
begin
InternalQueue(aThread, aProcedure, False);
end;
@ -788,6 +821,23 @@ begin
Result := TAnonymousThread.Create(aProc);
end;
{$ifdef FPC_HAS_REFERENCE_PROCEDURE}
class function TThread.CreateAnonymousThread(aProc: TThreadProcedure): TThread;
begin
if not Assigned(aProc) then
raise Exception.Create(SNoProcGiven);
Result := TAnonymousThread.Create(aProc);
end;
{$ENDIF}
class function TThread.CreateAnonymousThread(aProc: TThreadMethod): TThread;
begin
if not Assigned(aProc) then
raise Exception.Create(SNoProcGiven);
Result := TAnonymousThread.Create(aProc);
end;
class procedure TThread.NameThreadForDebugging(aThreadName: UnicodeString; aThreadID: TThreadID);
begin
@ -1029,19 +1079,20 @@ begin
end;
Class Function TThread.ExecuteInThread(AMethod : TThreadExecuteHandler; AOnTerminate : TNotifyEvent = Nil) : TThread;
class function TThread.ExecuteInThread(AMethod: TThreadExecuteHandler; AOnTerminate: TNotifyEvent): TThread;
begin
Result:=TSimpleThread.Create(AMethod,AOnTerminate);
end;
Class Function TThread.ExecuteInThread(AMethod : TThreadExecuteCallback; AData : Pointer; AOnTerminate : TNotifyCallback = Nil) : TThread;
class function TThread.ExecuteInThread(AMethod: TThreadExecuteCallback; AData: Pointer; AOnTerminate: TNotifyCallBack): TThread;
begin
Result:=TSimpleProcThread.Create(AMethod,AData,AOnTerminate);
end;
Class Function TThread.ExecuteInThread(AMethod : TThreadExecuteStatusHandler; AOnStatus : TThreadStatusNotifyEvent; AOnTerminate : TNotifyEvent = Nil) : TThread;
class function TThread.ExecuteInThread(AMethod: TThreadExecuteStatusHandler; AOnStatus: TThreadStatusNotifyEvent;
AOnTerminate: TNotifyEvent): TThread;
begin
If Not Assigned(AOnStatus) then
@ -1049,7 +1100,8 @@ begin
Result:=TSimpleStatusThread.Create(AMethod,AOnStatus,AOnTerminate);
end;
Class Function TThread.ExecuteInThread(AMethod : TThreadExecuteStatusCallback; AOnStatus : TThreadStatusNotifyCallback;AData : Pointer = Nil; AOnTerminate : TNotifyCallBack = Nil) : TThread;
class function TThread.ExecuteInThread(AMethod: TThreadExecuteStatusCallback; AOnStatus: TThreadStatusNotifyCallback;
AData: Pointer; AOnTerminate: TNotifyCallBack): TThread;
begin
If Not Assigned(AOnStatus) then

5
rtl/objpas/classes/classesh.inc
View File

@ -2284,8 +2284,11 @@ type
constructor Create(CreateSuspended: Boolean;
const StackSize: SizeUInt = DefaultStackSize);
destructor Destroy; override;
{ Note: Once closures are supported aProc will be changed to TProc }
class function CreateAnonymousThread(aProc: TProcedure): TThread; static;
{$ifdef FPC_HAS_REFERENCE_PROCEDURE}
class function CreateAnonymousThread(aProc: TThreadProcedure): TThread; static;
{$ENDIF}
class function CreateAnonymousThread(aProc: TThreadMethod): TThread; static;
class procedure NameThreadForDebugging(aThreadName: UnicodeString; aThreadID: TThreadID = TThreadID(-1)); static; inline;
class procedure NameThreadForDebugging(aThreadName: AnsiString; aThreadID: TThreadID = TThreadID(-1)); static; inline;
class procedure SetReturnValue(aValue: Integer); static;