From e06a0237423f55319dbcdfddef56d5f33acc9647 Mon Sep 17 00:00:00 2001 From: Michael Schimmel Date: Thu, 5 Jun 2025 22:11:54 +0200 Subject: [PATCH] Test Refactoring of signals --- Src/Myc.Core.Futures.pas | 4 +- Src/Myc.Core.Lazy.pas | 127 ++++- Src/Myc.Core.Signals.pas | 164 ++++-- Src/Myc.Core.Tasks.pas | 6 +- Src/Myc.Lazy.pas | 19 +- Src/Myc.Signals.pas | 161 ++++-- Src/Myc.Test.Core.Lazy.pas | 44 +- Src/Myc.Test.Lazy.pas | 8 +- .../Myc.Test.Signals.Latch.pas | 85 ++- Src/Myc.Trade.DataSeries.pas | 5 - Src/Myc.Trade.Ticker.pas | 72 +++ Test/MycTests.dpr | 7 +- Test/MycTests.dproj | 5 +- Test/TestCoreFutures.pas | 28 +- Test/TestFutures.pas | 10 +- Test/TestSignals_Dirty.pas | 529 ------------------ Test/TestTasks.pas | 28 +- 17 files changed, 528 insertions(+), 774 deletions(-) rename Test/TestSignals_Latch.pas => Src/Myc.Test.Signals.Latch.pas (90%) create mode 100644 Src/Myc.Trade.Ticker.pas delete mode 100644 Test/TestSignals_Dirty.pas diff --git a/Src/Myc.Core.Futures.pas b/Src/Myc.Core.Futures.pas index 2acb419..a167618 100644 --- a/Src/Myc.Core.Futures.pas +++ b/Src/Myc.Core.Futures.pas @@ -24,7 +24,7 @@ type TMycGateFuncFuture = class(TMycFuture) private FInit: TState.TSubscription; - FDone: IMycLatch; + FDone: IMycEvent; FResult: T; protected function GetResult: T; override; @@ -54,7 +54,7 @@ constructor TMycGateFuncFuture.Create(const ATaskManager: IMycTaskManager; co begin inherited Create; - FDone := TLatch.Construct(1); + FDone := TEvent.CreateLatch(1); // Subscribe the job execution to AGate. // The job will run when AGate notifies the subscriber returned by Run. diff --git a/Src/Myc.Core.Lazy.pas b/Src/Myc.Core.Lazy.pas index cf35491..6ceb913 100644 --- a/Src/Myc.Core.Lazy.pas +++ b/Src/Myc.Core.Lazy.pas @@ -8,38 +8,61 @@ uses Myc.Lazy; type - TMycLazy = class abstract(TInterfacedObject, IMycLazy) + TMycNullLazy = class(TInterfacedObject, IMycLazy) protected - function GetChanged: IMycState; virtual; abstract; + function GetChanged: TState; public - function Pop(out Res: T): Boolean; virtual; abstract; + function Pop(out Res: T): Boolean; end; - TMycNullLazy = class(TMycLazy) - protected - function GetChanged: IMycState; override; - public - function Pop(out Res: T): Boolean; override; - end; - - TMycFuncLazy = class(TMycLazy) - private - FChanged: IMycDirty; + TMycLazyBase = class(TInterfacedObject, IMycLazy) + strict private + FChanged: TFlag; FChangeState: TState.TSubscription; + function GetChanged: TState; + protected + function GetValue: T; virtual; abstract; + public + constructor Create(const AChanged: TState); + destructor Destroy; override; + function Pop(out Res: T): Boolean; + end; + + TMycFuncLazy = class(TMycLazyBase) + private FProc: TFunc; protected - function GetChanged: IMycState; override; + function GetValue: T; override; public constructor Create(const AChanged: TState; const AProc: TFunc); - destructor Destroy; override; - function Pop(out Res: T): Boolean; override; + end; + + TMycChainedLazy = class(TMycLazyBase) + private + FValue: IMycLazy; + protected + function GetValue: T; override; + public + constructor Create(const AValue: IMycLazy); + end; + + TMycMutable = class(TInterfacedObject, IMycLazy, IMycMutable) + private + FNotifier: TEvent; + FValue: T; + protected + function GetChanged: TState; + public + constructor Create; + function Pop(out Res: T): Boolean; + procedure SendValue(const Value: T); end; implementation { TMycNullLazy } -function TMycNullLazy.GetChanged: IMycState; +function TMycNullLazy.GetChanged: TState; begin Result := TState.Null; end; @@ -50,36 +73,88 @@ begin Result := true; end; -{ TMycFuncLazy } +{ TMycLazyBase } -constructor TMycFuncLazy.Create(const AChanged: TState; const AProc: TFunc); +constructor TMycLazyBase.Create(const AChanged: TState); begin inherited Create; - FChanged := TDirty.Construct; - FProc := AProc; + FChanged := TFlag.CreateFlag; FChangeState := AChanged.Subscribe(FChanged); end; -destructor TMycFuncLazy.Destroy; +destructor TMycLazyBase.Destroy; begin FChangeState.Unsubscribe; inherited; end; -function TMycFuncLazy.GetChanged: IMycState; +function TMycLazyBase.GetChanged: TState; begin Result := FChanged.State; end; -function TMycFuncLazy.Pop(out Res: T): Boolean; +function TMycLazyBase.Pop(out Res: T): Boolean; begin Result := FChanged.State.IsSet; if Result then begin - if Assigned(FProc) then - Res := FProc; + Res := GetValue; FChanged.Reset; end; end; +{ TMycFuncLazy } + +constructor TMycFuncLazy.Create(const AChanged: TState; const AProc: TFunc); +begin + inherited Create( AChanged ); + FProc := AProc; + Assert( Assigned(FProc) ); +end; + +function TMycFuncLazy.GetValue: T; +begin + Result := FProc(); +end; + +{ TMycChainedLazy } + +constructor TMycChainedLazy.Create(const AValue: IMycLazy); +begin + inherited Create( AValue.Changed ); + FValue := AValue; +end; + +function TMycChainedLazy.GetValue: T; +begin + if not FValue.Pop( Result ) then + raise Exception.Create('Lazy chain already popped'); +end; + +{ TMycMutable } + +constructor TMycMutable.Create; +begin + inherited Create; + FNotifier := TEvent.CreateNotifier; + FValue := Default(T); +end; + +function TMycMutable.GetChanged: TState; +begin + Result := FNotifier.State; +end; + +function TMycMutable.Pop(out Res: T): Boolean; +begin + Res := FValue; + exit(true); +end; + +procedure TMycMutable.SendValue(const Value: T); +begin + FValue := Value; + FNotifier.Notify; +end; + end. diff --git a/Src/Myc.Core.Signals.pas b/Src/Myc.Core.Signals.pas index d31afe6..d983c14 100644 --- a/Src/Myc.Core.Signals.pas +++ b/Src/Myc.Core.Signals.pas @@ -8,32 +8,38 @@ uses Myc.Signals; type - TMycState = class abstract(TInterfacedObject, IMycState) - protected - function GetIsSet: Boolean; virtual; abstract; - public - function Subscribe(Subscriber: IMycSubscriber): Pointer; virtual; abstract; - procedure Unsubscribe(Tag: TMycNotifyList.TTag); virtual; abstract; - property IsSet: Boolean read GetIsSet; - end; - // TMycNullState implements a "null object" pattern for IMycState. // This state is always considered "set". TMycNullState = class(TInterfacedObject, IMycState) protected // IMycState function GetIsSet: Boolean; - function Subscribe(Subscriber: IMycSubscriber): Pointer; - procedure Unsubscribe(Tag: TMycNotifyList.TTag); public constructor Create; + function Subscribe(Subscriber: IMycSubscriber): Pointer; + procedure Unsubscribe(Tag: TMycNotifyList.TTag); + end; + + // A state that acts as an event. It's state ist always set and it will always notify it's subscribers, if it gets notified by itself. + TMycNotifyEvent = class(TInterfacedObject, IMycState, IMycEvent) + strict private + FSubscribers: TMycNotifyList; + protected + function GetIsSet: Boolean; + function GetState: TState; + public + constructor Create; + destructor Destroy; override; + function Subscribe(Subscriber: IMycSubscriber): Pointer; + procedure Unsubscribe(Tag: TMycNotifyList.TTag); + function Notify: Boolean; end; // TMycLatch implements a countdown latch. // It is initialized with a count. Calls to its Notify method (as an IMycSubscriber) // decrement this count. When the count reaches zero, the latch transitions to the "set" // state (IsSet becomes true), notifies its current subscribers once, and then remains set. - TMycLatch = class(TMycState, IMycLatch) + TMycLatch = class(TInterfacedObject, IMycState, IMycEvent) strict private FSubscribers: TMycNotifyList; // List of subscribers waiting for this latch to be set. private @@ -41,7 +47,7 @@ type FCount: Integer; // The internal countdown value for the latch. function GetState: TState; // Implementation for IMycLatch.GetState and IMycFlag.GetState. protected - function GetIsSet: Boolean; override; final; // Implementation for IMycState.GetIsSet. + function GetIsSet: Boolean; public // Creates the latch with an initial count. // If ACount is 0 or less, the latch is effectively pre-set (delegates to FNull via CreateLatch factory). @@ -49,8 +55,8 @@ type destructor Destroy; override; // IMycSignal implementation - function Subscribe(Subscriber: IMycSubscriber): Pointer; override; - procedure Unsubscribe(Tag: TMycNotifyList.TTag); override; + function Subscribe(Subscriber: IMycSubscriber): Pointer; + procedure Unsubscribe(Tag: TMycNotifyList.TTag); // IMycSubscriber implementation for TMycLatch itself. // Decrements the internal count. If the count reaches zero, @@ -58,16 +64,16 @@ type function Notify: Boolean; end; - TMycNullLatch = class(TInterfacedObject, IMycLatch) + TMycNullEvent = class(TInterfacedObject, IMycEvent) private function GetState: TState; function Notify: Boolean; end; - // TMycDirty implements a resettable "dirty flag". + // TMycFlag implements a resettable "dirty flag". // It can be explicitly set to dirty (via Notify) or reset to clean (via Reset). // Subscribers are notified of relevant state changes. - TMycDirty = class(TMycState, IMycDirty) + TMycFlag = class(TInterfacedObject, IMycState, IMycFlag) strict private FSubscribers: TMycNotifyList; // List of subscribers interested in state changes of this dirty flag. private @@ -75,27 +81,27 @@ type FFlag: Boolean; // Internal state: true if dirty/set, false if clean/reset. function GetState: TState; protected - function GetIsSet: Boolean; override; final; // Implementation for IMycState.GetIsSet (true if dirty). + function GetIsSet: Boolean; public // Creates a new dirty flag, initially set to dirty (true). constructor Create; destructor Destroy; override; - // Factory method to create a new TMycDirty instance. - class function CreateDirty: IMycDirty; static; + // Factory method to create a new TMycFlag instance. + class function CreateDirty: IMycFlag; static; - function Subscribe(Subscriber: IMycSubscriber): Pointer; override; - procedure Unsubscribe(Tag: TMycNotifyList.TTag); override; + function Subscribe(Subscriber: IMycSubscriber): Pointer; + procedure Unsubscribe(Tag: TMycNotifyList.TTag); - // IMycSubscriber implementation for TMycDirty. + // IMycSubscriber implementation for TMycFlag. // Sets this flag to dirty (true). Notifies subscribers if it transitioned from clean to dirty. function Notify: Boolean; - // IMycDirty implementation. Resets the flag to clean (false). + // IMycFlag implementation. Resets the flag to clean (false). function Reset: Boolean; end; - TMycNullDirty = class(TInterfacedObject, IMycDirty) + TMycNullFlag = class(TInterfacedObject, IMycFlag) private function GetState: TState; function Notify: Boolean; @@ -135,14 +141,76 @@ begin // Unsubscribing from a null state has no effect. end; -{ TMycNullLatch } +{ TMycNotifyEvent } -function TMycNullLatch.GetState: TState; +constructor TMycNotifyEvent.Create; +begin + inherited Create; + FSubscribers.Create; +end; + +destructor TMycNotifyEvent.Destroy; +begin + FSubscribers.Destroy; + inherited; +end; + +function TMycNotifyEvent.GetIsSet: Boolean; +begin + Result := true; +end; + +function TMycNotifyEvent.GetState: TState; +begin + Result := Self; +end; + +function TMycNotifyEvent.Notify: Boolean; +begin + FSubscribers.Lock; + try + FSubscribers.Notify(function(Subscriber: IMycSubscriber): Boolean begin Result := Subscriber.Notify; end); + finally + FSubscribers.Release; + end; +end; + +function TMycNotifyEvent.Subscribe(Subscriber: IMycSubscriber): Pointer; +begin + Result := nil; + if not Assigned(Subscriber) then + exit; + + FSubscribers.Lock; + try + Subscriber.Notify; + Result := FSubscribers.Advise(Subscriber); + finally + FSubscribers.Release; + end; +end; + +procedure TMycNotifyEvent.Unsubscribe(Tag: TMycNotifyList.TTag); +begin + if Tag = nil then + exit; + + FSubscribers.Lock; + try + FSubscribers.Unadvise(Tag); + finally + FSubscribers.Release; + end; +end; + +{ TMycNullEvent } + +function TMycNullEvent.GetState: TState; begin Result := TState.Null; end; -function TMycNullLatch.Notify: Boolean; +function TMycNullEvent.Notify: Boolean; begin Result := false; end; @@ -246,63 +314,63 @@ begin end; end; -{ TMycNullDirty } +{ TMycNullFlag } -function TMycNullDirty.GetState: TState; +function TMycNullFlag.GetState: TState; begin Result := TState.Null; end; -function TMycNullDirty.Notify: Boolean; +function TMycNullFlag.Notify: Boolean; begin Result := false; end; -function TMycNullDirty.Reset: Boolean; +function TMycNullFlag.Reset: Boolean; begin Result := true; end; -{ TMycDirty } +{ TMycFlag } -constructor TMycDirty.Create; +constructor TMycFlag.Create; begin inherited Create; FFlag := true; // A new dirty flag is initially considered dirty. FSubscribers.Create; end; -class function TMycDirty.CreateDirty: IMycDirty; +class function TMycFlag.CreateDirty: IMycFlag; begin - // Factory method to create a new TMycDirty instance. - Result := TMycDirty.Create; + // Factory method to create a new TMycFlag instance. + Result := TMycFlag.Create; end; -destructor TMycDirty.Destroy; +destructor TMycFlag.Destroy; begin FSubscribers.Destroy; // Clean up the subscriber list. inherited; end; -function TMycDirty.Reset: Boolean; +function TMycFlag.Reset: Boolean; begin // Sets the flag to false (clean) and returns true if it was previously true (dirty). Result := TInterlocked.Exchange(FFlag, false); end; -function TMycDirty.GetIsSet: Boolean; +function TMycFlag.GetIsSet: Boolean; begin // IsSet is true if the flag is dirty (FFlag = true). Result := FFlag; end; -function TMycDirty.GetState: TState; +function TMycFlag.GetState: TState; begin - // TMycDirty itself implements IMycState. + // TMycFlag itself implements IMycState. Result := Self; end; -function TMycDirty.Notify: Boolean; +function TMycFlag.Notify: Boolean; var wasPreviouslyClean: Boolean; begin @@ -316,7 +384,7 @@ begin FSubscribers.Notify(function(Subscriber: IMycSubscriber): Boolean begin Result := Subscriber.Notify; end); end; // The return value of this Notify (as an IMycSubscriber) indicates if this - // TMycDirty instance itself would want more notifications if it were subscribed to something. + // TMycFlag instance itself would want more notifications if it were subscribed to something. // Here, it reflects whether a state change to dirty occurred due to this call. Result := wasPreviouslyClean; finally @@ -324,12 +392,12 @@ begin end; end; -function TMycDirty.Subscribe(Subscriber: IMycSubscriber): Pointer; +function TMycFlag.Subscribe(Subscriber: IMycSubscriber): Pointer; begin if not Assigned(Subscriber) then exit(nil); - // For TMycDirty, we always add the subscriber and then check if we need to notify immediately. + // For TMycFlag, we always add the subscriber and then check if we need to notify immediately. // Ref counting for the subscriber interface is assumed to be handled by TMycNotifyList.Advise/Unadvise. // Or, if explicit management is needed like in TMycLatch, it should be added. // For consistency with TMycLatch, let's add AddRef/Release here too. @@ -346,7 +414,7 @@ begin end; end; -procedure TMycDirty.Unsubscribe(Tag: TMycNotifyList.TTag); +procedure TMycFlag.Unsubscribe(Tag: TMycNotifyList.TTag); begin if Tag = nil then exit; diff --git a/Src/Myc.Core.Tasks.pas b/Src/Myc.Core.Tasks.pas index eb5ecea..0a3dada 100644 --- a/Src/Myc.Core.Tasks.pas +++ b/Src/Myc.Core.Tasks.pas @@ -203,11 +203,11 @@ end; function TMycTaskFactory.CreateThread(const Proc: TProc): IMycState; var - res: IMycLatch; + res: IMycEvent; capturedProc: TProc; begin // Create a latch that will be signaled when the proc finishes - res := TLatch.Construct(1); // Changed to use direct static call on TMycLatch + res := TEvent.CreateLatch(1); capturedProc := Proc; // Capture Proc for the anonymous method CreateAnonymousThread( @@ -309,7 +309,7 @@ begin raise ETaskException.Create('Task factory terminated'); if not Assigned(Job) then - exit(TLatch.Null); // Already correct, uses direct static property on TMycLatch + exit(TEvent.Null); // Already correct, uses direct static property on TMycLatch // Create a pending job Result := TMycPendingJob.Create(Self, Job); diff --git a/Src/Myc.Lazy.pas b/Src/Myc.Lazy.pas index ca2bd08..c429f28 100644 --- a/Src/Myc.Lazy.pas +++ b/Src/Myc.Lazy.pas @@ -7,12 +7,19 @@ uses Myc.Signals; type + IMycMutable = interface + function GetChanged: TState; + function GetValue: T; + property Changed: TState read GetChanged; + property Value: T read GetValue; + end; + IMycLazy = interface {$REGION 'property access'} - function GetChanged: IMycState; + function GetChanged: TState; {$ENDREGION} function Pop(out Res: T): Boolean; - property Changed: IMycState read GetChanged; + property Changed: TState read GetChanged; end; TLazy = record @@ -26,7 +33,8 @@ type public constructor Create(const ALazy: IMycLazy); - class function Construct(const Changing: IMycState; const Proc: TFunc): IMycLazy; static; + class function Construct(const Changing: IMycState; const Proc: TFunc): IMycLazy; overload; static; + class function Construct(const Value: IMycLazy): IMycLazy; overload; static; class operator Implicit(const A: IMycLazy): TLazy; overload; class operator Implicit(const A: TLazy): IMycLazy; overload; @@ -58,6 +66,11 @@ begin FNull := TMycNullLazy.Create; end; +class function TLazy.Construct(const Value: IMycLazy): IMycLazy; +begin + Result := TMycChainedLazy.Create(Value); +end; + function TLazy.GetChanged: IMycState; begin Result := FLazy.Changed; diff --git a/Src/Myc.Signals.pas b/Src/Myc.Signals.pas index 0dc9849..20495c3 100644 --- a/Src/Myc.Signals.pas +++ b/Src/Myc.Signals.pas @@ -61,44 +61,44 @@ type property IsSet: Boolean read GetIsSet; end; - // IMycLatch is a specific type of flag that, once set, remains set (non-resettable). - // It typically becomes set when an internal countdown reaches zero. - IMycLatch = interface(IMycSubscriber) - // Provides access to the IMycState interface of the flag. + IMycEvent = interface(IMycSubscriber) function GetState: TState; property State: TState read GetState; end; - TLatch = record + TEvent = record strict private class var - FNull: IMycLatch; + FNull: IMycEvent; class constructor ClassCreate; private - FLatch: IMycLatch; + FLatch: IMycEvent; function GetState: TState; inline; public - constructor Create(const ALatch: IMycLatch); - class operator Initialize(out Dest: TLatch); - class operator Implicit(const A: IMycLatch): TLatch; overload; - class operator Implicit(const A: TLatch): IMycLatch; overload; + constructor Create(const ALatch: IMycEvent); + class operator Initialize(out Dest: TEvent); + class operator Implicit(const A: IMycEvent): TEvent; overload; + class operator Implicit(const A: TEvent): IMycEvent; overload; - class function Construct(Count: Integer): TLatch; static; + // A notifier is an event that acts as a multi-cast event. Its state is always set and it forwards all notifications the all subscribers. + class function CreateNotifier: TEvent; static; - class function Enqueue(var Gate: TLatch; Count: Integer = 1): TState; static; + // A latch is a specific type of event that, once set, remains set (non-resettable). + // It becomes set when the internal countdown reaches zero. + class function CreateLatch(Count: Integer): TEvent; static; - class property Null: IMycLatch read FNull; + class function Enqueue(var Gate: TEvent; Count: Integer = 1): TState; static; + + class property Null: IMycEvent read FNull; function Notify: Boolean; inline; property State: TState read GetState; end; - // IMycDirty represents a resettable flag, typically indicating if a State is "dirty" (requiring attention) or "clean". - // It inherits from IMycFlag, meaning it has a State, can be notified, and subscribed to. - IMycDirty = interface(IMycSubscriber) - // Provides access to the IMycState interface of the flag. + // IMycFlag represents a resettable flag, typically indicating if a State is "dirty" (requiring attention) or "clean". + IMycFlag = interface(IMycSubscriber) function GetState: TState; // Resets the flag to its "clean" (not set / not dirty) State. // Returns true if the flag was actually dirty before this reset, false otherwise. @@ -106,14 +106,29 @@ type property State: TState read GetState; end; - TDirty = record + TFlag = record strict private class var - FNull: IMycDirty; + FNull: IMycFlag; class constructor ClassCreate; + + private + FDirty: IMycFlag; + function GetState: TState; inline; + public - class function Construct: IMycDirty; static; - class property Null: IMycDirty read FNull; + constructor Create(const ADirty: IMycFlag); + class operator Implicit(const A: IMycFlag): TFlag; overload; + class operator Implicit(const A: TFlag): IMycFlag; overload; + class operator Initialize(out Dest: TFlag); + + class function CreateFlag: IMycFlag; static; + class property Null: IMycFlag read FNull; + + function Notify: Boolean; inline; + function Reset: Boolean; + + property State: TState read GetState; end; implementation @@ -161,9 +176,9 @@ end; class function TState.All(const States: TArray): TState; var - Latch: IMycLatch; + Latch: IMycEvent; begin - Latch := TLatch.Construct(Length(States)); + Latch := TEvent.CreateLatch(Length(States)); for var i := 0 to High(States) do States[i].Subscribe(Latch); Result := Latch.State; @@ -171,7 +186,7 @@ end; class function TState.Any(const States: TArray): TState; var - Latch: IMycLatch; + Latch: IMycEvent; begin if Length(States) = 0 then begin @@ -179,7 +194,7 @@ begin end else begin - Latch := TLatch.Construct(1); + Latch := TEvent.CreateLatch(1); for var i := 0 to High(States) do States[i].Subscribe(Latch); Result := Latch.State; @@ -211,24 +226,75 @@ begin Result.Create(A); end; -{ TLatch } +{ TFlag } -class constructor TLatch.ClassCreate; +class constructor TFlag.ClassCreate; begin - // Create a singleton null latch instance that is initially (and always) set. - FNull := TMycNullLatch.Create; // Calls the instance constructor + FNull := TMycNullFlag.Create; end; -{ TLatch } +{ TFlag } -constructor TLatch.Create(const ALatch: IMycLatch); +constructor TFlag.Create(const ADirty: IMycFlag); +begin + FDirty := ADirty; + if not Assigned(FDirty) then + FDirty := FNull; +end; + +class function TFlag.CreateFlag: IMycFlag; +begin + Result := TMycFlag.Create; +end; + +function TFlag.GetState: TState; +begin + Result := FDirty.State; +end; + +function TFlag.Notify: Boolean; +begin + Result := FDirty.Notify; +end; + +function TFlag.Reset: Boolean; +begin + Result := FDirty.Reset; +end; + +class operator TFlag.Implicit(const A: IMycFlag): TFlag; +begin + Result.Create(A); +end; + +class operator TFlag.Implicit(const A: TFlag): IMycFlag; +begin + Result := A.FDirty; +end; + +class operator TFlag.Initialize(out Dest: TFlag); +begin + Dest.FDirty := FNull; +end; + +{ TEvent } + +class constructor TEvent.ClassCreate; +begin + // Create a singleton null latch instance that is initially (and always) set. + FNull := TMycNullEvent.Create; +end; + +{ TEvent } + +constructor TEvent.Create(const ALatch: IMycEvent); begin FLatch := ALatch; if not Assigned(FLatch) then FLatch := FNull; end; -class function TLatch.Construct(Count: Integer): TLatch; +class function TEvent.CreateLatch(Count: Integer): TEvent; begin if Count > 0 then Result := TMycLatch.Create(Count) @@ -236,7 +302,12 @@ begin Result := FNull; end; -class function TLatch.Enqueue(var Gate: TLatch; Count: Integer = 1): TState; +class function TEvent.CreateNotifier: TEvent; +begin + Result := TMycNotifyEvent.Create; +end; + +class function TEvent.Enqueue(var Gate: TEvent; Count: Integer = 1): TState; begin var gateState := Gate.State; Gate := TMycLatch.Create(Count); @@ -244,41 +315,29 @@ begin exit(Gate.State); end; -function TLatch.GetState: TState; +function TEvent.GetState: TState; begin Result := FLatch.State; end; -function TLatch.Notify: Boolean; +function TEvent.Notify: Boolean; begin Result := FLatch.Notify; end; -class operator TLatch.Implicit(const A: IMycLatch): TLatch; +class operator TEvent.Implicit(const A: IMycEvent): TEvent; begin Result.Create(A); end; -class operator TLatch.Implicit(const A: TLatch): IMycLatch; +class operator TEvent.Implicit(const A: TEvent): IMycEvent; begin Result := A.FLatch; end; -class operator TLatch.Initialize(out Dest: TLatch); +class operator TEvent.Initialize(out Dest: TEvent); begin Dest.FLatch := FNull; end; -{ TDirty } - -class constructor TDirty.ClassCreate; -begin - FNull := TMycNullDirty.Create; -end; - -class function TDirty.Construct: IMycDirty; -begin - Result := TMycDirty.Create; -end; - end. diff --git a/Src/Myc.Test.Core.Lazy.pas b/Src/Myc.Test.Core.Lazy.pas index 256065b..580a860 100644 --- a/Src/Myc.Test.Core.Lazy.pas +++ b/Src/Myc.Test.Core.Lazy.pas @@ -162,9 +162,9 @@ procedure TTestMycCoreLazy.TestFuncLazy_GetChanged_IsAlwaysTrueAfterCreation; var funcLazy: IMycLazy; changedState: IMycState; - sourceDirty: IMycDirty; + sourceDirty: IMycFlag; begin - sourceDirty := TDirty.Construct; + sourceDirty := TFlag.CreateFlag; sourceDirty.Reset; funcLazy := TMycFuncLazy.Create(sourceDirty.State, function: Integer begin Result := 10; end); Assert.IsNotNull(funcLazy, 'TMycFuncLazy instance should not be nil'); @@ -178,11 +178,11 @@ var funcLazy: IMycLazy; value: Integer; result: Boolean; - sourceDirty: IMycDirty; + sourceDirty: IMycFlag; procExecuted: Boolean; expectedValue: Integer; begin - sourceDirty := TDirty.Construct; + sourceDirty := TFlag.CreateFlag; sourceDirty.Reset; procExecuted := False; expectedValue := 50; @@ -211,9 +211,9 @@ var value: Integer; preCallValue: Integer; result: Boolean; - sourceDirty: IMycDirty; + sourceDirty: IMycFlag; begin - sourceDirty := TDirty.Construct; + sourceDirty := TFlag.CreateFlag; sourceDirty.Reset; funcLazy := TMycFuncLazy.Create(sourceDirty.State, nil); Assert.IsNotNull(funcLazy, 'TMycFuncLazy instance should not be nil'); @@ -235,10 +235,10 @@ end; procedure TTestMycCoreLazy.TestFuncLazy_AfterFirstPop_IfNoSourceChange_GetChangedIsFalse; var funcLazy: IMycLazy; - sourceDirty: IMycDirty; + sourceDirty: IMycFlag; initialProcValue: Integer; begin - sourceDirty := TDirty.Construct; + sourceDirty := TFlag.CreateFlag; sourceDirty.Reset; initialProcValue := 33; funcLazy := TMycFuncLazy.Create(sourceDirty.State, function: Integer begin Result := initialProcValue; end); @@ -251,11 +251,11 @@ var funcLazy: IMycLazy; value: Integer; result: Boolean; - sourceDirty: IMycDirty; + sourceDirty: IMycFlag; initialProcValue: Integer; procExecutedCount: Integer; begin - sourceDirty := TDirty.Construct; + sourceDirty := TFlag.CreateFlag; sourceDirty.Reset; initialProcValue := 44; procExecutedCount := 0; @@ -279,10 +279,10 @@ procedure TTestMycCoreLazy.TestFuncLazy_AfterSourceChange_GetChanged_IsSet; var funcLazy: IMycLazy; changedState: IMycState; - sourceDirty: IMycDirty; + sourceDirty: IMycFlag; initialProcValue: Integer; begin - sourceDirty := TDirty.Construct; + sourceDirty := TFlag.CreateFlag; sourceDirty.Reset; initialProcValue := 20; funcLazy := TMycFuncLazy.Create(sourceDirty.State, function: Integer begin Result := initialProcValue; end); @@ -297,11 +297,11 @@ var funcLazy: IMycLazy; value: Integer; result: Boolean; - sourceDirty: IMycDirty; + sourceDirty: IMycFlag; procCallCount: Integer; currentExpectedValue: Integer; begin - sourceDirty := TDirty.Construct; + sourceDirty := TFlag.CreateFlag; sourceDirty.Reset; procCallCount := 0; funcLazy := @@ -335,10 +335,10 @@ var funcLazy: IMycLazy; value: Integer; resultPop1, resultPop2: Boolean; - sourceDirty: IMycDirty; + sourceDirty: IMycFlag; procCallCount: Integer; begin - sourceDirty := TDirty.Construct; + sourceDirty := TFlag.CreateFlag; sourceDirty.Reset; procCallCount := 0; funcLazy := @@ -367,11 +367,11 @@ var funcLazy: IMycLazy; value: Integer; result: Boolean; - sourceDirty: IMycDirty; + sourceDirty: IMycFlag; procCallCount: Integer; initialValue, firstSourceChangeValue: Integer; begin - sourceDirty := TDirty.Construct; + sourceDirty := TFlag.CreateFlag; sourceDirty.Reset; // sourceDirty.IsSet is FALSE procCallCount := 0; initialValue := 51; @@ -427,10 +427,10 @@ end; procedure TTestMycCoreLazy.TestFuncLazy_Destroy_UnsubscribesFromSource; var funcLazyObj: TMycFuncLazy; - sourceDirty: IMycDirty; + sourceDirty: IMycFlag; tempVal: Integer; begin - sourceDirty := TDirty.Construct; + sourceDirty := TFlag.CreateFlag; sourceDirty.Reset; funcLazyObj := TMycFuncLazy.Create(sourceDirty.State, function: Integer begin Result := 1; end); Assert.IsTrue(funcLazyObj.Pop(tempVal), 'Initial Pop should succeed'); @@ -448,11 +448,11 @@ var funcLazy: IMycLazy; value: Integer; result: Boolean; - sourceDirty: IMycDirty; + sourceDirty: IMycFlag; expectedValue: Integer; procExecuted: Boolean; begin - sourceDirty := TDirty.Construct; + sourceDirty := TFlag.CreateFlag; Assert.IsTrue(sourceDirty.State.IsSet, 'SourceDirty should be initially set for this test scenario'); expectedValue := 70; procExecuted := False; diff --git a/Src/Myc.Test.Lazy.pas b/Src/Myc.Test.Lazy.pas index bc41443..98edb09 100644 --- a/Src/Myc.Test.Lazy.pas +++ b/Src/Myc.Test.Lazy.pas @@ -12,7 +12,7 @@ type [TestFixture] TTestMyLazy = class(TObject) private - FChangingSignal: IMycDirty; // Used as the 'Changing' state for functional lazy objects + FChangingSignal: IMycFlag; // Used as the 'Changing' state for functional lazy objects // Helper to consume the initial pop, which is always expected to succeed // for a TLazy wrapping a functional lazy object due to "Changed.IsSet initially true" design. @@ -76,7 +76,7 @@ begin // Create a common signal source for tests that need it. // TState.CreateDirty is from Myc.Signals.pas (interface part) // Its implementation might rely on Myc.Core.Signals, but that's an indirect usage. - FChangingSignal := TDirty.Construct; + FChangingSignal := TFlag.CreateFlag; FChangingSignal.Reset; // Start with a clean (not set) signal for predictable test starts end; @@ -306,9 +306,9 @@ end; procedure TTestMyLazy.TestConstruct_Destruction_UnsubscribesAndNoCrashOnSourceNotify; var lazyIntf: IMycLazy; - localChangingSignal: IMycDirty; // Use a local signal for this test to control its lifetime + localChangingSignal: IMycFlag; // Use a local signal for this test to control its lifetime begin - localChangingSignal := TDirty.Construct; + localChangingSignal := TFlag.CreateFlag; localChangingSignal.Reset; lazyIntf := TLazy.Construct(localChangingSignal.State, function: Integer begin Result := 1; end); diff --git a/Test/TestSignals_Latch.pas b/Src/Myc.Test.Signals.Latch.pas similarity index 90% rename from Test/TestSignals_Latch.pas rename to Src/Myc.Test.Signals.Latch.pas index 1d9e831..e4798b2 100644 --- a/Test/TestSignals_Latch.pas +++ b/Src/Myc.Test.Signals.Latch.pas @@ -1,5 +1,4 @@ -// Suggested filename: TestSignals_Latch.pas -unit TestSignals_Latch; +unit Myc.Test.Signals.Latch; interface @@ -121,10 +120,10 @@ end; procedure TTestMycLatch.TestCreate_InitialState(InitialCount: Integer; ExpectedIsSet: Boolean); var - latch: IMycLatch; + latch: IMycEvent; begin // TMycLatch.CreateLatch returns TMycLatch.Null if InitialCount <= 0 - latch := TLatch.Construct(InitialCount); + latch := TEvent.CreateLatch(InitialCount); Assert.AreEqual(ExpectedIsSet, latch.State.IsSet, 'Latch initial IsSet state mismatch for count ' + IntToStr(InitialCount) + '.'); end; @@ -134,11 +133,11 @@ procedure TTestMycLatch.TestNotify_ReturnValueAndState_AfterOneNotify( ExpectedIsSet: Boolean ); var - latch: IMycLatch; + latch: IMycEvent; returnedValueFromNotify: Boolean; begin - latch := TLatch.Construct(InitialCount); - returnedValueFromNotify := latch.Notify; // This is IMycLatch (as IMycSubscriber).Notify + latch := TEvent.CreateLatch(InitialCount); + returnedValueFromNotify := latch.Notify; // This is IMycEvent (as IMycSubscriber).Notify Assert.AreEqual( ExpectedReturn, @@ -154,9 +153,9 @@ end; procedure TTestMycLatch.TestNotify_DecrementsCounter_StateChanges; var - latch: IMycLatch; + latch: IMycEvent; begin - latch := TLatch.Construct(1); + latch := TEvent.CreateLatch(1); Assert.IsFalse(latch.State.IsSet, 'Latch should initially not be set (Count=1).'); latch.Notify; // Count becomes 0 Assert.IsTrue(latch.State.IsSet, 'Latch should be set after Notify (Count became 0).'); @@ -164,9 +163,9 @@ end; procedure TTestMycLatch.TestNotify_MultipleNotifies_CounterBecomesNegativeAndStaysSet; var - latch: IMycLatch; + latch: IMycEvent; begin - latch := TLatch.Construct(1); + latch := TEvent.CreateLatch(1); latch.Notify; // Count becomes 0, IsSet = True Assert.IsTrue(latch.State.IsSet, 'Latch should be set after first Notify.'); latch.Notify; // Count becomes -1, IsSet should remain True @@ -177,11 +176,11 @@ end; procedure TTestMycLatch.TestSubscriber_Single_IsNotifiedWhenLatchSet; var - latch: IMycLatch; + latch: IMycEvent; mockSub: TMockSubscriber; subscription: TState.TSubscription; begin - latch := TLatch.Construct(1); + latch := TEvent.CreateLatch(1); mockSub := TMockSubscriber.Create; subscription := latch.State.Subscribe(mockSub); // Subscribing to the Latch's state @@ -196,11 +195,11 @@ end; procedure TTestMycLatch.TestSubscriber_Multiple_AreNotifiedWhenLatchSet; var - latch: IMycLatch; + latch: IMycEvent; mockSub1, mockSub2, mockSub3: TMockSubscriber; sub1, sub2, sub3: TState.TSubscription; // Keep subscriptions in scope begin - latch := TLatch.Construct(1); + latch := TEvent.CreateLatch(1); mockSub1 := TMockSubscriber.Create; mockSub2 := TMockSubscriber.Create; mockSub3 := TMockSubscriber.Create; @@ -218,11 +217,11 @@ end; procedure TTestMycLatch.TestSubscriber_NotNotified_BeforeLatchSet; var - latch: IMycLatch; + latch: IMycEvent; mockSub: TMockSubscriber; subscription: TState.TSubscription; begin - latch := TLatch.Construct(2); // Count = 2 + latch := TEvent.CreateLatch(2); // Count = 2 mockSub := TMockSubscriber.Create; subscription := latch.State.Subscribe(mockSub); @@ -233,11 +232,11 @@ end; procedure TTestMycLatch.TestSubscriber_NotifiedOnlyOnce_AfterLatchSetAndUnadvised; var - latch: IMycLatch; + latch: IMycEvent; mockSub: TMockSubscriber; subscription: TState.TSubscription; begin - latch := TLatch.Construct(1); + latch := TEvent.CreateLatch(1); mockSub := TMockSubscriber.Create; subscription := latch.State.Subscribe(mockSub); @@ -250,11 +249,11 @@ end; procedure TTestMycLatch.TestSubscribe_ToAlreadySetLatch_NotifiesImmediately; var - latch: IMycLatch; + latch: IMycEvent; mockSub1, mockSub2: TMockSubscriber; subscription1, subscription2: TState.TSubscription; begin - latch := TLatch.Construct(1); // Create with count 1 + latch := TEvent.CreateLatch(1); // Create with count 1 mockSub1 := TMockSubscriber.Create; subscription1 := latch.State.Subscribe(mockSub1); // Subscribe before set @@ -278,12 +277,12 @@ end; procedure TTestMycLatch.TestChaining_A_Notifies_B; var - latchA, latchB: IMycLatch; + latchA, latchB: IMycEvent; mockSubForB: TMockSubscriber; subHandle_B_listens_A, subHandle_Mock_listens_B: TState.TSubscription; begin - latchA := TLatch.Construct(1); - latchB := TLatch.Construct(1); // latchB is an IMycSubscriber + latchA := TEvent.CreateLatch(1); + latchB := TEvent.CreateLatch(1); // latchB is an IMycSubscriber mockSubForB := TMockSubscriber.Create; subHandle_Mock_listens_B := latchB.State.Subscribe(mockSubForB); @@ -303,13 +302,13 @@ end; procedure TTestMycLatch.TestCascade_A_Notifies_B_Notifies_C; var - latchA, latchB, latchC: IMycLatch; + latchA, latchB, latchC: IMycEvent; mockSubForC: TMockSubscriber; sub_Mock_C, sub_C_B, sub_B_A: TState.TSubscription; begin - latchA := TLatch.Construct(1); - latchB := TLatch.Construct(1); - latchC := TLatch.Construct(1); + latchA := TEvent.CreateLatch(1); + latchB := TEvent.CreateLatch(1); + latchC := TEvent.CreateLatch(1); mockSubForC := TMockSubscriber.Create; sub_Mock_C := latchC.State.Subscribe(mockSubForC); @@ -326,14 +325,14 @@ end; procedure TTestMycLatch.TestChaining_B_NeedsMultipleNotifiesFromA_WithSubscriberOnB; var - latchA, latchB: IMycLatch; + latchA, latchB: IMycEvent; mockSubForB: TMockSubscriber; sub_Mock_B, sub_B_A: TState.TSubscription; begin // LatchA needs 2 notifies to become set. LatchB needs 1 notify to become set. // LatchB subscribes to LatchA. So LatchB will be notified once LatchA becomes set. - latchA := TLatch.Construct(2); - latchB := TLatch.Construct(1); + latchA := TEvent.CreateLatch(2); + latchB := TEvent.CreateLatch(1); mockSubForB := TMockSubscriber.Create; sub_Mock_B := latchB.State.Subscribe(mockSubForB); @@ -355,11 +354,11 @@ end; procedure TTestMycLatch.TestInitiallySetLatch_NotifiesNewSubscriberImmediately; var - latch: IMycLatch; // Will be TMycLatch.Null + latch: IMycEvent; // Will be TMycLatch.Null mockSub: TMockSubscriber; subscription: TState.TSubscription; begin - latch := TLatch.Construct(0); // Returns TMycLatch.Null which is set. + latch := TEvent.CreateLatch(0); // Returns TMycLatch.Null which is set. mockSub := TMockSubscriber.Create; subscription := latch.State.Subscribe(mockSub); // TMycLatch.Subscribe notifies immediately if already set. @@ -370,11 +369,11 @@ end; procedure TTestMycLatch.TestUnsubscribe_SubscriberNotNotified; var - latch: IMycLatch; + latch: IMycEvent; mockSub: TMockSubscriber; subscription: TState.TSubscription; begin - latch := TLatch.Construct(1); + latch := TEvent.CreateLatch(1); mockSub := TMockSubscriber.Create; subscription := latch.State.Subscribe(mockSub); @@ -389,11 +388,11 @@ end; procedure TTestMycLatch.TestMultipleTriggersNoSubscriber_StateCorrectForLaterSubscriber; var - latch: IMycLatch; + latch: IMycEvent; mockSub: TMockSubscriber; subscription: TState.TSubscription; begin - latch := TLatch.Construct(3); + latch := TEvent.CreateLatch(3); latch.Notify; // Count -> 2 latch.Notify; // Count -> 1 @@ -412,11 +411,11 @@ end; procedure TTestMycLatch.TestLatchSet_ClearsSubscribers_NoFurtherNotification; var - latch: IMycLatch; + latch: IMycEvent; mockSub1, mockSub2: TMockSubscriber; subscription1, subscription2: TState.TSubscription; begin - latch := TLatch.Construct(1); + latch := TEvent.CreateLatch(1); mockSub1 := TMockSubscriber.Create; mockSub2 := TMockSubscriber.Create; @@ -440,11 +439,11 @@ end; procedure TTestMycLatch.TestLatchSet_SubscriptionFinalize_IsSafePostUnadviseAll; var - latch: IMycLatch; + latch: IMycEvent; mockSub: TMockSubscriber; // 'subscription' will be declared in an inner scope to control its finalization begin - latch := TLatch.Construct(1); + latch := TEvent.CreateLatch(1); mockSub := TMockSubscriber.Create; var noException: Boolean := True; @@ -476,11 +475,11 @@ end; procedure TTestMycLatch.TestLatchSet_NewSubscriberToSetLatch_NotifiedImmediatelyButNotPersistedForLatchNotify; var - latch: IMycLatch; + latch: IMycEvent; mockSubInitial, mockSubNew: TMockSubscriber; subscriptionInitial, subscriptionNew: TState.TSubscription; begin - latch := TLatch.Construct(1); + latch := TEvent.CreateLatch(1); mockSubInitial := TMockSubscriber.Create; subscriptionInitial := latch.State.Subscribe(mockSubInitial); diff --git a/Src/Myc.Trade.DataSeries.pas b/Src/Myc.Trade.DataSeries.pas index ea3d11a..c6a761f 100644 --- a/Src/Myc.Trade.DataSeries.pas +++ b/Src/Myc.Trade.DataSeries.pas @@ -257,11 +257,6 @@ begin end; end; -function FindNextFile(const Filename: String): String; -begin - -end; - class destructor TDataSeries.CreateClass; begin FCachedFiles := TDictionary.Create; diff --git a/Src/Myc.Trade.Ticker.pas b/Src/Myc.Trade.Ticker.pas new file mode 100644 index 0000000..de4a795 --- /dev/null +++ b/Src/Myc.Trade.Ticker.pas @@ -0,0 +1,72 @@ +unit Myc.Trade.Ticker; + +interface + +uses + Myc.Lazy; + +type + TMycLogger = reference to procedure(const Msg: String); + + IMycTradeObject = interface + end; + + TMycTradeObject = class(TInterfacedObject, IMycTradeObject) + private + FCaption: string; + FLog: TMycLogger; + function GetCaption: string; + public + constructor Create(const ACaption: string; ALog: TMycLogger); + property Caption: string read GetCaption; + property Log: TMycLogger read FLog; + end; + + IMycTime = interface + {$REGION 'property access'} + function GetTimeStamp: TDateTime; + {$ENDREGION} + property TimeStamp: TDateTime read GetTimeStamp; + end; + + IMycTick = interface + {$REGION 'property access'} + function GetAsk: Double; + function GetBid: Double; + function GetTime: IMycTime; + function GetVolume: Double; + {$ENDREGION} + property Ask: Double read GetAsk; + property Bid: Double read GetBid; + property Time: IMycTime read GetTime; + property Volume: Double read GetVolume; + end; + + IMycTicker = interface(IMycTradeObject) + {$REGION 'property access'} + function GetLastTick: TLazy; + function GetCurrentTime: IMycTime; + {$ENDREGION} + property LastTick: TLazy read GetLastTick; + property CurrentTime: IMycTime read GetCurrentTime; + end; + + IMycHistoryTicker = interface(IMycTicker) + + end; + +implementation + +constructor TMycTradeObject.Create(const ACaption: string; ALog: TMycLogger); +begin + inherited Create; + FCaption := ACaption; + FLog := procedure(const Msg: String) begin ALog('[' + FCaption + '] ' + Msg); end; +end; + +function TMycTradeObject.GetCaption: string; +begin + Result := FCaption; +end; + +end. diff --git a/Test/MycTests.dpr b/Test/MycTests.dpr index 9ce5baf..2e8b02a 100644 --- a/Test/MycTests.dpr +++ b/Test/MycTests.dpr @@ -17,10 +17,8 @@ uses TestNotifier in 'TestNotifier.pas', TestNotifier_Threading in 'TestNotifier_Threading.pas' {/TestNotifier_ChaosStress in 'TestNotifier_ChaosStress.pas',}, TestNotifier_ChaosStress in 'TestNotifier_ChaosStress.pas', - TestSignals_Latch in 'TestSignals_Latch.pas', Myc.Core.Tasks in '..\Src\Myc.Core.Tasks.pas', TestTasks in 'TestTasks.pas', - TestSignals_Dirty in 'TestSignals_Dirty.pas', Myc.Futures in '..\Src\Myc.Futures.pas', TestCoreFutures in 'TestCoreFutures.pas', Myc.TaskManager in '..\Src\Myc.TaskManager.pas', @@ -31,7 +29,10 @@ uses Myc.Core.Lazy in '..\Src\Myc.Core.Lazy.pas', Myc.Test.Core.Lazy in '..\Src\Myc.Test.Core.Lazy.pas', Myc.Test.Lazy in '..\Src\Myc.Test.Lazy.pas', - Myc.Test.Core.Atomic in '..\Src\Myc.Test.Core.Atomic.pas'; + Myc.Test.Core.Atomic in '..\Src\Myc.Test.Core.Atomic.pas', + Myc.Trade.Ticker in '..\Src\Myc.Trade.Ticker.pas', + Myc.Test.Signals.Latch in '..\Src\Myc.Test.Signals.Latch.pas', + Myc.Test.Signals.Dirty in '..\Src\Myc.Test.Signals.Dirty.pas'; { keep comment here to protect the following conditional from being removed by the IDE when adding a unit } {$IFNDEF TESTINSIGHT} diff --git a/Test/MycTests.dproj b/Test/MycTests.dproj index 999941b..1f010d5 100644 --- a/Test/MycTests.dproj +++ b/Test/MycTests.dproj @@ -114,10 +114,8 @@ $(PreBuildEvent)]]>
/TestNotifier_ChaosStress in 'TestNotifier_ChaosStress.pas',
- - @@ -129,6 +127,9 @@ $(PreBuildEvent)]]> + + + Base diff --git a/Test/TestCoreFutures.pas b/Test/TestCoreFutures.pas index 2e4c49b..b6ac60d 100644 --- a/Test/TestCoreFutures.pas +++ b/Test/TestCoreFutures.pas @@ -16,9 +16,9 @@ type // Helper class to notify a latch when its Notify method is called. TLatchNotifierSubscriber = class(TInterfacedObject, IMycSubscriber) private - FGateLatch: IMycLatch; + FGateLatch: IMycEvent; public - constructor Create(AGateLatch: IMycLatch); + constructor Create(AGateLatch: IMycEvent); // IMycSubscriber function Notify: Boolean; // Implements IMycSubscriber.Notify [cite: 46, 181, 299] end; @@ -54,7 +54,7 @@ implementation { TLatchNotifierSubscriber } -constructor TLatchNotifierSubscriber.Create(AGateLatch: IMycLatch); +constructor TLatchNotifierSubscriber.Create(AGateLatch: IMycEvent); begin inherited Create; FGateLatch := AGateLatch; @@ -121,12 +121,12 @@ end; procedure TTestMycGateFuncFuture.Test_ChainedExecution_WithDelayedInitState; var LFuture: IMycFuture; - LInitLatch: IMycLatch; + LInitLatch: IMycEvent; LResultValue: string; const CExpectedResult = 'ChainCompleted'; begin - LInitLatch := TLatch.Construct(1); // Create an init state that is not yet set [cite: 77, 212, 330] + LInitLatch := TEvent.CreateLatch(1); // Create an init state that is not yet set [cite: 77, 212, 330] LFuture := TMycGateFuncFuture.Create( @@ -220,9 +220,9 @@ end; procedure TTestMycGateFuncFuture.Test_GetResult_BeforeDone_RaisesException; var LFuture: IMycFuture; - LInitLatch: IMycLatch; + LInitLatch: IMycEvent; begin - LInitLatch := TLatch.Construct(1); + LInitLatch := TEvent.CreateLatch(1); LFuture := TMycGateFuncFuture.Create( @@ -250,9 +250,9 @@ procedure TTestMycGateFuncFuture.Test_FanIn_OneFutureWaitsForMultipleOthers; var LPrerequisiteFuture1, LPrerequisiteFuture2: IMycFuture; LMainFuture: IMycFuture; - LGateLatch: IMycLatch; + LGateLatch: IMycEvent; LSub1, LSub2: IMycSubscriber; // To hold the TLatchNotifierSubscriber instances - LInitStateP1, LInitStateP2: IMycLatch; + LInitStateP1, LInitStateP2: IMycEvent; Subscriptions: array[1..2] of TState.TSubscription; // To manage subscriptions const CMainFutureResult = 'AllPrerequisitesCompleted'; @@ -260,7 +260,7 @@ begin FProcExecutionCount := 0; // Reset for this test // Gate Latch: MainFuture waits for this latch, which needs 2 notifications. - LGateLatch := TLatch.Construct(2); // [cite: 77, 212, 330] + LGateLatch := TEvent.CreateLatch(2); // [cite: 77, 212, 330] // Create MainFuture, AInitState is the GateLatch's state. LMainFuture := @@ -276,7 +276,7 @@ begin // Setup Prerequisite Futures // PrerequisiteFuture1 - LInitStateP1 := TLatch.Construct(1); // Controllable init state for PF1 + LInitStateP1 := TEvent.CreateLatch(1); // Controllable init state for PF1 LPrerequisiteFuture1 := TMycGateFuncFuture.Create( FTaskFactory, @@ -291,7 +291,7 @@ begin Subscriptions[1] := LPrerequisiteFuture1.Done.Subscribe(LSub1); // Subscribe to PF1's completion [cite: 56, 188, 306] // PrerequisiteFuture2 - LInitStateP2 := TLatch.Construct(1); // Controllable init state for PF2 + LInitStateP2 := TEvent.CreateLatch(1); // Controllable init state for PF2 LPrerequisiteFuture2 := TMycGateFuncFuture.Create( FTaskFactory, @@ -335,7 +335,7 @@ end; procedure TTestMycGateFuncFuture.Test_FanOut_MultipleFuturesWaitForOneTrigger; var - LTriggerLatch: IMycLatch; + LTriggerLatch: IMycEvent; LFutureA, LFutureB: IMycFuture; LFlagFutureARan, LFlagFutureBRan: Boolean; begin @@ -343,7 +343,7 @@ begin LFlagFutureBRan := False; Self.FSharedCounter := 0; // Reset shared counter for this test - LTriggerLatch := TLatch.Construct(1); // Single trigger [cite: 77, 212, 330] + LTriggerLatch := TEvent.CreateLatch(1); // Single trigger [cite: 77, 212, 330] // Future A LFutureA := diff --git a/Test/TestFutures.pas b/Test/TestFutures.pas index 89eeb65..384047e 100644 --- a/Test/TestFutures.pas +++ b/Test/TestFutures.pas @@ -148,11 +148,11 @@ end; procedure TTestFuture.TestConstructWithDelayedGate; var fut: TFuture; - delayedGate: IMycLatch; // IMycLatch implements IMycState [cite: 58] + delayedGate: IMycEvent; // IMycEvent implements IMycState [cite: 58] resultValue: Integer; begin - delayedGate := TLatch.Construct(1); // Create a latch that requires one notification to be set [cite: 66] - Assert.IsNotNull(delayedGate, 'The delayed gate (IMycLatch) should not be nil.'); // Static string + delayedGate := TEvent.CreateLatch(1); // Create a latch that requires one notification to be set [cite: 66] + Assert.IsNotNull(delayedGate, 'The delayed gate (IMycEvent) should not be nil.'); // Static string Assert.IsFalse(delayedGate.State.IsSet, 'The delayed gate should not be initially set.'); // Static string [cite: 59, 55] // Construct a future with a gate that is not yet set @@ -220,10 +220,10 @@ procedure TTestFuture.TestChainWithGate; var fut1: TFuture; fut2: TFuture; - delayedGate: IMycLatch; + delayedGate: IMycEvent; resultValue: string; begin - delayedGate := TLatch.Construct(1); // [cite: 66] + delayedGate := TEvent.CreateLatch(1); // [cite: 66] Assert.IsFalse(delayedGate.State.IsSet, 'The delayed gate for chain test should not be initially set.'); // Static string [cite: 59, 55] diff --git a/Test/TestSignals_Dirty.pas b/Test/TestSignals_Dirty.pas deleted file mode 100644 index 34d33f8..0000000 --- a/Test/TestSignals_Dirty.pas +++ /dev/null @@ -1,529 +0,0 @@ -unit TestSignals_Dirty; - -interface - -uses - DUnitX.TestFramework, - System.SysUtils, - Myc.Signals; // Unit under test - -type - // Helper class to mock a subscriber (reuse or redefine if not in common unit) - TMockSubscriber = class(TInterfacedObject, IMycSubscriber) - public - NotifyCount: Integer; - NotifyShouldReturn: Boolean; - WasCalled: Boolean; - LastReturnedValueFromSource: Boolean; // To store what the source's Notify returned - - constructor Create(AShouldReturn: Boolean = True); - function Notify: Boolean; // IMycSubscriber implementation. - end; - - [TestFixture] - TTestMycDirtyFlag = class(TObject) - private - // Helper to create a dirty flag and optionally reset it for a clean initial state - function CreateAndPrepareDirtyFlag(StartDirty: Boolean = True): IMycDirty; - public - [Setup] - procedure Setup; - [TearDown] - procedure TearDown; - - // Category 1: Basic State, Notify (as Subscriber method), and Reset - [Test] - procedure TestCreate_InitialStateIsDirty; - [Test] - procedure TestReset_FromDirtyState_BecomesCleanAndReturnsTrue; - [Test] - procedure TestReset_FromCleanState_StaysCleanAndReturnsFalse; - [Test] - procedure TestNotify_OnCleanFlag_SetsDirtyAndReturnsTrue; - [Test] - procedure TestNotify_OnDirtyFlag_StaysDirtyAndReturnsFalse; - - // Category 2: Subscriber Notifications - [Test] - procedure TestSubscribe_ToAlreadyDirtyFlag_NotifiesSubscriberImmediately; - [Test] - procedure TestSubscribe_ToCleanFlag_DoesNotNotifySubscriberImmediately; - [Test] - procedure TestSubscriber_Notified_WhenFlagTransitionsToDirty; - [Test] - procedure TestSubscriber_NotNotified_WhenSettingAlreadyDirtyFlagViaNotify; - [Test] - procedure TestSubscriber_NotNotified_ByResetAction; - [Test] - procedure TestMultipleSubscribers_Notified_WhenFlagTransitionsToDirty; - [Test] - procedure TestUnsubscribe_SubscriberNotNotified; - - // Category 3: Chaining Dirty Flags - [Test] - procedure TestChain_A_Notifies_B_SimplePropagation; - [Test] - procedure TestChain_A_Notifies_B_Notifies_C_SimplePropagation; - - // Category 4: Chaining with Resets and Re-triggering (Consistency) - [Test] - procedure TestChain_A_B_ResetB_RetriggerA_BStaysCleanIfANotChanged; - [Test] - procedure TestChain_A_B_ResetA_ThenTriggerA_FullPropagationToB; - [Test] - procedure TestChain_A_B_C_IntermediateBReset_RetriggerA_PropagatesToC; - [Test] - procedure TestChain_A_B_C_AllReset_RetriggerA_FullPropagation; - [Test] - procedure TestChain_A_B_C_TriggerA_ResetA_TriggerA_EnsureCNotifiedCorrectly; - - end; - -implementation - -{ TMockSubscriber } - -constructor TMockSubscriber.Create(AShouldReturn: Boolean = True); -begin - inherited Create; - NotifyCount := 0; - NotifyShouldReturn := AShouldReturn; - WasCalled := False; - LastReturnedValueFromSource := False; // Default -end; - -function TMockSubscriber.Notify: Boolean; -begin - Inc(NotifyCount); - WasCalled := True; - // This return value is what this subscriber tells the source signal. - // For testing, we usually want it to return false to signify it doesn't need more from this one event. - Result := NotifyShouldReturn; -end; - -{ TTestMycDirtyFlag } - -function TTestMycDirtyFlag.CreateAndPrepareDirtyFlag(StartDirty: Boolean = True): IMycDirty; -begin - Result := TDirty.Construct; // Initially dirty - if not StartDirty then - Result.Reset; // Reset to make it clean - Assert.AreEqual(StartDirty, Result.State.IsSet, 'CreateAndPrepareDirtyFlag initial state incorrect.'); -end; - -procedure TTestMycDirtyFlag.Setup; -begin - // Per-test setup -end; - -procedure TTestMycDirtyFlag.TearDown; -begin - // Per-test teardown -end; - -// Category 1: Basic State, Notify (as Subscriber method), and Reset - -procedure TTestMycDirtyFlag.TestCreate_InitialStateIsDirty; -var - dirtyFlag: IMycDirty; -begin - dirtyFlag := TDirty.Construct; - Assert.IsTrue(dirtyFlag.State.IsSet, 'Newly created dirty flag should be IsSet (dirty).'); -end; - -procedure TTestMycDirtyFlag.TestReset_FromDirtyState_BecomesCleanAndReturnsTrue; -var - dirtyFlag: IMycDirty; - resetResult: Boolean; -begin - dirtyFlag := CreateAndPrepareDirtyFlag(True); // Start dirty - - resetResult := dirtyFlag.Reset; - - Assert.IsFalse(dirtyFlag.State.IsSet, 'Flag should be clean (not IsSet) after Reset.'); - Assert.IsTrue(resetResult, 'Reset() should return True when resetting a dirty flag.'); -end; - -procedure TTestMycDirtyFlag.TestReset_FromCleanState_StaysCleanAndReturnsFalse; -var - dirtyFlag: IMycDirty; - resetResult: Boolean; -begin - dirtyFlag := CreateAndPrepareDirtyFlag(False); // Start clean - - resetResult := dirtyFlag.Reset; - - Assert.IsFalse(dirtyFlag.State.IsSet, 'Flag should remain clean (not IsSet) after Reset on clean flag.'); - Assert.IsFalse(resetResult, 'Reset() should return False when resetting an already clean flag.'); -end; - -procedure TTestMycDirtyFlag.TestNotify_OnCleanFlag_SetsDirtyAndReturnsTrue; -var - dirtyFlag: IMycDirty; - notifyResult: Boolean; -begin - dirtyFlag := CreateAndPrepareDirtyFlag(False); // Start clean - - notifyResult := dirtyFlag.Notify; // Call IMycSubscriber.Notify to make it dirty - - Assert.IsTrue(dirtyFlag.State.IsSet, 'Flag should be dirty (IsSet) after Notify on clean flag.'); - Assert.IsTrue(notifyResult, 'Notify() should return True indicating a state change from clean to dirty.'); -end; - -procedure TTestMycDirtyFlag.TestNotify_OnDirtyFlag_StaysDirtyAndReturnsFalse; -var - dirtyFlag: IMycDirty; - notifyResult: Boolean; -begin - dirtyFlag := CreateAndPrepareDirtyFlag(True); // Start dirty - - notifyResult := dirtyFlag.Notify; // Call IMycSubscriber.Notify again - - Assert.IsTrue(dirtyFlag.State.IsSet, 'Flag should remain dirty (IsSet).'); - Assert.IsFalse(notifyResult, 'Notify() should return False as flag was already dirty (no state change to dirty).'); -end; - -// Category 2: Subscriber Notifications - -procedure TTestMycDirtyFlag.TestSubscribe_ToAlreadyDirtyFlag_NotifiesSubscriberImmediately; -var - dirtyFlag: IMycDirty; - subscriber: TMockSubscriber; - subscription: TState.TSubscription; -begin - dirtyFlag := CreateAndPrepareDirtyFlag(True); // Start dirty - subscriber := TMockSubscriber.Create; - - subscription := dirtyFlag.State.Subscribe(subscriber); - - Assert.AreEqual(1, subscriber.NotifyCount, 'Subscriber should be notified immediately when subscribing to an already dirty flag.'); - Assert.IsTrue(subscriber.WasCalled, 'Subscriber WasCalled should be true.'); -end; - -procedure TTestMycDirtyFlag.TestSubscribe_ToCleanFlag_DoesNotNotifySubscriberImmediately; -var - dirtyFlag: IMycDirty; - subscriber: TMockSubscriber; - subscription: TState.TSubscription; -begin - dirtyFlag := CreateAndPrepareDirtyFlag(False); // Start clean - subscriber := TMockSubscriber.Create; - - subscription := dirtyFlag.State.Subscribe(subscriber); - - Assert.AreEqual(0, subscriber.NotifyCount, 'Subscriber should NOT be notified immediately when subscribing to a clean flag.'); - Assert.IsFalse(subscriber.WasCalled, 'Subscriber WasCalled should be false.'); -end; - -procedure TTestMycDirtyFlag.TestSubscriber_Notified_WhenFlagTransitionsToDirty; -var - dirtyFlag: IMycDirty; - subscriber: TMockSubscriber; - subscription: TState.TSubscription; -begin - dirtyFlag := CreateAndPrepareDirtyFlag(False); // Start clean - subscriber := TMockSubscriber.Create; - subscription := dirtyFlag.State.Subscribe(subscriber); - - Assert.AreEqual(0, subscriber.NotifyCount, 'Subscriber initially not notified.'); - - dirtyFlag.Notify; // Make the flag dirty - - Assert.AreEqual(1, subscriber.NotifyCount, 'Subscriber should be notified once flag transitions to dirty.'); -end; - -procedure TTestMycDirtyFlag.TestSubscriber_NotNotified_WhenSettingAlreadyDirtyFlagViaNotify; -var - dirtyFlag: IMycDirty; - subscriber: TMockSubscriber; - subscription: TState.TSubscription; -begin - dirtyFlag := CreateAndPrepareDirtyFlag(True); // Start dirty - subscriber := TMockSubscriber.Create; - subscription := dirtyFlag.State.Subscribe(subscriber); // Gets initial notification - - Assert.AreEqual(1, subscriber.NotifyCount, 'Subscriber notified on subscribe to dirty flag.'); - - dirtyFlag.Notify; // Notify again, flag was already dirty - - Assert.AreEqual(1, subscriber.NotifyCount, 'Subscriber should NOT be notified again if flag was already dirty.'); -end; - -procedure TTestMycDirtyFlag.TestSubscriber_NotNotified_ByResetAction; -var - dirtyFlag: IMycDirty; - subscriber: TMockSubscriber; - subscription: TState.TSubscription; -begin - dirtyFlag := CreateAndPrepareDirtyFlag(True); // Start dirty - subscriber := TMockSubscriber.Create; - subscription := dirtyFlag.State.Subscribe(subscriber); // Gets initial notification - - Assert.AreEqual(1, subscriber.NotifyCount, 'Subscriber notified on subscribe.'); - dirtyFlag.Reset; // Reset the flag - Assert.IsFalse(dirtyFlag.State.IsSet, 'Flag is now clean.'); - - // Current TMycDirty.Reset does not notify subscribers. - Assert.AreEqual(1, subscriber.NotifyCount, 'Subscriber should NOT be notified by Reset action.'); -end; - -procedure TTestMycDirtyFlag.TestMultipleSubscribers_Notified_WhenFlagTransitionsToDirty; -var - dirtyFlag: IMycDirty; - sub1, sub2: TMockSubscriber; - subscription1, subscription2: TState.TSubscription; -begin - dirtyFlag := CreateAndPrepareDirtyFlag(False); // Start clean - sub1 := TMockSubscriber.Create; - sub2 := TMockSubscriber.Create; - subscription1 := dirtyFlag.State.Subscribe(sub1); - subscription2 := dirtyFlag.State.Subscribe(sub2); - - dirtyFlag.Notify; // Make flag dirty - - Assert.AreEqual(1, sub1.NotifyCount, 'Subscriber 1 should be notified.'); - Assert.AreEqual(1, sub2.NotifyCount, 'Subscriber 2 should be notified.'); -end; - -procedure TTestMycDirtyFlag.TestUnsubscribe_SubscriberNotNotified; -var - dirtyFlag: IMycDirty; - subscriber: TMockSubscriber; - subscription: TState.TSubscription; -begin - dirtyFlag := CreateAndPrepareDirtyFlag(False); // Start clean - subscriber := TMockSubscriber.Create; - subscription := dirtyFlag.State.Subscribe(subscriber); - - subscription.Unsubscribe; // Explicitly unsubscribe - - dirtyFlag.Notify; // Make flag dirty - - Assert.AreEqual(0, subscriber.NotifyCount, 'Unsubscribed subscriber should not be notified.'); -end; - -// Category 3: Chaining Dirty Flags -// In these tests, FlagX.Notify means calling the IMycSubscriber.Notify method on FlagX. -// This makes FlagX dirty and potentially notifies its subscribers (like FlagY). - -procedure TTestMycDirtyFlag.TestChain_A_Notifies_B_SimplePropagation; -var - flagA, flagB: IMycDirty; - subToB: TMockSubscriber; - subscriptionA_B, subscriptionMock_B: TState.TSubscription; -begin - flagA := CreateAndPrepareDirtyFlag(False); // A starts clean - flagB := CreateAndPrepareDirtyFlag(False); // B starts clean - subToB := TMockSubscriber.Create; - - subscriptionMock_B := flagB.State.Subscribe(subToB); - subscriptionA_B := flagA.State.Subscribe(flagB); // B subscribes to A's state changes (B's Notify will be called) - - flagA.Notify; // Make A dirty. This should trigger B.Notify - - Assert.IsTrue(flagA.State.IsSet, 'Flag A should be dirty.'); - Assert.IsTrue(flagB.State.IsSet, 'Flag B should become dirty due to A.'); - Assert.AreEqual(1, subToB.NotifyCount, 'Subscriber to B should be notified once.'); -end; - -procedure TTestMycDirtyFlag.TestChain_A_Notifies_B_Notifies_C_SimplePropagation; -var - flagA, flagB, flagC: IMycDirty; - subToC: TMockSubscriber; - subscriptionB_A, subscriptionC_B, subscriptionMock_C: TState.TSubscription; -begin - flagA := CreateAndPrepareDirtyFlag(False); - flagB := CreateAndPrepareDirtyFlag(False); - flagC := CreateAndPrepareDirtyFlag(False); - subToC := TMockSubscriber.Create; - - subscriptionMock_C := flagC.State.Subscribe(subToC); - subscriptionC_B := flagB.State.Subscribe(flagC); // C subscribes to B - subscriptionB_A := flagA.State.Subscribe(flagB); // B subscribes to A - - flagA.Notify; // Make A dirty - - Assert.IsTrue(flagA.State.IsSet, 'Flag A should be dirty in cascade.'); - Assert.IsTrue(flagB.State.IsSet, 'Flag B should be dirty in cascade.'); - Assert.IsTrue(flagC.State.IsSet, 'Flag C should be dirty in cascade.'); - Assert.AreEqual(1, subToC.NotifyCount, 'Subscriber to C should be notified once in cascade.'); -end; - -// Category 4: Chaining with Resets and Re-triggering (Consistency) - -procedure TTestMycDirtyFlag.TestChain_A_B_ResetB_RetriggerA_BStaysCleanIfANotChanged; -var - flagA, flagB: IMycDirty; - subToB: TMockSubscriber; - subscriptionA_B, subscriptionMock_B: TState.TSubscription; -begin - flagA := CreateAndPrepareDirtyFlag(False); - flagB := CreateAndPrepareDirtyFlag(False); - subToB := TMockSubscriber.Create; - subscriptionMock_B := flagB.State.Subscribe(subToB); - subscriptionA_B := flagA.State.Subscribe(flagB); - - flagA.Notify; // A dirty -> B dirty. subToB notified. - Assert.IsTrue(flagB.State.IsSet, 'Flag B should be dirty initially.'); - Assert.AreEqual(1, subToB.NotifyCount, 'Subscriber to B initially notified.'); - - flagB.Reset; // B becomes clean. A is still dirty. - Assert.IsFalse(flagB.State.IsSet, 'Flag B should be clean after reset.'); - Assert.AreEqual(1, subToB.NotifyCount, 'Subscriber to B not notified by B.Reset.'); - - // Notify A again. A was already dirty. So A.Notify() returns false, A does not call ProtectedNotifyOwnSubscribers. - // Thus, B.Notify() is NOT called. B should remain clean. - flagA.Notify; - - Assert.IsTrue(flagA.State.IsSet, 'Flag A remains dirty.'); - Assert.IsFalse(flagB.State.IsSet, 'Flag B should remain clean if A did not transition to dirty.'); - Assert.AreEqual(1, subToB.NotifyCount, 'Subscriber to B should not be notified again.'); -end; - -procedure TTestMycDirtyFlag.TestChain_A_B_ResetA_ThenTriggerA_FullPropagationToB; -var - flagA, flagB: IMycDirty; - subToB: TMockSubscriber; - subscriptionA_B, subscriptionMock_B: TState.TSubscription; -begin - flagA := CreateAndPrepareDirtyFlag(False); - flagB := CreateAndPrepareDirtyFlag(False); - subToB := TMockSubscriber.Create; - subscriptionMock_B := flagB.State.Subscribe(subToB); - subscriptionA_B := flagA.State.Subscribe(flagB); - - flagA.Notify; // A dirty -> B dirty. subToB notified. - Assert.IsTrue(flagB.State.IsSet, 'Flag B should be dirty after A triggers.'); - Assert.AreEqual(1, subToB.NotifyCount, 'subToB notified once.'); - - flagA.Reset; // A becomes clean. B is still dirty (state change of A to clean doesn't propagate as a "dirty" signal to B). - Assert.IsFalse(flagA.State.IsSet, 'Flag A is clean after reset.'); - Assert.IsTrue(flagB.State.IsSet, 'Flag B remains dirty.'); // B's state doesn't change because A becoming clean doesn't call B.Notify - - flagA.Notify; // A (was clean) becomes dirty again. A.Notify() returns true. A notifies B. - // B.Notify() is called. B was dirty. B.Notify() sets FFlag to true (no change), returns false. - // So B does NOT notify subToB again. - - Assert.IsTrue(flagA.State.IsSet, 'Flag A is dirty again.'); - Assert.IsTrue(flagB.State.IsSet, 'Flag B is dirty (was already, and A.Notify called B.Notify which set it dirty again).'); - Assert.AreEqual(1, subToB.NotifyCount, 'subToB should NOT be notified again as B did not transition from clean to dirty.'); -end; - -procedure TTestMycDirtyFlag.TestChain_A_B_C_IntermediateBReset_RetriggerA_PropagatesToC; -var - flagA, flagB, flagC: IMycDirty; - subToC: TMockSubscriber; - subscriptionB_A, subscriptionC_B, subscriptionMock_C: TState.TSubscription; -begin - flagA := CreateAndPrepareDirtyFlag(False); - flagB := CreateAndPrepareDirtyFlag(False); - flagC := CreateAndPrepareDirtyFlag(False); - subToC := TMockSubscriber.Create; - - subscriptionMock_C := flagC.State.Subscribe(subToC); - subscriptionC_B := flagB.State.Subscribe(flagC); - subscriptionB_A := flagA.State.Subscribe(flagB); - - // Initial full propagation - flagA.Notify; // A dirty -> B dirty -> C dirty. subToC notified. - Assert.IsTrue(flagC.State.IsSet, 'Flag C should be dirty initially.'); - Assert.AreEqual(1, subToC.NotifyCount, 'subToC initial count.'); - - // Intermediate reset - flagB.Reset; // B becomes clean. A is dirty, C is dirty. - Assert.IsFalse(flagB.State.IsSet, 'Flag B is clean.'); - - // Reset and re-trigger A - flagA.Reset; // A becomes clean. - Assert.IsFalse(flagA.State.IsSet, 'Flag A is clean.'); - - flagA.Notify; // A (was clean) -> A dirty. A notifies B. - // B.Notify() called. B was clean -> B dirty. B notifies C. - // C.Notify() called. C was dirty -> C set dirty (no change), C.Notify() returns false. - // So subToC is NOT notified again. - - Assert.IsTrue(flagA.State.IsSet, 'Flag A is dirty again.'); - Assert.IsTrue(flagB.State.IsSet, 'Flag B becomes dirty again.'); - Assert.IsTrue(flagC.State.IsSet, 'Flag C is dirty (was already).'); - Assert.AreEqual(1, subToC.NotifyCount, 'subToC should NOT be notified again.'); -end; - -procedure TTestMycDirtyFlag.TestChain_A_B_C_AllReset_RetriggerA_FullPropagation; -var - flagA, flagB, flagC: IMycDirty; - subToC: TMockSubscriber; - subscriptionB_A, subscriptionC_B, subscriptionMock_C: TState.TSubscription; -begin - flagA := CreateAndPrepareDirtyFlag(False); - flagB := CreateAndPrepareDirtyFlag(False); - flagC := CreateAndPrepareDirtyFlag(False); - subToC := TMockSubscriber.Create; - - subscriptionMock_C := flagC.State.Subscribe(subToC); - subscriptionC_B := flagB.State.Subscribe(flagC); - subscriptionB_A := flagA.State.Subscribe(flagB); - - // All are clean. Trigger A. - flagA.Notify; // A dirty -> B dirty -> C dirty. subToC notified. - Assert.IsTrue(flagC.State.IsSet, 'Flag C dirty after first full propagation.'); - Assert.AreEqual(1, subToC.NotifyCount, 'subToC notified once.'); - - // Reset all - flagA.Reset; - flagB.Reset; - flagC.Reset; - Assert.IsFalse(flagA.State.IsSet, 'Flag A clean.'); - Assert.IsFalse(flagB.State.IsSet, 'Flag B clean.'); - Assert.IsFalse(flagC.State.IsSet, 'Flag C clean.'); - // subToC count is still 1, it's not notified by resets. - - // Re-trigger A - flagA.Notify; // A (was clean) -> A dirty. A notifies B. - // B.Notify() called. B was clean -> B dirty. B notifies C. - // C.Notify() called. C was clean -> C dirty. C notifies subToC. - - Assert.IsTrue(flagA.State.IsSet, 'Flag A dirty on re-trigger.'); - Assert.IsTrue(flagB.State.IsSet, 'Flag B dirty on re-trigger.'); - Assert.IsTrue(flagC.State.IsSet, 'Flag C dirty on re-trigger.'); - Assert.AreEqual(2, subToC.NotifyCount, 'subToC should be notified a second time.'); -end; - -procedure TTestMycDirtyFlag.TestChain_A_B_C_TriggerA_ResetA_TriggerA_EnsureCNotifiedCorrectly; -var - flagA, flagB, flagC: IMycDirty; - subToC: TMockSubscriber; - subscriptionB_A, subscriptionC_B, subscriptionMock_C: TState.TSubscription; -begin - flagA := CreateAndPrepareDirtyFlag(False); - flagB := CreateAndPrepareDirtyFlag(False); - flagC := CreateAndPrepareDirtyFlag(False); - subToC := TMockSubscriber.Create; - - subscriptionMock_C := flagC.State.Subscribe(subToC); - subscriptionC_B := flagB.State.Subscribe(flagC); - subscriptionB_A := flagA.State.Subscribe(flagB); - - // 1. Trigger A - flagA.Notify; // A, B, C become dirty. subToC notified (count = 1). - Assert.IsTrue(flagC.State.IsSet, 'C is dirty after 1st trigger.'); - Assert.AreEqual(1, subToC.NotifyCount, 'subToC count after 1st trigger.'); - - // 2. Reset A (B and C remain dirty) - flagA.Reset; - Assert.IsFalse(flagA.State.IsSet, 'A is clean.'); - Assert.IsTrue(flagB.State.IsSet, 'B remains dirty.'); - Assert.IsTrue(flagC.State.IsSet, 'C remains dirty.'); - - // 3. Trigger A again - flagA.Notify; // A (was clean) becomes dirty. A notifies B. - // B.Notify() is called. B was dirty. B.Notify sets FFlag to true (no change), returns false. - // B does NOT notify C. C remains dirty. subToC is NOT notified again. - Assert.IsTrue(flagA.State.IsSet, 'A is dirty after 2nd trigger.'); - Assert.IsTrue(flagB.State.IsSet, 'B is still dirty (state did not flip to clean then dirty).'); - Assert.IsTrue(flagC.State.IsSet, 'C is still dirty.'); - Assert.AreEqual(1, subToC.NotifyCount, 'subToC count should remain 1.'); -end; - -initialization - TDUnitX.RegisterTestFixture(TTestMycDirtyFlag); -end. diff --git a/Test/TestTasks.pas b/Test/TestTasks.pas index 54bf882..e44dbae 100644 --- a/Test/TestTasks.pas +++ b/Test/TestTasks.pas @@ -86,10 +86,10 @@ end; procedure TMycTaskFactoryTests.TestRunImmediateJob; var jobExecuted: Boolean; - jobCompletedLatch: IMycLatch; + jobCompletedLatch: IMycEvent; begin jobExecuted := False; - jobCompletedLatch := TLatch.Construct(1); // Changed from Signals.CreateLatch + jobCompletedLatch := TEvent.CreateLatch(1); // Changed from Signals.CreateLatch FFactory .Run( @@ -107,11 +107,11 @@ end; procedure TMycTaskFactoryTests.TestRunDelayedJobExecutesAfterAllNotifies; var jobExecuted: Boolean; - jobCompletedLatch: IMycLatch; + jobCompletedLatch: IMycEvent; subscriber: IMycSubscriber; begin jobExecuted := False; - jobCompletedLatch := TLatch.Construct(1); // Changed from Signals.CreateLatch + jobCompletedLatch := TEvent.CreateLatch(1); // Changed from Signals.CreateLatch subscriber := FFactory.Run( @@ -124,7 +124,7 @@ begin Assert.IsNotNull(subscriber, 'Run should return a subscriber for delayed job'); // Use TMycLatch.Null for comparison - Assert.AreNotEqual(TLatch.Null, subscriber, 'Subscriber should not be TMycLatch.Null for StartCount > 0'); + Assert.AreNotEqual(TEvent.Null, subscriber, 'Subscriber should not be TMycLatch.Null for StartCount > 0'); subscriber.Notify; @@ -134,11 +134,11 @@ end; procedure TMycTaskFactoryTests.TestWaitForAlreadySetState; var - alreadySetLatch: IMycLatch; + alreadySetLatch: IMycEvent; startTime, endTime: Cardinal; begin // TMycLatch.CreateLatch(0) will return TMycLatch.Null - alreadySetLatch := TLatch.Construct(0); // Changed from Signals.CreateLatch + alreadySetLatch := TEvent.CreateLatch(0); // Changed from Signals.CreateLatch Assert.IsTrue(alreadySetLatch.State.IsSet, 'Latch should be initially set'); startTime := TThread.GetTickCount; @@ -152,11 +152,11 @@ procedure TMycTaskFactoryTests.TestThreadInfoMethods; var inMainThreadInJob: Boolean; inWorkerThreadInJob: Boolean; - jobDoneLatch: IMycLatch; + jobDoneLatch: IMycEvent; begin inMainThreadInJob := True; inWorkerThreadInJob := False; - jobDoneLatch := TLatch.Construct(1); // Changed from Signals.CreateLatch + jobDoneLatch := TEvent.CreateLatch(1); // Changed from Signals.CreateLatch Assert.IsTrue(FFactory.InMainThread, 'Test method itself should be in main thread'); Assert.IsFalse(FFactory.InWorkerThread, 'Test method itself should not be in a factory worker thread'); @@ -178,9 +178,9 @@ end; procedure TMycTaskFactoryTests.TestExceptionPropagationFromJob; var - jobDoneLatch: IMycLatch; + jobDoneLatch: IMycEvent; begin - jobDoneLatch := TLatch.Construct(1); + jobDoneLatch := TEvent.CreateLatch(1); FFactory.EnqueueJob( procedure @@ -222,12 +222,12 @@ end; procedure TMycTaskFactoryTests.TestWaitForInWorkerThreadRaisesException; var exceptionCaughtInJob: Boolean; - jobDoneLatch: IMycLatch; + jobDoneLatch: IMycEvent; dummyStateToWaitFor: IMycState; begin exceptionCaughtInJob := False; - jobDoneLatch := TLatch.Construct(1); - dummyStateToWaitFor := TLatch.Construct(1).State; + jobDoneLatch := TEvent.CreateLatch(1); + dummyStateToWaitFor := TEvent.CreateLatch(1).State; FFactory.EnqueueJob( procedure