From 867ba84ce78f0f8bde2b78a8d301af0263b268ca Mon Sep 17 00:00:00 2001 From: Gustavo Carreno Date: Mon, 25 Sep 2023 00:09:29 +0100 Subject: [PATCH] feat: Added `TInterfacedThread` and tests Also renamed all classes to `TInterfaced*` --- .../polykerma.dispatcher.common.pas | 21 ++++ .../polykerma.dispatcher.interfaces.pas | 8 +- src/dispatcher/polykerma.dispatcher.pas | 22 ++-- src/messages/polykerma.messages.message.pas | 8 +- src/modules/polykerma.modules.module.pas | 15 ++- src/threads/polykerma.threads.interfaces.pas | 26 ++++ src/threads/polykerma.threads.thread.pas | 75 ++++++++++++ .../dispatcher/polykerma.test.dispatcher.pas | 2 +- tests/messages/polykerma.test.messages.pas | 2 +- tests/modules/polykerma.test.module.pas | 2 +- tests/polykermatests.lpi | 113 +++++++++++++++--- tests/polykermatests.lpr | 8 ++ tests/threads/polykerma.test.threads.pas | 42 +++++++ 13 files changed, 302 insertions(+), 42 deletions(-) create mode 100644 src/dispatcher/polykerma.dispatcher.common.pas create mode 100644 tests/threads/polykerma.test.threads.pas diff --git a/src/dispatcher/polykerma.dispatcher.common.pas b/src/dispatcher/polykerma.dispatcher.common.pas new file mode 100644 index 0000000..64b7db3 --- /dev/null +++ b/src/dispatcher/polykerma.dispatcher.common.pas @@ -0,0 +1,21 @@ +unit PolyKerma.Dispatcher.Common; + +{$mode objfpc}{$H+} + +interface + +uses + Classes +; + +const + cDispatcherChannelControllerOut = 'controller.out'; + cDispatcherChannelControllerIn = 'controller.in'; + cDispatcherChannelCommsOut = 'comms.out'; + cDispatcherChannelCommsIn = 'comms.in'; + cDispatcherChannelModelOut = 'model.out'; + cDispatcherChannelModelIn = 'model.in'; + +implementation + +end. diff --git a/src/dispatcher/polykerma.dispatcher.interfaces.pas b/src/dispatcher/polykerma.dispatcher.interfaces.pas index 77ff918..047bba3 100644 --- a/src/dispatcher/polykerma.dispatcher.interfaces.pas +++ b/src/dispatcher/polykerma.dispatcher.interfaces.pas @@ -6,16 +6,16 @@ interface uses Classes -//, PolyLKerma.Messages.Interfaces -//, PolyLKerma.Modules.Interfaces +, PolyKerma.Messages.Interfaces +, PolyKerma.Modules.Interfaces ; type { IDispatcher } IDispatcher = Interface ['{1CD54522-D37B-486E-9181-A97CCF768DE9}'] - function Register(const AChannel: String{, const AModule: IModule}): Boolean; - procedure Post(const AChannel: String{, const AMessage: IMessage}); + function Register(const AChannel: String; const AModule: IModule): Boolean; + procedure Post(const AChannel: String; const AMessage: IMessage); end; implementation diff --git a/src/dispatcher/polykerma.dispatcher.pas b/src/dispatcher/polykerma.dispatcher.pas index 72c6287..5c7f456 100644 --- a/src/dispatcher/polykerma.dispatcher.pas +++ b/src/dispatcher/polykerma.dispatcher.pas @@ -7,42 +7,46 @@ interface uses Classes , PolyKerma.Dispatcher.Interfaces +//, PolyKerma.Dispatcher.Common +, PolyKerma.Messages.Interfaces +, PolyKerma.Modules.Interfaces ; type -{ TDispatcher } - TDispatcher = class(TInterfacedObject, IDispatcher) +{ TInterfacedDispatcher } + TInterfacedDispatcher = class(TInterfacedObject, IDispatcher) private protected public constructor Create; destructor Destroy; override; - function Register(const AChannel: String{, const AModule: IModule}): Boolean; - procedure Post(const AChannel: String{, const AMessage: IMessage}); + function Register(const AChannel: String; const AModule: IModule): Boolean; + procedure Post(const AChannel: String; const AMessage: IMessage); published end; implementation -{ TDispatcher } +{ TInterfacedDispatcher } -constructor TDispatcher.Create; +constructor TInterfacedDispatcher.Create; begin end; -destructor TDispatcher.Destroy; +destructor TInterfacedDispatcher.Destroy; begin inherited Destroy; end; -function TDispatcher.Register(const AChannel: String): Boolean; +function TInterfacedDispatcher.Register(const AChannel: String; + const AModule: IModule): Boolean; begin Result:= false; end; -procedure TDispatcher.Post(const AChannel: String); +procedure TInterfacedDispatcher.Post(const AChannel: String; const AMessage: IMessage); begin end; diff --git a/src/messages/polykerma.messages.message.pas b/src/messages/polykerma.messages.message.pas index 1a63b45..dc55ec1 100644 --- a/src/messages/polykerma.messages.message.pas +++ b/src/messages/polykerma.messages.message.pas @@ -10,8 +10,8 @@ interface ; type -{ TMessage } - TMessage = class(TInterfacedObject, IMessage) +{ TInterfacedMessage } + TInterfacedMessage = class(TInterfacedObject, IMessage) private protected public @@ -25,12 +25,12 @@ implementation { TDispatcher } -constructor TMessage.Create; +constructor TInterfacedMessage.Create; begin end; -destructor TMessage.Destroy; +destructor TInterfacedMessage.Destroy; begin inherited Destroy; end; diff --git a/src/modules/polykerma.modules.module.pas b/src/modules/polykerma.modules.module.pas index 52003bd..db36e09 100644 --- a/src/modules/polykerma.modules.module.pas +++ b/src/modules/polykerma.modules.module.pas @@ -6,16 +6,18 @@ interface uses Classes +, PolyKerma.Dispatcher.Interfaces , PolyKerma.Modules.Interfaces ; type -{ TModule } - TModule = class(TInterfacedObject, IModule) +{ TInterfacedModule } + TInterfacedModule = class(TInterfacedObject, IModule) private + FDispatcher: IDispatcher; protected public - constructor Create; + constructor Create(const ADispatcher: IDispatcher); destructor Destroy; override; published @@ -25,13 +27,14 @@ implementation { TDispatcher } -constructor TModule.Create; +constructor TInterfacedModule.Create(const ADispatcher: IDispatcher); begin - + FDispatcher:= ADispatcher; end; -destructor TModule.Destroy; +destructor TInterfacedModule.Destroy; begin + FDispatcher:= nil; inherited Destroy; end; diff --git a/src/threads/polykerma.threads.interfaces.pas b/src/threads/polykerma.threads.interfaces.pas index e69de29..288e776 100644 --- a/src/threads/polykerma.threads.interfaces.pas +++ b/src/threads/polykerma.threads.interfaces.pas @@ -0,0 +1,26 @@ +unit PolyKerma.Threads.Interfaces; + +{$mode ObjFPC}{$H+} + +interface + +uses + Classes +; + +type +{ IThread } + IThread = interface + ['{5D340B25-31E7-40C3-A5AB-8AFE68AA31C0}'] + + procedure Start; + procedure Resume; + procedure Terminate; + function WaitFor: Integer; + + end; + +implementation + +end. + diff --git a/src/threads/polykerma.threads.thread.pas b/src/threads/polykerma.threads.thread.pas index e69de29..88b9314 100644 --- a/src/threads/polykerma.threads.thread.pas +++ b/src/threads/polykerma.threads.thread.pas @@ -0,0 +1,75 @@ +unit PolyKerma.Threads.Thread; + +{$mode ObjFPC}{$H+} + +interface + +uses + Classes +, PolyKerma.Threads.Interfaces +; + +type + +{ TInterfacedThread } + TInterfacedThread = class(TThread, IThread) + protected + FRefCount : longint; + FDestroyCount : longint; + + function QueryInterface( + {$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} iid : tguid;out obj + ) : longint;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF}; + function _AddRef : longint;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF}; + function _Release : longint;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF}; + + public + constructor Create(const CreateSuspended: Boolean); reintroduce; + destructor Destroy; override; + + end; + TInterfacedThreadClass = class of TInterfacedThread; + +implementation + +{ TInterfacedThread } + +function TInterfacedThread.QueryInterface( + {$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} iid : tguid;out obj +) : longint;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF}; +begin + if getinterface(iid,obj) then + Result:= S_OK + else + Result:= longint(E_NOINTERFACE); +end; + +function TInterfacedThread._AddRef: longint; + {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF}; +begin + Result:= interlockedincrement(FRefCount); +end; + +function TInterfacedThread._Release: longint; + {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF}; +begin + Result:=interlockeddecrement(FRefCount); + if Result = 0 then + begin + if interlockedincrement(FDestroyCount)=1 then + Self.destroy; + end; +end; + +constructor TInterfacedThread.Create(const CreateSuspended: Boolean); +begin + inherited Create(CreateSuspended); +end; + +destructor TInterfacedThread.Destroy; +begin + inherited Destroy; +end; + +end. + diff --git a/tests/dispatcher/polykerma.test.dispatcher.pas b/tests/dispatcher/polykerma.test.dispatcher.pas index 16b8c25..97b6372 100644 --- a/tests/dispatcher/polykerma.test.dispatcher.pas +++ b/tests/dispatcher/polykerma.test.dispatcher.pas @@ -29,7 +29,7 @@ implementation procedure TTestDispatcher.TestDispatcherCreate; begin - FDispatcher:= TDispatcher.Create; + FDispatcher:= TInterfacedDispatcher.Create; AssertNotNull('Dispatcher not null', FDispatcher); end; diff --git a/tests/messages/polykerma.test.messages.pas b/tests/messages/polykerma.test.messages.pas index 3f8484f..cf58b20 100644 --- a/tests/messages/polykerma.test.messages.pas +++ b/tests/messages/polykerma.test.messages.pas @@ -29,7 +29,7 @@ implementation procedure TTestMessages.TestMessageCreate; begin - FMessage:= TMessage.Create; + FMessage:= TInterfacedMessage.Create; AssertNotNull('Message not null', FMessage); end; diff --git a/tests/modules/polykerma.test.module.pas b/tests/modules/polykerma.test.module.pas index 315e8ad..d422e32 100644 --- a/tests/modules/polykerma.test.module.pas +++ b/tests/modules/polykerma.test.module.pas @@ -29,7 +29,7 @@ implementation procedure TTestModule.TestModuleCreate; begin - FModule:= TModule.Create; + FModule:= TInterfacedModule.Create(nil); AssertNotNull('Module not null', FModule); end; diff --git a/tests/polykermatests.lpi b/tests/polykermatests.lpi index 839f9c4..7108a04 100644 --- a/tests/polykermatests.lpi +++ b/tests/polykermatests.lpi @@ -14,8 +14,69 @@ - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + @@ -29,7 +90,7 @@ - + @@ -46,40 +107,60 @@ - + - + - + - + - + - + - + - + - + - + - + - + + + + + + - + + + + + + + + + + + + + + + + @@ -89,7 +170,7 @@ - + diff --git a/tests/polykermatests.lpr b/tests/polykermatests.lpr index 2a549a2..fb5170a 100644 --- a/tests/polykermatests.lpr +++ b/tests/polykermatests.lpr @@ -3,11 +3,19 @@ {$mode objfpc}{$H+} uses + {$IFDEF UNIX} + cthreads, + cmem, + {$ENDIF} + {$IFDEF HASAMIGA} + athreads, + {$ENDIF} Classes , consoletestrunner , PolyKerma.Test.Dispatcher , PolyKerma.Test.Messages , PolyKerma.Test.Module +, PolyKerma.Test.Threads ; type diff --git a/tests/threads/polykerma.test.threads.pas b/tests/threads/polykerma.test.threads.pas new file mode 100644 index 0000000..65e053d --- /dev/null +++ b/tests/threads/polykerma.test.threads.pas @@ -0,0 +1,42 @@ +unit PolyKerma.Test.Threads; + +{$mode objfpc}{$H+} + +interface + +uses + Classes +, SysUtils +, fpcunit +//, testutils +, testregistry +, PolyKerma.Threads.Interfaces +, PolyKerma.Threads.Thread +; + +type + + TTestThreads= class(TTestCase) + private + FThread: IThread; + protected + public + published + procedure TestThreadCreate; + end; + +implementation + +procedure TTestThreads.TestThreadCreate; +begin + FThread:= TInterfacedThread.Create(True); + AssertNotNull('Thread not null', FThread); +end; + + + +initialization + + RegisterTest(TTestThreads); +end. +