From e7e26f2a120bdb934e42aa127bb104e70281bd21 Mon Sep 17 00:00:00 2001 From: Michael Schimmel Date: Mon, 2 Jun 2025 14:27:00 +0200 Subject: [PATCH] Future helper record --- Src/Myc.Core.Signals.pas | 362 ++++++++++++++++++ Src/Myc.Core.Tasks.pas | 8 +- Src/Myc.Futures.pas | 58 ++- Src/Myc.TaskManager.pas | 7 + Test/MycTests.dpr | 5 +- Test/MycTests.dproj | 3 +- Test/TestCoreFutures.pas | 368 ++++++++++++++++++ Test/TestFutures.pas | 780 ++++++++++++++++++++++++--------------- 8 files changed, 1269 insertions(+), 322 deletions(-) create mode 100644 Src/Myc.Core.Signals.pas create mode 100644 Test/TestCoreFutures.pas diff --git a/Src/Myc.Core.Signals.pas b/Src/Myc.Core.Signals.pas new file mode 100644 index 0000000..d7b4b23 --- /dev/null +++ b/Src/Myc.Core.Signals.pas @@ -0,0 +1,362 @@ +unit Myc.Core.Signals; + +interface + +uses + System.SysUtils, + Myc.Core.Notifier, + Myc.Signals; + +type + TMycState = class abstract( TInterfacedObject, IMycState ) + strict private + class var + FNull: IMycState; + class constructor ClassCreate; + protected + function GetIsSet: Boolean; virtual; abstract; + public + function Subscribe(Subscriber: IMycSubscriber): TMycSubscription; virtual; abstract; + procedure Unsubscribe(Tag: TMycNotifyList.TTag); virtual; abstract; + property IsSet: Boolean read GetIsSet; + // Provides access to the singleton null latch instance (always set). + class property Null: IMycState read FNull; + 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): TMycSubscription; + procedure Unsubscribe(Tag: TMycNotifyList.TTag); + public + constructor Create; + 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) + strict private + FSubscribers: TMycNotifyList; // List of subscribers waiting for this latch to be set. + class var + FNull: IMycLatch; // Singleton instance of a latch that is always set. + class constructor ClassCreate; // Class constructor to initialize FNull. + private + [volatile] FCount: Integer; // The internal countdown value for the latch. + function GetState: IMycState; // Implementation for IMycLatch.GetState and IMycFlag.GetState. + protected + function GetIsSet: Boolean; override; final; // Implementation for IMycState.GetIsSet. + 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). + constructor Create(ACount: Integer); + destructor Destroy; override; + + // Factory method: creates a new countdown latch or returns the Null latch if Count <= 0. + class function CreateLatch(Count: Integer): IMycLatch; static; + + // IMycSignal implementation + function Subscribe(Subscriber: IMycSubscriber): TMycSubscription; override; + procedure Unsubscribe(Tag: TMycNotifyList.TTag); override; + + // 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; + + // Provides access to the singleton null latch instance (always set). + class property Null: IMycLatch read FNull; + end; + + // TMycDirty 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) + strict private + FSubscribers: TMycNotifyList; // List of subscribers interested in state changes of this dirty flag. + private + [volatile] FFlag: Boolean; // Internal state: true if dirty/set, false if clean/reset. + function GetState: IMycState; // Implementation for IMycFlag.GetState. + protected + function GetIsSet: Boolean; override; final; // Implementation for IMycState.GetIsSet (true if dirty). + 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; + + // IMycSignal implementation + function Subscribe(Subscriber: IMycSubscriber): TMycSubscription; override; + procedure Unsubscribe(Tag: TMycNotifyList.TTag); override; + + // IMycSubscriber implementation for TMycDirty. + // 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). + function Reset: Boolean; + end; + +implementation + +uses + System.SyncObjs; // For TInterlocked + +class constructor TMycState.ClassCreate; +begin + // Create a singleton null latch instance that is initially (and always) set. + FNull := TMycNullState.Create(); // Calls the instance constructor +end; + +{ TMycNullState } + +constructor TMycNullState.Create; +begin + inherited Create; +end; + +function TMycNullState.GetIsSet: Boolean; +begin + Result := true; // Null state is always set. +end; + +function TMycNullState.Subscribe(Subscriber: IMycSubscriber): TMycSubscription; +begin + // Since the state is always set, notify the subscriber immediately. + if Assigned(Subscriber) then + begin + Subscriber.Notify; + end; + // No ongoing subscription is necessary or meaningful for a null state. + Result.Create(Self, nil); // Return an empty subscription. +end; + +procedure TMycNullState.Unsubscribe(Tag: TMycNotifyList.TTag); +begin + // Unsubscribing from a null state has no effect. +end; + +{ TMycLatch } + +constructor TMycLatch.Create(ACount: Integer); +begin + inherited Create; + Assert( ACount >= 0 ); + FCount := ACount; + FSubscribers.Create; +end; + +class constructor TMycLatch.ClassCreate; +begin + // Create a singleton null latch instance that is initially (and always) set. + FNull := TMycLatch.Create(0); // Calls the instance constructor +end; + +destructor TMycLatch.Destroy; +begin + FSubscribers.Destroy; + inherited; +end; + +class function TMycLatch.CreateLatch(Count: Integer): IMycLatch; +begin + // Factory method: returns a new latch or the shared Null latch if Count <= 0. + if Count > 0 then + Result := TMycLatch.Create(Count) // Instance constructor + else + Result := FNull; +end; + +function TMycLatch.Notify: Boolean; +var + currentCountAfterDecrement: Integer; + shouldNotifySubscribers: Boolean; +begin + FSubscribers.Lock; + try + currentCountAfterDecrement := TInterlocked.Decrement(FCount); + + if currentCountAfterDecrement < -MaxInt div 2 then + TInterlocked.Increment(FCount); // Defend against extreme underflow. + + shouldNotifySubscribers := (currentCountAfterDecrement = 0); // Notify only on transition to zero. + + if shouldNotifySubscribers then + begin + FSubscribers.Notify( + function(Subscriber: IMycSubscriber): Boolean + begin + Result := Subscriber.Notify; + end); + end; + + // Returns true if the latch has not yet been set by this Notify call (count > 0). + Result := currentCountAfterDecrement > 0; + + // If the latch is now set (or was already set), unadvise all subscribers. + // This ensures one-shot notification for the current set of subscribers. + if currentCountAfterDecrement <= 0 then + FSubscribers.UnadviseAll; + finally + FSubscribers.Release; + end; +end; + +function TMycLatch.GetIsSet: Boolean; +begin + // The latch is set if its count has reached zero or less. + Result := FCount <= 0; +end; + +function TMycLatch.GetState: IMycState; +begin + // TMycLatch itself implements IMycState. + exit(Self); +end; + +function TMycLatch.Subscribe(Subscriber: IMycSubscriber): TMycSubscription; +var + alreadySet: Boolean; +begin + if not Assigned(Subscriber) then + exit; + + FSubscribers.Lock; + try + alreadySet := (FCount <= 0); // Check if latch is already set. + + if alreadySet then + begin + // If already set, notify immediately; no persistent subscription needed. + Subscriber.Notify; + end + else + begin + // If not yet set, advise the subscriber. + Result.Create(Self, FSubscribers.Advise(Subscriber)); + end; + finally + FSubscribers.Release; + end; +end; + +procedure TMycLatch.Unsubscribe(Tag: TMycNotifyList.TTag); +begin + if Tag = nil then + exit; + + FSubscribers.Lock; + try + FSubscribers.Unadvise(Tag); + finally + FSubscribers.Release; + end; +end; + +{ TMycDirty } + +constructor TMycDirty.Create; +begin + inherited Create; + FFlag := true; // A new dirty flag is initially considered dirty. + FSubscribers.Create; +end; + +class function TMycDirty.CreateDirty: IMycDirty; +begin + // Factory method to create a new TMycDirty instance. + Result := TMycDirty.Create; +end; + +destructor TMycDirty.Destroy; +begin + FSubscribers.Destroy; // Clean up the subscriber list. + inherited; +end; + +function TMycDirty.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; +begin + // IsSet is true if the flag is dirty (FFlag = true). + Result := FFlag; +end; + +function TMycDirty.GetState: IMycState; +begin + // TMycDirty itself implements IMycState. + exit(Self); +end; + +function TMycDirty.Notify: Boolean; +var + wasPreviouslyClean: Boolean; +begin + FSubscribers.Lock; + try + // Set the flag to true (dirty) and check if it was previously false (clean). + wasPreviouslyClean := not TInterlocked.Exchange(FFlag, true); + + if wasPreviouslyClean then // Only notify subscribers if state changed from clean to dirty. + 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. + // Here, it reflects whether a state change to dirty occurred due to this call. + Result := wasPreviouslyClean; + finally + FSubscribers.Release; + end; +end; + +function TMycDirty.Subscribe(Subscriber: IMycSubscriber): TMycSubscription; +begin + if not Assigned(Subscriber) then + exit; + + // For TMycDirty, 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. + FSubscribers.Lock; + try + // Add subscriber regardless of current state. + Result.Create(Self, FSubscribers.Advise(Subscriber)); + if FFlag then // If currently dirty, notify the new subscriber immediately. + begin + Subscriber.Notify; + end; + finally + FSubscribers.Release; + end; +end; + +procedure TMycDirty.Unsubscribe(Tag: TMycNotifyList.TTag); +begin + if Tag = nil then + exit; + + FSubscribers.Lock; + try + FSubscribers.Unadvise(Tag); + finally + FSubscribers.Release; + end; +end; + +end. diff --git a/Src/Myc.Core.Tasks.pas b/Src/Myc.Core.Tasks.pas index 1dbcd69..ccb7395 100644 --- a/Src/Myc.Core.Tasks.pas +++ b/Src/Myc.Core.Tasks.pas @@ -41,13 +41,6 @@ type // will be re-raised in the calling (main) thread. procedure Teardown; - // Waits for the operation associated with State to complete. - // Must not be called from a worker thread of this factory. - // After waiting, or if the state is already set, any first stored exception - // from any worker thread of this factory will be re-raised in the calling (main) thread. - // Raises ETaskException if called from within a worker thread. - procedure WaitFor(State: IMycState); - // Gets the number of worker threads. property ThreadCount: Integer read GetThreadCount; end; @@ -89,6 +82,7 @@ type function InMainThread: Boolean; function InWorkerThread: Boolean; + // Initialize global TaskManager class procedure AquireTaskManager; class procedure ReleaseTaskManager; end; diff --git a/Src/Myc.Futures.pas b/Src/Myc.Futures.pas index 4bf4c7f..0f3a66f 100644 --- a/Src/Myc.Futures.pas +++ b/Src/Myc.Futures.pas @@ -22,14 +22,26 @@ type Future = record strict private FFuture: IMycFuture; + function GetDone: IMycState; inline; + function GetResult: T; inline; + class constructor CreateClass; class destructor DestroyClass; - constructor Create(const AFuture: IMycFuture); - public - class function Construct(const Proc: TFunc): Future; overload; static; - class function Construct(const Gate: IMycState; const Proc: TFunc): Future; overload; static; - function Chain(const Proc: TFunc): Future; + public + constructor Create(const AFuture: IMycFuture); + class operator Implicit(const A: IMycFuture): Future; overload; + class operator Implicit(const A: Future): IMycFuture; overload; + + class function Construct(const Proc: TFunc): IMycFuture; overload; static; + class function Construct(const Gate: IMycState; const Proc: TFunc): IMycFuture; overload; static; + + function Chain(const Proc: TFunc): IMycFuture; + + function WaitFor: T; + + property Done: IMycState read GetDone; + property Result: T read GetResult; end; implementation @@ -52,7 +64,7 @@ begin TMycTaskFactory.ReleaseTaskManager; end; -function Future.Chain(const Proc: TFunc): Future; +function Future.Chain(const Proc: TFunc): IMycFuture; begin var Cap := FFuture; @@ -63,14 +75,40 @@ begin end ); end; -class function Future.Construct(const Proc: TFunc): Future; +class function Future.Construct(const Proc: TFunc): IMycFuture; begin - Result.Create( TMycInitStateFuncFuture.Create( TaskManager, nil, Proc ) ); + Result := TMycInitStateFuncFuture.Create( TaskManager, nil, Proc ); end; -class function Future.Construct(const Gate: IMycState; const Proc: TFunc): Future; +class function Future.Construct(const Gate: IMycState; const Proc: TFunc): IMycFuture; begin - Result.Create( TMycInitStateFuncFuture.Create( TaskManager, Gate, Proc ) ); + Result := TMycInitStateFuncFuture.Create( TaskManager, Gate, Proc ); +end; + +function Future.GetDone: IMycState; +begin + Result := FFuture.Done; +end; + +function Future.GetResult: T; +begin + Result := FFuture.Result; +end; + +function Future.WaitFor: T; +begin + TaskManager.WaitFor( FFuture.Done ); + Result := FFuture.Result; +end; + +class operator Future.Implicit(const A: IMycFuture): Future; +begin + Result.Create( A ); +end; + +class operator Future.Implicit(const A: Future): IMycFuture; +begin + Result := A.FFuture; end; end. diff --git a/Src/Myc.TaskManager.pas b/Src/Myc.TaskManager.pas index c46ee00..1b59796 100644 --- a/Src/Myc.TaskManager.pas +++ b/Src/Myc.TaskManager.pas @@ -9,6 +9,13 @@ uses type IMycTaskManager = interface function CreateTask( const Gate: IMycState; const Proc: TProc ): TMycSubscription; + + // Waits for the operation associated with State to complete. + // Must not be called from a worker thread of this factory. + // After waiting, or if the state is already set, any first stored exception + // from any worker thread of this factory will be re-raised in the calling (main) thread. + // Raises ETaskException if called from within a worker thread. + procedure WaitFor(State: IMycState); end; var diff --git a/Test/MycTests.dpr b/Test/MycTests.dpr index c0102d3..83bd83b 100644 --- a/Test/MycTests.dpr +++ b/Test/MycTests.dpr @@ -24,10 +24,11 @@ uses TestTasks in 'TestTasks.pas', TestSignals_Dirty in 'TestSignals_Dirty.pas', Myc.Futures in '..\Src\Myc.Futures.pas', - TestFutures in 'TestFutures.pas', + TestCoreFutures in 'TestCoreFutures.pas', Myc.TaskManager in '..\Src\Myc.TaskManager.pas', Myc.Core.Futures in '..\Src\Myc.Core.Futures.pas', - Myc.Core.Signals in '..\Src\Myc.Core.Signals.pas'; + Myc.Core.Signals in '..\Src\Myc.Core.Signals.pas', + TestFutures in 'TestFutures.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 e473c6c..029bcac 100644 --- a/Test/MycTests.dproj +++ b/Test/MycTests.dproj @@ -123,10 +123,11 @@ $(PostBuildEvent)]]> - + + Base diff --git a/Test/TestCoreFutures.pas b/Test/TestCoreFutures.pas new file mode 100644 index 0000000..68252bc --- /dev/null +++ b/Test/TestCoreFutures.pas @@ -0,0 +1,368 @@ +unit TestCoreFutures; + +interface + +uses + DUnitX.TestFramework, + System.SysUtils, System.Generics.Collections, // Added for TObjectList if needed, not strictly for this + System.SyncObjs, + Myc.Signals, // For IMycLatch, TMycLatch, IMycState, IMycSubscriber [cite: 62, 68, 53, 45] + Myc.Core.Tasks, // For IMycTaskFactory, TMycTaskFactory [cite: 97, 113] + Myc.Futures, Myc.Core.Futures; // For IMycFuture, TMycInitStateFuncFuture + +type + // Helper class to notify a latch when its Notify method is called. + TLatchNotifierSubscriber = class(TInterfacedObject, IMycSubscriber) + private + FGateLatch: IMycLatch; + public + constructor Create(AGateLatch: IMycLatch); + // IMycSubscriber + function Notify: Boolean; // Implements IMycSubscriber.Notify [cite: 46, 181, 299] + end; + + [TestFixture] + [IgnoreMemoryLeaks(true)] + TTestMycInitStateFuncFuture = class(TObject) + private + FTaskFactory: IMycTaskFactory; + FProcExecutionCount: Integer; // Counter for side effects of AProc + FSharedCounter: Integer; // For Fan-Out test side effects + public + [Setup] + procedure Setup; + [TearDown] + procedure TearDown; + + [Test] + procedure Test_BasicSuccess_WithImmediateInitState; + [Test] + procedure Test_ChainedExecution_WithDelayedInitState; + [Test] + procedure Test_ExceptionInProc_HandledAsPlanned; + [Test] + procedure Test_GetResult_BeforeDone_RaisesException; + [Test] + procedure Test_FanIn_OneFutureWaitsForMultipleOthers; + [Test] + procedure Test_FanOut_MultipleFuturesWaitForOneTrigger; + end; + +implementation + +{ TLatchNotifierSubscriber } + +constructor TLatchNotifierSubscriber.Create(AGateLatch: IMycLatch); +begin + inherited Create; + FGateLatch := AGateLatch; +end; + +function TLatchNotifierSubscriber.Notify: Boolean; +begin + if Assigned(FGateLatch) then + begin + FGateLatch.Notify; // Notify the provided gate latch [cite: 80, 215, 333] + end; + Result := False; // This subscriber is typically one-shot for this purpose. +end; + +{ TTestMycInitStateFuncFuture } + +procedure TTestMycInitStateFuncFuture.Setup; +begin + FTaskFactory := TMycTaskFactory.Create; // Create a new task factory instance for each test [cite: 113, 235, 353] + FProcExecutionCount := 0; + FSharedCounter := 0; +end; + +procedure TTestMycInitStateFuncFuture.TearDown; +begin + if Assigned(FTaskFactory) then + begin + FTaskFactory.Teardown; // Teardown the factory, this may re-raise exceptions [cite: 107, 234, 352] + FTaskFactory := nil; + end; +end; + +procedure TTestMycInitStateFuncFuture.Test_BasicSuccess_WithImmediateInitState; +var + LFuture: IMycFuture; + LInitStateAsState: IMycState; // Parameter for Create + LResultValue: Integer; +const + CExpectedResult = 42; +begin + // Use TMycLatch.Null for an already set init state [cite: 71, 81, 206, 216, 324, 334] + LInitStateAsState := State.Null; + + LFuture := TMycInitStateFuncFuture.Create(FTaskFactory, LInitStateAsState, + function: Integer + begin + Inc(Self.FProcExecutionCount); + Result := CExpectedResult; + end); + + FTaskFactory.WaitFor(LFuture.Done); // Accesses IMycFuture.GetDone [cite: 110, 234, 352] + + Assert.IsTrue(LFuture.Done.IsSet, 'Future should be marked as done.'); // Accesses IMycState.IsSet [cite: 57, 194, 312] + Assert.AreEqual(1, FProcExecutionCount, 'AProc should have been executed once.'); + + LResultValue := LFuture.GetResult; // Accesses IMycFuture.GetResult + Assert.AreEqual(CExpectedResult, LResultValue, 'GetResult returned an unexpected value.'); +end; + +procedure TTestMycInitStateFuncFuture.Test_ChainedExecution_WithDelayedInitState; +var + LFuture: IMycFuture; + LInitLatch: IMycLatch; + LResultValue: string; +const + CExpectedResult = 'ChainCompleted'; +begin + LInitLatch := State.CreateLatch(1); // Create an init state that is not yet set [cite: 77, 212, 330] + + LFuture := TMycInitStateFuncFuture.Create(FTaskFactory, LInitLatch.State, + function: string + begin + Inc(Self.FProcExecutionCount); + Result := CExpectedResult; + end); + + Assert.AreEqual(0, FProcExecutionCount, 'AProc should not have executed yet.'); + Assert.IsFalse(LFuture.Done.IsSet, 'Future should not be done yet.'); + + LInitLatch.Notify; // Trigger the initial state [cite: 80, 215, 333] + + FTaskFactory.WaitFor(LFuture.Done); + + Assert.IsTrue(LFuture.Done.IsSet, 'Future should be marked as done after init state trigger.'); + Assert.AreEqual(1, FProcExecutionCount, 'AProc should have been executed once after init state.'); + + LResultValue := LFuture.GetResult; + Assert.AreEqual(CExpectedResult, LResultValue, 'GetResult returned an unexpected value after delayed init.'); +end; + +procedure TTestMycInitStateFuncFuture.Test_ExceptionInProc_HandledAsPlanned; +var + LFuture: IMycFuture; + LLocalTaskFactory: IMycTaskFactory; + LInitStateAsState: IMycState; + LResultValue: Integer; + LExpectedExceptionRaisedByFactory: Boolean; +const + CExceptionMessage = 'Test exception from AProc'; +begin + LExpectedExceptionRaisedByFactory := False; + LLocalTaskFactory := TMycTaskFactory.Create; + LInitStateAsState := State.Null; // Immediate execution + + LFuture := TMycInitStateFuncFuture.Create(LLocalTaskFactory, LInitStateAsState, + function: Integer + begin + Inc(Self.FProcExecutionCount); + raise Exception.Create(CExceptionMessage); + end); + + try + LLocalTaskFactory.WaitFor(LFuture.Done); + except + on E: Exception do + begin + if E.Message = CExceptionMessage then + LExpectedExceptionRaisedByFactory := True; + end; + end; + + Assert.IsTrue(LFuture.Done.IsSet, 'Future should be done even if AProc raised an exception.'); + Assert.AreEqual(1, FProcExecutionCount, 'AProc (which raised) should have been executed once.'); + + LResultValue := LFuture.GetResult; + Assert.AreEqual(Default(Integer), LResultValue, 'GetResult should return Default(T) when AProc raises an exception.'); + + if not LExpectedExceptionRaisedByFactory then + begin + try + LLocalTaskFactory.Teardown; // This should re-raise the exception [cite: 108, 234, 352] + except + on E: Exception do + begin + Assert.AreEqual(CExceptionMessage, E.Message, 'TaskFactory did not re-raise the correct exception message on Teardown.'); + LExpectedExceptionRaisedByFactory := True; + end; + end; + Assert.IsTrue(LExpectedExceptionRaisedByFactory, 'TaskFactory Teardown did not raise any exception as expected.'); + end; + + if LExpectedExceptionRaisedByFactory then // Factory was torn down (implicitly or explicitly) and did its job + LLocalTaskFactory := nil + else if Assigned(LLocalTaskFactory) then // Teardown didn't raise as expected, or wasn't called due to earlier exception path + begin + LLocalTaskFactory.Teardown; // Ensure it's torn down if test logic failed to confirm exception + LLocalTaskFactory := nil; + end; +end; + +procedure TTestMycInitStateFuncFuture.Test_GetResult_BeforeDone_RaisesException; +var + LFuture: IMycFuture; + LInitLatch: IMycLatch; +begin + LInitLatch := State.CreateLatch(1); + + LFuture := TMycInitStateFuncFuture.Create(FTaskFactory, LInitLatch.State, + function: Integer + begin + Inc(Self.FProcExecutionCount); + Result := 123; + end); + + Assert.IsFalse(LFuture.Done.IsSet, 'Future should not be marked as done initially.'); + + Assert.WillRaise( + procedure + begin + LFuture.GetResult; + end ); + + LInitLatch.Notify; + + FTaskFactory.WaitFor(LFuture.Done); + + Assert.WillNotRaise( + procedure + begin + LFuture.GetResult; + end ); +end; + +procedure TTestMycInitStateFuncFuture.Test_FanIn_OneFutureWaitsForMultipleOthers; +var + LPrerequisiteFuture1, LPrerequisiteFuture2: IMycFuture; + LMainFuture: IMycFuture; + LGateLatch: IMycLatch; + LSub1, LSub2: IMycSubscriber; // To hold the TLatchNotifierSubscriber instances + LInitStateP1, LInitStateP2: IMycLatch; + Subscriptions: array[1..2] of TMycSubscription; // To manage subscriptions +const + CMainFutureResult = 'AllPrerequisitesCompleted'; +begin + FProcExecutionCount := 0; // Reset for this test + + // Gate Latch: MainFuture waits for this latch, which needs 2 notifications. + LGateLatch := State.CreateLatch(2); // [cite: 77, 212, 330] + + // Create MainFuture, AInitState is the GateLatch's state. + LMainFuture := TMycInitStateFuncFuture.Create(FTaskFactory, LGateLatch.State, + function: string + begin + Inc(Self.FProcExecutionCount, 10); // Indicate MainFuture's proc ran + Result := CMainFutureResult; + end); + + // Setup Prerequisite Futures + // PrerequisiteFuture1 + LInitStateP1 := State.CreateLatch(1); // Controllable init state for PF1 + LPrerequisiteFuture1 := TMycInitStateFuncFuture.Create(FTaskFactory, LInitStateP1.State, + function: Integer + begin + Inc(Self.FProcExecutionCount, 1); // PF1 ran + Result := 1; + end); + LSub1 := TLatchNotifierSubscriber.Create(LGateLatch); + Subscriptions[1] := LPrerequisiteFuture1.Done.Subscribe(LSub1); // Subscribe to PF1's completion [cite: 56, 188, 306] + + // PrerequisiteFuture2 + LInitStateP2 := State.CreateLatch(1); // Controllable init state for PF2 + LPrerequisiteFuture2 := TMycInitStateFuncFuture.Create(FTaskFactory, LInitStateP2.State, + function: Integer + begin + Inc(Self.FProcExecutionCount, 1); // PF2 ran + Result := 2; + end); + LSub2 := TLatchNotifierSubscriber.Create(LGateLatch); + Subscriptions[2] := LPrerequisiteFuture2.Done.Subscribe(LSub2); // Subscribe to PF2's completion + + // --- Execution & Verification --- + Assert.IsFalse(LMainFuture.Done.IsSet, 'MainFuture should not be done yet.'); + Assert.AreEqual(0, FProcExecutionCount, 'No AProc should have executed yet.'); + + // Trigger PrerequisiteFuture1 + LInitStateP1.Notify; // + FTaskFactory.WaitFor(LPrerequisiteFuture1.Done); // Ensure PF1 completes and notifies GateLatch + Assert.IsFalse(LGateLatch.State.IsSet, 'GateLatch should not be set after only one prerequisite.'); + Assert.IsFalse(LMainFuture.Done.IsSet, 'MainFuture should still not be done.'); + Assert.AreEqual(1, FProcExecutionCount mod 10, 'Only PF1 AProc should have run.'); + + + // Trigger PrerequisiteFuture2 + LInitStateP2.Notify; // + FTaskFactory.WaitFor(LPrerequisiteFuture2.Done); // Ensure PF2 completes and notifies GateLatch + + // Now GateLatch should be set, and MainFuture should execute + FTaskFactory.WaitFor(LMainFuture.Done); + + Assert.IsTrue(LGateLatch.State.IsSet, 'GateLatch should be set after both prerequisites.'); + Assert.IsTrue(LMainFuture.Done.IsSet, 'MainFuture should be done now.'); + Assert.AreEqual(12, FProcExecutionCount, 'All AProcs (PF1, PF2, Main) should have run.'); // 1+1+10 + Assert.AreEqual(CMainFutureResult, LMainFuture.GetResult, 'MainFuture returned an unexpected result.'); + + // Clean up subscriptions explicitly, though ARC + managed records handle much + Subscriptions[1].Unsubscribe; // [cite: 52, 186, 304] + Subscriptions[2].Unsubscribe; // +end; + +procedure TTestMycInitStateFuncFuture.Test_FanOut_MultipleFuturesWaitForOneTrigger; +var + LTriggerLatch: IMycLatch; + LFutureA, LFutureB: IMycFuture; + LFlagFutureARan, LFlagFutureBRan: Boolean; +begin + LFlagFutureARan := False; + LFlagFutureBRan := False; + Self.FSharedCounter := 0; // Reset shared counter for this test + + LTriggerLatch := State.CreateLatch(1); // Single trigger [cite: 77, 212, 330] + + // Future A + LFutureA := TMycInitStateFuncFuture.Create(FTaskFactory, LTriggerLatch.State, + function: Integer + begin + LFlagFutureARan := True; + System.SyncObjs.TInterlocked.Increment(Self.FSharedCounter); // Thread-safe increment + Result := 100; + end); + + // Future B + LFutureB := TMycInitStateFuncFuture.Create(FTaskFactory, LTriggerLatch.State, + function: Integer + begin + LFlagFutureBRan := True; + System.SyncObjs.TInterlocked.Increment(Self.FSharedCounter); // Thread-safe increment + Result := 200; + end); + + Assert.IsFalse(LFutureA.Done.IsSet, 'FutureA should not be done yet.'); + Assert.IsFalse(LFutureB.Done.IsSet, 'FutureB should not be done yet.'); + Assert.AreEqual(0, Self.FSharedCounter, 'No future AProcs should have executed yet.'); + + // Trigger the common latch + LTriggerLatch.Notify; // [cite: 80, 215, 333] + + // Wait for both futures to complete + FTaskFactory.WaitFor(LFutureA.Done); + FTaskFactory.WaitFor(LFutureB.Done); + + Assert.IsTrue(LFutureA.Done.IsSet, 'FutureA should be done.'); + Assert.IsTrue(LFutureB.Done.IsSet, 'FutureB should be done.'); + Assert.IsTrue(LFlagFutureARan, 'FutureA AProc should have run.'); + Assert.IsTrue(LFlagFutureBRan, 'FutureB AProc should have run.'); + Assert.AreEqual(2, Self.FSharedCounter, 'Both future AProcs should have incremented the counter.'); + Assert.AreEqual(100, LFutureA.GetResult, 'FutureA GetResult value mismatch.'); + Assert.AreEqual(200, LFutureB.GetResult, 'FutureB GetResult value mismatch.'); +end; + +initialization + // For DUnitX, attributes typically handle registration. + // If needed for older DUnit: RegisterTest(TTestMycInitStateFuncFuture.Suite); +end. diff --git a/Test/TestFutures.pas b/Test/TestFutures.pas index 642f22b..5d65290 100644 --- a/Test/TestFutures.pas +++ b/Test/TestFutures.pas @@ -1,33 +1,21 @@ -unit TestFutures; +unit TestFutures; // Or TestFutures as per your previous version interface uses DUnitX.TestFramework, - System.SysUtils, System.Generics.Collections, // Added for TObjectList if needed, not strictly for this - System.SyncObjs, - Myc.Signals, // For IMycLatch, TMycLatch, IMycState, IMycSubscriber [cite: 62, 68, 53, 45] - Myc.Core.Tasks, // For IMycTaskFactory, TMycTaskFactory [cite: 97, 113] - Myc.Futures, Myc.Core.Futures; // For IMycFuture, TMycInitStateFuncFuture + System.SysUtils, + System.SyncObjs, // For TSemaphore, TEvent etc. + System.Classes, // For TThread, TThread.Sleep + Myc.Signals, + Myc.Core.Signals, // For State factory methods like State.CreateLatch, State.Null + Myc.TaskManager, // For the global TaskManager variable + Myc.Core.Tasks, // For TMycTaskFactory + Myc.Futures; // For Future type - // Helper class to notify a latch when its Notify method is called. - TLatchNotifierSubscriber = class(TInterfacedObject, IMycSubscriber) - private - FGateLatch: IMycLatch; - public - constructor Create(AGateLatch: IMycLatch); - // IMycSubscriber - function Notify: Boolean; // Implements IMycSubscriber.Notify [cite: 46, 181, 299] - end; - [TestFixture] - [IgnoreMemoryLeaks(true)] - TTestMycInitStateFuncFuture = class(TObject) - private - FTaskFactory: IMycTaskFactory; - FProcExecutionCount: Integer; // Counter for side effects of AProc - FSharedCounter: Integer; // For Fan-Out test side effects + TTestFuture = class(TObject) public [Setup] procedure Setup; @@ -35,334 +23,522 @@ type procedure TearDown; [Test] - procedure Test_BasicSuccess_WithImmediateInitState; + procedure TestConstructSimple; [Test] - procedure Test_ChainedExecution_WithDelayedInitState; + procedure TestConstructWithNilGate; [Test] - procedure Test_ExceptionInProc_HandledAsPlanned; + procedure TestConstructWithPresetGate; [Test] - procedure Test_GetResult_BeforeDone_RaisesException; + procedure TestConstructWithDelayedGate; [Test] - procedure Test_FanIn_OneFutureWaitsForMultipleOthers; + procedure TestChainSimple; [Test] - procedure Test_FanOut_MultipleFuturesWaitForOneTrigger; + procedure TestChainWithGate; + [Test] + procedure TestMultipleChains; + [Test] + [TestCase('StringFutureTest', 'Test String')] + [TestCase('IntegerFutureTestForParam', '12345')] + procedure TestConstructSimple_Parametric(const ParamValue: string); + + [Test] + procedure TestStress_StateAll; + [Test] + procedure TestStress_StateAny; + + [Test] + procedure TestNestedFuture_Construct; // New test for Future> via Construct + [Test] + procedure TestNestedFuture_Chain; // New test for Future> via Chain end; implementation -{ TLatchNotifierSubscriber } - -constructor TLatchNotifierSubscriber.Create(AGateLatch: IMycLatch); +procedure TTestFuture.Setup; begin - inherited Create; - FGateLatch := AGateLatch; + // Currently empty as per user's code. end; -function TLatchNotifierSubscriber.Notify: Boolean; +procedure TTestFuture.TearDown; begin - if Assigned(FGateLatch) then - begin - FGateLatch.Notify; // Notify the provided gate latch [cite: 80, 215, 333] - end; - Result := False; // This subscriber is typically one-shot for this purpose. + // Currently empty as per user's code. end; -{ TTestMycInitStateFuncFuture } +{ TTestFuture } -procedure TTestMycInitStateFuncFuture.Setup; -begin - FTaskFactory := TMycTaskFactory.Create; // Create a new task factory instance for each test [cite: 113, 235, 353] - FProcExecutionCount := 0; - FSharedCounter := 0; -end; - -procedure TTestMycInitStateFuncFuture.TearDown; -begin - if Assigned(FTaskFactory) then - begin - FTaskFactory.Teardown; // Teardown the factory, this may re-raise exceptions [cite: 107, 234, 352] - FTaskFactory := nil; - end; -end; - -procedure TTestMycInitStateFuncFuture.Test_BasicSuccess_WithImmediateInitState; +[Test] +procedure TTestFuture.TestConstructSimple; var - LFuture: IMycFuture; - LInitStateAsState: IMycState; // Parameter for Create - LResultValue: Integer; -const - CExpectedResult = 42; + fut: Future; + resultValue: Integer; begin - // Use TMycLatch.Null for an already set init state [cite: 71, 81, 206, 216, 324, 334] - LInitStateAsState := State.Null; + // Test construction with a simple function that returns an Integer + fut := Future.Construct( // [cite: 146] + function: Integer + begin + TThread.Sleep(20); // Simulate some background work + Result := 42; + end + ); - LFuture := TMycInitStateFuncFuture.Create(FTaskFactory, LInitStateAsState, - function: Integer - begin - Inc(Self.FProcExecutionCount); - Result := CExpectedResult; - end); + Assert.IsNotNull(fut.Done, 'Future.Done property should not be nil after construction.'); // Static string [cite: 148] + fut.WaitFor(); // Wait for the future to complete its execution [cite: 148] - FTaskFactory.WaitFor(LFuture.Done); // Accesses IMycFuture.GetDone [cite: 110, 234, 352] - - Assert.IsTrue(LFuture.Done.IsSet, 'Future should be marked as done.'); // Accesses IMycState.IsSet [cite: 57, 194, 312] - Assert.AreEqual(1, FProcExecutionCount, 'AProc should have been executed once.'); - - LResultValue := LFuture.GetResult; // Accesses IMycFuture.GetResult - Assert.AreEqual(CExpectedResult, LResultValue, 'GetResult returned an unexpected value.'); + Assert.IsTrue(fut.Done.IsSet, 'Future.Done.IsSet should be true after completion.'); // Static string [cite: 148] + resultValue := fut.Result; // Retrieve the result of the future [cite: 148] + Assert.AreEqual(42, resultValue, 'The result of the future is not the expected value.'); // Static string end; -procedure TTestMycInitStateFuncFuture.Test_ChainedExecution_WithDelayedInitState; +[Test] +procedure TTestFuture.TestConstructWithNilGate; var - LFuture: IMycFuture; - LInitLatch: IMycLatch; - LResultValue: string; -const - CExpectedResult = 'ChainCompleted'; + fut: Future; + resultValue: Integer; begin - LInitLatch := State.CreateLatch(1); // Create an init state that is not yet set [cite: 77, 212, 330] + // Test construction with a nil gate, which should execute the task immediately + fut := Future.Construct(nil, // Explicitly providing a nil gate [cite: 147] + function: Integer + begin + TThread.Sleep(20); // Simulate work + Result := 43; + end + ); - LFuture := TMycInitStateFuncFuture.Create(FTaskFactory, LInitLatch.State, - function: string - begin - Inc(Self.FProcExecutionCount); - Result := CExpectedResult; - end); + Assert.IsNotNull(fut.Done, 'Future.Done should not be nil when constructed with a nil gate.'); // Static string [cite: 148] + fut.WaitFor(); // [cite: 148] - Assert.AreEqual(0, FProcExecutionCount, 'AProc should not have executed yet.'); - Assert.IsFalse(LFuture.Done.IsSet, 'Future should not be done yet.'); - - LInitLatch.Notify; // Trigger the initial state [cite: 80, 215, 333] - - FTaskFactory.WaitFor(LFuture.Done); - - Assert.IsTrue(LFuture.Done.IsSet, 'Future should be marked as done after init state trigger.'); - Assert.AreEqual(1, FProcExecutionCount, 'AProc should have been executed once after init state.'); - - LResultValue := LFuture.GetResult; - Assert.AreEqual(CExpectedResult, LResultValue, 'GetResult returned an unexpected value after delayed init.'); + Assert.IsTrue(fut.Done.IsSet, 'Future.Done.IsSet should be true for nil gate construct.'); // Static string [cite: 148] + resultValue := fut.Result; // [cite: 148] + Assert.AreEqual(43, resultValue, 'Future result is incorrect for nil gate construct.'); // Static string end; -procedure TTestMycInitStateFuncFuture.Test_ExceptionInProc_HandledAsPlanned; +[Test] +procedure TTestFuture.TestConstructWithPresetGate; var - LFuture: IMycFuture; - LLocalTaskFactory: IMycTaskFactory; - LInitStateAsState: IMycState; - LResultValue: Integer; - LExpectedExceptionRaisedByFactory: Boolean; -const - CExceptionMessage = 'Test exception from AProc'; + fut: Future; + presetGate: IMycState; + resultValue: Integer; begin - LExpectedExceptionRaisedByFactory := False; - LLocalTaskFactory := TMycTaskFactory.Create; - LInitStateAsState := State.Null; // Immediate execution + presetGate := State.Null; // State.Null is an IMycState that is always set [cite: 68] + Assert.IsTrue(presetGate.IsSet, 'The preset gate (State.Null) should be initially set.'); // Static string [cite: 55] - LFuture := TMycInitStateFuncFuture.Create(LLocalTaskFactory, LInitStateAsState, - function: Integer - begin - Inc(Self.FProcExecutionCount); - raise Exception.Create(CExceptionMessage); - end); + // Construct a future with a gate that is already set + fut := Future.Construct(presetGate, // [cite: 147] + function: Integer + begin + Result := 44; // This should execute quickly + end + ); - try - LLocalTaskFactory.WaitFor(LFuture.Done); - except - on E: Exception do + Assert.IsNotNull(fut.Done, 'Future.Done should not be nil for preset gate construct.'); // Static string [cite: 148] + fut.WaitFor(); // [cite: 148] + + Assert.IsTrue(fut.Done.IsSet, 'Future.Done.IsSet should be true for preset gate construct.'); // Static string [cite: 148] + resultValue := fut.Result; // [cite: 148] + Assert.AreEqual(44, resultValue, 'Future result is incorrect for preset gate construct.'); // Static string +end; + +[Test] +procedure TTestFuture.TestConstructWithDelayedGate; +var + fut: Future; + delayedGate: IMycLatch; // IMycLatch implements IMycState [cite: 58] + resultValue: Integer; +begin + delayedGate := State.CreateLatch(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 + 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 + fut := Future.Construct(delayedGate.State, // Get the IMycState interface from the latch [cite: 147, 59] + function: Integer + begin + Result := 45; + end + ); + + Assert.IsNotNull(fut.Done, 'Future.Done should not be nil for delayed gate construct.'); // Static string [cite: 148] + + // Verify the future is not yet done as the gate is not set + TThread.Sleep(50); // Allow some time for task scheduling + Assert.IsFalse(fut.Done.IsSet, 'Future.Done.IsSet should be false before the delayed gate is triggered.'); // Static string [cite: 148, 55] + + delayedGate.Notify; // Trigger the latch [cite: 46, 94] (IMycSubscriber.Notify) + + fut.WaitFor(); // Wait for the future to complete now that the gate is set [cite: 148] + + Assert.IsTrue(delayedGate.State.IsSet, 'The delayed gate should be set after Notify.'); // Static string [cite: 59, 55] + Assert.IsTrue(fut.Done.IsSet, 'Future.Done.IsSet should be true after the delayed gate is triggered.'); // Static string [cite: 148, 55] + resultValue := fut.Result; // [cite: 148] + Assert.AreEqual(45, resultValue, 'Future result is incorrect for delayed gate construct.'); // Static string +end; + +[Test] +procedure TTestFuture.TestChainSimple; +var + fut1: Future; + fut2: Future; + resultValue: string; +begin + // Create an initial future + fut1 := Future.Construct( // [cite: 146] + function: Integer + begin + TThread.Sleep(20); // Simulate work + Result := 100; + end + ); + + // Chain a second future that depends on the result of the first + fut2 := fut1.Chain( // [cite: 147] + function(Input: Integer): string // This function receives the result of fut1 + begin + TThread.Sleep(20); // Simulate further work + Result := 'Value: ' + Input.ToString; // Use ToString for converting Integer to String + end + ); + + Assert.IsNotNull(fut2.Done, 'Chained Future.Done should not be nil.'); // Static string [cite: 148] + fut2.WaitFor(); // Wait for the chained future to complete [cite: 148] + + Assert.IsTrue(fut2.Done.IsSet, 'Chained Future.Done.IsSet should be true after completion.'); // Static string [cite: 148, 55] + resultValue := fut2.Result; // [cite: 148] + Assert.AreEqual('Value: 100', resultValue, 'Chained Future result is incorrect.'); // Static string +end; + +[Test] +procedure TTestFuture.TestChainWithGate; +var + fut1: Future; + fut2: Future; + delayedGate: IMycLatch; + resultValue: string; +begin + delayedGate := State.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] + + // First future depends on the delayedGate + fut1 := Future.Construct(delayedGate.State, // [cite: 147, 59] + function: Integer + begin + Result := 200; + end + ); + + // Second future is chained to the first + fut2 := fut1.Chain( // [cite: 147] + function(Input: Integer): string + begin + Result := 'ChainVal: ' + Input.ToString; + end + ); + + Assert.IsNotNull(fut2.Done, 'Chained (with gate) Future.Done should not be nil.'); // Static string [cite: 148] + + // Verify futures are not done yet + TThread.Sleep(50); + Assert.IsFalse(fut1.Done.IsSet, 'Initial future (gated) should not be done before gate is set.'); // Static string [cite: 148, 55] + Assert.IsFalse(fut2.Done.IsSet, 'Chained future (gated) should not be done before gate is set.'); // Static string [cite: 148, 55] + + delayedGate.Notify; // Trigger the gate [cite: 46, 94] + + fut2.WaitFor(); // Wait for the final chained future to complete [cite: 148] + + Assert.IsTrue(fut1.Done.IsSet, 'Initial future (gated) should be done after gate is set.'); // Static string [cite: 148, 55] + Assert.IsTrue(fut2.Done.IsSet, 'Chained future (gated) should be done after gate is set.'); // Static string [cite: 148, 55] + + resultValue := fut2.Result; // [cite: 148] + Assert.AreEqual('ChainVal: 200', resultValue, 'Chained future (gated) result is incorrect.'); // Static string +end; + +[Test] +procedure TTestFuture.TestMultipleChains; +var + futA: Future; + futB: Future; // Using Real for intermediate type + futC: Future; // Final result as string + finalResult: string; +begin + // Initial future A + futA := Future.Construct( // [cite: 146] + function: Integer + begin + TThread.Sleep(10); + Result := 10; + end + ); + + // Future B, chained from A + futB := futA.Chain( // [cite: 147] + function(InputA: Integer): Real + begin + TThread.Sleep(10); + Result := InputA * 2.5; // Calculation: 10 * 2.5 = 25.0 + end + ); + + // Future C, chained from B + futC := futB.Chain( // [cite: 147] + function(InputB: Real): string + begin + TThread.Sleep(10); + Result := 'Final: ' + FloatToStr(InputB); // Convert Real to String + end + ); + + Assert.IsNotNull(futC.Done, 'Multi-chained Future.Done should not be nil.'); // Static string [cite: 148] + futC.WaitFor(); // Wait for the last future in the chain [cite: 148] + + Assert.IsTrue(futA.Done.IsSet, 'Future A in chain should be done.'); // Static string [cite: 148, 55] + Assert.IsTrue(futB.Done.IsSet, 'Future B in chain should be done.'); // Static string [cite: 148, 55] + Assert.IsTrue(futC.Done.IsSet, 'Future C (multi-chained) should be done.'); // Static string [cite: 148, 55] + + finalResult := futC.Result; // [cite: 148] + // Ensure FloatToStr conversion is consistent for comparison + Assert.AreEqual('Final: ' + FloatToStr(25.0), finalResult, 'Multi-chained Future result is incorrect.'); // Static string +end; + +[Test] +[TestCase('StringFutureTest', 'Test String')] +[TestCase('IntegerFutureTestForParam', '12345')] +procedure TTestFuture.TestConstructSimple_Parametric(const ParamValue: string); +var + fut: Future; + resultValue: string; +begin + // Parametric test for Future + fut := Future.Construct( // [cite: 146] + function: string + begin + TThread.Sleep(10); + Result := ParamValue; // Use the parameter in the future's function + end + ); + + Assert.IsNotNull(fut.Done, 'Parametric Future.Done should not be nil.'); // Static string [cite: 148] + fut.WaitFor(); // [cite: 148] + + Assert.IsTrue(fut.Done.IsSet, 'Parametric Future.Done.IsSet should be true.'); // Static string [cite: 148, 55] + resultValue := fut.Result; // [cite: 148] + Assert.AreEqual(ParamValue, resultValue, 'Parametric Future result does not match input parameter.'); // Static string +end; + +[Test] +procedure TTestFuture.TestStress_StateAll; +const + StressTestFutureCount = 100; // Number of futures for the stress test +var + futures: TArray>; + doneStates: TArray; + combinedStateAll: IMycState; + masterFuture: Future; + i: Integer; +begin + SetLength(futures, StressTestFutureCount); + SetLength(doneStates, StressTestFutureCount); + Randomize; // Initialize random number generator for varied delays + + // Create multiple futures, each with a small random delay + for i := 0 to High(futures) do begin - if E.Message = CExceptionMessage then - LExpectedExceptionRaisedByFactory := True; + // Capture loop variable for use in anonymous method + futures[i] := Future.Construct( // [cite: 146] + (function(captureIndex: Integer): TFunc + begin + Result := function: Integer + var + delay: Integer; + begin + delay := 10 + Random(40); // Random delay between 10ms and 49ms + TThread.Sleep(delay); + Result := captureIndex; // Return the captured index + end; + end)(i) + ); + doneStates[i] := futures[i].Done; // [cite: 148] end; - end; - Assert.IsTrue(LFuture.Done.IsSet, 'Future should be done even if AProc raised an exception.'); - Assert.AreEqual(1, FProcExecutionCount, 'AProc (which raised) should have been executed once.'); + combinedStateAll := State.All(doneStates); // [cite: 67] + Assert.IsNotNull(combinedStateAll, 'State.All should return a valid IMycState.'); // Static string - LResultValue := LFuture.GetResult; - Assert.AreEqual(Default(Integer), LResultValue, 'GetResult should return Default(T) when AProc raises an exception.'); + // Create a master future that waits on the combined State.All state + masterFuture := Future.Construct(combinedStateAll, // [cite: 147] + function: Boolean + begin + Result := True; // This function executes when combinedStateAll is set + end + ); + masterFuture.WaitFor(); // Wait for all futures to complete via the master future [cite: 148] - if not LExpectedExceptionRaisedByFactory then - begin - try - LLocalTaskFactory.Teardown; // This should re-raise the exception [cite: 108, 234, 352] - except - on E: Exception do - begin - Assert.AreEqual(CExceptionMessage, E.Message, 'TaskFactory did not re-raise the correct exception message on Teardown.'); - LExpectedExceptionRaisedByFactory := True; - end; + Assert.IsTrue(combinedStateAll.IsSet, 'Combined State.All should be set after masterFuture.WaitFor().'); // Static string [cite: 55] + + // Verify all individual futures are done and their results are correct + for i := 0 to High(futures) do + begin + Assert.IsTrue(futures[i].Done.IsSet, 'An individual future was not set after State.All completed.'); // Static string [cite: 148, 55] + if futures[i].Done.IsSet then // Additional check to safely access Result + begin + Assert.AreEqual(i, futures[i].Result, 'A future''s result was incorrect in State.All stress test.'); // Static string [cite: 148] + end; end; - Assert.IsTrue(LExpectedExceptionRaisedByFactory, 'TaskFactory Teardown did not raise any exception as expected.'); - end; - - if LExpectedExceptionRaisedByFactory then // Factory was torn down (implicitly or explicitly) and did its job - LLocalTaskFactory := nil - else if Assigned(LLocalTaskFactory) then // Teardown didn't raise as expected, or wasn't called due to earlier exception path - begin - LLocalTaskFactory.Teardown; // Ensure it's torn down if test logic failed to confirm exception - LLocalTaskFactory := nil; - end; end; -procedure TTestMycInitStateFuncFuture.Test_GetResult_BeforeDone_RaisesException; -var - LFuture: IMycFuture; - LInitLatch: IMycLatch; -begin - LInitLatch := State.CreateLatch(1); - - LFuture := TMycInitStateFuncFuture.Create(FTaskFactory, LInitLatch.State, - function: Integer - begin - Inc(Self.FProcExecutionCount); - Result := 123; - end); - - Assert.IsFalse(LFuture.Done.IsSet, 'Future should not be marked as done initially.'); - - Assert.WillRaise( - procedure - begin - LFuture.GetResult; - end ); - - LInitLatch.Notify; - - FTaskFactory.WaitFor(LFuture.Done); - - Assert.WillNotRaise( - procedure - begin - LFuture.GetResult; - end ); -end; - -procedure TTestMycInitStateFuncFuture.Test_FanIn_OneFutureWaitsForMultipleOthers; -var - LPrerequisiteFuture1, LPrerequisiteFuture2: IMycFuture; - LMainFuture: IMycFuture; - LGateLatch: IMycLatch; - LSub1, LSub2: IMycSubscriber; // To hold the TLatchNotifierSubscriber instances - LInitStateP1, LInitStateP2: IMycLatch; - Subscriptions: array[1..2] of TMycSubscription; // To manage subscriptions +[Test] +procedure TTestFuture.TestStress_StateAny; const - CMainFutureResult = 'AllPrerequisitesCompleted'; -begin - FProcExecutionCount := 0; // Reset for this test - - // Gate Latch: MainFuture waits for this latch, which needs 2 notifications. - LGateLatch := State.CreateLatch(2); // [cite: 77, 212, 330] - - // Create MainFuture, AInitState is the GateLatch's state. - LMainFuture := TMycInitStateFuncFuture.Create(FTaskFactory, LGateLatch.State, - function: string - begin - Inc(Self.FProcExecutionCount, 10); // Indicate MainFuture's proc ran - Result := CMainFutureResult; - end); - - // Setup Prerequisite Futures - // PrerequisiteFuture1 - LInitStateP1 := State.CreateLatch(1); // Controllable init state for PF1 - LPrerequisiteFuture1 := TMycInitStateFuncFuture.Create(FTaskFactory, LInitStateP1.State, - function: Integer - begin - Inc(Self.FProcExecutionCount, 1); // PF1 ran - Result := 1; - end); - LSub1 := TLatchNotifierSubscriber.Create(LGateLatch); - Subscriptions[1] := LPrerequisiteFuture1.Done.Subscribe(LSub1); // Subscribe to PF1's completion [cite: 56, 188, 306] - - // PrerequisiteFuture2 - LInitStateP2 := State.CreateLatch(1); // Controllable init state for PF2 - LPrerequisiteFuture2 := TMycInitStateFuncFuture.Create(FTaskFactory, LInitStateP2.State, - function: Integer - begin - Inc(Self.FProcExecutionCount, 1); // PF2 ran - Result := 2; - end); - LSub2 := TLatchNotifierSubscriber.Create(LGateLatch); - Subscriptions[2] := LPrerequisiteFuture2.Done.Subscribe(LSub2); // Subscribe to PF2's completion - - // --- Execution & Verification --- - Assert.IsFalse(LMainFuture.Done.IsSet, 'MainFuture should not be done yet.'); - Assert.AreEqual(0, FProcExecutionCount, 'No AProc should have executed yet.'); - - // Trigger PrerequisiteFuture1 - LInitStateP1.Notify; // - FTaskFactory.WaitFor(LPrerequisiteFuture1.Done); // Ensure PF1 completes and notifies GateLatch - Assert.IsFalse(LGateLatch.State.IsSet, 'GateLatch should not be set after only one prerequisite.'); - Assert.IsFalse(LMainFuture.Done.IsSet, 'MainFuture should still not be done.'); - Assert.AreEqual(1, FProcExecutionCount mod 10, 'Only PF1 AProc should have run.'); - - - // Trigger PrerequisiteFuture2 - LInitStateP2.Notify; // - FTaskFactory.WaitFor(LPrerequisiteFuture2.Done); // Ensure PF2 completes and notifies GateLatch - - // Now GateLatch should be set, and MainFuture should execute - FTaskFactory.WaitFor(LMainFuture.Done); - - Assert.IsTrue(LGateLatch.State.IsSet, 'GateLatch should be set after both prerequisites.'); - Assert.IsTrue(LMainFuture.Done.IsSet, 'MainFuture should be done now.'); - Assert.AreEqual(12, FProcExecutionCount, 'All AProcs (PF1, PF2, Main) should have run.'); // 1+1+10 - Assert.AreEqual(CMainFutureResult, LMainFuture.GetResult, 'MainFuture returned an unexpected result.'); - - // Clean up subscriptions explicitly, though ARC + managed records handle much - Subscriptions[1].Unsubscribe; // [cite: 52, 186, 304] - Subscriptions[2].Unsubscribe; // -end; - -procedure TTestMycInitStateFuncFuture.Test_FanOut_MultipleFuturesWaitForOneTrigger; + StressTestFutureCount = 50; // Number of futures for the stress test + QuickFutureIndex = StressTestFutureCount div 3; // Designate one future to be quicker var - LTriggerLatch: IMycLatch; - LFutureA, LFutureB: IMycFuture; - LFlagFutureARan, LFlagFutureBRan: Boolean; + futures: TArray>; + doneStates: TArray; + combinedStateAny: IMycState; + masterFuture: Future; + i: Integer; + isAtLeastOneSet: Boolean; begin - LFlagFutureARan := False; - LFlagFutureBRan := False; - Self.FSharedCounter := 0; // Reset shared counter for this test + SetLength(futures, StressTestFutureCount); + SetLength(doneStates, StressTestFutureCount); + Randomize; // Initialize random number generator - LTriggerLatch := State.CreateLatch(1); // Single trigger [cite: 77, 212, 330] - - // Future A - LFutureA := TMycInitStateFuncFuture.Create(FTaskFactory, LTriggerLatch.State, - function: Integer + // Create multiple futures, one of which is designed to finish quickly + for i := 0 to High(futures) do begin - LFlagFutureARan := True; - System.SyncObjs.TInterlocked.Increment(Self.FSharedCounter); // Thread-safe increment - Result := 100; - end); + // Capture loop variable + futures[i] := Future.Construct( // [cite: 146] + (function(captureIndex: Integer): TFunc + begin + Result := function: Integer + var + delay: Integer; + begin + if captureIndex = QuickFutureIndex then + delay := 5 // Short delay for the 'quick' future + else + delay := 50 + Random(100); // Longer random delay (50-149ms) for others + TThread.Sleep(delay); + Result := captureIndex; + end; + end)(i) + ); + doneStates[i] := futures[i].Done; // [cite: 148] + end; - // Future B - LFutureB := TMycInitStateFuncFuture.Create(FTaskFactory, LTriggerLatch.State, - function: Integer + combinedStateAny := State.Any(doneStates); // [cite: 68] + Assert.IsNotNull(combinedStateAny, 'State.Any should return a valid IMycState.'); // Static string + + // Create a master future that waits on the combined State.Any state + masterFuture := Future.Construct(combinedStateAny, // [cite: 147] + function: Boolean + begin + Result := True; // This function executes when combinedStateAny is set + end + ); + masterFuture.WaitFor(); // Wait for at least one future to complete [cite: 148] + + Assert.IsTrue(combinedStateAny.IsSet, 'Combined State.Any should be set after masterFuture.WaitFor().'); // Static string [cite: 55] + + // Verify that at least one of the original futures is now set + isAtLeastOneSet := False; + for i := 0 to High(futures) do begin - LFlagFutureBRan := True; - System.SyncObjs.TInterlocked.Increment(Self.FSharedCounter); // Thread-safe increment - Result := 200; - end); + if futures[i].Done.IsSet then // [cite: 148, 55] + begin + isAtLeastOneSet := True; + end; + end; + Assert.IsTrue(isAtLeastOneSet, 'At least one underlying future should be set after State.Any completed.'); // Static string - Assert.IsFalse(LFutureA.Done.IsSet, 'FutureA should not be done yet.'); - Assert.IsFalse(LFutureB.Done.IsSet, 'FutureB should not be done yet.'); - Assert.AreEqual(0, Self.FSharedCounter, 'No future AProcs should have executed yet.'); - - // Trigger the common latch - LTriggerLatch.Notify; // [cite: 80, 215, 333] - - // Wait for both futures to complete - FTaskFactory.WaitFor(LFutureA.Done); - FTaskFactory.WaitFor(LFutureB.Done); - - Assert.IsTrue(LFutureA.Done.IsSet, 'FutureA should be done.'); - Assert.IsTrue(LFutureB.Done.IsSet, 'FutureB should be done.'); - Assert.IsTrue(LFlagFutureARan, 'FutureA AProc should have run.'); - Assert.IsTrue(LFlagFutureBRan, 'FutureB AProc should have run.'); - Assert.AreEqual(2, Self.FSharedCounter, 'Both future AProcs should have incremented the counter.'); - Assert.AreEqual(100, LFutureA.GetResult, 'FutureA GetResult value mismatch.'); - Assert.AreEqual(200, LFutureB.GetResult, 'FutureB GetResult value mismatch.'); + // It's good practice to ensure all futures complete + for i := 0 to High(futures) do + begin + if not futures[i].Done.IsSet then // [cite: 148, 55] + begin + futures[i].WaitFor(); // Wait for any remaining futures [cite: 148] + end; + end; +end; + +[Test] +procedure TTestFuture.TestNestedFuture_Construct; +var + outerFuture: Future>; + innerFuture: Future; + finalResult: Integer; +begin + // Create an outer future that, when resolved, produces another (inner) future. + outerFuture := Future>.Construct( // [cite: 146] + function: Future // This lambda returns a Future + begin + TThread.Sleep(10); // Simulate work for the outer future to produce the inner one + Result := Future.Construct( // [cite: 146] + function: Integer + begin + TThread.Sleep(10); // Simulate work for the inner future + Result := 123; // The final value + end + ); + end + ); + + Assert.IsNotNull(outerFuture.Done, 'Outer future''s Done state should not be nil.'); // Static string [cite: 148] + outerFuture.WaitFor(); // Wait for the outer future to complete and yield the inner future [cite: 148] + Assert.IsTrue(outerFuture.Done.IsSet, 'Outer future should be done after WaitFor.'); // Static string [cite: 148, 55] + + innerFuture := outerFuture.Result; // Retrieve the inner future [cite: 148] + Assert.IsNotNull(innerFuture.Done, 'Inner future (from outer.Result) should have a non-nil Done state.'); // Static string [cite: 148] + + innerFuture.WaitFor(); // Wait for the inner future to complete and yield the final result [cite: 148] + Assert.IsTrue(innerFuture.Done.IsSet, 'Inner future should be done after its WaitFor.'); // Static string [cite: 148, 55] + + finalResult := innerFuture.Result; // Retrieve the final integer result [cite: 148] + Assert.AreEqual(123, finalResult, 'Nested future final result from Construct is incorrect.'); // Static string +end; + +[Test] +procedure TTestFuture.TestNestedFuture_Chain; +var + initialFuture: Future; + outerChainedFuture: Future>; // Future where S is Future + innerStringFuture: Future; + finalResult: string; +begin + // Create an initial future + initialFuture := Future.Construct( // [cite: 146] + function: Integer + begin + TThread.Sleep(10); + Result := 77; + end + ); + + // Chain it with a function that itself returns a new Future + outerChainedFuture := initialFuture.Chain>( // [cite: 147] + function(Input: Integer): Future // This lambda returns a Future + begin + TThread.Sleep(10); // Simulate work in the chain function + // Input is the result of initialFuture (77) + Result := Future.Construct( // [cite: 146] + function: string + begin + TThread.Sleep(10); // Simulate work for the inner-most future + Result := 'Value: ' + Input.ToString; // Input is captured (77) + end + ); + end + ); + + Assert.IsNotNull(outerChainedFuture.Done, 'Outer chained future''s Done state should not be nil.'); // Static string [cite: 148] + outerChainedFuture.WaitFor(); // Wait for initialFuture to complete AND the chain function to execute [cite: 148] + Assert.IsTrue(outerChainedFuture.Done.IsSet, 'Outer chained future should be done after WaitFor.'); // Static string [cite: 148, 55] + + innerStringFuture := outerChainedFuture.Result; // Get the Future produced by the chain function [cite: 148] + Assert.IsNotNull(innerStringFuture.Done, 'Inner string future (from chain) should have a non-nil Done state.'); // Static string [cite: 148] + + innerStringFuture.WaitFor(); // Wait for the inner Future to complete [cite: 148] + Assert.IsTrue(innerStringFuture.Done.IsSet, 'Inner string future should be done after its WaitFor.'); // Static string [cite: 148, 55] + + finalResult := innerStringFuture.Result; // Get the final string result [cite: 148] + Assert.AreEqual('Value: 77', finalResult, 'Nested future (via Chain) final result is incorrect.'); // Static string end; -initialization - // For DUnitX, attributes typically handle registration. - // If needed for older DUnit: RegisterTest(TTestMycInitStateFuncFuture.Suite); end.