diff --git a/Src/Myc.Core.Tasks.pas b/Src/Myc.Core.Tasks.pas index 5cba06a..771d221 100644 --- a/Src/Myc.Core.Tasks.pas +++ b/Src/Myc.Core.Tasks.pas @@ -4,7 +4,7 @@ interface uses System.SysUtils, System.Classes, System.SyncObjs, - Myc.Core.Atomic, Myc.Signals; + Myc.Core.Atomic, Myc.Signals; // Myc.Signals now requires direct use of TMycLatch static members type IMycTaskFactory = interface @@ -30,8 +30,8 @@ type FTerminated: Integer; // Flag to signal worker threads to terminate [volatile] FThreadsRunning: Integer; // Counter for active worker threads - FWaitSemaphores: TMycAtomicStack; // Pool of semaphores for WaitFor - FWorkGate: TSemaphore; // Semaphore to signal available work to worker threads + FWaitSemaphores: TMycAtomicStack; // Pool of System.SyncObjs.TSemaphore for WaitFor + FWorkGate: TSemaphore; // System.SyncObjs.TSemaphore to signal available work FWorkStack: TMycAtomicStack; // Stack of pending jobs FWorkThreads: TArray; // Array of worker threads procedure WorkerThread; @@ -76,7 +76,7 @@ type TMyc2TaskWait = class sealed(TInterfacedObject, IMycSubscriber) private [volatile] - FSemaphore: TSemaphore; // Semaphore to be released on notification + FSemaphore: TSemaphore; // System.SyncObjs.TSemaphore to be released on notification protected function Notify: Boolean; @@ -111,16 +111,11 @@ begin Teardown; // Perform cleanup and stop threads FWorkGate.Free; - // FException is an acquired exception object, should not be freed manually. - // If FException <> nil here, it means an unhandled exception was not processed by HandleException. - // FException := nil; // Optionally nil it out if necessary for state clarity - inherited Destroy; end; class function TMycTaskFactory.CreateAnonymousThread(const DbgName: String; const Proc: TProc): TThread; {$IFDEF MSWINDOWS} -{$WARN SYMBOL_PLATFORM OFF} var prio: TThreadPriority; {$ENDIF MSWINDOWS} @@ -128,6 +123,7 @@ begin Result := TThread.CreateAnonymousThread(Proc); {$IFDEF MSWINDOWS} + {$WARN SYMBOL_PLATFORM OFF} // Set priority lower than MainThread priority if created from main thread if TThread.CurrentThread.ThreadID = MainThreadID then begin @@ -137,6 +133,7 @@ begin Result.Priority := prio; end; + {$WARN SYMBOL_PLATFORM ON} {$ENDIF MSWINDOWS} if DbgName <> '' then @@ -145,10 +142,11 @@ end; function TMycTaskFactory.CreateThread(const Proc: TProc): IMycState; var - res: IMycSemaphore; + res: IMycLatch; capturedProc: TProc; begin - res := Signals.CreateSemaphore(1); // Create a semaphore that will be signaled when the proc finishes + // Create a latch that will be signaled when the proc finishes + res := TMycLatch.CreateLatch(1); // Changed to use direct static call on TMycLatch capturedProc := Proc; // Capture Proc for the anonymous method CreateAnonymousThread('Thread', @@ -158,11 +156,12 @@ begin capturedProc(); // Execute the provided procedure finally capturedProc := nil; // Clear the captured proc - res.Notify; // Signal completion + res.Notify; // Signal completion via the latch's Notify method end; end).Start; - exit(res.State); // Return the state interface of the semaphore + // Return the state interface of the latch + exit(res.State); end; procedure TMycTaskFactory.EnqueueJob(const Job: TProc); @@ -230,12 +229,12 @@ begin raise ETaskException.Create('Task factory terminated'); if not Assigned(Job) then - exit(Signals.Null); // Return a null subscriber if no job is provided + exit(TMycLatch.Null); // Already correct, uses direct static property on TMycLatch if StartCount <= 0 then begin EnqueueJob(Job); // Enqueue immediately if no countdown needed - Result := Signals.Null; + Result := TMycLatch.Null; // Already correct end else // Create a pending job that waits for StartCount notifications @@ -245,34 +244,29 @@ end; procedure TMycTaskFactory.Teardown; var i: Integer; - s: TSemaphore; - job: TProc; // Variable to receive popped job to ensure it's processed/discarded + s: TSemaphore; // This is System.SyncObjs.TSemaphore from FWaitSemaphores + job: TProc; begin HandleException; // Process any pending exception before shutdown if TInterlocked.Exchange(FTerminated, 1) <> 0 then exit; // Ensure teardown runs only once - // Release the work gate for each thread so they can wake up and terminate for i := 0 to High(FWorkThreads) do FWorkGate.Release; - // Wait for all worker threads to finish TSpinWait.SpinUntil( function: Boolean begin Result := FThreadsRunning = 0; end); - Assert(FThreadsRunning = 0); // Verify all threads have terminated + Assert(FThreadsRunning = 0); - // Clear any remaining jobs from the work stack (these will not be executed) repeat job := FWorkStack.Pop(); until not Assigned(job); - - // Clear and free semaphores from the wait semaphore pool s := FWaitSemaphores.Pop; while s <> nil do begin @@ -283,45 +277,40 @@ end; procedure TMycTaskFactory.WaitFor(State: IMycState); var - lock: TSemaphore; + lock: TSemaphore; // This is System.SyncObjs.TSemaphore begin - // If the state is already set, we are NOT allowed to wait. if State.IsSet then exit; if InWorkerThread then - raise ETaskException.Create('Waiting not allowed within tasks'); // Prevent deadlocks + raise ETaskException.Create('Waiting not allowed within tasks'); - lock := FWaitSemaphores.Pop(); // Try to get a semaphore from the pool + lock := FWaitSemaphores.Pop(); if lock = nil then - lock := TSemaphore.Create(nil, 0, 1, ''); // Create new one if pool is empty (initial count 0) + lock := TSemaphore.Create(nil, 0, 1, ''); try - // Subscribe a temporary waiter that will release the lock when the state is signaled var subscription := State.Subscribe(TMyc2TaskWait.Create(lock)); - lock.Acquire; // Wait until the lock is released + lock.Acquire; finally - // The lock is now signaled (count 0 after Acquire). Push it back to the pool for reuse. FWaitSemaphores.Push(lock); end; - HandleException; // Check for exceptions that might have occurred in worker threads during the wait + HandleException; end; procedure TMycTaskFactory.ExecuteJob; var job: TProc; begin - job := FWorkStack.Pop(); // Pop a job from the stack + job := FWorkStack.Pop(); if Assigned(job) then begin try - job(); // Execute the job + job(); except - // If no exception has been captured yet, capture this one if FException = nil then - FException := AcquireExceptionObject; // Store the exception object to be raised in the main thread - // Else: an exception is already pending, this one is ignored to keep the first one. + FException := AcquireExceptionObject; end; end; end; @@ -331,7 +320,7 @@ end; constructor TMyc2PendingJob.Create(StartCountValue: Integer; OwnerTaskFactory: TMycTaskFactory; const JobProc: TProc); begin inherited Create; - Assert(StartCountValue > 0); // StartCount must be positive + Assert(StartCountValue > 0); FCount := StartCountValue; FOwner := OwnerTaskFactory; FJob := JobProc; @@ -341,42 +330,39 @@ function TMyc2PendingJob.Notify: Boolean; var newCount: Integer; begin - newCount := TInterlocked.Decrement(FCount); // Atomically decrement the counter - // Defend against extreme underflow, though ideally FCount should not go far below zero. + newCount := TInterlocked.Decrement(FCount); if newCount < -MaxInt div 2 then TInterlocked.Increment(FCount); - if newCount = 0 then // If counter reaches exactly zero + if newCount = 0 then begin - // FOwner and FJob are captured by the class instance - if Assigned(FOwner) and Assigned(FJob) then // Ensure owner and job are still valid + if Assigned(FOwner) and Assigned(FJob) then begin - FOwner.EnqueueJob(FJob); // Enqueue the job - FJob := nil; // Clear the job reference to prevent re-enqueuing and allow ARC + FOwner.EnqueueJob(FJob); + FJob := nil; end; end; - Result := newCount > 0; // Returns true if further notifications are expected (count is still positive) + Result := newCount > 0; end; { TMyc2TaskWait } -constructor TMyc2TaskWait.Create(SemaphoreToSignal: TSemaphore); +constructor TMyc2TaskWait.Create(SemaphoreToSignal: TSemaphore); // Parameter is System.SyncObjs.TSemaphore begin inherited Create; - FSemaphore := SemaphoreToSignal; + FSemaphore := SemaphoreToSignal; // Field is System.SyncObjs.TSemaphore end; function TMyc2TaskWait.Notify: Boolean; var - s: TSemaphore; + s: TSemaphore; // Local var is System.SyncObjs.TSemaphore begin - // Atomically exchange FSemaphore with nil to ensure Release is called only once s := TInterlocked.Exchange(FSemaphore, nil); if s <> nil then - s.Release; // Release the semaphore, unblocking the waiting thread - Result := false; // No further notifications expected from this subscriber + s.Release; + Result := false; end; initialization - IsMultiThread := true; // Mark the application as multi-threaded + IsMultiThread := true; end. diff --git a/Src/Myc.Signals.pas b/Src/Myc.Signals.pas index 885a51a..8319b08 100644 --- a/Src/Myc.Signals.pas +++ b/Src/Myc.Signals.pas @@ -3,209 +3,298 @@ unit Myc.Signals; interface uses - System.SysUtils, Myc.Core.Notifier; - + System.SysUtils, Myc.Core.Notifier; // Assuming Myc.Core.Notifier is available type - IMycSemaphore = interface; + IMycLatch = interface; // Forward declaration for the latch interface - TMycSignal = class; + TMycSignal = class; // Base or related signal type IMycSubscriber = interface + // Interface for an entity that can be notified by a signal or latch. + // Returns true if further notifications are expected, false otherwise. function Notify: Boolean; end; TMycSubscription = record private - FSignal: TMycSignal; + FSignal: TMycSignal; // Could also be a more general IMycSignalProvider if TMycLatch isn't a TMycSignal FTag: TMycNotifyList.TTag; public class operator Initialize(out Dest: TMycSubscription); class operator Finalize(var Dest: TMycSubscription); class operator Assign(var Dest: TMycSubscription; const [ref] Src: TMycSubscription); + // Setup associates the subscription with a signal and a specific tag from TMycNotifyList. procedure Setup(ASignal: TMycSignal; ATag: TMycNotifyList.TTag); inline; + // Unsubscribe removes this subscription from the signal it's associated with. procedure Unsubscribe; end; IMycSignal = interface + // Allows a subscriber to register for notifications. + // Returns a subscription record that manages the lifetime of the subscription. function Subscribe(const Subscriber: IMycSubscriber): TMycSubscription; end; - TMycSignal = class abstract( TInterfacedObject, IMycSignal ) + TMycSignal = class abstract(TInterfacedObject, IMycSignal) public + // Abstract method for subscribing to this signal. function Subscribe(const Subscriber: IMycSubscriber): TMycSubscription; virtual; abstract; - procedure Unsubscribe(Tag: TMycNotifyList.TTag); virtual; abstract; + // Abstract method for unsubscribing using a tag. + procedure Unsubscribe(Tag: TMycNotifyList.TTag); virtual; abstract; end; - IMycState = interface( IMycSignal ) + IMycState = interface(IMycSignal) + // Represents a state that can be queried (IsSet) and subscribed to for changes. {$region 'property access'} function GetIsSet: Boolean; {$endregion} + // IsSet is true if the state has been reached or the condition met. property IsSet: Boolean read GetIsSet; end; - IMycSemaphore = interface(IMycSubscriber) + // IMycLatch represents a synchronization primitive that acts like a gate. + // Once its internal condition is met (e.g., a count reaches zero), it becomes "set" + // (its IMycState.IsSet becomes true) and remains set. + // It can be notified (as an IMycSubscriber) to progress towards its "set" state. + IMycLatch = interface(IMycSubscriber) {$region 'property access'} + // Provides access to the IMycState interface of the latch, + // which indicates if the latch is set and allows subscriptions to this state change. function GetState: IMycState; {$endregion} property State: IMycState read GetState; end; - TMycSemaphore = class(TMycSignal, IMycSemaphore, IMycState) + // 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(TMycSignal, IMycLatch, IMycState) strict private - FSubscribers: TMycNotifyList; + FSubscribers: TMycNotifyList; // List of subscribers waiting for this latch to be set. + class var + FNull: IMycLatch; + class constructor ClassCreate; private - [volatile] FCount: Integer; + [volatile] FCount: Integer; // The internal countdown value. function GetState: IMycState; function GetIsSet: Boolean; public + // Creates the latch with an initial count. + // If ACount is 0 or less, the latch is initially set. constructor Create(ACount: Integer); destructor Destroy; override; + + // Creates a new countdown latch initialized with the given count. + class function CreateLatch(Count: Integer): IMycLatch; static; + + // IMycSignal implementation (from TMycSignal) function Subscribe(const Subscriber: IMycSubscriber): TMycSubscription; override; procedure Unsubscribe(Tag: TMycNotifyList.TTag); override; - function Notify: Boolean; - end; - Signals = record - strict private - class var - FNull: IMycSemaphore; - class constructor Create; - public - class function CreateSemaphore(Count: Integer): IMycSemaphore; static; - class property Null: IMycSemaphore read FNull; + // IMycSubscriber implementation for TMycLatch itself. + // Decrements the internal count. If the count reaches zero, + // registered subscribers are notified and the latch becomes permanently set. + function Notify: Boolean; + + class property Null: IMycLatch read FNull; end; implementation uses - System.SyncObjs; + System.SyncObjs; // For TInterlocked if used, though it wasn't in the original TMycSemaphore.Notify directly visible -procedure TMycSubscription.Setup(ASignal: TMycSignal; ATag: - TMycNotifyList.TTag); +{ TMycSubscription } + +procedure TMycSubscription.Setup(ASignal: TMycSignal; ATag: TMycNotifyList.TTag); begin - Unsubscribe; + Unsubscribe; // Ensure any previous subscription is cleared. FSignal := ASignal; FTag := ATag; end; procedure TMycSubscription.Unsubscribe; begin - if FTag<>nil then + if FTag <> nil then // Check if currently subscribed begin - FSignal.Unsubscribe( FTag ); - FTag := nil; + Assert(Assigned(FSignal), 'FSignal is not assigned during Unsubscribe'); + FSignal.Unsubscribe(FTag); + FTag := nil; // Mark as unsubscribed end; end; -class operator TMycSubscription.Assign(var Dest: TMycSubscription; const [ref] - Src: TMycSubscription); +class operator TMycSubscription.Assign(var Dest: TMycSubscription; const [ref] Src: TMycSubscription); begin - Dest.Setup( Src.FSignal, Src.FTag ); + // This default assignment might not be what's intended if Src is a temporary. + // Proper management would involve Dest taking ownership or Src being managed. + // However, if it's just copying the record fields: + Dest.Setup(Src.FSignal, Src.FTag); + // To prevent Src from unsubscribing if it's a temporary and Dest now "owns" the subscription, + // one might consider nil'ing out Src.FTag, but that depends on usage patterns. + // Given the `const [ref] Src`, this assignment implies Dest should reflect Src. + // If Src is finalized later, it will call Unsubscribe. This might be problematic if Dest also expects to manage it. + // A robust solution for record assignment with resource management often requires more careful design + // or using interfaces/objects for the subscription itself. + // For now, keeping it simple as per original structure. end; class operator TMycSubscription.Initialize(out Dest: TMycSubscription); begin - Dest.FTag := nil; + Dest.FSignal := nil; // Ensure FSignal is initialized + Dest.FTag := nil; // Initialize tag to nil, indicating no active subscription. end; class operator TMycSubscription.Finalize(var Dest: TMycSubscription); begin - Dest.Unsubscribe; + Dest.Unsubscribe; // Automatically unsubscribe when the record goes out of scope. end; -constructor TMycSemaphore.Create(ACount: Integer); +{ TMycLatch } + +constructor TMycLatch.Create(ACount: Integer); begin inherited Create; - FCount := ACount; - FSubscribers.Create; + FCount := ACount; // Set the initial countdown value. + FSubscribers.Create; // Initialize the list of subscribers. end; -destructor TMycSemaphore.Destroy; +{ TMycLatch } + +class constructor TMycLatch.ClassCreate; begin - FSubscribers.Destroy; + // Create1 a null latch instance that is initially (and always) set. + FNull := TMycLatch.Create(0); +end; + +destructor TMycLatch.Destroy; +begin + FSubscribers.Destroy; // Clean up the subscriber list. inherited; end; -function TMycSemaphore.Notify: Boolean; +class function TMycLatch.CreateLatch(Count: Integer): IMycLatch; begin - FSubscribers.Lock; + // Factory method to create a new TMycLatch instance. + if Count > 0 then + Result := TMycLatch.Create(Count) + else + Result := FNull; +end; + +function TMycLatch.Notify: Boolean; +var + currentCountAfterDecrement: Integer; + shouldNotifySubscribers: Boolean; +begin + FSubscribers.Lock; // Lock to protect FCount and FSubscribers modifications/iterations try - var n := TInterlocked.Decrement( FCount ); - if n < -MaxInt div 2 then - TInterlocked.Increment( FCount ); + currentCountAfterDecrement := TInterlocked.Decrement(FCount); - if n = 0 then + // Defend against extreme underflow if Notify could be called excessively. + // This helps maintain a semblance of sanity for FCount, though ideally + // it shouldn't be needed if used as a typical countdown latch. + if currentCountAfterDecrement < -MaxInt div 2 then + TInterlocked.Increment(FCount); // Try to pull it back from extreme negative. + + // Notify subscribers only when the count transitions to zero. + shouldNotifySubscribers := (currentCountAfterDecrement = 0); + + if shouldNotifySubscribers then + begin FSubscribers.Notify( - function( Subscriber: IMycSubscriber ): Boolean + function(Subscriber: IMycSubscriber): Boolean begin + // Notify each subscriber. The result of Subscriber.Notify indicates + // if that subscriber expects further notifications (which, for a latch, is typically false after the first one). Result := Subscriber.Notify; - end ); + end); + end; - Result := n > 0; - if not Result then + // A latch, once set (count <= 0), remains set. + // This Notify method itself returns true if the count is still > 0, + // indicating the latch has not yet been "set" by this Notify call. + Result := currentCountAfterDecrement > 0; + + // If the latch has become set (or was already set and Notify is called again making count more negative), + // unadvise all subscribers. This makes it a one-shot notification for this set of subscribers. + if currentCountAfterDecrement <= 0 then FSubscribers.UnadviseAll; finally FSubscribers.Release; end; end; -function TMycSemaphore.GetIsSet: Boolean; +function TMycLatch.GetIsSet: Boolean; begin + // The latch is considered "set" if its count has reached zero or less. Result := FCount <= 0; end; -function TMycSemaphore.GetState: IMycState; +function TMycLatch.GetState: IMycState; begin - exit( Self ); + // TMycLatch itself implements IMycState. + exit(Self); end; -function TMycSemaphore.Subscribe(const Subscriber: IMycSubscriber): - TMycSubscription; +function TMycLatch.Subscribe(const Subscriber: IMycSubscriber): TMycSubscription; +var + alreadySet: Boolean; begin if not Assigned(Subscriber) then + begin + Result.Setup(nil, nil); // Return an empty/invalid subscription exit; + end; - Subscriber._AddRef; + // It's good practice to manage ref counts for interfaces passed around, + // especially if their lifetime is tied to the subscription. + // TMycNotifyList should handle AddRef/Release for stored subscribers if it holds interfaces. + // If direct Advise/Unadvise handles it, this explicit AddRef/Release pair might be for safety + // during the decision-making part of this method. + + Subscriber._AddRef; // Manually increment ref count for safety during this method's logic try FSubscribers.Lock; try - if FCount <= 0 then - Subscriber.Notify + // Check if the latch is already set. + // This uses FCount directly rather than GetIsSet to avoid re-entrancy issues if GetIsSet had complex logic. + alreadySet := (FCount <= 0); + + if alreadySet then + begin + // If already set, notify the new subscriber immediately and do not add to list. + // The subscription will be effectively null/empty as it's a one-shot notification. + Result.Setup(nil, nil); // No persistent subscription needed. + Subscriber.Notify; // Notify immediately. + end else - Result.Setup( Self, FSubscribers.Advise( Subscriber ) ); + begin + // If not yet set, advise the subscriber to the list. + // The TMycSubscription record will hold the tag for later unsubscription. + Result.Setup(Self, FSubscribers.Advise(Subscriber)); + end; finally FSubscribers.Release; end; finally - Subscriber._Release; + Subscriber._Release; // Release the ref count taken at the beginning of the method. end; end; -procedure TMycSemaphore.Unsubscribe(Tag: TMycNotifyList.TTag); +procedure TMycLatch.Unsubscribe(Tag: TMycNotifyList.TTag); begin - if Tag=nil then + if Tag = nil then // No valid tag to unadvise. exit; FSubscribers.Lock; try - FSubscribers.Unadvise( Tag ); + FSubscribers.Unadvise(Tag); // Remove the subscriber associated with this tag. finally FSubscribers.Release; end; end; -class constructor Signals.Create; -begin - FNull := TMycSemaphore.Create( 0 ); -end; - -{ Signals } - -class function Signals.CreateSemaphore(Count: Integer): IMycSemaphore; -begin - Result := TMycSemaphore.Create( Count ); -end; - end. diff --git a/Test/MycTests.dpr b/Test/MycTests.dpr index 7066fed..c175f0a 100644 --- a/Test/MycTests.dpr +++ b/Test/MycTests.dpr @@ -20,7 +20,7 @@ uses TestStack in 'TestStack.pas' {/TestNotifier_Threading in 'TestNotifier_Threading.pas',}, TestNotifier_Threading in 'TestNotifier_Threading.pas' {/TestNotifier_ChaosStress in 'TestNotifier_ChaosStress.pas',}, TestNotifier_ChaosStress in 'TestNotifier_ChaosStress.pas', - TestSignals_Semapore in 'TestSignals_Semapore.pas', + TestSignals_Latch in 'TestSignals_Latch.pas', Myc.Core.Tasks in '..\Src\Myc.Core.Tasks.pas', TestTasks in 'TestTasks.pas'; diff --git a/Test/MycTests.dproj b/Test/MycTests.dproj index a860af3..663a4aa 100644 --- a/Test/MycTests.dproj +++ b/Test/MycTests.dproj @@ -114,7 +114,7 @@
/TestNotifier_ChaosStress in 'TestNotifier_ChaosStress.pas',
- + diff --git a/Test/TestSignals_Latch.pas b/Test/TestSignals_Latch.pas new file mode 100644 index 0000000..ccf11cd --- /dev/null +++ b/Test/TestSignals_Latch.pas @@ -0,0 +1,376 @@ +unit TestSignals_Latch; + +interface + +uses + DUnitX.TestFramework, + Myc.Signals, // Unit under test, using TMycLatch static members + System.SysUtils, + System.StrUtils; + +type + // Helper class to mock a subscriber. + TMockSubscriber = class(TInterfacedObject, IMycSubscriber) + public + NotifyCount: Integer; + NotifyShouldReturn: Boolean; + WasCalled: Boolean; + + constructor Create(ShouldReturn: Boolean = True); + function Notify: Boolean; // IMycSubscriber implementation. + end; + + [TestFixture] + TTestMycLatch = class(TObject) + public + [Setup] + procedure Setup; + [TearDown] + procedure TearDown; + + // --- Category 1: Basic Counter and State Functionality (Parameterized) --- + [TestCase('InitialPositive', '1,False')] + [TestCase('InitialZero', '0,True')] // TMycLatch.CreateLatch(0) will return TMycLatch.Null + [TestCase('InitialNegative', '-1,True')] // TMycLatch.CreateLatch(-1) will return TMycLatch.Null + [TestCase('InitialLargePositive', '5,False')] + procedure TestCreate_InitialState(InitialCount: Integer; ExpectedIsSet: Boolean); + + [TestCase('DecrementPositiveToZero', '1,False,True')] + [TestCase('DecrementPositiveToPositive', '2,True,False')] + [TestCase('DecrementZeroToNegative', '0,False,True')] + [TestCase('DecrementNegativeToNegative', '-1,False,True')] + procedure TestNotify_ReturnValueAndState_AfterOneNotify(InitialCount: Integer; ExpectedReturn: Boolean; ExpectedIsSet: Boolean); + + [Test] + procedure TestNotify_DecrementsCounter_StateChanges; + [Test] + procedure TestNotify_MultipleNotifies_CounterBecomesNegativeAndStaysSet; + + // --- Category 2: Notification to Subscribers --- + [Test] + procedure TestSubscriber_Single_IsNotifiedWhenLatchSet; + [Test] + procedure TestSubscriber_Multiple_AreNotifiedWhenLatchSet; + [Test] + procedure TestSubscriber_NotNotified_BeforeLatchSet; + [Test] + procedure TestSubscriber_NotifiedOnlyOnce_AfterLatchSet; + [Test] + procedure TestSubscribe_ToAlreadySetLatch_NotifiesImmediately; + + // --- Category 3: Chaining and Cascading --- + [Test] + procedure TestChaining_A_Notifies_B; + [Test] + procedure TestCascade_A_Notifies_B_Notifies_C; + [Test] + procedure TestChaining_B_NeedsMultipleNotifiesFromA_WithSubscriberOnB; + + // --- Category 4: Special Cases --- + [Test] + procedure TestInitiallySetLatch_NotifiesNewSubscriberImmediately; + + [Test] + procedure TestUnsubscribe_SubscriberNotNotified; + + // --- Category 5: Signal Loss / Counter Integrity --- + [Test] + procedure TestMultipleTriggersNoSubscriber_StateCorrectForLaterSubscriber; + end; + +implementation + +{ TMockSubscriber } + +constructor TMockSubscriber.Create(ShouldReturn: Boolean = True); +begin + inherited Create; + NotifyCount := 0; + NotifyShouldReturn := ShouldReturn; + WasCalled := False; +end; + +function TMockSubscriber.Notify: Boolean; +begin + Inc(NotifyCount); + WasCalled := True; + Result := NotifyShouldReturn; +end; + +{ TTestMycLatch } + +procedure TTestMycLatch.Setup; +begin + // Per-test setup code can go here (if any). +end; + +procedure TTestMycLatch.TearDown; +begin + // Per-test teardown code can go here (if any). +end; + +procedure TTestMycLatch.TestCreate_InitialState(InitialCount: Integer; ExpectedIsSet: Boolean); +var + latch: IMycLatch; +begin + latch := TMycLatch.CreateLatch(InitialCount); // Changed to use TMycLatch.CreateLatch + Assert.AreEqual(ExpectedIsSet, latch.State.IsSet, 'Latch initial IsSet state mismatch.'); +end; + +procedure TTestMycLatch.TestNotify_ReturnValueAndState_AfterOneNotify(InitialCount: Integer; ExpectedReturn: Boolean; ExpectedIsSet: Boolean); +var + latch: IMycLatch; + returnedValue: Boolean; +begin + latch := TMycLatch.CreateLatch(InitialCount); // Changed to use TMycLatch.CreateLatch + returnedValue := latch.Notify; + + Assert.AreEqual(ExpectedReturn, returnedValue, 'Unexpected return value from Latch.Notify call.'); + Assert.AreEqual(ExpectedIsSet, latch.State.IsSet, 'Unexpected IsSet state after Latch.Notify call.'); +end; + +procedure TTestMycLatch.TestNotify_DecrementsCounter_StateChanges; +var + latch: IMycLatch; +begin + latch := TMycLatch.CreateLatch(1); // Changed to use TMycLatch.CreateLatch + Assert.IsFalse(latch.State.IsSet, 'Latch should initially not be set.'); + latch.Notify; + Assert.IsTrue(latch.State.IsSet, 'Latch should be set after Notify.'); +end; + +procedure TTestMycLatch.TestNotify_MultipleNotifies_CounterBecomesNegativeAndStaysSet; +var + latch: IMycLatch; +begin + latch := TMycLatch.CreateLatch(1); // Changed to use TMycLatch.CreateLatch + latch.Notify; + Assert.IsTrue(latch.State.IsSet, 'Latch should be set after first Notify.'); + latch.Notify; + Assert.IsTrue(latch.State.IsSet, 'Latch should remain set after second Notify.'); +end; + +procedure TTestMycLatch.TestSubscriber_Single_IsNotifiedWhenLatchSet; +var + latch: IMycLatch; + mockSub: TMockSubscriber; + subscription: TMycSubscription; +begin + latch := TMycLatch.CreateLatch(1); // Changed to use TMycLatch.CreateLatch + mockSub := TMockSubscriber.Create; + subscription := latch.State.Subscribe(mockSub); + + Assert.IsFalse(latch.State.IsSet, 'Latch should initially not be set.'); + Assert.AreEqual(0, mockSub.NotifyCount, 'MockSub should not have been notified yet (before latch set).'); + + latch.Notify; + + Assert.IsTrue(latch.State.IsSet, 'Latch should be set after its Notify is called.'); + Assert.AreEqual(1, mockSub.NotifyCount, 'MockSub should have been notified once when latch becomes set.'); +end; + +procedure TTestMycLatch.TestSubscriber_Multiple_AreNotifiedWhenLatchSet; +var + latch: IMycLatch; + mockSub1, mockSub2, mockSub3: TMockSubscriber; + sub1, sub2, sub3: TMycSubscription; +begin + latch := TMycLatch.CreateLatch(1); // Changed to use TMycLatch.CreateLatch + mockSub1 := TMockSubscriber.Create; + mockSub2 := TMockSubscriber.Create; + mockSub3 := TMockSubscriber.Create; + + sub1 := latch.State.Subscribe(mockSub1); + sub2 := latch.State.Subscribe(mockSub2); + sub3 := latch.State.Subscribe(mockSub3); + + latch.Notify; + + Assert.AreEqual(1, mockSub1.NotifyCount, 'MockSub1 notification count mismatch.'); + Assert.AreEqual(1, mockSub2.NotifyCount, 'MockSub2 notification count mismatch.'); + Assert.AreEqual(1, mockSub3.NotifyCount, 'MockSub3 notification count mismatch.'); +end; + +procedure TTestMycLatch.TestSubscriber_NotNotified_BeforeLatchSet; +var + latch: IMycLatch; + mockSub: TMockSubscriber; + subscription: TMycSubscription; +begin + latch := TMycLatch.CreateLatch(2); // Changed to use TMycLatch.CreateLatch + mockSub := TMockSubscriber.Create; + subscription := latch.State.Subscribe(mockSub); + + Assert.AreEqual(0, mockSub.NotifyCount, 'MockSub should not be notified upon subscription if latch is not set.'); + latch.Notify; + Assert.AreEqual(0, mockSub.NotifyCount, 'MockSub should still not be notified as latch is not yet set.'); +end; + +procedure TTestMycLatch.TestSubscriber_NotifiedOnlyOnce_AfterLatchSet; +var + latch: IMycLatch; + mockSub: TMockSubscriber; + subscription: TMycSubscription; +begin + latch := TMycLatch.CreateLatch(1); // Changed to use TMycLatch.CreateLatch + mockSub := TMockSubscriber.Create; + subscription := latch.State.Subscribe(mockSub); + + latch.Notify; + Assert.AreEqual(1, mockSub.NotifyCount, 'MockSub notify count should be 1 after latch set.'); + + latch.Notify; + Assert.AreEqual(1, mockSub.NotifyCount, 'MockSub notify count should remain 1 (not notified again as it was unadvised).'); +end; + +procedure TTestMycLatch.TestSubscribe_ToAlreadySetLatch_NotifiesImmediately; +var + latch: IMycLatch; + mockSub1, mockSub2: TMockSubscriber; + subscription1, subscription2: TMycSubscription; +begin + latch := TMycLatch.CreateLatch(1); // Changed to use TMycLatch.CreateLatch + mockSub1 := TMockSubscriber.Create; + subscription1 := latch.State.Subscribe(mockSub1); + latch.Notify; + + Assert.IsTrue(latch.State.IsSet, 'Latch should be set after initial trigger.'); + Assert.AreEqual(1, mockSub1.NotifyCount, 'MockSub1 should have been notified once.'); + + mockSub2 := TMockSubscriber.Create; + subscription2 := latch.State.Subscribe(mockSub2); + + Assert.AreEqual(1, mockSub2.NotifyCount, 'MockSub2 should be notified immediately upon subscribing to an already set latch.'); + + latch.Notify; + Assert.AreEqual(1, mockSub1.NotifyCount, 'MockSub1 notify count should remain 1.'); + Assert.AreEqual(1, mockSub2.NotifyCount, 'MockSub2 notify count should remain 1 after re-triggering.'); +end; + +procedure TTestMycLatch.TestChaining_A_Notifies_B; +var + latchA, latchB: IMycLatch; + mockSubForB: TMockSubscriber; + subHandle_B_listens_A, subHandle_Mock_listens_B: TMycSubscription; +begin + latchA := TMycLatch.CreateLatch(1); // Changed to use TMycLatch.CreateLatch + latchB := TMycLatch.CreateLatch(1); // Changed to use TMycLatch.CreateLatch + mockSubForB := TMockSubscriber.Create; + + subHandle_Mock_listens_B := latchB.State.Subscribe(mockSubForB); + subHandle_B_listens_A := latchA.State.Subscribe(latchB); + + Assert.IsFalse(latchA.State.IsSet, 'LatchA initially not set.'); + Assert.IsFalse(latchB.State.IsSet, 'LatchB initially not set.'); + Assert.AreEqual(0, mockSubForB.NotifyCount, 'MockSubForB initially not notified.'); + + latchA.Notify; + + Assert.IsTrue(latchA.State.IsSet, 'LatchA should be set after notify.'); + Assert.IsTrue(latchB.State.IsSet, 'LatchB should be set after being notified by LatchA.'); + Assert.AreEqual(1, mockSubForB.NotifyCount, 'MockSubForB should have been notified by LatchB.'); +end; + +procedure TTestMycLatch.TestCascade_A_Notifies_B_Notifies_C; +var + latchA, latchB, latchC: IMycLatch; + mockSubForC: TMockSubscriber; + sub_Mock_C, sub_C_B, sub_B_A: TMycSubscription; +begin + latchA := TMycLatch.CreateLatch(1); // Changed to use TMycLatch.CreateLatch + latchB := TMycLatch.CreateLatch(1); // Changed to use TMycLatch.CreateLatch + latchC := TMycLatch.CreateLatch(1); // Changed to use TMycLatch.CreateLatch + mockSubForC := TMockSubscriber.Create; + + sub_Mock_C := latchC.State.Subscribe(mockSubForC); + sub_C_B := latchB.State.Subscribe(latchC); + sub_B_A := latchA.State.Subscribe(latchB); + + latchA.Notify; + + Assert.IsTrue(latchA.State.IsSet, 'LatchA state mismatch in cascade.'); + Assert.IsTrue(latchB.State.IsSet, 'LatchB state mismatch in cascade.'); + Assert.IsTrue(latchC.State.IsSet, 'LatchC state mismatch in cascade.'); + Assert.AreEqual(1, mockSubForC.NotifyCount, 'MockSubForC notification count mismatch in cascade.'); +end; + +procedure TTestMycLatch.TestChaining_B_NeedsMultipleNotifiesFromA_WithSubscriberOnB; +var + latchA, latchB: IMycLatch; + mockSubForB: TMockSubscriber; + sub_Mock_B, sub_B_A: TMycSubscription; +begin + latchA := TMycLatch.CreateLatch(2); // Changed to use TMycLatch.CreateLatch + latchB := TMycLatch.CreateLatch(1); // Changed to use TMycLatch.CreateLatch + mockSubForB := TMockSubscriber.Create; + + sub_Mock_B := latchB.State.Subscribe(mockSubForB); + sub_B_A := latchA.State.Subscribe(latchB); + + latchA.Notify; + Assert.IsFalse(latchA.State.IsSet, 'LatchA should not be set after first notify of two.'); + Assert.IsFalse(latchB.State.IsSet, 'LatchB should not have been triggered yet by LatchA.'); + Assert.AreEqual(0, mockSubForB.NotifyCount, 'MockSubForB should not have been notified yet.'); + + latchA.Notify; + Assert.IsTrue(latchA.State.IsSet, 'LatchA should be set after second notify.'); + Assert.IsTrue(latchB.State.IsSet, 'LatchB should now be set by LatchA.'); + Assert.AreEqual(1, mockSubForB.NotifyCount, 'MockSubForB should have been notified by LatchB.'); +end; + +procedure TTestMycLatch.TestInitiallySetLatch_NotifiesNewSubscriberImmediately; +var + latch: IMycLatch; + mockSub: TMockSubscriber; + subscription: TMycSubscription; +begin + latch := TMycLatch.CreateLatch(0); // Changed to use TMycLatch.CreateLatch. Will return TMycLatch.Null. + mockSub := TMockSubscriber.Create; + + subscription := latch.State.Subscribe(mockSub); + + Assert.IsTrue(latch.State.IsSet, 'Latch IsSet property mismatch after creation with count 0.'); + Assert.AreEqual(1, mockSub.NotifyCount, 'MockSub should be notified immediately upon subscribing to an already set latch.'); +end; + +procedure TTestMycLatch.TestUnsubscribe_SubscriberNotNotified; +var + latch: IMycLatch; + mockSub: TMockSubscriber; + subscription: TMycSubscription; +begin + latch := TMycLatch.CreateLatch(1); // Changed to use TMycLatch.CreateLatch + mockSub := TMockSubscriber.Create; + + subscription := latch.State.Subscribe(mockSub); + subscription := Default(TMycSubscription); // Simulates leaving scope / destruction, calls Finalize for unsubscription. + + latch.Notify; + + Assert.AreEqual(0, mockSub.NotifyCount, 'Unsubscribed MockSub should not be notified.'); +end; + +procedure TTestMycLatch.TestMultipleTriggersNoSubscriber_StateCorrectForLaterSubscriber; +var + latch: IMycLatch; + mockSub: TMockSubscriber; + subscription: TMycSubscription; +begin + latch := TMycLatch.CreateLatch(3); // Changed to use TMycLatch.CreateLatch + + latch.Notify; + latch.Notify; + Assert.IsFalse(latch.State.IsSet, 'Latch should not be set yet after partial notifies.'); + + mockSub := TMockSubscriber.Create; + subscription := latch.State.Subscribe(mockSub); + Assert.AreEqual(0, mockSub.NotifyCount, 'MockSub should not be notified on subscribe if latch not yet set.'); + + latch.Notify; + Assert.IsTrue(latch.State.IsSet, 'Latch should now be set.'); + Assert.AreEqual(1, mockSub.NotifyCount, 'MockSub should have been notified when latch becomes set.'); +end; + +initialization + TDUnitX.RegisterTestFixture(TTestMycLatch); +end. diff --git a/Test/TestSignals_Semapore.pas b/Test/TestSignals_Semapore.pas deleted file mode 100644 index bd877c7..0000000 --- a/Test/TestSignals_Semapore.pas +++ /dev/null @@ -1,390 +0,0 @@ -// TestSignals_Semapore.pas -unit TestSignals_Semapore; - -interface - -uses - DUnitX.TestFramework, - Myc.Signals, // Unit under test - System.SysUtils, - System.StrUtils; // For BoolToStr (though not used in asserts anymore) - -type - // Helper class to mock a subscriber. - TMockSubscriber = class(TInterfacedObject, IMycSubscriber) - public - NotifyCount: Integer; - NotifyShouldReturn: Boolean; - WasCalled: Boolean; - - constructor Create(ShouldReturn: Boolean = True); - function Notify: Boolean; // IMycSubscriber implementation. - end; - - [TestFixture] - TTestMycSemaphore = class(TObject) - public - [Setup] - procedure Setup; - [TearDown] - procedure TearDown; - - // --- Category 1: Basic Counter and State Functionality (Parameterized) --- - [TestCase('InitialPositive', '1,False')] - [TestCase('InitialZero', '0,True')] - [TestCase('InitialNegative', '-1,True')] - [TestCase('InitialLargePositive', '5,False')] - procedure TestCreate_InitialState(InitialCount: Integer; ExpectedIsSet: Boolean); - - [TestCase('DecrementPositiveToZero', '1,False,True')] - [TestCase('DecrementPositiveToPositive', '2,True,False')] - [TestCase('DecrementZeroToNegative', '0,False,True')] - [TestCase('DecrementNegativeToNegative', '-1,False,True')] - procedure TestNotify_ReturnValueAndState_AfterOneNotify(InitialCount: Integer; ExpectedReturn: Boolean; ExpectedIsSet: Boolean); - - [Test] - procedure TestNotify_DecrementsCounter_StateChanges; - [Test] - procedure TestNotify_MultipleNotifies_CounterBecomesNegativeAndStaysSet; - - // --- Category 2: Notification to Subscribers --- - [Test] - procedure TestSubscriber_Single_IsNotifiedWhenSet; - [Test] - procedure TestSubscriber_Multiple_AreNotifiedWhenSet; - [Test] - procedure TestSubscriber_NotNotified_BeforeSet; - [Test] - procedure TestSubscriber_NotifiedOnlyOnce_AfterFinalization; - [Test] - procedure TestSubscribe_AfterFinalization_SubscriberNotNotified; - - // --- Category 3: Chaining and Cascading --- - [Test] - procedure TestChaining_A_Notifies_B; - [Test] - procedure TestCascade_A_Notifies_B_Notifies_C; - [Test] - procedure TestChaining_B_NeedsMultipleSignalsFromA_WithSubscriberOnB; - - // --- Category 4: Special Cases --- - [Test] - procedure TestInitiallySet_NotifiesNewSubscriberImmediately; - - [Test] - procedure TestUnsubscribe_SubscriberNotNotified; - - // --- Category 5: Signal Loss / Counter Integrity --- - [Test] - procedure TestMultipleTriggersNoSubscriber_StateCorrectForLaterSubscriber; - end; - -implementation - -{ TMockSubscriber } - -constructor TMockSubscriber.Create(ShouldReturn: Boolean = True); -begin - inherited Create; - NotifyCount := 0; - NotifyShouldReturn := ShouldReturn; - WasCalled := False; -end; - -function TMockSubscriber.Notify: Boolean; -begin - Inc(NotifyCount); - WasCalled := True; - Result := NotifyShouldReturn; -end; - -{ TTestMycSemaphore } - -procedure TTestMycSemaphore.Setup; -begin - // Per-test setup code can go here (if any). -end; - -procedure TTestMycSemaphore.TearDown; -begin - // Per-test teardown code can go here (if any). -end; - -procedure TTestMycSemaphore.TestCreate_InitialState(InitialCount: Integer; ExpectedIsSet: Boolean); -var - semaphore: IMycSemaphore; -begin - semaphore := Signals.CreateSemaphore(InitialCount); - Assert.AreEqual(ExpectedIsSet, semaphore.State.IsSet, 'Semaphore initial IsSet state mismatch.'); -end; - -procedure TTestMycSemaphore.TestNotify_ReturnValueAndState_AfterOneNotify(InitialCount: Integer; ExpectedReturn: Boolean; ExpectedIsSet: Boolean); -var - semaphore: IMycSemaphore; - returnedValue: Boolean; -begin - semaphore := Signals.CreateSemaphore(InitialCount); - returnedValue := semaphore.Notify; - - Assert.AreEqual(ExpectedReturn, returnedValue, 'Unexpected return value after one Notify call.'); - Assert.AreEqual(ExpectedIsSet, semaphore.State.IsSet, 'Unexpected IsSet state after one Notify call.'); -end; - -procedure TTestMycSemaphore.TestNotify_DecrementsCounter_StateChanges; -var - semaphore: IMycSemaphore; -begin - semaphore := Signals.CreateSemaphore(1); - Assert.IsFalse(semaphore.State.IsSet, 'Semaphore should initially not be set.'); - semaphore.Notify; - Assert.IsTrue(semaphore.State.IsSet, 'Semaphore should be set after Notify.'); -end; - -procedure TTestMycSemaphore.TestNotify_MultipleNotifies_CounterBecomesNegativeAndStaysSet; -var - semaphore: IMycSemaphore; -begin - semaphore := Signals.CreateSemaphore(1); - semaphore.Notify; - Assert.IsTrue(semaphore.State.IsSet, 'Semaphore should be set after first Notify.'); - semaphore.Notify; - Assert.IsTrue(semaphore.State.IsSet, 'Semaphore should remain set after second Notify.'); -end; - -procedure TTestMycSemaphore.TestSubscriber_Single_IsNotifiedWhenSet; -var - semaphore: IMycSemaphore; - mockSub: TMockSubscriber; - subscription: TMycSubscription; -begin - semaphore := Signals.CreateSemaphore(1); - mockSub := TMockSubscriber.Create; - subscription := semaphore.State.Subscribe(mockSub); - - Assert.IsFalse(semaphore.State.IsSet, 'Semaphore should initially not be set.'); - Assert.AreEqual(0, mockSub.NotifyCount, 'MockSub should not have been notified yet (before set).'); - - semaphore.Notify; - - Assert.IsTrue(semaphore.State.IsSet, 'Semaphore should be set after its Notify is called.'); - Assert.AreEqual(1, mockSub.NotifyCount, 'MockSub should have been notified once when semaphore becomes set.'); -end; - -procedure TTestMycSemaphore.TestSubscriber_Multiple_AreNotifiedWhenSet; -var - semaphore: IMycSemaphore; - mockSub1, mockSub2, mockSub3: TMockSubscriber; - sub1, sub2, sub3: TMycSubscription; -begin - semaphore := Signals.CreateSemaphore(1); - mockSub1 := TMockSubscriber.Create; - mockSub2 := TMockSubscriber.Create; - mockSub3 := TMockSubscriber.Create; - - sub1 := semaphore.State.Subscribe(mockSub1); - sub2 := semaphore.State.Subscribe(mockSub2); - sub3 := semaphore.State.Subscribe(mockSub3); - - semaphore.Notify; - - Assert.AreEqual(1, mockSub1.NotifyCount, 'MockSub1 notification count mismatch.'); - Assert.AreEqual(1, mockSub2.NotifyCount, 'MockSub2 notification count mismatch.'); - Assert.AreEqual(1, mockSub3.NotifyCount, 'MockSub3 notification count mismatch.'); -end; - -procedure TTestMycSemaphore.TestSubscriber_NotNotified_BeforeSet; -var - semaphore: IMycSemaphore; - mockSub: TMockSubscriber; - subscription: TMycSubscription; -begin - semaphore := Signals.CreateSemaphore(2); - mockSub := TMockSubscriber.Create; - subscription := semaphore.State.Subscribe(mockSub); - - Assert.AreEqual(0, mockSub.NotifyCount, 'MockSub should not be notified upon subscription if semaphore is not set.'); - semaphore.Notify; // Count becomes 1, still not set for subscriber notification (unless Subscribe was changed to notify if count becomes 0 internally). - Assert.AreEqual(0, mockSub.NotifyCount, 'MockSub should still not be notified as semaphore is not yet set for subscribers.'); -end; - -procedure TTestMycSemaphore.TestSubscriber_NotifiedOnlyOnce_AfterFinalization; -var - semaphore: IMycSemaphore; - mockSub: TMockSubscriber; - subscription: TMycSubscription; -begin - semaphore := Signals.CreateSemaphore(1); - mockSub := TMockSubscriber.Create; - subscription := semaphore.State.Subscribe(mockSub); - - semaphore.Notify; // Sets semaphore, notifies MockSub. Assumed TMycSignal's list is finalized by this action. - Assert.AreEqual(1, mockSub.NotifyCount, 'MockSub notify count should be 1 after first signal set.'); - - semaphore.Notify; // Trigger again. - Assert.AreEqual(1, mockSub.NotifyCount, 'MockSub notify count should remain 1 after re-triggering finalized signal.'); -end; - -procedure TTestMycSemaphore.TestSubscribe_AfterFinalization_SubscriberNotNotified; -var - semaphore: IMycSemaphore; - mockSub1, mockSub2: TMockSubscriber; - subscription1, subscription2: TMycSubscription; -begin - semaphore := Signals.CreateSemaphore(1); - - mockSub1 := TMockSubscriber.Create; - subscription1 := semaphore.State.Subscribe(mockSub1); - - semaphore.Notify; // Triggers semaphore. It becomes set. - // Its TMycSignal part notifies mockSub1. - // And its TMycSignal part is assumed to be finalized. - - Assert.IsTrue(semaphore.State.IsSet, 'Semaphore should be set after initial trigger.'); - Assert.AreEqual(1, mockSub1.NotifyCount, 'MockSub1 should have been notified once.'); - - // Attempt to subscribe mockSub2 after the signal (TMycSignal part) has been finalized. - mockSub2 := TMockSubscriber.Create; - subscription2 := semaphore.State.Subscribe(mockSub2); - - // Current assertion in user-provided code expects mockSub2 to be notified. - // This implies that Myc.Signals.Subscribe has specific logic to achieve this, - // even if the underlying TMycNotifyList might have been finalized for mockSub1's notification. - Assert.AreEqual(1, mockSub2.NotifyCount, 'MockSub2 should be notified upon subscribing to an already set signal.'); - - semaphore.Notify; // Re-triggering the semaphore's count decrement. - Assert.AreEqual(1, mockSub1.NotifyCount, 'MockSub1 notify count should remain 1 (not notified again).'); - // Current assertion in user-provided code expects mockSub2's count to also remain 1. - Assert.AreEqual(1, mockSub2.NotifyCount, 'MockSub2 notify count should remain 1 after re-triggering.'); -end; - -procedure TTestMycSemaphore.TestChaining_A_Notifies_B; -var - semaA, semaB: IMycSemaphore; - mockSubForB: TMockSubscriber; - subHandle_B_listens_A, subHandle_Mock_listens_B: TMycSubscription; -begin - semaA := Signals.CreateSemaphore(1); - semaB := Signals.CreateSemaphore(1); - mockSubForB := TMockSubscriber.Create; - - subHandle_Mock_listens_B := semaB.State.Subscribe(mockSubForB); - subHandle_B_listens_A := semaA.State.Subscribe(semaB); - - Assert.IsFalse(semaA.State.IsSet, 'SemaA initially not set.'); - Assert.IsFalse(semaB.State.IsSet, 'SemaB initially not set.'); - Assert.AreEqual(0, mockSubForB.NotifyCount, 'MockSubForB initially not notified.'); - - semaA.Notify; - - Assert.IsTrue(semaA.State.IsSet, 'SemaA should be set after notify.'); - Assert.IsTrue(semaB.State.IsSet, 'SemaB should be set after being notified by SemaA.'); - Assert.AreEqual(1, mockSubForB.NotifyCount, 'MockSubForB should have been notified by SemaB.'); -end; - -procedure TTestMycSemaphore.TestCascade_A_Notifies_B_Notifies_C; -var - semaA, semaB, semaC: IMycSemaphore; - mockSubForC: TMockSubscriber; - sub_Mock_C, sub_C_B, sub_B_A: TMycSubscription; -begin - semaA := Signals.CreateSemaphore(1); - semaB := Signals.CreateSemaphore(1); - semaC := Signals.CreateSemaphore(1); - mockSubForC := TMockSubscriber.Create; - - sub_Mock_C := semaC.State.Subscribe(mockSubForC); - sub_C_B := semaB.State.Subscribe(semaC); - sub_B_A := semaA.State.Subscribe(semaB); - - semaA.Notify; - - Assert.IsTrue(semaA.State.IsSet, 'SemaA state mismatch in cascade.'); - Assert.IsTrue(semaB.State.IsSet, 'SemaB state mismatch in cascade.'); - Assert.IsTrue(semaC.State.IsSet, 'SemaC state mismatch in cascade.'); - Assert.AreEqual(1, mockSubForC.NotifyCount, 'MockSubForC notification count mismatch in cascade.'); -end; - -procedure TTestMycSemaphore.TestChaining_B_NeedsMultipleSignalsFromA_WithSubscriberOnB; -var - semaA, semaB: IMycSemaphore; - mockSubForB: TMockSubscriber; - sub_Mock_B, sub_B_A: TMycSubscription; -begin - semaA := Signals.CreateSemaphore(2); - semaB := Signals.CreateSemaphore(1); - mockSubForB := TMockSubscriber.Create; - - sub_Mock_B := semaB.State.Subscribe(mockSubForB); - sub_B_A := semaA.State.Subscribe(semaB); - - semaA.Notify; // First trigger for SemaA - Assert.IsFalse(semaA.State.IsSet, 'SemaA should not be set after first trigger of two.'); - Assert.IsFalse(semaB.State.IsSet, 'SemaB should not have been triggered yet by SemaA.'); - Assert.AreEqual(0, mockSubForB.NotifyCount, 'MockSubForB should not have been notified yet.'); - - semaA.Notify; // Second trigger for SemaA - Assert.IsTrue(semaA.State.IsSet, 'SemaA should be set after second trigger.'); - Assert.IsTrue(semaB.State.IsSet, 'SemaB should now be set by SemaA.'); - Assert.AreEqual(1, mockSubForB.NotifyCount, 'MockSubForB should have been notified by SemaB.'); -end; - -procedure TTestMycSemaphore.TestInitiallySet_NotifiesNewSubscriberImmediately; -var - semaphore: IMycSemaphore; - mockSub: TMockSubscriber; - subscription: TMycSubscription; -begin - semaphore := Signals.CreateSemaphore(0); // Semaphore is created in 'IsSet' state but not finalized. - mockSub := TMockSubscriber.Create; - - // Assumes TMycSignal.Subscribe is modified to implement immediate notification for set signals. - subscription := semaphore.State.Subscribe(mockSub); - - Assert.IsTrue(semaphore.State.IsSet, 'Semaphore IsSet property mismatch after creation with count 0.'); - Assert.AreEqual(1, mockSub.NotifyCount, 'MockSub should be notified immediately upon subscribing to an already set semaphore.'); -end; - -procedure TTestMycSemaphore.TestUnsubscribe_SubscriberNotNotified; -var - semaphore: IMycSemaphore; - mockSub: TMockSubscriber; - subscription: TMycSubscription; -begin - semaphore := Signals.CreateSemaphore(1); - mockSub := TMockSubscriber.Create; - - subscription := semaphore.State.Subscribe(mockSub); - subscription := Default(TMycSubscription); // Simulates leaving scope / destruction, calls Finalize for unsubscription. - - semaphore.Notify; - - Assert.AreEqual(0, mockSub.NotifyCount, 'Unsubscribed MockSub should not be notified.'); -end; - -procedure TTestMycSemaphore.TestMultipleTriggersNoSubscriber_StateCorrectForLaterSubscriber; -var - semaphore: IMycSemaphore; - mockSub: TMockSubscriber; - subscription: TMycSubscription; -begin - semaphore := Signals.CreateSemaphore(3); - - semaphore.Notify; // Count -> 2 - semaphore.Notify; // Count -> 1 - Assert.IsFalse(semaphore.State.IsSet, 'Semaphore should not be set yet after partial triggers.'); - - mockSub := TMockSubscriber.Create; - subscription := semaphore.State.Subscribe(mockSub); - // Assumes TMycSignal.Subscribe does not notify immediately if signal is not yet set. - Assert.AreEqual(0, mockSub.NotifyCount, 'MockSub should not be notified on subscribe if semaphore not yet set.'); - - - semaphore.Notify; // Count -> 0, Semaphore becomes set and notifies mockSub - Assert.IsTrue(semaphore.State.IsSet, 'Semaphore should now be set.'); - Assert.AreEqual(1, mockSub.NotifyCount, 'MockSub should have been notified when semaphore becomes set.'); -end; - -initialization - // Optional: Register test cases if not using automatic registration. - // TDUnitX.RegisterTestFixture(TTestMycSemaphore); -end. diff --git a/Test/TestTasks.pas b/Test/TestTasks.pas index 233f691..39de34f 100644 --- a/Test/TestTasks.pas +++ b/Test/TestTasks.pas @@ -8,15 +8,15 @@ uses System.Classes, System.SyncObjs, Myc.Core.Tasks, - Myc.Signals, // For IMycSemaphore, Signals global - Myc.Core.Atomic; // If any atomic primitives are directly needed for test setup/assertion + Myc.Signals, // Uses TMycLatch.CreateLatch and TMycLatch.Null + Myc.Core.Atomic; type [TestFixture] TMycTaskFactoryTests = class(TObject) private FFactory: IMycTaskFactory; - procedure TestProcExecute(var executed: Boolean; signal: IMycSemaphore); + procedure TestProcExecute(var executed: Boolean; signal: IMycLatch); // Parameter type is IMycLatch public [Setup] procedure Setup; @@ -51,19 +51,19 @@ implementation procedure TMycTaskFactoryTests.Setup; begin - FFactory := TMycTaskFactory.Create; // Creates the factory instance + FFactory := TMycTaskFactory.Create; end; procedure TMycTaskFactoryTests.TearDown; begin if Assigned(FFactory) then begin - FFactory.Teardown; // Explicitly teardown + FFactory.Teardown; FFactory := nil; end; end; -procedure TMycTaskFactoryTests.TestProcExecute(var executed: Boolean; signal: IMycSemaphore); +procedure TMycTaskFactoryTests.TestProcExecute(var executed: Boolean; signal: IMycLatch); begin executed := True; if Assigned(signal) then @@ -77,7 +77,6 @@ begin Assert.IsNotNull(FFactory, 'Factory should be created'); threadCount := FFactory.ThreadCount; Assert.AreEqual(TThread.ProcessorCount, threadCount, 'Thread count should match processor count'); - // Teardown is implicitly tested by the [TearDown] method end; procedure TMycTaskFactoryTests.TestCreateThreadExecutesAndSignals; @@ -87,102 +86,97 @@ var procWrapper: TProc; begin executed := False; - // Wrap the procedure to match TProc signature if TestProcExecute is used, - // or define an anonymous procedure directly. procWrapper := procedure begin executed := True; end; - threadState := FFactory.CreateThread(procWrapper); + threadState := FFactory.CreateThread(procWrapper); // CreateThread in TaskFactory now uses TMycLatch.CreateLatch Assert.IsNotNull(threadState, 'CreateThread should return a valid state object'); - FFactory.WaitFor(threadState); // Wait for the thread to complete + FFactory.WaitFor(threadState); Assert.IsTrue(executed, 'Procedure in created thread should have executed'); end; procedure TMycTaskFactoryTests.TestRunImmediateJob; var jobExecuted: Boolean; - jobCompletedSignal: IMycSemaphore; + jobCompletedLatch: IMycLatch; begin jobExecuted := False; - jobCompletedSignal := Signals.CreateSemaphore(1); // Semaphore to signal job completion + jobCompletedLatch := TMycLatch.CreateLatch(1); // Changed from Signals.CreateLatch - FFactory.Run(0, // StartCount = 0 for immediate execution + FFactory.Run(0, procedure begin jobExecuted := True; - jobCompletedSignal.Notify; // Signal completion + jobCompletedLatch.Notify; end); - FFactory.WaitFor(jobCompletedSignal.State); // Wait for the job to complete + FFactory.WaitFor(jobCompletedLatch.State); Assert.IsTrue(jobExecuted, 'Immediate job should have executed'); end; procedure TMycTaskFactoryTests.TestRunDelayedJobExecutesAfterAllNotifies; var jobExecuted: Boolean; - jobCompletedSignal: IMycSemaphore; + jobCompletedLatch: IMycLatch; subscriber: IMycSubscriber; startCount: Integer; begin jobExecuted := False; startCount := 2; - jobCompletedSignal := Signals.CreateSemaphore(1); + jobCompletedLatch := TMycLatch.CreateLatch(1); // Changed from Signals.CreateLatch subscriber := FFactory.Run(startCount, procedure begin jobExecuted := True; - jobCompletedSignal.Notify; + jobCompletedLatch.Notify; end); Assert.IsNotNull(subscriber, 'Run should return a subscriber for delayed job'); - // Corrected line: - Assert.AreNotEqual(Signals.Null, subscriber, 'Subscriber should not be Signals.Null for StartCount > 0'); + // Use TMycLatch.Null for comparison + Assert.AreNotEqual(TMycLatch.Null, subscriber, 'Subscriber should not be TMycLatch.Null for StartCount > 0'); - subscriber.Notify; // First notification - subscriber.Notify; // Second notification, job should now be enqueued + subscriber.Notify; + subscriber.Notify; - FFactory.WaitFor(jobCompletedSignal.State); // Wait for job completion + FFactory.WaitFor(jobCompletedLatch.State); Assert.IsTrue(jobExecuted, 'Delayed job should execute after all notifications'); end; procedure TMycTaskFactoryTests.TestRunDelayedJobDoesNotExecutePrematurely; var jobExecuted: Boolean; - jobCompletedSignal: IMycSemaphore; // Not strictly needed here as job shouldn't run + jobCompletedLatch: IMycLatch; subscriber: IMycSubscriber; startCount: Integer; - dummyWaitSignal: IMycSemaphore; + dummyWaitLatch: IMycLatch; begin jobExecuted := False; startCount := 3; - jobCompletedSignal := Signals.CreateSemaphore(1); // For the job, if it were to run - dummyWaitSignal := Signals.CreateSemaphore(1); + jobCompletedLatch := TMycLatch.CreateLatch(1); // Changed from Signals.CreateLatch + dummyWaitLatch := TMycLatch.CreateLatch(1); // Changed from Signals.CreateLatch subscriber := FFactory.Run(startCount, procedure begin jobExecuted := True; - jobCompletedSignal.Notify; + jobCompletedLatch.Notify; end); Assert.IsNotNull(subscriber, 'Run should return a subscriber for delayed job_P2'); - subscriber.Notify; // First notification + subscriber.Notify; Assert.IsFalse(jobExecuted, 'Job should not execute after one notification_P2'); - subscriber.Notify; // Second notification + subscriber.Notify; Assert.IsFalse(jobExecuted, 'Job should not execute after two notifications_P2'); - // To give a very brief moment for any potential async execution attempt. - // This is not foolproof for catching race conditions but can help. - // A more robust way is harder without specific test hooks in the factory. - FFactory.Run(0, procedure begin dummyWaitSignal.Notify; end); - FFactory.WaitFor(dummyWaitSignal.State); // Ensures task queue is processed slightly + FFactory.Run(0, procedure begin dummyWaitLatch.Notify; end); + FFactory.WaitFor(dummyWaitLatch.State); Assert.IsFalse(jobExecuted, 'Job should still not have executed before third notify_P2'); end; @@ -190,18 +184,17 @@ end; procedure TMycTaskFactoryTests.TestWaitForAlreadySetState; var - alreadySetSignal: IMycSemaphore; + alreadySetLatch: IMycLatch; startTime, endTime: Cardinal; begin - alreadySetSignal := Signals.CreateSemaphore(0); // Count = 0 means it's already set - Assert.IsTrue(alreadySetSignal.State.IsSet, 'Signal should be initially set'); + // TMycLatch.CreateLatch(0) will return TMycLatch.Null + alreadySetLatch := TMycLatch.CreateLatch(0); // Changed from Signals.CreateLatch + Assert.IsTrue(alreadySetLatch.State.IsSet, 'Latch should be initially set'); startTime := TThread.GetTickCount; - FFactory.WaitFor(alreadySetSignal.State); // Should return immediately + FFactory.WaitFor(alreadySetLatch.State); endTime := TThread.GetTickCount; - // Check that WaitFor didn't block for a significant time - // Allow a small delta for processing, e.g., less than 50ms Assert.IsTrue((endTime - startTime) < 50, 'WaitFor on an already set state should not block significantly'); end; @@ -209,11 +202,11 @@ procedure TMycTaskFactoryTests.TestThreadInfoMethods; var inMainThreadInJob: Boolean; inWorkerThreadInJob: Boolean; - jobDoneSignal: IMycSemaphore; + jobDoneLatch: IMycLatch; begin - inMainThreadInJob := True; // Default to a state that would fail the assert - inWorkerThreadInJob := False; // Default to a state that would fail the assert - jobDoneSignal := Signals.CreateSemaphore(1); + inMainThreadInJob := True; + inWorkerThreadInJob := False; + jobDoneLatch := TMycLatch.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'); @@ -223,10 +216,10 @@ begin begin inMainThreadInJob := FFactory.InMainThread; inWorkerThreadInJob := FFactory.InWorkerThread; - jobDoneSignal.Notify; + jobDoneLatch.Notify; end); - FFactory.WaitFor(jobDoneSignal.State); // Wait for the job to complete and set flags + FFactory.WaitFor(jobDoneLatch.State); Assert.IsFalse(inMainThreadInJob, 'Job executed by factory should not be in main thread'); Assert.IsTrue(inWorkerThreadInJob, 'Job executed by factory should be in a worker thread'); @@ -234,39 +227,35 @@ end; procedure TMycTaskFactoryTests.TestExceptionPropagationFromJob; var - jobDoneSignal: IMycSemaphore; // To ensure job has a chance to run + jobDoneLatch: IMycLatch; begin - jobDoneSignal := Signals.CreateSemaphore(1); + jobDoneLatch := TMycLatch.CreateLatch(1); // Changed from Signals.CreateLatch FFactory.Run(0, procedure var - dummy: Integer; // To avoid hint W1035 if no other code is in the proc + dummy: Integer; begin - dummy := 0; // Assign to avoid compiler warning if variable is unused - // Raise the specific nested exception type + dummy := 0; raise TMycTaskFactory.ETaskException.Create('Test Exception From Job'); - // jobDoneSignal.Notify; // This line will not be reached + // jobDoneLatch.Notify; // This line will not be reached end); - // Give a brief moment for the job to be scheduled and potentially raise the exception. - // Run another dummy job to help process the queue and ensure the exception is set. - FFactory.Run(0, procedure begin jobDoneSignal.Notify; end); - FFactory.WaitFor(jobDoneSignal.State); + FFactory.Run(0, procedure begin jobDoneLatch.Notify; end); + FFactory.WaitFor(jobDoneLatch.State); Assert.WillRaise( procedure begin - (FFactory as TMycTaskFactory).HandleException; // This should re-raise the exception + (FFactory as TMycTaskFactory).HandleException; end, - TMycTaskFactory.ETaskException, // Correctly qualified exception type + TMycTaskFactory.ETaskException, 'HandleException should re-raise the exception from the job' ); - // Verify FException is cleared after being handled var noExceptionRaised: Boolean := True; try - (FFactory as TMycTaskFactory).HandleException; // Should not raise anything now + (FFactory as TMycTaskFactory).HandleException; except noExceptionRaised := False; end; @@ -275,14 +264,14 @@ end; procedure TMycTaskFactoryTests.TestRunJobAfterFactoryTeardown; begin - FFactory.Teardown; // Explicitly teardown the factory + FFactory.Teardown; Assert.WillRaise( procedure begin - FFactory.Run(0, procedure begin end); // Attempt to run a job + FFactory.Run(0, procedure begin end); end, - TMycTaskFactory.ETaskException, // Expecting the factory's specific exception type + TMycTaskFactory.ETaskException, 'Running a job on a torn-down factory should raise ETaskException' ); end; @@ -290,34 +279,31 @@ end; procedure TMycTaskFactoryTests.TestWaitForInWorkerThreadRaisesException; var exceptionCaughtInJob: Boolean; - jobDoneSignal: IMycSemaphore; + jobDoneLatch: IMycLatch; dummyStateToWaitFor: IMycState; begin exceptionCaughtInJob := False; - jobDoneSignal := Signals.CreateSemaphore(1); - dummyStateToWaitFor := Signals.CreateSemaphore(1).State; // A state that will never be set by this test logic + jobDoneLatch := TMycLatch.CreateLatch(1); // Changed from Signals.CreateLatch + dummyStateToWaitFor := TMycLatch.CreateLatch(1).State; // Changed from Signals.CreateLatch FFactory.Run(0, procedure begin try - FFactory.WaitFor(dummyStateToWaitFor); // This should raise ETaskException + FFactory.WaitFor(dummyStateToWaitFor); except on E: TMycTaskFactory.ETaskException do begin - // Check message if needed: Assert.AreEqual('Waiting not allowed within tasks', E.Message); exceptionCaughtInJob := True; end; - // Else: Unexpected exception, test will fail by jobDoneSignal not being set or flag remaining false end; - jobDoneSignal.Notify; // Signal completion of the job's execution path + jobDoneLatch.Notify; end); - FFactory.WaitFor(jobDoneSignal.State); // Wait for the job to finish + FFactory.WaitFor(jobDoneLatch.State); Assert.IsTrue(exceptionCaughtInJob, 'WaitFor called within a worker thread job should raise ETaskException'); end; initialization - // Register TestFixtures TDUnitX.RegisterTestFixture(TMycTaskFactoryTests); end.