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, TSignal.ISubscriber) private FGateLatch: TLatch.ILatch; public constructor Create(AGateLatch: TLatch.ILatch); // TSignal.ISubscriber function Notify: Boolean; // Implements TSignal.ISubscriber.Notify [cite: 46, 181, 299] end; [TestFixture] [IgnoreMemoryLeaks(true)] TTestMycGateFuncFuture = class(TObject) private FTaskFactory: IThreadPool; 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: TLatch.ILatch); 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; { TTestMycGateFuncFuture } procedure TTestMycGateFuncFuture.Setup; begin FTaskFactory := TMycTaskFactory.Create; // Create a new task factory instance for each test [cite: 113, 235, 353] FProcExecutionCount := 0; FSharedCounter := 0; end; procedure TTestMycGateFuncFuture.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 TTestMycGateFuncFuture.Test_BasicSuccess_WithImmediateInitState; var LFuture: TFuture.IFuture; LInitStateAsState: TState.IState; // 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 := TState.Null; LFuture := TMycGateFuncFuture.Create( FTaskFactory, LInitStateAsState, function: Integer begin Inc(Self.FProcExecutionCount); Result := CExpectedResult; end ); FTaskFactory.WaitFor(LFuture.Done); // Accesses IFuture.GetDone [cite: 110, 234, 352] Assert.IsTrue(LFuture.Done.IsSet, 'Future should be marked as done.'); // Accesses TState.IState.IsSet [cite: 57, 194, 312] Assert.AreEqual(1, FProcExecutionCount, 'AProc should have been executed once.'); LResultValue := LFuture.GetValue; // Accesses IFuture.GetResult Assert.AreEqual(CExpectedResult, LResultValue, 'GetResult returned an unexpected value.'); end; procedure TTestMycGateFuncFuture.Test_ChainedExecution_WithDelayedInitState; var LFuture: tFuture.IFuture; LInitLatch: TLatch.ILatch; LResultValue: string; const CExpectedResult = 'ChainCompleted'; begin LInitLatch := TLatch.CreateLatch(1); // Create an init state that is not yet set [cite: 77, 212, 330] LFuture := TMycGateFuncFuture.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.Value; Assert.AreEqual(CExpectedResult, LResultValue, 'GetResult returned an unexpected value after delayed init.'); end; procedure TTestMycGateFuncFuture.Test_ExceptionInProc_HandledAsPlanned; var LFuture: TFuture.IFuture; LLocalTaskFactory: IThreadPool; LInitStateAsState: TState.IState; LResultValue: Integer; LExpectedExceptionRaisedByFactory: Boolean; const CExceptionMessage = 'Test exception from AProc'; begin LExpectedExceptionRaisedByFactory := False; LLocalTaskFactory := TMycTaskFactory.Create; LInitStateAsState := TState.Null; // Immediate execution LFuture := TMycGateFuncFuture.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.Value; 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 TTestMycGateFuncFuture.Test_GetResult_BeforeDone_RaisesException; var LFuture: TFuture.IFuture; LInitLatch: TLatch.ILatch; begin LInitLatch := TLatch.CreateLatch(1); LFuture := TMycGateFuncFuture.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.Value; end); LInitLatch.Notify; FTaskFactory.WaitFor(LFuture.Done); Assert.WillNotRaise(procedure begin LFuture.Value; end); end; procedure TTestMycGateFuncFuture.Test_FanIn_OneFutureWaitsForMultipleOthers; var LPrerequisiteFuture1, LPrerequisiteFuture2: TFuture.IFuture; LMainFuture: TFuture.IFuture; LGateLatch: TLatch.ILatch; LSub1, LSub2: TSignal.ISubscriber; // To hold the TLatchNotifierSubscriber instances LInitStateP1, LInitStateP2: TLatch.ILatch; Subscriptions: array[1..2] of TSignal.TSubscription; // 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 := TLatch.CreateLatch(2); // [cite: 77, 212, 330] // Create MainFuture, AInitState is the GateLatch's state. LMainFuture := TMycGateFuncFuture.Create( FTaskFactory, LGateLatch.State, function: string begin Inc(Self.FProcExecutionCount, 10); // Indicate MainFuture's proc ran Result := CMainFutureResult; end ); // Setup Prerequisite Futures // PrerequisiteFuture1 LInitStateP1 := TLatch.CreateLatch(1); // Controllable init state for PF1 LPrerequisiteFuture1 := TMycGateFuncFuture.Create( FTaskFactory, LInitStateP1.State, function: Integer begin Inc(Self.FProcExecutionCount, 1); // PF1 ran Result := 1; end ); LSub1 := TLatchNotifierSubscriber.Create(LGateLatch); Subscriptions[1] := LPrerequisiteFuture1.Done.Signal.Subscribe(LSub1); // Subscribe to PF1's completion [cite: 56, 188, 306] // PrerequisiteFuture2 LInitStateP2 := TLatch.CreateLatch(1); // Controllable init state for PF2 LPrerequisiteFuture2 := TMycGateFuncFuture.Create( FTaskFactory, LInitStateP2.State, function: Integer begin Inc(Self.FProcExecutionCount, 1); // PF2 ran Result := 2; end ); LSub2 := TLatchNotifierSubscriber.Create(LGateLatch); Subscriptions[2] := LPrerequisiteFuture2.Done.Signal.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.Value, '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 TTestMycGateFuncFuture.Test_FanOut_MultipleFuturesWaitForOneTrigger; var LTriggerLatch: TLatch.ILatch; LFutureA, LFutureB: TFuture.IFuture; LFlagFutureARan, LFlagFutureBRan: Boolean; begin LFlagFutureARan := False; LFlagFutureBRan := False; Self.FSharedCounter := 0; // Reset shared counter for this test LTriggerLatch := TLatch.CreateLatch(1); // Single trigger [cite: 77, 212, 330] // Future A LFutureA := TMycGateFuncFuture.Create( FTaskFactory, LTriggerLatch.State, function: Integer begin LFlagFutureARan := True; System.SyncObjs.TInterlocked.Increment(Self.FSharedCounter); // Thread-safe increment Result := 100; end ); // Future B LFutureB := TMycGateFuncFuture.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.Value, 'FutureA Value value mismatch.'); Assert.AreEqual(200, LFutureB.Value, 'FutureB Value value mismatch.'); end; initialization // For DUnitX, attributes typically handle registration. // If needed for older DUnit: RegisterTest(TTestMycGateFuncFuture.Suite); end.