Brummel/MycLib
1
0
Fork 0
Code Issues 1 Pull Requests Actions Packages Projects 1 Releases Wiki Activity

Future<T> helper record

Browse Source
This commit is contained in:
Michael Schimmel
2025-06-02 14:27:00 +02:00
parent 48f4c945ce
commit e7e26f2a12
8 changed files with 1269 additions and 322 deletions
Download Patch File Download Diff File Expand all files Collapse all files
Src/Myc.Core.Signals.pas
+362
View File
@@ -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<IMycSubscriber>.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<IMycSubscriber>.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<IMycSubscriber>; // 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<IMycSubscriber>.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<IMycSubscriber>; // 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<IMycSubscriber>.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<IMycSubscriber>.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<IMycSubscriber>.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<IMycSubscriber>.TTag);
begin
if Tag = nil then
exit;
FSubscribers.Lock;
try
FSubscribers.Unadvise(Tag);
finally
FSubscribers.Release;
end;
end;
end.
Src/Myc.Core.Tasks.pas
+1 -7
View File
@@ -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;
Src/Myc.Futures.pas
+48 -10
View File
@@ -22,14 +22,26 @@ type
Future<T> = record
strict private
FFuture: IMycFuture<T>;
function GetDone: IMycState; inline;
function GetResult: T; inline;
class constructor CreateClass;
class destructor DestroyClass;
constructor Create(const AFuture: IMycFuture<T>);
public
class function Construct(const Proc: TFunc<T>): Future<T>; overload; static;
class function Construct(const Gate: IMycState; const Proc: TFunc<T>): Future<T>; overload; static;
function Chain<S>(const Proc: TFunc<T, S>): Future<S>;
public
constructor Create(const AFuture: IMycFuture<T>);
class operator Implicit(const A: IMycFuture<T>): Future<T>; overload;
class operator Implicit(const A: Future<T>): IMycFuture<T>; overload;
class function Construct(const Proc: TFunc<T>): IMycFuture<T>; overload; static;
class function Construct(const Gate: IMycState; const Proc: TFunc<T>): IMycFuture<T>; overload; static;
function Chain<S>(const Proc: TFunc<T, S>): IMycFuture<S>;
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<T>.Chain<S>(const Proc: TFunc<T, S>): Future<S>;
function Future<T>.Chain<S>(const Proc: TFunc<T, S>): IMycFuture<S>;
begin
var Cap := FFuture;
@@ -63,14 +75,40 @@ begin
end );
end;
class function Future<T>.Construct(const Proc: TFunc<T>): Future<T>;
class function Future<T>.Construct(const Proc: TFunc<T>): IMycFuture<T>;
begin
Result.Create( TMycInitStateFuncFuture<T>.Create( TaskManager, nil, Proc ) );
Result := TMycInitStateFuncFuture<T>.Create( TaskManager, nil, Proc );
end;
class function Future<T>.Construct(const Gate: IMycState; const Proc: TFunc<T>): Future<T>;
class function Future<T>.Construct(const Gate: IMycState; const Proc: TFunc<T>): IMycFuture<T>;
begin
Result.Create( TMycInitStateFuncFuture<T>.Create( TaskManager, Gate, Proc ) );
Result := TMycInitStateFuncFuture<T>.Create( TaskManager, Gate, Proc );
end;
function Future<T>.GetDone: IMycState;
begin
Result := FFuture.Done;
end;
function Future<T>.GetResult: T;
begin
Result := FFuture.Result;
end;
function Future<T>.WaitFor: T;
begin
TaskManager.WaitFor( FFuture.Done );
Result := FFuture.Result;
end;
class operator Future<T>.Implicit(const A: IMycFuture<T>): Future<T>;
begin
Result.Create( A );
end;
class operator Future<T>.Implicit(const A: Future<T>): IMycFuture<T>;
begin
Result := A.FFuture;
end;
end.
Src/Myc.TaskManager.pas
+7
View File
@@ -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
Test/MycTests.dpr
+3 -2
View File
@@ -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}
Test/MycTests.dproj
+2 -1
View File
@@ -123,10 +123,11 @@ $(PostBuildEvent)]]></PostBuildEvent>
<DCCReference Include="TestTasks.pas"/>
<DCCReference Include="TestSignals_Dirty.pas"/>
<DCCReference Include="..\Src\Myc.Futures.pas"/>
<DCCReference Include="TestFutures.pas"/>
<DCCReference Include="TestCoreFutures.pas"/>
<DCCReference Include="..\Src\Myc.TaskManager.pas"/>
<DCCReference Include="..\Src\Myc.Core.Futures.pas"/>
<DCCReference Include="..\Src\Myc.Core.Signals.pas"/>
<DCCReference Include="TestFutures.pas"/>
<BuildConfiguration Include="Base">
<Key>Base</Key>
</BuildConfiguration>
Test/TestCoreFutures.pas
+368
View File
@@ -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<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 := State.Null;
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 := State.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 := State.Null; // 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;
begin
LInitLatch := State.CreateLatch(1);
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.');
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<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 := State.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 := State.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 := State.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 := State.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.
Test/TestFutures.pas
+478 -302
View File
@@ -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<T>
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<Future<T>> via Construct
[Test]
procedure TestNestedFuture_Chain; // New test for Future<Future<T>> 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<Integer>;
LInitStateAsState: IMycState; // Parameter for Create
LResultValue: Integer;
const
CExpectedResult = 42;
fut: Future<Integer>;
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<Integer>.Construct( // [cite: 146]
function: Integer
begin
TThread.Sleep(20); // Simulate some background work
Result := 42;
end
);
LFuture := TMycInitStateFuncFuture<Integer>.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<string>;
LInitLatch: IMycLatch;
LResultValue: string;
const
CExpectedResult = 'ChainCompleted';
fut: Future<Integer>;
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<Integer>.Construct(nil, // Explicitly providing a nil gate [cite: 147]
function: Integer
begin
TThread.Sleep(20); // Simulate work
Result := 43;
end
);
LFuture := TMycInitStateFuncFuture<string>.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<Integer>;
LLocalTaskFactory: IMycTaskFactory;
LInitStateAsState: IMycState;
LResultValue: Integer;
LExpectedExceptionRaisedByFactory: Boolean;
const
CExceptionMessage = 'Test exception from AProc';
fut: Future<Integer>;
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<Integer>.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<Integer>.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<Integer>;
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<Integer>.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<Integer>;
fut2: Future<string>;
resultValue: string;
begin
// Create an initial future
fut1 := Future<Integer>.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<string>( // [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<Integer>;
fut2: Future<string>;
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<Integer>.Construct(delayedGate.State, // [cite: 147, 59]
function: Integer
begin
Result := 200;
end
);
// Second future is chained to the first
fut2 := fut1.Chain<string>( // [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<Integer>;
futB: Future<Real>; // Using Real for intermediate type
futC: Future<string>; // Final result as string
finalResult: string;
begin
// Initial future A
futA := Future<Integer>.Construct( // [cite: 146]
function: Integer
begin
TThread.Sleep(10);
Result := 10;
end
);
// Future B, chained from A
futB := futA.Chain<Real>( // [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<string>( // [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<string>;
resultValue: string;
begin
// Parametric test for Future<string>
fut := Future<string>.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<Future<Integer>>;
doneStates: TArray<IMycState>;
combinedStateAll: IMycState;
masterFuture: Future<Boolean>;
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<Integer>.Construct( // [cite: 146]
(function(captureIndex: Integer): TFunc<Integer>
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<Boolean>.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<Integer>;
LInitLatch: IMycLatch;
begin
LInitLatch := State.CreateLatch(1);
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.');
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<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
[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<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 := State.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 := State.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;
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<Integer>;
LFlagFutureARan, LFlagFutureBRan: Boolean;
futures: TArray<Future<Integer>>;
doneStates: TArray<IMycState>;
combinedStateAny: IMycState;
masterFuture: Future<Boolean>;
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<Integer>.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<Integer>.Construct( // [cite: 146]
(function(captureIndex: Integer): TFunc<Integer>
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<Integer>.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<Boolean>.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<Future<Integer>>;
innerFuture: Future<Integer>;
finalResult: Integer;
begin
// Create an outer future that, when resolved, produces another (inner) future.
outerFuture := Future<Future<Integer>>.Construct( // [cite: 146]
function: Future<Integer> // This lambda returns a Future<Integer>
begin
TThread.Sleep(10); // Simulate work for the outer future to produce the inner one
Result := Future<Integer>.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<Integer>;
outerChainedFuture: Future<Future<string>>; // Future<S> where S is Future<string>
innerStringFuture: Future<string>;
finalResult: string;
begin
// Create an initial future
initialFuture := Future<Integer>.Construct( // [cite: 146]
function: Integer
begin
TThread.Sleep(10);
Result := 77;
end
);
// Chain it with a function that itself returns a new Future<string>
outerChainedFuture := initialFuture.Chain<Future<string>>( // [cite: 147]
function(Input: Integer): Future<string> // This lambda returns a Future<string>
begin
TThread.Sleep(10); // Simulate work in the chain function
// Input is the result of initialFuture (77)
Result := Future<string>.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<string> 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<string> 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.