Files
MycLib/Test/TestFutures.pas
T
Michael Schimmel 63484cd495 added Futures
2025-06-02 00:45:30 +02:00

371 lines
14 KiB
ObjectPascal

unit TestFutures;
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; // 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<Integer>;
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 := TMycLatch.Null.State; // Get IMycState from IMycLatch [cite: 61, 196, 314]
LFuture := TMycInitStateFuncFuture<Integer>.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<string>;
LInitLatch: IMycLatch;
LResultValue: string;
const
CExpectedResult = 'ChainCompleted';
begin
LInitLatch := TMycLatch.CreateLatch(1); // Create an init state that is not yet set [cite: 77, 212, 330]
LFuture := TMycInitStateFuncFuture<string>.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<Integer>;
LLocalTaskFactory: IMycTaskFactory;
LInitStateAsState: IMycState;
LResultValue: Integer;
LExpectedExceptionRaisedByFactory: Boolean;
const
CExceptionMessage = 'Test exception from AProc';
begin
LExpectedExceptionRaisedByFactory := False;
LLocalTaskFactory := TMycTaskFactory.Create;
LInitStateAsState := TMycLatch.Null.State; // Immediate execution
LFuture := TMycInitStateFuncFuture<Integer>.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<Integer>;
LInitLatch: IMycLatch;
LExpectedExceptionRaised: Boolean;
const
CExpectedExceptionMessage = 'Result is not yet available for the future.';
begin
LExpectedExceptionRaised := False;
LInitLatch := TMycLatch.CreateLatch(1); // Create a latch that is not yet set [cite: 77, 212, 330]
LFuture := TMycInitStateFuncFuture<Integer>.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.');
try
LFuture.GetResult;
except
on E: Exception do
begin
Assert.AreEqual(CExpectedExceptionMessage, E.Message, 'Exception message mismatch.');
LExpectedExceptionRaised := True;
end;
end;
Assert.IsTrue(LExpectedExceptionRaised, 'Calling GetResult before done should raise an exception.');
LInitLatch.Notify; // [cite: 80, 215, 333]
FTaskFactory.WaitFor(LFuture.Done); //
end;
procedure TTestMycInitStateFuncFuture.Test_FanIn_OneFutureWaitsForMultipleOthers;
var
LPrerequisiteFuture1, LPrerequisiteFuture2: IMycFuture<Integer>;
LMainFuture: IMycFuture<string>;
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 := TMycLatch.CreateLatch(2); // [cite: 77, 212, 330]
// Create MainFuture, AInitState is the GateLatch's state.
LMainFuture := TMycInitStateFuncFuture<string>.Create(FTaskFactory, LGateLatch.State,
function: string
begin
Inc(Self.FProcExecutionCount, 10); // Indicate MainFuture's proc ran
Result := CMainFutureResult;
end);
// Setup Prerequisite Futures
// PrerequisiteFuture1
LInitStateP1 := TMycLatch.CreateLatch(1); // Controllable init state for PF1
LPrerequisiteFuture1 := TMycInitStateFuncFuture<Integer>.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 := TMycLatch.CreateLatch(1); // Controllable init state for PF2
LPrerequisiteFuture2 := TMycInitStateFuncFuture<Integer>.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<Integer>;
LFlagFutureARan, LFlagFutureBRan: Boolean;
begin
LFlagFutureARan := False;
LFlagFutureBRan := False;
Self.FSharedCounter := 0; // Reset shared counter for this test
LTriggerLatch := TMycLatch.CreateLatch(1); // Single trigger [cite: 77, 212, 330]
// Future A
LFutureA := TMycInitStateFuncFuture<Integer>.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<Integer>.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.