feat: Added TInterfacedThread and tests

Also renamed all classes to `TInterfaced*`
gcarreno · Sep 24, 2023 · 867ba84 · 867ba84
1 parent ad8e75a
commit 867ba84
Show file tree

Hide file tree

Showing 13 changed files with 302 additions and 42 deletions.
diff --git a/src/dispatcher/polykerma.dispatcher.common.pas 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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -29,7 +29,7 @@ implementation
 
 procedure TTestModule.TestModuleCreate;
 begin
-  FModule:= TModule.Create;
+  FModule:= TInterfacedModule.Create(nil);
   AssertNotNull('Module not null', FModule);
 end;