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

Code formatting

Browse Source
This commit is contained in:
Michael Schimmel
2025-06-05 10:26:28 +02:00
parent f033ef2c0f
commit 6bed68748d
22 changed files with 1884 additions and 1743 deletions
Download Patch File Download Diff File Expand all files Collapse all files
Test/MycTests.dpr
+66 -66
View File
@@ -1,87 +1,87 @@
program MycTests;
{$IFNDEF TESTINSIGHT}
{$APPTYPE CONSOLE}
{$APPTYPE CONSOLE}
{$ENDIF}
{$STRONGLINKTYPES ON}
uses
FastMM5,
DUnitX.MemoryLeakMonitor.FastMM5,
System.SysUtils,
{$IFDEF TESTINSIGHT}
TestInsight.DUnitX,
{$ELSE}
DUnitX.Loggers.Console,
{$ENDIF }
DUnitX.TestFramework,
TestNotifier in 'TestNotifier.pas',
TestNotifier_Threading in 'TestNotifier_Threading.pas' {/TestNotifier_ChaosStress in 'TestNotifier_ChaosStress.pas',},
TestNotifier_ChaosStress in 'TestNotifier_ChaosStress.pas',
TestSignals_Latch in 'TestSignals_Latch.pas',
Myc.Core.Tasks in '..\Src\Myc.Core.Tasks.pas',
TestTasks in 'TestTasks.pas',
TestSignals_Dirty in 'TestSignals_Dirty.pas',
Myc.Futures in '..\Src\Myc.Futures.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',
TestFutures in 'TestFutures.pas',
Myc.Lazy in '..\Src\Myc.Lazy.pas',
Myc.Core.Lazy in '..\Src\Myc.Core.Lazy.pas',
Myc.Test.Core.Lazy in '..\Src\Myc.Test.Core.Lazy.pas',
Myc.Test.Lazy in '..\Src\Myc.Test.Lazy.pas',
Myc.Test.Core.Atomic in '..\Src\Myc.Test.Core.Atomic.pas';
FastMM5,
DUnitX.MemoryLeakMonitor.FastMM5,
System.SysUtils,
{$IFDEF TESTINSIGHT}
TestInsight.DUnitX,
{$ELSE}
DUnitX.Loggers.Console,
{$ENDIF }
DUnitX.TestFramework,
TestNotifier in 'TestNotifier.pas',
TestNotifier_Threading in 'TestNotifier_Threading.pas' {/TestNotifier_ChaosStress in 'TestNotifier_ChaosStress.pas',},
TestNotifier_ChaosStress in 'TestNotifier_ChaosStress.pas',
TestSignals_Latch in 'TestSignals_Latch.pas',
Myc.Core.Tasks in '..\Src\Myc.Core.Tasks.pas',
TestTasks in 'TestTasks.pas',
TestSignals_Dirty in 'TestSignals_Dirty.pas',
Myc.Futures in '..\Src\Myc.Futures.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',
TestFutures in 'TestFutures.pas',
Myc.Lazy in '..\Src\Myc.Lazy.pas',
Myc.Core.Lazy in '..\Src\Myc.Core.Lazy.pas',
Myc.Test.Core.Lazy in '..\Src\Myc.Test.Core.Lazy.pas',
Myc.Test.Lazy in '..\Src\Myc.Test.Lazy.pas',
Myc.Test.Core.Atomic in '..\Src\Myc.Test.Core.Atomic.pas';
{ keep comment here to protect the following conditional from being removed by the IDE when adding a unit }
{$IFNDEF TESTINSIGHT}
var
runner: ITestRunner;
results: IRunResults;
logger: ITestLogger;
nunitLogger : ITestLogger;
runner: ITestRunner;
results: IRunResults;
logger: ITestLogger;
nunitLogger: ITestLogger;
{$ENDIF}
begin
{$IFDEF TESTINSIGHT}
TestInsight.DUnitX.RunRegisteredTests;
TestInsight.DUnitX.RunRegisteredTests;
{$ELSE}
try
//Check command line options, will exit if invalid
TDUnitX.CheckCommandLine;
//Create the test runner
runner := TDUnitX.CreateRunner;
//Tell the runner to use RTTI to find Fixtures
runner.UseRTTI := True;
//When true, Assertions must be made during tests;
runner.FailsOnNoAsserts := False;
try
//Check command line options, will exit if invalid
TDUnitX.CheckCommandLine;
//Create the test runner
runner := TDUnitX.CreateRunner;
//Tell the runner to use RTTI to find Fixtures
runner.UseRTTI := True;
//When true, Assertions must be made during tests;
runner.FailsOnNoAsserts := False;
//tell the runner how we will log things
//Log to the console window if desired
if TDUnitX.Options.ConsoleMode <> TDunitXConsoleMode.Off then
begin
logger := TDUnitXConsoleLogger.Create(TDUnitX.Options.ConsoleMode = TDunitXConsoleMode.Quiet);
runner.AddLogger(logger);
end;
//Generate an NUnit compatible XML File
nunitLogger := TDUnitXXMLNUnitFileLogger.Create(TDUnitX.Options.XMLOutputFile);
runner.AddLogger(nunitLogger);
//tell the runner how we will log things
//Log to the console window if desired
if TDUnitX.Options.ConsoleMode <> TDunitXConsoleMode.Off then
begin
logger := TDUnitXConsoleLogger.Create(TDUnitX.Options.ConsoleMode = TDunitXConsoleMode.Quiet);
runner.AddLogger(logger);
end;
//Generate an NUnit compatible XML File
nunitLogger := TDUnitXXMLNUnitFileLogger.Create(TDUnitX.Options.XMLOutputFile);
runner.AddLogger(nunitLogger);
//Run tests
results := runner.Execute;
if not results.AllPassed then
System.ExitCode := EXIT_ERRORS;
//Run tests
results := runner.Execute;
if not results.AllPassed then
System.ExitCode := EXIT_ERRORS;
{$IFNDEF CI}
//We don't want this happening when running under CI.
if TDUnitX.Options.ExitBehavior = TDUnitXExitBehavior.Pause then
begin
System.Write('Done.. press <Enter> key to quit.');
System.Readln;
end;
//We don't want this happening when running under CI.
if TDUnitX.Options.ExitBehavior = TDUnitXExitBehavior.Pause then
begin
System.Write('Done.. press <Enter> key to quit.');
System.Readln;
end;
{$ENDIF}
except
on E: Exception do
System.Writeln(E.ClassName, ': ', E.Message);
end;
except
on E: Exception do
System.Writeln(E.ClassName, ': ', E.Message);
end;
{$ENDIF}
end.
Test/TestCoreFutures.pas
+290 -261
View File
@@ -3,50 +3,52 @@ 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
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;
// 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)]
TTestMycGateFuncFuture = 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;
[TestFixture]
[IgnoreMemoryLeaks(true)]
TTestMycGateFuncFuture = 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;
[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
@@ -54,315 +56,342 @@ implementation
constructor TLatchNotifierSubscriber.Create(AGateLatch: IMycLatch);
begin
inherited Create;
FGateLatch := AGateLatch;
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.
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;
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;
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: IMycFuture<Integer>;
LInitStateAsState: IMycState; // Parameter for Create
LResultValue: Integer;
LFuture: IMycFuture<Integer>;
LInitStateAsState: IMycState; // Parameter for Create
LResultValue: Integer;
const
CExpectedResult = 42;
CExpectedResult = 42;
begin
// Use TMycLatch.Null for an already set init state [cite: 71, 81, 206, 216, 324, 334]
LInitStateAsState := TState.Null;
// Use TMycLatch.Null for an already set init state [cite: 71, 81, 206, 216, 324, 334]
LInitStateAsState := TState.Null;
LFuture := TMycGateFuncFuture<Integer>.Create(FTaskFactory, LInitStateAsState,
function: Integer
begin
Inc(Self.FProcExecutionCount);
Result := CExpectedResult;
end);
LFuture :=
TMycGateFuncFuture<Integer>.Create(
FTaskFactory,
LInitStateAsState,
function: Integer
begin
Inc(Self.FProcExecutionCount);
Result := CExpectedResult;
end
);
FTaskFactory.WaitFor(LFuture.Done); // Accesses IMycFuture.GetDone [cite: 110, 234, 352]
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.');
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.');
LResultValue := LFuture.GetResult; // Accesses IMycFuture.GetResult
Assert.AreEqual(CExpectedResult, LResultValue, 'GetResult returned an unexpected value.');
end;
procedure TTestMycGateFuncFuture.Test_ChainedExecution_WithDelayedInitState;
var
LFuture: IMycFuture<string>;
LInitLatch: IMycLatch;
LResultValue: string;
LFuture: IMycFuture<string>;
LInitLatch: IMycLatch;
LResultValue: string;
const
CExpectedResult = 'ChainCompleted';
CExpectedResult = 'ChainCompleted';
begin
LInitLatch := TLatch.Construct(1); // Create an init state that is not yet set [cite: 77, 212, 330]
LInitLatch := TLatch.Construct(1); // Create an init state that is not yet set [cite: 77, 212, 330]
LFuture := TMycGateFuncFuture<string>.Create(FTaskFactory, LInitLatch.State,
function: string
begin
Inc(Self.FProcExecutionCount);
Result := CExpectedResult;
end);
LFuture :=
TMycGateFuncFuture<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.');
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]
LInitLatch.Notify; // Trigger the initial state [cite: 80, 215, 333]
FTaskFactory.WaitFor(LFuture.Done);
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.');
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.');
LResultValue := LFuture.GetResult;
Assert.AreEqual(CExpectedResult, LResultValue, 'GetResult returned an unexpected value after delayed init.');
end;
procedure TTestMycGateFuncFuture.Test_ExceptionInProc_HandledAsPlanned;
var
LFuture: IMycFuture<Integer>;
LLocalTaskFactory: IMycTaskFactory;
LInitStateAsState: IMycState;
LResultValue: Integer;
LExpectedExceptionRaisedByFactory: Boolean;
LFuture: IMycFuture<Integer>;
LLocalTaskFactory: IMycTaskFactory;
LInitStateAsState: IMycState;
LResultValue: Integer;
LExpectedExceptionRaisedByFactory: Boolean;
const
CExceptionMessage = 'Test exception from AProc';
CExceptionMessage = 'Test exception from AProc';
begin
LExpectedExceptionRaisedByFactory := False;
LLocalTaskFactory := TMycTaskFactory.Create;
LInitStateAsState := TState.Null; // Immediate execution
LExpectedExceptionRaisedByFactory := False;
LLocalTaskFactory := TMycTaskFactory.Create;
LInitStateAsState := TState.Null; // Immediate execution
LFuture := TMycGateFuncFuture<Integer>.Create(LLocalTaskFactory, LInitStateAsState,
function: Integer
begin
Inc(Self.FProcExecutionCount);
raise Exception.Create(CExceptionMessage);
end);
LFuture :=
TMycGateFuncFuture<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]
LLocalTaskFactory.WaitFor(LFuture.Done);
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;
on E: Exception do
begin
if E.Message = CExceptionMessage then
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;
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 TTestMycGateFuncFuture.Test_GetResult_BeforeDone_RaisesException;
var
LFuture: IMycFuture<Integer>;
LInitLatch: IMycLatch;
LFuture: IMycFuture<Integer>;
LInitLatch: IMycLatch;
begin
LInitLatch := TLatch.Construct(1);
LInitLatch := TLatch.Construct(1);
LFuture := TMycGateFuncFuture<Integer>.Create(FTaskFactory, LInitLatch.State,
function: Integer
begin
Inc(Self.FProcExecutionCount);
Result := 123;
end);
LFuture :=
TMycGateFuncFuture<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.IsFalse(LFuture.Done.IsSet, 'Future should not be marked as done initially.');
Assert.WillRaise(
procedure
begin
LFuture.GetResult;
end );
Assert.WillRaise(procedure begin LFuture.GetResult; end);
LInitLatch.Notify;
LInitLatch.Notify;
FTaskFactory.WaitFor(LFuture.Done);
FTaskFactory.WaitFor(LFuture.Done);
Assert.WillNotRaise(
procedure
begin
LFuture.GetResult;
end );
Assert.WillNotRaise(procedure begin LFuture.GetResult; end);
end;
procedure TTestMycGateFuncFuture.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 TState.TSubscription; // To manage subscriptions
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 TState.TSubscription; // To manage subscriptions
const
CMainFutureResult = 'AllPrerequisitesCompleted';
CMainFutureResult = 'AllPrerequisitesCompleted';
begin
FProcExecutionCount := 0; // Reset for this test
FProcExecutionCount := 0; // Reset for this test
// Gate Latch: MainFuture waits for this latch, which needs 2 notifications.
LGateLatch := TLatch.Construct(2); // [cite: 77, 212, 330]
// Gate Latch: MainFuture waits for this latch, which needs 2 notifications.
LGateLatch := TLatch.Construct(2); // [cite: 77, 212, 330]
// Create MainFuture, AInitState is the GateLatch's state.
LMainFuture := TMycGateFuncFuture<string>.Create(FTaskFactory, LGateLatch.State,
function: string
begin
Inc(Self.FProcExecutionCount, 10); // Indicate MainFuture's proc ran
Result := CMainFutureResult;
end);
// Create MainFuture, AInitState is the GateLatch's state.
LMainFuture :=
TMycGateFuncFuture<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 := TLatch.Construct(1); // Controllable init state for PF1
LPrerequisiteFuture1 := TMycGateFuncFuture<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]
// Setup Prerequisite Futures
// PrerequisiteFuture1
LInitStateP1 := TLatch.Construct(1); // Controllable init state for PF1
LPrerequisiteFuture1 :=
TMycGateFuncFuture<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 := TLatch.Construct(1); // Controllable init state for PF2
LPrerequisiteFuture2 := TMycGateFuncFuture<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
// PrerequisiteFuture2
LInitStateP2 := TLatch.Construct(1); // Controllable init state for PF2
LPrerequisiteFuture2 :=
TMycGateFuncFuture<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.');
// --- 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 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
// 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);
// 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.');
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; //
// 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: IMycLatch;
LFutureA, LFutureB: IMycFuture<Integer>;
LFlagFutureARan, LFlagFutureBRan: Boolean;
LTriggerLatch: IMycLatch;
LFutureA, LFutureB: IMycFuture<Integer>;
LFlagFutureARan, LFlagFutureBRan: Boolean;
begin
LFlagFutureARan := False;
LFlagFutureBRan := False;
Self.FSharedCounter := 0; // Reset shared counter for this test
LFlagFutureARan := False;
LFlagFutureBRan := False;
Self.FSharedCounter := 0; // Reset shared counter for this test
LTriggerLatch := TLatch.Construct(1); // Single trigger [cite: 77, 212, 330]
LTriggerLatch := TLatch.Construct(1); // Single trigger [cite: 77, 212, 330]
// Future A
LFutureA := TMycGateFuncFuture<Integer>.Create(FTaskFactory, LTriggerLatch.State,
function: Integer
begin
LFlagFutureARan := True;
System.SyncObjs.TInterlocked.Increment(Self.FSharedCounter); // Thread-safe increment
Result := 100;
end);
// Future A
LFutureA :=
TMycGateFuncFuture<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 := TMycGateFuncFuture<Integer>.Create(FTaskFactory, LTriggerLatch.State,
function: Integer
begin
LFlagFutureBRan := True;
System.SyncObjs.TInterlocked.Increment(Self.FSharedCounter); // Thread-safe increment
Result := 200;
end);
// Future B
LFutureB :=
TMycGateFuncFuture<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.');
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]
// Trigger the common latch
LTriggerLatch.Notify; // [cite: 80, 215, 333]
// Wait for both futures to complete
FTaskFactory.WaitFor(LFutureA.Done);
FTaskFactory.WaitFor(LFutureB.Done);
// 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.');
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(TTestMycGateFuncFuture.Suite);
// For DUnitX, attributes typically handle registration.
// If needed for older DUnit: RegisterTest(TTestMycGateFuncFuture.Suite);
end.
Test/TestFutures.pas
+269 -247
View File
@@ -16,7 +16,7 @@ uses
type
[TestFixture]
TTestFuture = class( TObject )
TTestFuture = class(TObject)
public
[Setup]
procedure Setup;
@@ -38,9 +38,9 @@ type
[Test]
procedure TestMultipleChains;
[Test]
[TestCase( 'StringFutureTest', 'Test String' )]
[TestCase( 'IntegerFutureTestForParam', '12345' )]
procedure TestConstructSimple_Parametric( const ParamValue: string );
[TestCase('StringFutureTest', 'Test String')]
[TestCase('IntegerFutureTestForParam', '12345')]
procedure TestConstructSimple_Parametric(const ParamValue: string);
[Test]
procedure TestStress_StateAll;
@@ -59,7 +59,7 @@ implementation
procedure TTestFuture.Setup;
begin
// SetupTaskManagerMock;
// SetupTaskManagerMock;
end;
procedure TTestFuture.TearDown;
@@ -74,20 +74,21 @@ var
resultValue: Integer;
begin
// Test construction with a simple function that returns an Integer
fut := TFuture<Integer>.Construct( // [cite: 146]
function: Integer
begin
TThread.Sleep( 20 ); // Simulate some background work
Result := 42;
end
);
fut :=
TFuture<Integer>.Construct( // [cite: 146]
function: Integer
begin
TThread.Sleep(20); // Simulate some background work
Result := 42;
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]
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]
Assert.IsTrue( fut.Done.IsSet, 'Future.Done.IsSet should be true after completion.' ); // Static string [cite: 148]
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
Assert.AreEqual(42, resultValue, 'The result of the future is not the expected value.'); // Static string
end;
[Test]
@@ -97,20 +98,22 @@ var
resultValue: Integer;
begin
// Test construction with a nil gate, which should execute the task immediately
fut := TFuture<Integer>.Construct( nil, // Explicitly providing a nil gate [cite: 147]
function: Integer
begin
TThread.Sleep( 20 ); // Simulate work
Result := 43;
end
);
fut :=
TFuture<Integer>.Construct(
nil, // Explicitly providing a nil gate [cite: 147]
function: Integer
begin
TThread.Sleep(20); // Simulate work
Result := 43;
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.IsNotNull(fut.Done, 'Future.Done should not be nil when constructed with a nil gate.'); // Static string [cite: 148]
fut.WaitFor(); // [cite: 148]
Assert.IsTrue( fut.Done.IsSet, 'Future.Done.IsSet should be true for nil gate construct.' ); // Static string [cite: 148]
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
Assert.AreEqual(43, resultValue, 'Future result is incorrect for nil gate construct.'); // Static string
end;
[Test]
@@ -121,22 +124,24 @@ var
resultValue: Integer;
begin
presetGate := TState.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]
Assert.IsTrue(presetGate.IsSet, 'The preset gate (State.Null) should be initially set.'); // Static string [cite: 55]
// Construct a future with a gate that is already set
fut := TFuture<Integer>.Construct( presetGate, // [cite: 147]
function: Integer
begin
Result := 44; // This should execute quickly
end
);
fut :=
TFuture<Integer>.Construct(
presetGate, // [cite: 147]
function: Integer
begin
Result := 44; // This should execute quickly
end
);
Assert.IsNotNull( fut.Done, 'Future.Done should not be nil for preset gate construct.' ); // Static string [cite: 148]
fut.WaitFor( ); // [cite: 148]
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]
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
Assert.AreEqual(44, resultValue, 'Future result is incorrect for preset gate construct.'); // Static string
end;
[Test]
@@ -146,34 +151,33 @@ var
delayedGate: IMycLatch; // IMycLatch implements IMycState [cite: 58]
resultValue: Integer;
begin
delayedGate := TLatch.Construct( 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]
delayedGate := TLatch.Construct(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 := TFuture<Integer>.Construct( delayedGate.State, // Get the IMycState interface from the latch [cite: 147, 59]
function: Integer
begin
Result := 45;
end
);
fut :=
TFuture<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]
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.' );
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]
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.' );
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
Assert.AreEqual(45, resultValue, 'Future result is incorrect for delayed gate construct.'); // Static string
end;
[Test]
@@ -184,29 +188,31 @@ var
resultValue: string;
begin
// Create an initial future
fut1 := TFuture<Integer>.Construct( // [cite: 146]
function: Integer
begin
TThread.Sleep( 20 ); // Simulate work
Result := 100;
end
);
fut1 :=
TFuture<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
);
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.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]
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
Assert.AreEqual('Value: 100', resultValue, 'Chained Future result is incorrect.'); // Static string
end;
[Test]
@@ -217,42 +223,39 @@ var
delayedGate: IMycLatch;
resultValue: string;
begin
delayedGate := TLatch.Construct( 1 ); // [cite: 66]
Assert.IsFalse( delayedGate.State.IsSet, 'The delayed gate for chain test should not be initially set.' );
delayedGate := TLatch.Construct(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 := TFuture<Integer>.Construct( delayedGate.State, // [cite: 147, 59]
function: Integer
begin
Result := 200;
end
);
fut1 :=
TFuture<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
);
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]
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]
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]
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]
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
Assert.AreEqual('ChainVal: 200', resultValue, 'Chained future (gated) result is incorrect.'); // Static string
end;
[Test]
@@ -264,67 +267,71 @@ var
finalResult: string;
begin
// Initial future A
futA := TFuture<Integer>.Construct( // [cite: 146]
function: Integer
begin
TThread.Sleep( 10 );
Result := 10;
end
);
futA :=
TFuture<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
);
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
);
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.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]
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
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 );
[TestCase('StringFutureTest', 'Test String')]
[TestCase('IntegerFutureTestForParam', '12345')]
procedure TTestFuture.TestConstructSimple_Parametric(const ParamValue: string);
var
fut: TFuture<string>;
resultValue: string;
begin
// Parametric test for Future<string>
fut := TFuture<string>.Construct( // [cite: 146]
function: string
begin
TThread.Sleep( 10 );
Result := ParamValue; // Use the parameter in the future's function
end
);
fut :=
TFuture<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.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]
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
Assert.AreEqual(ParamValue, resultValue, 'Parametric Future result does not match input parameter.'); // Static string
end;
[Test]
@@ -338,53 +345,58 @@ var
masterFuture: TFuture<Boolean>;
i: Integer;
begin
SetLength( Futures, StressTestFutureCount );
SetLength( doneStates, StressTestFutureCount );
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
for i := 0 to High(Futures) do
begin
// Capture loop variable for use in anonymous method
Futures[i] := TFuture<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 )
);
Futures[i] :=
TFuture<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;
combinedStateAll := TState.All( doneStates ); // [cite: 67]
Assert.IsNotNull( combinedStateAll, 'State.All should return a valid IMycState.' ); // Static string
combinedStateAll := TState.All(doneStates); // [cite: 67]
Assert.IsNotNull(combinedStateAll, 'State.All should return a valid IMycState.'); // Static string
// Create a master future that waits on the combined State.All state
masterFuture := TFuture<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]
masterFuture :=
TFuture<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]
Assert.IsTrue( combinedStateAll.IsSet, 'Combined State.All should be set after masterFuture.WaitFor().' ); // Static string [cite: 55]
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
for i := 0 to High(Futures) do
begin
Assert.IsTrue( Futures[i].Done.IsSet, 'An individual future was not set after State.All completed.' );
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.' );
Assert.AreEqual(i, Futures[i].Result, 'A future''s result was incorrect in State.All stress test.');
// Static string [cite: 148]
end;
end;
@@ -403,65 +415,70 @@ var
i: Integer;
isAtLeastOneSet: Boolean;
begin
SetLength( Futures, StressTestFutureCount );
SetLength( doneStates, StressTestFutureCount );
SetLength(Futures, StressTestFutureCount);
SetLength(doneStates, StressTestFutureCount);
Randomize; // Initialize random number generator
// Create multiple futures, one of which is designed to finish quickly
for i := 0 to High( Futures ) do
for i := 0 to High(Futures) do
begin
// Capture loop variable
Futures[i] := TFuture<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 )
);
Futures[i] :=
TFuture<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;
combinedStateAny := TState.Any( doneStates ); // [cite: 68]
Assert.IsNotNull( combinedStateAny, 'State.Any should return a valid IMycState.' ); // Static string
combinedStateAny := TState.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 := TFuture<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]
masterFuture :=
TFuture<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]
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
for i := 0 to High(Futures) do
begin
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.IsTrue(isAtLeastOneSet, 'At least one underlying future should be set after State.Any completed.'); // Static string
// It's good practice to ensure all futures complete
for i := 0 to High( Futures ) do
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]
Futures[i].WaitFor(); // Wait for any remaining futures [cite: 148]
end;
end;
end;
@@ -474,32 +491,34 @@ var
finalResult: Integer;
begin
// Create an outer future that, when resolved, produces another (inner) future.
outerFuture := TFuture < TFuture < Integer >>.Construct( // [cite: 146]
function: TFuture<Integer> // This lambda returns a Future<Integer>
begin
TThread.Sleep( 10 ); // Simulate work for the outer future to produce the inner one
Result := TFuture<Integer>.Construct( // [cite: 146]
function: Integer
begin
TThread.Sleep( 10 ); // Simulate work for the inner future
Result := 123; // The final value
end
);
end
);
outerFuture :=
TFuture<TFuture<Integer>>.Construct( // [cite: 146]
function: TFuture<Integer> // This lambda returns a Future<Integer>
begin
TThread.Sleep(10); // Simulate work for the outer future to produce the inner one
Result :=
TFuture<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]
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]
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]
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
Assert.AreEqual(123, finalResult, 'Nested future final result from Construct is incorrect.'); // Static string
end;
[Test]
@@ -511,43 +530,46 @@ var
finalResult: string;
begin
// Create an initial future
initialFuture := TFuture<Integer>.Construct( // [cite: 146]
function: Integer
begin
TThread.Sleep( 10 );
Result := 77;
end
);
initialFuture :=
TFuture<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 < TFuture < string >> ( // [cite: 147]
function( Input: Integer ): TFuture<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 := TFuture<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
);
outerChainedFuture :=
initialFuture.Chain<TFuture<string>>( // [cite: 147]
function(Input: Integer): TFuture<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 :=
TFuture<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]
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.' );
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]
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
Assert.AreEqual('Value: 77', finalResult, 'Nested future (via Chain) final result is incorrect.'); // Static string
end;
end.
Test/TestNotifier.pas
+70 -69
View File
@@ -9,19 +9,19 @@ uses
type
// Dummy interface and class for testing
IMyTestInterface = interface( IInterface )
IMyTestInterface = interface(IInterface)
['{7A8C1A01-1C6B-4A7A-B9D8-28E6A8D02A0F}']
// Unique GUID
procedure Foo;
function GetValue: Integer;
end;
TMyTestReceiver = class( TInterfacedObject, IMyTestInterface )
TMyTestReceiver = class(TInterfacedObject, IMyTestInterface)
private
FValue: Integer;
FCallCount: Integer;
public
constructor Create( AValue: Integer );
constructor Create(AValue: Integer);
procedure Foo;
function GetValue: Integer;
property CallCount: Integer read FCallCount write FCallCount;
@@ -53,7 +53,7 @@ implementation
{ TMyTestReceiver }
constructor TMyTestReceiver.Create( AValue: Integer );
constructor TMyTestReceiver.Create(AValue: Integer);
begin
inherited Create;
FValue := AValue;
@@ -62,7 +62,7 @@ end;
procedure TMyTestReceiver.Foo;
begin
Inc( FCallCount );
Inc(FCallCount);
end;
function TMyTestReceiver.GetValue: Integer;
@@ -93,7 +93,7 @@ begin
// This call is expected to succeed without raising EAssertionFailed or other exceptions
// if TMycNotifyList.Destroy is implemented correctly.
FNotifier.Destroy;
Assert.IsTrue( True, 'FNotifier.Destroy completed without raising an exception.' );
Assert.IsTrue(True, 'FNotifier.Destroy completed without raising an exception.');
end;
// Test for: Correct execution of Notify on an empty, locked, and finalized list.
@@ -105,22 +105,23 @@ var
dummyPredicate: TPredicate<IMyTestInterface>;
begin
predicateCallCount := 0;
dummyPredicate := function( Item: IMyTestInterface ): Boolean
begin
Inc( predicateCallCount );
Result := True;
end;
dummyPredicate :=
function(Item: IMyTestInterface): Boolean
begin
Inc(predicateCallCount);
Result := True;
end;
FNotifier.Lock;
Assert.IsTrue( FNotifier.IsLocked, 'Notifier should be locked.' );
Assert.IsTrue(FNotifier.IsLocked, 'Notifier should be locked.');
// FNotifier.Finalize; // Internally, FFirst becomes 2 (locked & finalized state bits) if it was 0 after Lock
// Assert.IsTrue( FNotifier.IsFinalized, 'Notifier should be finalized.' );
// FNotifier.Finalize; // Internally, FFirst becomes 2 (locked & finalized state bits) if it was 0 after Lock
// Assert.IsTrue( FNotifier.IsFinalized, 'Notifier should be finalized.' );
// In a corrected Notifier, this call should not cause an AV and not call the predicate.
FNotifier.Notify( dummyPredicate );
Assert.AreEqual( 0, predicateCallCount, 'Notify predicate should not have been called for an empty, finalized list.' );
Assert.IsTrue( True, 'FNotifier.Notify on finalized locked empty list completed without AV.' );
FNotifier.Notify(dummyPredicate);
Assert.AreEqual(0, predicateCallCount, 'Notify predicate should not have been called for an empty, finalized list.');
Assert.IsTrue(True, 'FNotifier.Notify on finalized locked empty list completed without AV.');
if FNotifier.IsLocked then // Release lock for subsequent operations or cleanup
begin
@@ -134,14 +135,14 @@ end;
procedure TMycTestNotifierTests.Test03_UnadviseAllOnFinalizedLockedEmptyListExecutesWithoutErrors;
begin
FNotifier.Lock;
Assert.IsTrue( FNotifier.IsLocked, 'Notifier should be locked.' );
Assert.IsTrue(FNotifier.IsLocked, 'Notifier should be locked.');
// FNotifier.Finalize; // FFirst becomes 2 internally
// Assert.IsTrue( FNotifier.IsFinalized, 'Notifier should be finalized.' );
// FNotifier.Finalize; // FFirst becomes 2 internally
// Assert.IsTrue( FNotifier.IsFinalized, 'Notifier should be finalized.' );
// In a corrected Notifier, this call should not cause an AV.
FNotifier.UnadviseAll;
Assert.IsTrue( True, 'FNotifier.UnadviseAll on finalized locked empty list completed without AV.' );
Assert.IsTrue(True, 'FNotifier.UnadviseAll on finalized locked empty list completed without AV.');
if FNotifier.IsLocked then // Release lock
begin
@@ -156,37 +157,37 @@ var
tag1, tag2: TMycNotifyList<IMyTestInterface>.TTag;
receiver1, receiver2: IMyTestInterface;
begin
receiver1 := TMyTestReceiver.Create( 1 );
receiver2 := TMyTestReceiver.Create( 2 );
receiver1 := TMyTestReceiver.Create(1);
receiver2 := TMyTestReceiver.Create(2);
FNotifier.Lock;
try
tag1 := FNotifier.Advise( receiver1 );
Assert.AreNotEqual( TMycNotifyList<IMyTestInterface>.TTag( nil ), tag1, 'Tag1 should not be nil.' );
FNotifier.Unadvise( tag1 );
tag1 := FNotifier.Advise(receiver1);
Assert.AreNotEqual(TMycNotifyList<IMyTestInterface>.TTag(nil), tag1, 'Tag1 should not be nil.');
FNotifier.Unadvise(tag1);
tag1 := FNotifier.Advise( receiver1 );
Assert.AreNotEqual( TMycNotifyList<IMyTestInterface>.TTag( nil ), tag1, 'Tag1 should not be nil.' );
tag1 := FNotifier.Advise(receiver1);
Assert.AreNotEqual(TMycNotifyList<IMyTestInterface>.TTag(nil), tag1, 'Tag1 should not be nil.');
tag2 := FNotifier.Advise( receiver2 );
Assert.AreNotEqual( TMycNotifyList<IMyTestInterface>.TTag( nil ), tag2, 'Tag2 should not be nil.' );
Assert.AreNotEqual( tag1, tag2, 'Tag1 and Tag2 should be different.' );
tag2 := FNotifier.Advise(receiver2);
Assert.AreNotEqual(TMycNotifyList<IMyTestInterface>.TTag(nil), tag2, 'Tag2 should not be nil.');
Assert.AreNotEqual(tag1, tag2, 'Tag1 and Tag2 should be different.');
FNotifier.Unadvise( tag1 );
FNotifier.Unadvise( tag2 );
FNotifier.Unadvise(tag1);
FNotifier.Unadvise(tag2);
// Re-add and unadvise in different order
tag1 := FNotifier.Advise( receiver1 );
tag2 := FNotifier.Advise( receiver2 );
Assert.AreNotEqual( TMycNotifyList<IMyTestInterface>.TTag( nil ), tag1 );
Assert.AreNotEqual( TMycNotifyList<IMyTestInterface>.TTag( nil ), tag2 );
FNotifier.Unadvise( tag2 );
FNotifier.Unadvise( tag1 );
tag1 := FNotifier.Advise(receiver1);
tag2 := FNotifier.Advise(receiver2);
Assert.AreNotEqual(TMycNotifyList<IMyTestInterface>.TTag(nil), tag1);
Assert.AreNotEqual(TMycNotifyList<IMyTestInterface>.TTag(nil), tag2);
FNotifier.Unadvise(tag2);
FNotifier.Unadvise(tag1);
finally
FNotifier.Release;
end;
Assert.IsFalse( FNotifier.IsLocked, 'Notifier should be unlocked.' );
Assert.IsFalse(FNotifier.IsLocked, 'Notifier should be unlocked.');
end;
// Test for: Notify calls advised items and can remove items based on the predicate.
@@ -196,30 +197,30 @@ var
rcv1, rcv2, rcv3: TMyTestReceiver;
itemsProcessedCount: Integer;
begin
rcv1 := TMyTestReceiver.Create( 10 ); // Keep
rcv2 := TMyTestReceiver.Create( 20 ); // Remove
rcv3 := TMyTestReceiver.Create( 30 ); // Keep
rcv1 := TMyTestReceiver.Create(10); // Keep
rcv2 := TMyTestReceiver.Create(20); // Remove
rcv3 := TMyTestReceiver.Create(30); // Keep
FNotifier.Lock;
try
FNotifier.Advise( rcv1 );
FNotifier.Advise( rcv2 );
FNotifier.Advise( rcv3 );
FNotifier.Advise(rcv1);
FNotifier.Advise(rcv2);
FNotifier.Advise(rcv3);
itemsProcessedCount := 0;
FNotifier.Notify(
function( Item: IMyTestInterface ): Boolean
begin
Inc( itemsProcessedCount );
TMyTestReceiver( Item ).Foo;
Result := Item.GetValue <> 20; // Remove item with value 20
end
);
function(Item: IMyTestInterface): Boolean
begin
Inc(itemsProcessedCount);
TMyTestReceiver(Item).Foo;
Result := Item.GetValue <> 20; // Remove item with value 20
end
);
Assert.AreEqual( 3, itemsProcessedCount, 'Notify predicate called for all 3 items.' );
Assert.AreEqual( 1, rcv1.CallCount, 'Receiver1 called once.' );
Assert.AreEqual( 1, rcv2.CallCount, 'Receiver2 called once (before removal).' );
Assert.AreEqual( 1, rcv3.CallCount, 'Receiver3 called once.' );
Assert.AreEqual(3, itemsProcessedCount, 'Notify predicate called for all 3 items.');
Assert.AreEqual(1, rcv1.CallCount, 'Receiver1 called once.');
Assert.AreEqual(1, rcv2.CallCount, 'Receiver2 called once (before removal).');
Assert.AreEqual(1, rcv3.CallCount, 'Receiver3 called once.');
// Reset counts and check again
rcv1.CallCount := 0;
@@ -228,17 +229,17 @@ begin
itemsProcessedCount := 0;
FNotifier.Notify(
function( Item: IMyTestInterface ): Boolean
begin
Inc( itemsProcessedCount );
TMyTestReceiver( Item ).Foo;
Result := True; // Keep remaining
end
);
Assert.AreEqual( 2, itemsProcessedCount, 'Notify predicate called for 2 remaining items.' );
Assert.AreEqual( 1, rcv1.CallCount, 'Receiver1 called again.' );
Assert.AreEqual( 0, rcv2.CallCount, 'Receiver2 (removed) not called again.' );
Assert.AreEqual( 1, rcv3.CallCount, 'Receiver3 called again.' );
function(Item: IMyTestInterface): Boolean
begin
Inc(itemsProcessedCount);
TMyTestReceiver(Item).Foo;
Result := True; // Keep remaining
end
);
Assert.AreEqual(2, itemsProcessedCount, 'Notify predicate called for 2 remaining items.');
Assert.AreEqual(1, rcv1.CallCount, 'Receiver1 called again.');
Assert.AreEqual(0, rcv2.CallCount, 'Receiver2 (removed) not called again.');
Assert.AreEqual(1, rcv3.CallCount, 'Receiver3 called again.');
finally
FNotifier.Release;
@@ -257,6 +258,6 @@ end;
initialization
TDUnitX.RegisterTestFixture( TMycTestNotifierTests );
TDUnitX.RegisterTestFixture(TMycTestNotifierTests);
end.
Test/TestNotifier_ChaosStress.pas
+55 -34
View File
@@ -20,8 +20,7 @@ type
function GetInstanceID: Integer;
function GetExpectedToBeAdvised: Boolean;
procedure SetExpectedToBeAdvised(const Value: Boolean);
property ExpectedToBeAdvised: Boolean read GetExpectedToBeAdvised write
SetExpectedToBeAdvised;
property ExpectedToBeAdvised: Boolean read GetExpectedToBeAdvised write SetExpectedToBeAdvised;
end;
TMyStressReceiver = class(TInterfacedObject, IMyStressTestInterface)
@@ -39,8 +38,7 @@ type
function GetValue: Integer;
function GetNotificationCount: Integer;
function GetInstanceID: Integer;
property ExpectedToBeAdvised: Boolean read GetExpectedToBeAdvised write
SetExpectedToBeAdvised;
property ExpectedToBeAdvised: Boolean read GetExpectedToBeAdvised write SetExpectedToBeAdvised;
end;
// Record type to store an advised receiver and its tag
@@ -66,7 +64,7 @@ type
destructor Destroy; override;
property Error: Exception read FError;
function GetAdvisedReceiverCountByThread: Integer;
// procedure GetMyExpectedLiveReceivers(AList: TList<TMyStressReceiver>); // Not strictly needed with current verification
// procedure GetMyExpectedLiveReceivers(AList: TList<TMyStressReceiver>); // Not strictly needed with current verification
end;
[TestFixture]
@@ -165,7 +163,8 @@ begin
try
for i := 1 to FIterations do
begin
if Terminated then Break; // Respond to termination request
if Terminated then
Break; // Respond to termination request
op := Random(100);
@@ -211,21 +210,23 @@ begin
begin
FOwnerFixture.FNotifier.Lock;
try
// if not FOwnerFixture.FNotifier.IsFinalized then // Don't notify if finalized
// if not FOwnerFixture.FNotifier.IsFinalized then // Don't notify if finalized
begin
FOwnerFixture.FNotifier.Notify(
function(Item: IMyStressTestInterface): Boolean
begin
Item.Foo(FThreadID); // Pass ThreadID as notification type for context
Result := True; // Keep item
end);
function(Item: IMyStressTestInterface): Boolean
begin
Item.Foo(FThreadID); // Pass ThreadID as notification type for context
Result := True; // Keep item
end
);
end;
finally
FOwnerFixture.FNotifier.Release;
end;
end;
if (i mod 75 = 0) then Sleep(0); // Yield occasionally to encourage context switching
if (i mod 75 = 0) then
Sleep(0); // Yield occasionally to encourage context switching
end;
except
on E: Exception do
@@ -250,7 +251,6 @@ end;
// end;
// end;
{ TMycNotifierChaosStressTests }
procedure TMycNotifierChaosStressTests.Setup;
begin
@@ -263,8 +263,8 @@ end;
procedure TMycNotifierChaosStressTests.TearDown;
var
// receiver: TMyStressReceiver; // Not used directly in this simplified TearDown
i: Integer;
// receiver: TMyStressReceiver; // Not used directly in this simplified TearDown
i: Integer;
begin
// Attempt to shut down the Notifier cleanly.
try
@@ -272,7 +272,7 @@ begin
try
// UnadviseAll should be safe if the IsFinalized guard is present
// and the FFirst state is not pathological.
// if not FNotifier.IsFinalized then
// if not FNotifier.IsFinalized then
begin
FNotifier.UnadviseAll;
end;
@@ -294,7 +294,7 @@ begin
// as long as no other strong references exist.
// Setting list items to nil is good practice if the list itself isn't immediately freed.
for i := 0 to FAllReceiversCreated.Count - 1 do
FAllReceiversCreated[i] := nil; // Break reference cycles if any, allow ARC
FAllReceiversCreated[i] := nil; // Break reference cycles if any, allow ARC
FAllReceiversCreated.Free;
FAllReceiversCreated := nil;
end;
@@ -307,7 +307,7 @@ end;
procedure TMycNotifierChaosStressTests.Test_MixedOperations_Stress;
const
NumThreads = 24; // Number of concurrent worker threads
NumThreads = 24; // Number of concurrent worker threads
IterationsPerThread = 2000; // Number of random operations per thread
var
threads: array of TStressWorkerThread;
@@ -337,8 +337,7 @@ begin
begin
// If an error occurred, Assert.IsNull would fail.
// The message can safely use LThreadError.Message here.
Assert.IsNull(LThreadError,
'Thread ' + threads[i].FThreadID.ToString + ' reported an error: ' + LThreadError.Message);
Assert.IsNull(LThreadError, 'Thread ' + threads[i].FThreadID.ToString + ' reported an error: ' + LThreadError.Message);
end
else
begin
@@ -357,14 +356,15 @@ begin
try
FNotifier.Lock;
try
// if not FNotifier.IsFinalized then
// if not FNotifier.IsFinalized then
begin
FNotifier.Notify(
function(Item: IMyStressTestInterface): Boolean
begin
actualLiveReceiversInNotifier.Add(Item);
Result := True;
end);
function(Item: IMyStressTestInterface): Boolean
begin
actualLiveReceiversInNotifier.Add(Item);
Result := True;
end
);
end;
finally
FNotifier.Release;
@@ -372,8 +372,14 @@ begin
actualLiveInNotifierAtEnd := actualLiveReceiversInNotifier.Count;
// 2. Compare overall counts
Assert.AreEqual(totalExpectedLiveByThreadsAtEnd, actualLiveInNotifierAtEnd,
Format('Mismatch in live item count at end. Threads expected %d, Notifier has %d.', [totalExpectedLiveByThreadsAtEnd, actualLiveInNotifierAtEnd]));
Assert.AreEqual(
totalExpectedLiveByThreadsAtEnd,
actualLiveInNotifierAtEnd,
Format(
'Mismatch in live item count at end. Threads expected %d, Notifier has %d.',
[totalExpectedLiveByThreadsAtEnd, actualLiveInNotifierAtEnd]
)
);
// 3. Detailed check: Iterate all receivers ever created.
// Their 'ExpectedToBeAdvised' flag (last known state from its managing thread)
@@ -393,14 +399,29 @@ begin
end;
end;
Assert.AreEqual(receiver.ExpectedToBeAdvised, found,
Format('Receiver ID %d: Thread expected it to be advised=%d, but its presence in Notifier is %d. NotificationCount=%d',
[receiver.GetInstanceID, Integer(receiver.ExpectedToBeAdvised), Integer(found), receiver.GetNotificationCount]));
Assert.AreEqual(
receiver.ExpectedToBeAdvised,
found,
Format(
'Receiver ID %d: Thread expected it to be advised=%d, but its presence in Notifier is %d. NotificationCount=%d',
[
receiver.GetInstanceID,
Integer(receiver.ExpectedToBeAdvised),
Integer(found),
receiver.GetNotificationCount
]
)
);
// Further checks on NotificationCount could be added if specific notification patterns were expected.
// For this chaos test, ensuring count is non-negative and consistent with advised state is a good start.
Assert.IsTrue(receiver.GetNotificationCount >= 0,
Format('Receiver ID %d has non-positive notification count: %d', [receiver.GetInstanceID, receiver.GetNotificationCount]));
Assert.IsTrue(
receiver.GetNotificationCount >= 0,
Format(
'Receiver ID %d has non-positive notification count: %d',
[receiver.GetInstanceID, receiver.GetNotificationCount]
)
);
if found and (receiver.GetNotificationCount = 0) then
begin
// This might be okay if Notify calls were very sparse or the item was just added and not yet notified.
Test/TestNotifier_Threading.pas
+29 -19
View File
@@ -127,7 +127,8 @@ begin
// Acquire lock before calling Advise
FOwnerFixture.FNotifier.Lock;
try
{var tag :=} FOwnerFixture.FNotifier.Advise(FReceiversToAdd[i]);
{var tag :=}
FOwnerFixture.FNotifier.Advise(FReceiversToAdd[i]);
// The 'tag' could be used here if necessary for other test scenarios
finally
// Definitely release lock in the finally block
@@ -168,7 +169,7 @@ begin
try
// UnadviseAll should be safe if the IsFinalized guard is present
// and the FFirst state is not pathological.
// if not FNotifier.IsFinalized then
// if not FNotifier.IsFinalized then
begin
FNotifier.UnadviseAll;
end;
@@ -206,7 +207,7 @@ var
currentNotifyCount: Integer;
receiver: IMyTestInterface;
LThreadError: Exception; // For safe error message handling
LMessage: string; // For safe error message handling
LMessage: string; // For safe error message handling
begin
totalAdvisedExpected := NumThreads * ItemsPerThread;
SetLength(threads, NumThreads);
@@ -255,18 +256,24 @@ begin
FNotifier.Lock;
try
FNotifier.Notify(
function(Item: IMyTestInterface): Boolean
begin
Inc(currentNotifyCount);
Result := True; // Keep item in the Notifier
end
function(Item: IMyTestInterface): Boolean
begin
Inc(currentNotifyCount);
Result := True; // Keep item in the Notifier
end
);
finally
FNotifier.Release;
end;
Assert.AreEqual(totalAdvisedExpected, currentNotifyCount,
'The number of items in the Notifier after all Advise operations (' + currentNotifyCount.ToString +
') does not match the expected number (' + totalAdvisedExpected.ToString + ').');
Assert.AreEqual(
totalAdvisedExpected,
currentNotifyCount,
'The number of items in the Notifier after all Advise operations ('
+ currentNotifyCount.ToString
+ ') does not match the expected number ('
+ totalAdvisedExpected.ToString
+ ').'
);
// 2. Execute UnadviseAll
FNotifier.Lock;
@@ -281,21 +288,24 @@ begin
FNotifier.Lock;
try
FNotifier.Notify(
function(Item: IMyTestInterface): Boolean
begin
Inc(currentNotifyCount);
Result := True;
end
function(Item: IMyTestInterface): Boolean
begin
Inc(currentNotifyCount);
Result := True;
end
);
finally
FNotifier.Release;
end;
Assert.AreEqual(0, currentNotifyCount,
'The Notifier should be empty after UnadviseAll, but still contains ' + currentNotifyCount.ToString + ' items.');
Assert.AreEqual(
0,
currentNotifyCount,
'The Notifier should be empty after UnadviseAll, but still contains ' + currentNotifyCount.ToString + ' items.'
);
end;
initialization
TDUnitX.RegisterTestFixture(TMycNotifierThreadingTests);
TDUnitX.RegisterTestFixture(TMycNotifierThreadingTests);
end.
Test/TestSignals_Dirty.pas
+327 -327
View File
@@ -3,81 +3,81 @@ unit TestSignals_Dirty;
interface
uses
DUnitX.TestFramework,
System.SysUtils,
Myc.Signals; // Unit under test
DUnitX.TestFramework,
System.SysUtils,
Myc.Signals; // Unit under test
type
// Helper class to mock a subscriber (reuse or redefine if not in common unit)
TMockSubscriber = class(TInterfacedObject, IMycSubscriber)
public
NotifyCount: Integer;
NotifyShouldReturn: Boolean;
WasCalled: Boolean;
LastReturnedValueFromSource: Boolean; // To store what the source's Notify returned
// Helper class to mock a subscriber (reuse or redefine if not in common unit)
TMockSubscriber = class(TInterfacedObject, IMycSubscriber)
public
NotifyCount: Integer;
NotifyShouldReturn: Boolean;
WasCalled: Boolean;
LastReturnedValueFromSource: Boolean; // To store what the source's Notify returned
constructor Create(AShouldReturn: Boolean = True);
function Notify: Boolean; // IMycSubscriber implementation.
end;
constructor Create(AShouldReturn: Boolean = True);
function Notify: Boolean; // IMycSubscriber implementation.
end;
[TestFixture]
TTestMycDirtyFlag = class(TObject)
private
// Helper to create a dirty flag and optionally reset it for a clean initial state
function CreateAndPrepareDirtyFlag(StartDirty: Boolean = True): IMycDirty;
public
[Setup]
procedure Setup;
[TearDown]
procedure TearDown;
[TestFixture]
TTestMycDirtyFlag = class(TObject)
private
// Helper to create a dirty flag and optionally reset it for a clean initial state
function CreateAndPrepareDirtyFlag(StartDirty: Boolean = True): IMycDirty;
public
[Setup]
procedure Setup;
[TearDown]
procedure TearDown;
// Category 1: Basic State, Notify (as Subscriber method), and Reset
[Test]
procedure TestCreate_InitialStateIsDirty;
[Test]
procedure TestReset_FromDirtyState_BecomesCleanAndReturnsTrue;
[Test]
procedure TestReset_FromCleanState_StaysCleanAndReturnsFalse;
[Test]
procedure TestNotify_OnCleanFlag_SetsDirtyAndReturnsTrue;
[Test]
procedure TestNotify_OnDirtyFlag_StaysDirtyAndReturnsFalse;
// Category 1: Basic State, Notify (as Subscriber method), and Reset
[Test]
procedure TestCreate_InitialStateIsDirty;
[Test]
procedure TestReset_FromDirtyState_BecomesCleanAndReturnsTrue;
[Test]
procedure TestReset_FromCleanState_StaysCleanAndReturnsFalse;
[Test]
procedure TestNotify_OnCleanFlag_SetsDirtyAndReturnsTrue;
[Test]
procedure TestNotify_OnDirtyFlag_StaysDirtyAndReturnsFalse;
// Category 2: Subscriber Notifications
[Test]
procedure TestSubscribe_ToAlreadyDirtyFlag_NotifiesSubscriberImmediately;
[Test]
procedure TestSubscribe_ToCleanFlag_DoesNotNotifySubscriberImmediately;
[Test]
procedure TestSubscriber_Notified_WhenFlagTransitionsToDirty;
[Test]
procedure TestSubscriber_NotNotified_WhenSettingAlreadyDirtyFlagViaNotify;
[Test]
procedure TestSubscriber_NotNotified_ByResetAction;
[Test]
procedure TestMultipleSubscribers_Notified_WhenFlagTransitionsToDirty;
[Test]
procedure TestUnsubscribe_SubscriberNotNotified;
// Category 2: Subscriber Notifications
[Test]
procedure TestSubscribe_ToAlreadyDirtyFlag_NotifiesSubscriberImmediately;
[Test]
procedure TestSubscribe_ToCleanFlag_DoesNotNotifySubscriberImmediately;
[Test]
procedure TestSubscriber_Notified_WhenFlagTransitionsToDirty;
[Test]
procedure TestSubscriber_NotNotified_WhenSettingAlreadyDirtyFlagViaNotify;
[Test]
procedure TestSubscriber_NotNotified_ByResetAction;
[Test]
procedure TestMultipleSubscribers_Notified_WhenFlagTransitionsToDirty;
[Test]
procedure TestUnsubscribe_SubscriberNotNotified;
// Category 3: Chaining Dirty Flags
[Test]
procedure TestChain_A_Notifies_B_SimplePropagation;
[Test]
procedure TestChain_A_Notifies_B_Notifies_C_SimplePropagation;
// Category 3: Chaining Dirty Flags
[Test]
procedure TestChain_A_Notifies_B_SimplePropagation;
[Test]
procedure TestChain_A_Notifies_B_Notifies_C_SimplePropagation;
// Category 4: Chaining with Resets and Re-triggering (Consistency)
[Test]
procedure TestChain_A_B_ResetB_RetriggerA_BStaysCleanIfANotChanged;
[Test]
procedure TestChain_A_B_ResetA_ThenTriggerA_FullPropagationToB;
[Test]
procedure TestChain_A_B_C_IntermediateBReset_RetriggerA_PropagatesToC;
[Test]
procedure TestChain_A_B_C_AllReset_RetriggerA_FullPropagation;
[Test]
procedure TestChain_A_B_C_TriggerA_ResetA_TriggerA_EnsureCNotifiedCorrectly;
// Category 4: Chaining with Resets and Re-triggering (Consistency)
[Test]
procedure TestChain_A_B_ResetB_RetriggerA_BStaysCleanIfANotChanged;
[Test]
procedure TestChain_A_B_ResetA_ThenTriggerA_FullPropagationToB;
[Test]
procedure TestChain_A_B_C_IntermediateBReset_RetriggerA_PropagatesToC;
[Test]
procedure TestChain_A_B_C_AllReset_RetriggerA_FullPropagation;
[Test]
procedure TestChain_A_B_C_TriggerA_ResetA_TriggerA_EnsureCNotifiedCorrectly;
end;
end;
implementation
@@ -85,221 +85,221 @@ implementation
constructor TMockSubscriber.Create(AShouldReturn: Boolean = True);
begin
inherited Create;
NotifyCount := 0;
NotifyShouldReturn := AShouldReturn;
WasCalled := False;
LastReturnedValueFromSource := False; // Default
inherited Create;
NotifyCount := 0;
NotifyShouldReturn := AShouldReturn;
WasCalled := False;
LastReturnedValueFromSource := False; // Default
end;
function TMockSubscriber.Notify: Boolean;
begin
Inc(NotifyCount);
WasCalled := True;
// This return value is what this subscriber tells the source signal.
// For testing, we usually want it to return false to signify it doesn't need more from this one event.
Result := NotifyShouldReturn;
Inc(NotifyCount);
WasCalled := True;
// This return value is what this subscriber tells the source signal.
// For testing, we usually want it to return false to signify it doesn't need more from this one event.
Result := NotifyShouldReturn;
end;
{ TTestMycDirtyFlag }
function TTestMycDirtyFlag.CreateAndPrepareDirtyFlag(StartDirty: Boolean = True): IMycDirty;
begin
Result := TDirty.Construct; // Initially dirty
if not StartDirty then
Result.Reset; // Reset to make it clean
Assert.AreEqual(StartDirty, Result.State.IsSet, 'CreateAndPrepareDirtyFlag initial state incorrect.');
Result := TDirty.Construct; // Initially dirty
if not StartDirty then
Result.Reset; // Reset to make it clean
Assert.AreEqual(StartDirty, Result.State.IsSet, 'CreateAndPrepareDirtyFlag initial state incorrect.');
end;
procedure TTestMycDirtyFlag.Setup;
begin
// Per-test setup
// Per-test setup
end;
procedure TTestMycDirtyFlag.TearDown;
begin
// Per-test teardown
// Per-test teardown
end;
// Category 1: Basic State, Notify (as Subscriber method), and Reset
procedure TTestMycDirtyFlag.TestCreate_InitialStateIsDirty;
var
dirtyFlag: IMycDirty;
dirtyFlag: IMycDirty;
begin
dirtyFlag := TDirty.Construct;
Assert.IsTrue(dirtyFlag.State.IsSet, 'Newly created dirty flag should be IsSet (dirty).');
dirtyFlag := TDirty.Construct;
Assert.IsTrue(dirtyFlag.State.IsSet, 'Newly created dirty flag should be IsSet (dirty).');
end;
procedure TTestMycDirtyFlag.TestReset_FromDirtyState_BecomesCleanAndReturnsTrue;
var
dirtyFlag: IMycDirty;
resetResult: Boolean;
dirtyFlag: IMycDirty;
resetResult: Boolean;
begin
dirtyFlag := CreateAndPrepareDirtyFlag(True); // Start dirty
dirtyFlag := CreateAndPrepareDirtyFlag(True); // Start dirty
resetResult := dirtyFlag.Reset;
resetResult := dirtyFlag.Reset;
Assert.IsFalse(dirtyFlag.State.IsSet, 'Flag should be clean (not IsSet) after Reset.');
Assert.IsTrue(resetResult, 'Reset() should return True when resetting a dirty flag.');
Assert.IsFalse(dirtyFlag.State.IsSet, 'Flag should be clean (not IsSet) after Reset.');
Assert.IsTrue(resetResult, 'Reset() should return True when resetting a dirty flag.');
end;
procedure TTestMycDirtyFlag.TestReset_FromCleanState_StaysCleanAndReturnsFalse;
var
dirtyFlag: IMycDirty;
resetResult: Boolean;
dirtyFlag: IMycDirty;
resetResult: Boolean;
begin
dirtyFlag := CreateAndPrepareDirtyFlag(False); // Start clean
dirtyFlag := CreateAndPrepareDirtyFlag(False); // Start clean
resetResult := dirtyFlag.Reset;
resetResult := dirtyFlag.Reset;
Assert.IsFalse(dirtyFlag.State.IsSet, 'Flag should remain clean (not IsSet) after Reset on clean flag.');
Assert.IsFalse(resetResult, 'Reset() should return False when resetting an already clean flag.');
Assert.IsFalse(dirtyFlag.State.IsSet, 'Flag should remain clean (not IsSet) after Reset on clean flag.');
Assert.IsFalse(resetResult, 'Reset() should return False when resetting an already clean flag.');
end;
procedure TTestMycDirtyFlag.TestNotify_OnCleanFlag_SetsDirtyAndReturnsTrue;
var
dirtyFlag: IMycDirty;
notifyResult: Boolean;
dirtyFlag: IMycDirty;
notifyResult: Boolean;
begin
dirtyFlag := CreateAndPrepareDirtyFlag(False); // Start clean
dirtyFlag := CreateAndPrepareDirtyFlag(False); // Start clean
notifyResult := dirtyFlag.Notify; // Call IMycSubscriber.Notify to make it dirty
notifyResult := dirtyFlag.Notify; // Call IMycSubscriber.Notify to make it dirty
Assert.IsTrue(dirtyFlag.State.IsSet, 'Flag should be dirty (IsSet) after Notify on clean flag.');
Assert.IsTrue(notifyResult, 'Notify() should return True indicating a state change from clean to dirty.');
Assert.IsTrue(dirtyFlag.State.IsSet, 'Flag should be dirty (IsSet) after Notify on clean flag.');
Assert.IsTrue(notifyResult, 'Notify() should return True indicating a state change from clean to dirty.');
end;
procedure TTestMycDirtyFlag.TestNotify_OnDirtyFlag_StaysDirtyAndReturnsFalse;
var
dirtyFlag: IMycDirty;
notifyResult: Boolean;
dirtyFlag: IMycDirty;
notifyResult: Boolean;
begin
dirtyFlag := CreateAndPrepareDirtyFlag(True); // Start dirty
dirtyFlag := CreateAndPrepareDirtyFlag(True); // Start dirty
notifyResult := dirtyFlag.Notify; // Call IMycSubscriber.Notify again
notifyResult := dirtyFlag.Notify; // Call IMycSubscriber.Notify again
Assert.IsTrue(dirtyFlag.State.IsSet, 'Flag should remain dirty (IsSet).');
Assert.IsFalse(notifyResult, 'Notify() should return False as flag was already dirty (no state change to dirty).');
Assert.IsTrue(dirtyFlag.State.IsSet, 'Flag should remain dirty (IsSet).');
Assert.IsFalse(notifyResult, 'Notify() should return False as flag was already dirty (no state change to dirty).');
end;
// Category 2: Subscriber Notifications
procedure TTestMycDirtyFlag.TestSubscribe_ToAlreadyDirtyFlag_NotifiesSubscriberImmediately;
var
dirtyFlag: IMycDirty;
subscriber: TMockSubscriber;
subscription: TState.TSubscription;
dirtyFlag: IMycDirty;
subscriber: TMockSubscriber;
subscription: TState.TSubscription;
begin
dirtyFlag := CreateAndPrepareDirtyFlag(True); // Start dirty
subscriber := TMockSubscriber.Create;
dirtyFlag := CreateAndPrepareDirtyFlag(True); // Start dirty
subscriber := TMockSubscriber.Create;
subscription := dirtyFlag.State.Subscribe(subscriber);
subscription := dirtyFlag.State.Subscribe(subscriber);
Assert.AreEqual(1, subscriber.NotifyCount, 'Subscriber should be notified immediately when subscribing to an already dirty flag.');
Assert.IsTrue(subscriber.WasCalled, 'Subscriber WasCalled should be true.');
Assert.AreEqual(1, subscriber.NotifyCount, 'Subscriber should be notified immediately when subscribing to an already dirty flag.');
Assert.IsTrue(subscriber.WasCalled, 'Subscriber WasCalled should be true.');
end;
procedure TTestMycDirtyFlag.TestSubscribe_ToCleanFlag_DoesNotNotifySubscriberImmediately;
var
dirtyFlag: IMycDirty;
subscriber: TMockSubscriber;
subscription: TState.TSubscription;
dirtyFlag: IMycDirty;
subscriber: TMockSubscriber;
subscription: TState.TSubscription;
begin
dirtyFlag := CreateAndPrepareDirtyFlag(False); // Start clean
subscriber := TMockSubscriber.Create;
dirtyFlag := CreateAndPrepareDirtyFlag(False); // Start clean
subscriber := TMockSubscriber.Create;
subscription := dirtyFlag.State.Subscribe(subscriber);
subscription := dirtyFlag.State.Subscribe(subscriber);
Assert.AreEqual(0, subscriber.NotifyCount, 'Subscriber should NOT be notified immediately when subscribing to a clean flag.');
Assert.IsFalse(subscriber.WasCalled, 'Subscriber WasCalled should be false.');
Assert.AreEqual(0, subscriber.NotifyCount, 'Subscriber should NOT be notified immediately when subscribing to a clean flag.');
Assert.IsFalse(subscriber.WasCalled, 'Subscriber WasCalled should be false.');
end;
procedure TTestMycDirtyFlag.TestSubscriber_Notified_WhenFlagTransitionsToDirty;
var
dirtyFlag: IMycDirty;
subscriber: TMockSubscriber;
subscription: TState.TSubscription;
dirtyFlag: IMycDirty;
subscriber: TMockSubscriber;
subscription: TState.TSubscription;
begin
dirtyFlag := CreateAndPrepareDirtyFlag(False); // Start clean
subscriber := TMockSubscriber.Create;
subscription := dirtyFlag.State.Subscribe(subscriber);
dirtyFlag := CreateAndPrepareDirtyFlag(False); // Start clean
subscriber := TMockSubscriber.Create;
subscription := dirtyFlag.State.Subscribe(subscriber);
Assert.AreEqual(0, subscriber.NotifyCount, 'Subscriber initially not notified.');
Assert.AreEqual(0, subscriber.NotifyCount, 'Subscriber initially not notified.');
dirtyFlag.Notify; // Make the flag dirty
dirtyFlag.Notify; // Make the flag dirty
Assert.AreEqual(1, subscriber.NotifyCount, 'Subscriber should be notified once flag transitions to dirty.');
Assert.AreEqual(1, subscriber.NotifyCount, 'Subscriber should be notified once flag transitions to dirty.');
end;
procedure TTestMycDirtyFlag.TestSubscriber_NotNotified_WhenSettingAlreadyDirtyFlagViaNotify;
var
dirtyFlag: IMycDirty;
subscriber: TMockSubscriber;
subscription: TState.TSubscription;
dirtyFlag: IMycDirty;
subscriber: TMockSubscriber;
subscription: TState.TSubscription;
begin
dirtyFlag := CreateAndPrepareDirtyFlag(True); // Start dirty
subscriber := TMockSubscriber.Create;
subscription := dirtyFlag.State.Subscribe(subscriber); // Gets initial notification
dirtyFlag := CreateAndPrepareDirtyFlag(True); // Start dirty
subscriber := TMockSubscriber.Create;
subscription := dirtyFlag.State.Subscribe(subscriber); // Gets initial notification
Assert.AreEqual(1, subscriber.NotifyCount, 'Subscriber notified on subscribe to dirty flag.');
Assert.AreEqual(1, subscriber.NotifyCount, 'Subscriber notified on subscribe to dirty flag.');
dirtyFlag.Notify; // Notify again, flag was already dirty
dirtyFlag.Notify; // Notify again, flag was already dirty
Assert.AreEqual(1, subscriber.NotifyCount, 'Subscriber should NOT be notified again if flag was already dirty.');
Assert.AreEqual(1, subscriber.NotifyCount, 'Subscriber should NOT be notified again if flag was already dirty.');
end;
procedure TTestMycDirtyFlag.TestSubscriber_NotNotified_ByResetAction;
var
dirtyFlag: IMycDirty;
subscriber: TMockSubscriber;
subscription: TState.TSubscription;
dirtyFlag: IMycDirty;
subscriber: TMockSubscriber;
subscription: TState.TSubscription;
begin
dirtyFlag := CreateAndPrepareDirtyFlag(True); // Start dirty
subscriber := TMockSubscriber.Create;
subscription := dirtyFlag.State.Subscribe(subscriber); // Gets initial notification
dirtyFlag := CreateAndPrepareDirtyFlag(True); // Start dirty
subscriber := TMockSubscriber.Create;
subscription := dirtyFlag.State.Subscribe(subscriber); // Gets initial notification
Assert.AreEqual(1, subscriber.NotifyCount, 'Subscriber notified on subscribe.');
dirtyFlag.Reset; // Reset the flag
Assert.IsFalse(dirtyFlag.State.IsSet, 'Flag is now clean.');
Assert.AreEqual(1, subscriber.NotifyCount, 'Subscriber notified on subscribe.');
dirtyFlag.Reset; // Reset the flag
Assert.IsFalse(dirtyFlag.State.IsSet, 'Flag is now clean.');
// Current TMycDirty.Reset does not notify subscribers.
Assert.AreEqual(1, subscriber.NotifyCount, 'Subscriber should NOT be notified by Reset action.');
// Current TMycDirty.Reset does not notify subscribers.
Assert.AreEqual(1, subscriber.NotifyCount, 'Subscriber should NOT be notified by Reset action.');
end;
procedure TTestMycDirtyFlag.TestMultipleSubscribers_Notified_WhenFlagTransitionsToDirty;
var
dirtyFlag: IMycDirty;
sub1, sub2: TMockSubscriber;
subscription1, subscription2: TState.TSubscription;
dirtyFlag: IMycDirty;
sub1, sub2: TMockSubscriber;
subscription1, subscription2: TState.TSubscription;
begin
dirtyFlag := CreateAndPrepareDirtyFlag(False); // Start clean
sub1 := TMockSubscriber.Create;
sub2 := TMockSubscriber.Create;
subscription1 := dirtyFlag.State.Subscribe(sub1);
subscription2 := dirtyFlag.State.Subscribe(sub2);
dirtyFlag := CreateAndPrepareDirtyFlag(False); // Start clean
sub1 := TMockSubscriber.Create;
sub2 := TMockSubscriber.Create;
subscription1 := dirtyFlag.State.Subscribe(sub1);
subscription2 := dirtyFlag.State.Subscribe(sub2);
dirtyFlag.Notify; // Make flag dirty
dirtyFlag.Notify; // Make flag dirty
Assert.AreEqual(1, sub1.NotifyCount, 'Subscriber 1 should be notified.');
Assert.AreEqual(1, sub2.NotifyCount, 'Subscriber 2 should be notified.');
Assert.AreEqual(1, sub1.NotifyCount, 'Subscriber 1 should be notified.');
Assert.AreEqual(1, sub2.NotifyCount, 'Subscriber 2 should be notified.');
end;
procedure TTestMycDirtyFlag.TestUnsubscribe_SubscriberNotNotified;
var
dirtyFlag: IMycDirty;
subscriber: TMockSubscriber;
subscription: TState.TSubscription;
dirtyFlag: IMycDirty;
subscriber: TMockSubscriber;
subscription: TState.TSubscription;
begin
dirtyFlag := CreateAndPrepareDirtyFlag(False); // Start clean
subscriber := TMockSubscriber.Create;
subscription := dirtyFlag.State.Subscribe(subscriber);
dirtyFlag := CreateAndPrepareDirtyFlag(False); // Start clean
subscriber := TMockSubscriber.Create;
subscription := dirtyFlag.State.Subscribe(subscriber);
subscription.Unsubscribe; // Explicitly unsubscribe
subscription.Unsubscribe; // Explicitly unsubscribe
dirtyFlag.Notify; // Make flag dirty
dirtyFlag.Notify; // Make flag dirty
Assert.AreEqual(0, subscriber.NotifyCount, 'Unsubscribed subscriber should not be notified.');
Assert.AreEqual(0, subscriber.NotifyCount, 'Unsubscribed subscriber should not be notified.');
end;
// Category 3: Chaining Dirty Flags
@@ -308,222 +308,222 @@ end;
procedure TTestMycDirtyFlag.TestChain_A_Notifies_B_SimplePropagation;
var
flagA, flagB: IMycDirty;
subToB: TMockSubscriber;
subscriptionA_B, subscriptionMock_B: TState.TSubscription;
flagA, flagB: IMycDirty;
subToB: TMockSubscriber;
subscriptionA_B, subscriptionMock_B: TState.TSubscription;
begin
flagA := CreateAndPrepareDirtyFlag(False); // A starts clean
flagB := CreateAndPrepareDirtyFlag(False); // B starts clean
subToB := TMockSubscriber.Create;
flagA := CreateAndPrepareDirtyFlag(False); // A starts clean
flagB := CreateAndPrepareDirtyFlag(False); // B starts clean
subToB := TMockSubscriber.Create;
subscriptionMock_B := flagB.State.Subscribe(subToB);
subscriptionA_B := flagA.State.Subscribe(flagB); // B subscribes to A's state changes (B's Notify will be called)
subscriptionMock_B := flagB.State.Subscribe(subToB);
subscriptionA_B := flagA.State.Subscribe(flagB); // B subscribes to A's state changes (B's Notify will be called)
flagA.Notify; // Make A dirty. This should trigger B.Notify
flagA.Notify; // Make A dirty. This should trigger B.Notify
Assert.IsTrue(flagA.State.IsSet, 'Flag A should be dirty.');
Assert.IsTrue(flagB.State.IsSet, 'Flag B should become dirty due to A.');
Assert.AreEqual(1, subToB.NotifyCount, 'Subscriber to B should be notified once.');
Assert.IsTrue(flagA.State.IsSet, 'Flag A should be dirty.');
Assert.IsTrue(flagB.State.IsSet, 'Flag B should become dirty due to A.');
Assert.AreEqual(1, subToB.NotifyCount, 'Subscriber to B should be notified once.');
end;
procedure TTestMycDirtyFlag.TestChain_A_Notifies_B_Notifies_C_SimplePropagation;
var
flagA, flagB, flagC: IMycDirty;
subToC: TMockSubscriber;
subscriptionB_A, subscriptionC_B, subscriptionMock_C: TState.TSubscription;
flagA, flagB, flagC: IMycDirty;
subToC: TMockSubscriber;
subscriptionB_A, subscriptionC_B, subscriptionMock_C: TState.TSubscription;
begin
flagA := CreateAndPrepareDirtyFlag(False);
flagB := CreateAndPrepareDirtyFlag(False);
flagC := CreateAndPrepareDirtyFlag(False);
subToC := TMockSubscriber.Create;
flagA := CreateAndPrepareDirtyFlag(False);
flagB := CreateAndPrepareDirtyFlag(False);
flagC := CreateAndPrepareDirtyFlag(False);
subToC := TMockSubscriber.Create;
subscriptionMock_C := flagC.State.Subscribe(subToC);
subscriptionC_B := flagB.State.Subscribe(flagC); // C subscribes to B
subscriptionB_A := flagA.State.Subscribe(flagB); // B subscribes to A
subscriptionMock_C := flagC.State.Subscribe(subToC);
subscriptionC_B := flagB.State.Subscribe(flagC); // C subscribes to B
subscriptionB_A := flagA.State.Subscribe(flagB); // B subscribes to A
flagA.Notify; // Make A dirty
flagA.Notify; // Make A dirty
Assert.IsTrue(flagA.State.IsSet, 'Flag A should be dirty in cascade.');
Assert.IsTrue(flagB.State.IsSet, 'Flag B should be dirty in cascade.');
Assert.IsTrue(flagC.State.IsSet, 'Flag C should be dirty in cascade.');
Assert.AreEqual(1, subToC.NotifyCount, 'Subscriber to C should be notified once in cascade.');
Assert.IsTrue(flagA.State.IsSet, 'Flag A should be dirty in cascade.');
Assert.IsTrue(flagB.State.IsSet, 'Flag B should be dirty in cascade.');
Assert.IsTrue(flagC.State.IsSet, 'Flag C should be dirty in cascade.');
Assert.AreEqual(1, subToC.NotifyCount, 'Subscriber to C should be notified once in cascade.');
end;
// Category 4: Chaining with Resets and Re-triggering (Consistency)
procedure TTestMycDirtyFlag.TestChain_A_B_ResetB_RetriggerA_BStaysCleanIfANotChanged;
var
flagA, flagB: IMycDirty;
subToB: TMockSubscriber;
subscriptionA_B, subscriptionMock_B: TState.TSubscription;
flagA, flagB: IMycDirty;
subToB: TMockSubscriber;
subscriptionA_B, subscriptionMock_B: TState.TSubscription;
begin
flagA := CreateAndPrepareDirtyFlag(False);
flagB := CreateAndPrepareDirtyFlag(False);
subToB := TMockSubscriber.Create;
subscriptionMock_B := flagB.State.Subscribe(subToB);
subscriptionA_B := flagA.State.Subscribe(flagB);
flagA := CreateAndPrepareDirtyFlag(False);
flagB := CreateAndPrepareDirtyFlag(False);
subToB := TMockSubscriber.Create;
subscriptionMock_B := flagB.State.Subscribe(subToB);
subscriptionA_B := flagA.State.Subscribe(flagB);
flagA.Notify; // A dirty -> B dirty. subToB notified.
Assert.IsTrue(flagB.State.IsSet, 'Flag B should be dirty initially.');
Assert.AreEqual(1, subToB.NotifyCount, 'Subscriber to B initially notified.');
flagA.Notify; // A dirty -> B dirty. subToB notified.
Assert.IsTrue(flagB.State.IsSet, 'Flag B should be dirty initially.');
Assert.AreEqual(1, subToB.NotifyCount, 'Subscriber to B initially notified.');
flagB.Reset; // B becomes clean. A is still dirty.
Assert.IsFalse(flagB.State.IsSet, 'Flag B should be clean after reset.');
Assert.AreEqual(1, subToB.NotifyCount, 'Subscriber to B not notified by B.Reset.');
flagB.Reset; // B becomes clean. A is still dirty.
Assert.IsFalse(flagB.State.IsSet, 'Flag B should be clean after reset.');
Assert.AreEqual(1, subToB.NotifyCount, 'Subscriber to B not notified by B.Reset.');
// Notify A again. A was already dirty. So A.Notify() returns false, A does not call ProtectedNotifyOwnSubscribers.
// Thus, B.Notify() is NOT called. B should remain clean.
flagA.Notify;
// Notify A again. A was already dirty. So A.Notify() returns false, A does not call ProtectedNotifyOwnSubscribers.
// Thus, B.Notify() is NOT called. B should remain clean.
flagA.Notify;
Assert.IsTrue(flagA.State.IsSet, 'Flag A remains dirty.');
Assert.IsFalse(flagB.State.IsSet, 'Flag B should remain clean if A did not transition to dirty.');
Assert.AreEqual(1, subToB.NotifyCount, 'Subscriber to B should not be notified again.');
Assert.IsTrue(flagA.State.IsSet, 'Flag A remains dirty.');
Assert.IsFalse(flagB.State.IsSet, 'Flag B should remain clean if A did not transition to dirty.');
Assert.AreEqual(1, subToB.NotifyCount, 'Subscriber to B should not be notified again.');
end;
procedure TTestMycDirtyFlag.TestChain_A_B_ResetA_ThenTriggerA_FullPropagationToB;
var
flagA, flagB: IMycDirty;
subToB: TMockSubscriber;
subscriptionA_B, subscriptionMock_B: TState.TSubscription;
flagA, flagB: IMycDirty;
subToB: TMockSubscriber;
subscriptionA_B, subscriptionMock_B: TState.TSubscription;
begin
flagA := CreateAndPrepareDirtyFlag(False);
flagB := CreateAndPrepareDirtyFlag(False);
subToB := TMockSubscriber.Create;
subscriptionMock_B := flagB.State.Subscribe(subToB);
subscriptionA_B := flagA.State.Subscribe(flagB);
flagA := CreateAndPrepareDirtyFlag(False);
flagB := CreateAndPrepareDirtyFlag(False);
subToB := TMockSubscriber.Create;
subscriptionMock_B := flagB.State.Subscribe(subToB);
subscriptionA_B := flagA.State.Subscribe(flagB);
flagA.Notify; // A dirty -> B dirty. subToB notified.
Assert.IsTrue(flagB.State.IsSet, 'Flag B should be dirty after A triggers.');
Assert.AreEqual(1, subToB.NotifyCount, 'subToB notified once.');
flagA.Notify; // A dirty -> B dirty. subToB notified.
Assert.IsTrue(flagB.State.IsSet, 'Flag B should be dirty after A triggers.');
Assert.AreEqual(1, subToB.NotifyCount, 'subToB notified once.');
flagA.Reset; // A becomes clean. B is still dirty (state change of A to clean doesn't propagate as a "dirty" signal to B).
Assert.IsFalse(flagA.State.IsSet, 'Flag A is clean after reset.');
Assert.IsTrue(flagB.State.IsSet, 'Flag B remains dirty.'); // B's state doesn't change because A becoming clean doesn't call B.Notify
flagA.Reset; // A becomes clean. B is still dirty (state change of A to clean doesn't propagate as a "dirty" signal to B).
Assert.IsFalse(flagA.State.IsSet, 'Flag A is clean after reset.');
Assert.IsTrue(flagB.State.IsSet, 'Flag B remains dirty.'); // B's state doesn't change because A becoming clean doesn't call B.Notify
flagA.Notify; // A (was clean) becomes dirty again. A.Notify() returns true. A notifies B.
// B.Notify() is called. B was dirty. B.Notify() sets FFlag to true (no change), returns false.
// So B does NOT notify subToB again.
flagA.Notify; // A (was clean) becomes dirty again. A.Notify() returns true. A notifies B.
// B.Notify() is called. B was dirty. B.Notify() sets FFlag to true (no change), returns false.
// So B does NOT notify subToB again.
Assert.IsTrue(flagA.State.IsSet, 'Flag A is dirty again.');
Assert.IsTrue(flagB.State.IsSet, 'Flag B is dirty (was already, and A.Notify called B.Notify which set it dirty again).');
Assert.AreEqual(1, subToB.NotifyCount, 'subToB should NOT be notified again as B did not transition from clean to dirty.');
Assert.IsTrue(flagA.State.IsSet, 'Flag A is dirty again.');
Assert.IsTrue(flagB.State.IsSet, 'Flag B is dirty (was already, and A.Notify called B.Notify which set it dirty again).');
Assert.AreEqual(1, subToB.NotifyCount, 'subToB should NOT be notified again as B did not transition from clean to dirty.');
end;
procedure TTestMycDirtyFlag.TestChain_A_B_C_IntermediateBReset_RetriggerA_PropagatesToC;
var
flagA, flagB, flagC: IMycDirty;
subToC: TMockSubscriber;
subscriptionB_A, subscriptionC_B, subscriptionMock_C: TState.TSubscription;
flagA, flagB, flagC: IMycDirty;
subToC: TMockSubscriber;
subscriptionB_A, subscriptionC_B, subscriptionMock_C: TState.TSubscription;
begin
flagA := CreateAndPrepareDirtyFlag(False);
flagB := CreateAndPrepareDirtyFlag(False);
flagC := CreateAndPrepareDirtyFlag(False);
subToC := TMockSubscriber.Create;
flagA := CreateAndPrepareDirtyFlag(False);
flagB := CreateAndPrepareDirtyFlag(False);
flagC := CreateAndPrepareDirtyFlag(False);
subToC := TMockSubscriber.Create;
subscriptionMock_C := flagC.State.Subscribe(subToC);
subscriptionC_B := flagB.State.Subscribe(flagC);
subscriptionB_A := flagA.State.Subscribe(flagB);
subscriptionMock_C := flagC.State.Subscribe(subToC);
subscriptionC_B := flagB.State.Subscribe(flagC);
subscriptionB_A := flagA.State.Subscribe(flagB);
// Initial full propagation
flagA.Notify; // A dirty -> B dirty -> C dirty. subToC notified.
Assert.IsTrue(flagC.State.IsSet, 'Flag C should be dirty initially.');
Assert.AreEqual(1, subToC.NotifyCount, 'subToC initial count.');
// Initial full propagation
flagA.Notify; // A dirty -> B dirty -> C dirty. subToC notified.
Assert.IsTrue(flagC.State.IsSet, 'Flag C should be dirty initially.');
Assert.AreEqual(1, subToC.NotifyCount, 'subToC initial count.');
// Intermediate reset
flagB.Reset; // B becomes clean. A is dirty, C is dirty.
Assert.IsFalse(flagB.State.IsSet, 'Flag B is clean.');
// Intermediate reset
flagB.Reset; // B becomes clean. A is dirty, C is dirty.
Assert.IsFalse(flagB.State.IsSet, 'Flag B is clean.');
// Reset and re-trigger A
flagA.Reset; // A becomes clean.
Assert.IsFalse(flagA.State.IsSet, 'Flag A is clean.');
// Reset and re-trigger A
flagA.Reset; // A becomes clean.
Assert.IsFalse(flagA.State.IsSet, 'Flag A is clean.');
flagA.Notify; // A (was clean) -> A dirty. A notifies B.
// B.Notify() called. B was clean -> B dirty. B notifies C.
// C.Notify() called. C was dirty -> C set dirty (no change), C.Notify() returns false.
// So subToC is NOT notified again.
flagA.Notify; // A (was clean) -> A dirty. A notifies B.
// B.Notify() called. B was clean -> B dirty. B notifies C.
// C.Notify() called. C was dirty -> C set dirty (no change), C.Notify() returns false.
// So subToC is NOT notified again.
Assert.IsTrue(flagA.State.IsSet, 'Flag A is dirty again.');
Assert.IsTrue(flagB.State.IsSet, 'Flag B becomes dirty again.');
Assert.IsTrue(flagC.State.IsSet, 'Flag C is dirty (was already).');
Assert.AreEqual(1, subToC.NotifyCount, 'subToC should NOT be notified again.');
Assert.IsTrue(flagA.State.IsSet, 'Flag A is dirty again.');
Assert.IsTrue(flagB.State.IsSet, 'Flag B becomes dirty again.');
Assert.IsTrue(flagC.State.IsSet, 'Flag C is dirty (was already).');
Assert.AreEqual(1, subToC.NotifyCount, 'subToC should NOT be notified again.');
end;
procedure TTestMycDirtyFlag.TestChain_A_B_C_AllReset_RetriggerA_FullPropagation;
var
flagA, flagB, flagC: IMycDirty;
subToC: TMockSubscriber;
subscriptionB_A, subscriptionC_B, subscriptionMock_C: TState.TSubscription;
flagA, flagB, flagC: IMycDirty;
subToC: TMockSubscriber;
subscriptionB_A, subscriptionC_B, subscriptionMock_C: TState.TSubscription;
begin
flagA := CreateAndPrepareDirtyFlag(False);
flagB := CreateAndPrepareDirtyFlag(False);
flagC := CreateAndPrepareDirtyFlag(False);
subToC := TMockSubscriber.Create;
flagA := CreateAndPrepareDirtyFlag(False);
flagB := CreateAndPrepareDirtyFlag(False);
flagC := CreateAndPrepareDirtyFlag(False);
subToC := TMockSubscriber.Create;
subscriptionMock_C := flagC.State.Subscribe(subToC);
subscriptionC_B := flagB.State.Subscribe(flagC);
subscriptionB_A := flagA.State.Subscribe(flagB);
subscriptionMock_C := flagC.State.Subscribe(subToC);
subscriptionC_B := flagB.State.Subscribe(flagC);
subscriptionB_A := flagA.State.Subscribe(flagB);
// All are clean. Trigger A.
flagA.Notify; // A dirty -> B dirty -> C dirty. subToC notified.
Assert.IsTrue(flagC.State.IsSet, 'Flag C dirty after first full propagation.');
Assert.AreEqual(1, subToC.NotifyCount, 'subToC notified once.');
// All are clean. Trigger A.
flagA.Notify; // A dirty -> B dirty -> C dirty. subToC notified.
Assert.IsTrue(flagC.State.IsSet, 'Flag C dirty after first full propagation.');
Assert.AreEqual(1, subToC.NotifyCount, 'subToC notified once.');
// Reset all
flagA.Reset;
flagB.Reset;
flagC.Reset;
Assert.IsFalse(flagA.State.IsSet, 'Flag A clean.');
Assert.IsFalse(flagB.State.IsSet, 'Flag B clean.');
Assert.IsFalse(flagC.State.IsSet, 'Flag C clean.');
// subToC count is still 1, it's not notified by resets.
// Reset all
flagA.Reset;
flagB.Reset;
flagC.Reset;
Assert.IsFalse(flagA.State.IsSet, 'Flag A clean.');
Assert.IsFalse(flagB.State.IsSet, 'Flag B clean.');
Assert.IsFalse(flagC.State.IsSet, 'Flag C clean.');
// subToC count is still 1, it's not notified by resets.
// Re-trigger A
flagA.Notify; // A (was clean) -> A dirty. A notifies B.
// B.Notify() called. B was clean -> B dirty. B notifies C.
// C.Notify() called. C was clean -> C dirty. C notifies subToC.
// Re-trigger A
flagA.Notify; // A (was clean) -> A dirty. A notifies B.
// B.Notify() called. B was clean -> B dirty. B notifies C.
// C.Notify() called. C was clean -> C dirty. C notifies subToC.
Assert.IsTrue(flagA.State.IsSet, 'Flag A dirty on re-trigger.');
Assert.IsTrue(flagB.State.IsSet, 'Flag B dirty on re-trigger.');
Assert.IsTrue(flagC.State.IsSet, 'Flag C dirty on re-trigger.');
Assert.AreEqual(2, subToC.NotifyCount, 'subToC should be notified a second time.');
Assert.IsTrue(flagA.State.IsSet, 'Flag A dirty on re-trigger.');
Assert.IsTrue(flagB.State.IsSet, 'Flag B dirty on re-trigger.');
Assert.IsTrue(flagC.State.IsSet, 'Flag C dirty on re-trigger.');
Assert.AreEqual(2, subToC.NotifyCount, 'subToC should be notified a second time.');
end;
procedure TTestMycDirtyFlag.TestChain_A_B_C_TriggerA_ResetA_TriggerA_EnsureCNotifiedCorrectly;
var
flagA, flagB, flagC: IMycDirty;
subToC: TMockSubscriber;
subscriptionB_A, subscriptionC_B, subscriptionMock_C: TState.TSubscription;
flagA, flagB, flagC: IMycDirty;
subToC: TMockSubscriber;
subscriptionB_A, subscriptionC_B, subscriptionMock_C: TState.TSubscription;
begin
flagA := CreateAndPrepareDirtyFlag(False);
flagB := CreateAndPrepareDirtyFlag(False);
flagC := CreateAndPrepareDirtyFlag(False);
subToC := TMockSubscriber.Create;
flagA := CreateAndPrepareDirtyFlag(False);
flagB := CreateAndPrepareDirtyFlag(False);
flagC := CreateAndPrepareDirtyFlag(False);
subToC := TMockSubscriber.Create;
subscriptionMock_C := flagC.State.Subscribe(subToC);
subscriptionC_B := flagB.State.Subscribe(flagC);
subscriptionB_A := flagA.State.Subscribe(flagB);
subscriptionMock_C := flagC.State.Subscribe(subToC);
subscriptionC_B := flagB.State.Subscribe(flagC);
subscriptionB_A := flagA.State.Subscribe(flagB);
// 1. Trigger A
flagA.Notify; // A, B, C become dirty. subToC notified (count = 1).
Assert.IsTrue(flagC.State.IsSet, 'C is dirty after 1st trigger.');
Assert.AreEqual(1, subToC.NotifyCount, 'subToC count after 1st trigger.');
// 1. Trigger A
flagA.Notify; // A, B, C become dirty. subToC notified (count = 1).
Assert.IsTrue(flagC.State.IsSet, 'C is dirty after 1st trigger.');
Assert.AreEqual(1, subToC.NotifyCount, 'subToC count after 1st trigger.');
// 2. Reset A (B and C remain dirty)
flagA.Reset;
Assert.IsFalse(flagA.State.IsSet, 'A is clean.');
Assert.IsTrue(flagB.State.IsSet, 'B remains dirty.');
Assert.IsTrue(flagC.State.IsSet, 'C remains dirty.');
// 2. Reset A (B and C remain dirty)
flagA.Reset;
Assert.IsFalse(flagA.State.IsSet, 'A is clean.');
Assert.IsTrue(flagB.State.IsSet, 'B remains dirty.');
Assert.IsTrue(flagC.State.IsSet, 'C remains dirty.');
// 3. Trigger A again
flagA.Notify; // A (was clean) becomes dirty. A notifies B.
// B.Notify() is called. B was dirty. B.Notify sets FFlag to true (no change), returns false.
// B does NOT notify C. C remains dirty. subToC is NOT notified again.
Assert.IsTrue(flagA.State.IsSet, 'A is dirty after 2nd trigger.');
Assert.IsTrue(flagB.State.IsSet, 'B is still dirty (state did not flip to clean then dirty).');
Assert.IsTrue(flagC.State.IsSet, 'C is still dirty.');
Assert.AreEqual(1, subToC.NotifyCount, 'subToC count should remain 1.');
// 3. Trigger A again
flagA.Notify; // A (was clean) becomes dirty. A notifies B.
// B.Notify() is called. B was dirty. B.Notify sets FFlag to true (no change), returns false.
// B does NOT notify C. C remains dirty. subToC is NOT notified again.
Assert.IsTrue(flagA.State.IsSet, 'A is dirty after 2nd trigger.');
Assert.IsTrue(flagB.State.IsSet, 'B is still dirty (state did not flip to clean then dirty).');
Assert.IsTrue(flagC.State.IsSet, 'C is still dirty.');
Assert.AreEqual(1, subToC.NotifyCount, 'subToC count should remain 1.');
end;
initialization
TDUnitX.RegisterTestFixture(TTestMycDirtyFlag);
TDUnitX.RegisterTestFixture(TTestMycDirtyFlag);
end.
Test/TestSignals_Latch.pas
+322 -306
View File
@@ -4,87 +4,87 @@ unit TestSignals_Latch;
interface
uses
DUnitX.TestFramework,
System.SysUtils,
Myc.Signals; // Unit under test, using TMycLatch static members
DUnitX.TestFramework,
System.SysUtils,
Myc.Signals; // Unit under test, using TMycLatch static members
type
// Helper class to mock a subscriber.
TMockSubscriber = class(TInterfacedObject, IMycSubscriber)
public
NotifyCount: Integer;
NotifyShouldReturn: Boolean; // Determines what this mock's Notify method returns
WasCalled: Boolean;
// Helper class to mock a subscriber.
TMockSubscriber = class(TInterfacedObject, IMycSubscriber)
public
NotifyCount: Integer;
NotifyShouldReturn: Boolean; // Determines what this mock's Notify method returns
WasCalled: Boolean;
constructor Create(AShouldReturn: Boolean = True); // Parameter name AShouldReturn for clarity
function Notify: Boolean; // IMycSubscriber implementation.
end;
constructor Create(AShouldReturn: Boolean = True); // Parameter name AShouldReturn for clarity
function Notify: Boolean; // IMycSubscriber implementation.
end;
[TestFixture]
TTestMycLatch = class(TObject)
public
[Setup]
procedure Setup;
[TearDown]
procedure TearDown;
[TestFixture]
TTestMycLatch = class(TObject)
public
[Setup]
procedure Setup;
[TearDown]
procedure TearDown;
// --- Category 1: Basic Counter and State Functionality (Parameterized) ---
[TestCase('InitialPositive', '1,False')]
[TestCase('InitialZero_ReturnsNullLatch', '0,True')]
[TestCase('InitialNegative_ReturnsNullLatch', '-1,True')]
[TestCase('InitialLargePositive', '5,False')]
procedure TestCreate_InitialState(InitialCount: Integer; ExpectedIsSet: Boolean);
// --- Category 1: Basic Counter and State Functionality (Parameterized) ---
[TestCase('InitialPositive', '1,False')]
[TestCase('InitialZero_ReturnsNullLatch', '0,True')]
[TestCase('InitialNegative_ReturnsNullLatch', '-1,True')]
[TestCase('InitialLargePositive', '5,False')]
procedure TestCreate_InitialState(InitialCount: Integer; ExpectedIsSet: Boolean);
[TestCase('DecrementPositiveToZero', '1,False,True')] // InitialCount, ExpectedReturnFromLatchNotify, ExpectedIsSetAfterNotify
[TestCase('DecrementPositiveToPositive', '2,True,False')]
[TestCase('DecrementZeroToNegative', '0,False,True')] // Latch.Notify on count 0 returns false (0 > 0 is false)
[TestCase('DecrementNegativeToNegative', '-1,False,True')] // Latch.Notify on count -1 returns false (-1 > 0 is false)
procedure TestNotify_ReturnValueAndState_AfterOneNotify(InitialCount: Integer; ExpectedReturn: Boolean; ExpectedIsSet: Boolean);
[TestCase('DecrementPositiveToZero', '1,False,True')] // InitialCount, ExpectedReturnFromLatchNotify, ExpectedIsSetAfterNotify
[TestCase('DecrementPositiveToPositive', '2,True,False')]
[TestCase('DecrementZeroToNegative', '0,False,True')] // Latch.Notify on count 0 returns false (0 > 0 is false)
[TestCase('DecrementNegativeToNegative', '-1,False,True')] // Latch.Notify on count -1 returns false (-1 > 0 is false)
procedure TestNotify_ReturnValueAndState_AfterOneNotify(InitialCount: Integer; ExpectedReturn: Boolean; ExpectedIsSet: Boolean);
[Test]
procedure TestNotify_DecrementsCounter_StateChanges;
[Test]
procedure TestNotify_MultipleNotifies_CounterBecomesNegativeAndStaysSet;
[Test]
procedure TestNotify_DecrementsCounter_StateChanges;
[Test]
procedure TestNotify_MultipleNotifies_CounterBecomesNegativeAndStaysSet;
// --- Category 2: Notification to Subscribers ---
[Test]
procedure TestSubscriber_Single_IsNotifiedWhenLatchSet;
[Test]
procedure TestSubscriber_Multiple_AreNotifiedWhenLatchSet;
[Test]
procedure TestSubscriber_NotNotified_BeforeLatchSet;
[Test]
procedure TestSubscriber_NotifiedOnlyOnce_AfterLatchSetAndUnadvised; // Clarified name
[Test]
procedure TestSubscribe_ToAlreadySetLatch_NotifiesImmediately;
// --- Category 2: Notification to Subscribers ---
[Test]
procedure TestSubscriber_Single_IsNotifiedWhenLatchSet;
[Test]
procedure TestSubscriber_Multiple_AreNotifiedWhenLatchSet;
[Test]
procedure TestSubscriber_NotNotified_BeforeLatchSet;
[Test]
procedure TestSubscriber_NotifiedOnlyOnce_AfterLatchSetAndUnadvised; // Clarified name
[Test]
procedure TestSubscribe_ToAlreadySetLatch_NotifiesImmediately;
// --- Category 3: Chaining and Cascading Latches ---
[Test]
procedure TestChaining_A_Notifies_B;
[Test]
procedure TestCascade_A_Notifies_B_Notifies_C;
[Test]
procedure TestChaining_B_NeedsMultipleNotifiesFromA_WithSubscriberOnB;
// --- Category 3: Chaining and Cascading Latches ---
[Test]
procedure TestChaining_A_Notifies_B;
[Test]
procedure TestCascade_A_Notifies_B_Notifies_C;
[Test]
procedure TestChaining_B_NeedsMultipleNotifiesFromA_WithSubscriberOnB;
// --- Category 4: Special Cases ---
[Test]
procedure TestInitiallySetLatch_NotifiesNewSubscriberImmediately; // Using CreateLatch(0)
// --- Category 4: Special Cases ---
[Test]
procedure TestInitiallySetLatch_NotifiesNewSubscriberImmediately; // Using CreateLatch(0)
[Test]
procedure TestUnsubscribe_SubscriberNotNotified;
[Test]
procedure TestUnsubscribe_SubscriberNotNotified;
// --- Category 5: Counter Integrity / State for Later Subscribers ---
[Test]
procedure TestMultipleTriggersNoSubscriber_StateCorrectForLaterSubscriber;
// --- Category 5: Counter Integrity / State for Later Subscribers ---
[Test]
procedure TestMultipleTriggersNoSubscriber_StateCorrectForLaterSubscriber;
// --- Category 6: UnadviseAll Behavior on Latch Set ---
[Test]
procedure TestLatchSet_ClearsSubscribers_NoFurtherNotification;
[Test]
procedure TestLatchSet_SubscriptionFinalize_IsSafePostUnadviseAll;
[Test]
procedure TestLatchSet_NewSubscriberToSetLatch_NotifiedImmediatelyButNotPersistedForLatchNotify;
end;
// --- Category 6: UnadviseAll Behavior on Latch Set ---
[Test]
procedure TestLatchSet_ClearsSubscribers_NoFurtherNotification;
[Test]
procedure TestLatchSet_SubscriptionFinalize_IsSafePostUnadviseAll;
[Test]
procedure TestLatchSet_NewSubscriberToSetLatch_NotifiedImmediatelyButNotPersistedForLatchNotify;
end;
implementation
@@ -92,409 +92,425 @@ implementation
constructor TMockSubscriber.Create(AShouldReturn: Boolean = True);
begin
inherited Create;
NotifyCount := 0;
NotifyShouldReturn := AShouldReturn;
WasCalled := False;
inherited Create;
NotifyCount := 0;
NotifyShouldReturn := AShouldReturn;
WasCalled := False;
end;
function TMockSubscriber.Notify: Boolean;
begin
Inc(NotifyCount);
WasCalled := True;
Result := NotifyShouldReturn; // This mock subscriber returns what it's configured to.
Inc(NotifyCount);
WasCalled := True;
Result := NotifyShouldReturn; // This mock subscriber returns what it's configured to.
end;
{ TTestMycLatch }
procedure TTestMycLatch.Setup;
begin
// Per-test setup code can go here (if any).
// Per-test setup code can go here (if any).
end;
procedure TTestMycLatch.TearDown;
begin
// Per-test teardown code can go here (if any).
// Per-test teardown code can go here (if any).
end;
// --- Category 1: Basic Counter and State Functionality (Parameterized) ---
procedure TTestMycLatch.TestCreate_InitialState(InitialCount: Integer; ExpectedIsSet: Boolean);
var
latch: IMycLatch;
latch: IMycLatch;
begin
// TMycLatch.CreateLatch returns TMycLatch.Null if InitialCount <= 0
latch := TLatch.Construct(InitialCount);
Assert.AreEqual(ExpectedIsSet, latch.State.IsSet, 'Latch initial IsSet state mismatch for count ' + IntToStr(InitialCount) + '.');
// TMycLatch.CreateLatch returns TMycLatch.Null if InitialCount <= 0
latch := TLatch.Construct(InitialCount);
Assert.AreEqual(ExpectedIsSet, latch.State.IsSet, 'Latch initial IsSet state mismatch for count ' + IntToStr(InitialCount) + '.');
end;
procedure TTestMycLatch.TestNotify_ReturnValueAndState_AfterOneNotify(InitialCount: Integer; ExpectedReturn: Boolean; ExpectedIsSet: Boolean);
procedure TTestMycLatch.TestNotify_ReturnValueAndState_AfterOneNotify(
InitialCount: Integer;
ExpectedReturn: Boolean;
ExpectedIsSet: Boolean
);
var
latch: IMycLatch;
returnedValueFromNotify: Boolean;
latch: IMycLatch;
returnedValueFromNotify: Boolean;
begin
latch := TLatch.Construct(InitialCount);
returnedValueFromNotify := latch.Notify; // This is IMycLatch (as IMycSubscriber).Notify
latch := TLatch.Construct(InitialCount);
returnedValueFromNotify := latch.Notify; // This is IMycLatch (as IMycSubscriber).Notify
Assert.AreEqual(ExpectedReturn, returnedValueFromNotify, 'Unexpected return value from Latch.Notify call for initial count ' + IntToStr(InitialCount) + '.');
Assert.AreEqual(ExpectedIsSet, latch.State.IsSet, 'Unexpected IsSet state after Latch.Notify call for initial count ' + IntToStr(InitialCount) + '.');
Assert.AreEqual(
ExpectedReturn,
returnedValueFromNotify,
'Unexpected return value from Latch.Notify call for initial count ' + IntToStr(InitialCount) + '.'
);
Assert.AreEqual(
ExpectedIsSet,
latch.State.IsSet,
'Unexpected IsSet state after Latch.Notify call for initial count ' + IntToStr(InitialCount) + '.'
);
end;
procedure TTestMycLatch.TestNotify_DecrementsCounter_StateChanges;
var
latch: IMycLatch;
latch: IMycLatch;
begin
latch := TLatch.Construct(1);
Assert.IsFalse(latch.State.IsSet, 'Latch should initially not be set (Count=1).');
latch.Notify; // Count becomes 0
Assert.IsTrue(latch.State.IsSet, 'Latch should be set after Notify (Count became 0).');
latch := TLatch.Construct(1);
Assert.IsFalse(latch.State.IsSet, 'Latch should initially not be set (Count=1).');
latch.Notify; // Count becomes 0
Assert.IsTrue(latch.State.IsSet, 'Latch should be set after Notify (Count became 0).');
end;
procedure TTestMycLatch.TestNotify_MultipleNotifies_CounterBecomesNegativeAndStaysSet;
var
latch: IMycLatch;
latch: IMycLatch;
begin
latch := TLatch.Construct(1);
latch.Notify; // Count becomes 0, IsSet = True
Assert.IsTrue(latch.State.IsSet, 'Latch should be set after first Notify.');
latch.Notify; // Count becomes -1, IsSet should remain True
Assert.IsTrue(latch.State.IsSet, 'Latch should remain set after second Notify.');
latch := TLatch.Construct(1);
latch.Notify; // Count becomes 0, IsSet = True
Assert.IsTrue(latch.State.IsSet, 'Latch should be set after first Notify.');
latch.Notify; // Count becomes -1, IsSet should remain True
Assert.IsTrue(latch.State.IsSet, 'Latch should remain set after second Notify.');
end;
// --- Category 2: Notification to Subscribers ---
procedure TTestMycLatch.TestSubscriber_Single_IsNotifiedWhenLatchSet;
var
latch: IMycLatch;
mockSub: TMockSubscriber;
subscription: TState.TSubscription;
latch: IMycLatch;
mockSub: TMockSubscriber;
subscription: TState.TSubscription;
begin
latch := TLatch.Construct(1);
mockSub := TMockSubscriber.Create;
subscription := latch.State.Subscribe(mockSub); // Subscribing to the Latch's state
latch := TLatch.Construct(1);
mockSub := TMockSubscriber.Create;
subscription := latch.State.Subscribe(mockSub); // Subscribing to the Latch's state
Assert.IsFalse(latch.State.IsSet, 'Latch should initially not be set.');
Assert.AreEqual(0, mockSub.NotifyCount, 'MockSub should not have been notified yet (before latch set).');
Assert.IsFalse(latch.State.IsSet, 'Latch should initially not be set.');
Assert.AreEqual(0, mockSub.NotifyCount, 'MockSub should not have been notified yet (before latch set).');
latch.Notify; // Latch becomes set, notifies subscribers
latch.Notify; // Latch becomes set, notifies subscribers
Assert.IsTrue(latch.State.IsSet, 'Latch should be set after its Notify is called.');
Assert.AreEqual(1, mockSub.NotifyCount, 'MockSub should have been notified once when latch becomes set.');
Assert.IsTrue(latch.State.IsSet, 'Latch should be set after its Notify is called.');
Assert.AreEqual(1, mockSub.NotifyCount, 'MockSub should have been notified once when latch becomes set.');
end;
procedure TTestMycLatch.TestSubscriber_Multiple_AreNotifiedWhenLatchSet;
var
latch: IMycLatch;
mockSub1, mockSub2, mockSub3: TMockSubscriber;
sub1, sub2, sub3: TState.TSubscription; // Keep subscriptions in scope
latch: IMycLatch;
mockSub1, mockSub2, mockSub3: TMockSubscriber;
sub1, sub2, sub3: TState.TSubscription; // Keep subscriptions in scope
begin
latch := TLatch.Construct(1);
mockSub1 := TMockSubscriber.Create;
mockSub2 := TMockSubscriber.Create;
mockSub3 := TMockSubscriber.Create;
latch := TLatch.Construct(1);
mockSub1 := TMockSubscriber.Create;
mockSub2 := TMockSubscriber.Create;
mockSub3 := TMockSubscriber.Create;
sub1 := latch.State.Subscribe(mockSub1);
sub2 := latch.State.Subscribe(mockSub2);
sub3 := latch.State.Subscribe(mockSub3);
sub1 := latch.State.Subscribe(mockSub1);
sub2 := latch.State.Subscribe(mockSub2);
sub3 := latch.State.Subscribe(mockSub3);
latch.Notify; // Latch becomes set
latch.Notify; // Latch becomes set
Assert.AreEqual(1, mockSub1.NotifyCount, 'MockSub1 notification count mismatch.');
Assert.AreEqual(1, mockSub2.NotifyCount, 'MockSub2 notification count mismatch.');
Assert.AreEqual(1, mockSub3.NotifyCount, 'MockSub3 notification count mismatch.');
Assert.AreEqual(1, mockSub1.NotifyCount, 'MockSub1 notification count mismatch.');
Assert.AreEqual(1, mockSub2.NotifyCount, 'MockSub2 notification count mismatch.');
Assert.AreEqual(1, mockSub3.NotifyCount, 'MockSub3 notification count mismatch.');
end;
procedure TTestMycLatch.TestSubscriber_NotNotified_BeforeLatchSet;
var
latch: IMycLatch;
mockSub: TMockSubscriber;
subscription: TState.TSubscription;
latch: IMycLatch;
mockSub: TMockSubscriber;
subscription: TState.TSubscription;
begin
latch := TLatch.Construct(2); // Count = 2
mockSub := TMockSubscriber.Create;
subscription := latch.State.Subscribe(mockSub);
latch := TLatch.Construct(2); // Count = 2
mockSub := TMockSubscriber.Create;
subscription := latch.State.Subscribe(mockSub);
Assert.AreEqual(0, mockSub.NotifyCount, 'MockSub should not be notified upon subscription if latch is not set.');
latch.Notify; // Count becomes 1, still not set
Assert.AreEqual(0, mockSub.NotifyCount, 'MockSub should still not be notified as latch is not yet set (Count=1).');
Assert.AreEqual(0, mockSub.NotifyCount, 'MockSub should not be notified upon subscription if latch is not set.');
latch.Notify; // Count becomes 1, still not set
Assert.AreEqual(0, mockSub.NotifyCount, 'MockSub should still not be notified as latch is not yet set (Count=1).');
end;
procedure TTestMycLatch.TestSubscriber_NotifiedOnlyOnce_AfterLatchSetAndUnadvised;
var
latch: IMycLatch;
mockSub: TMockSubscriber;
subscription: TState.TSubscription;
latch: IMycLatch;
mockSub: TMockSubscriber;
subscription: TState.TSubscription;
begin
latch := TLatch.Construct(1);
mockSub := TMockSubscriber.Create;
subscription := latch.State.Subscribe(mockSub);
latch := TLatch.Construct(1);
mockSub := TMockSubscriber.Create;
subscription := latch.State.Subscribe(mockSub);
latch.Notify; // Sets latch, notifies MockSub. Subscribers are then unadvised by UnadviseAll.
Assert.AreEqual(1, mockSub.NotifyCount, 'MockSub notify count should be 1 after latch set.');
latch.Notify; // Sets latch, notifies MockSub. Subscribers are then unadvised by UnadviseAll.
Assert.AreEqual(1, mockSub.NotifyCount, 'MockSub notify count should be 1 after latch set.');
latch.Notify; // Call Notify on latch again (FCount becomes more negative).
Assert.AreEqual(1, mockSub.NotifyCount, 'MockSub notify count should remain 1 (not notified again as it was unadvised).');
latch.Notify; // Call Notify on latch again (FCount becomes more negative).
Assert.AreEqual(1, mockSub.NotifyCount, 'MockSub notify count should remain 1 (not notified again as it was unadvised).');
end;
procedure TTestMycLatch.TestSubscribe_ToAlreadySetLatch_NotifiesImmediately;
var
latch: IMycLatch;
mockSub1, mockSub2: TMockSubscriber;
subscription1, subscription2: TState.TSubscription;
latch: IMycLatch;
mockSub1, mockSub2: TMockSubscriber;
subscription1, subscription2: TState.TSubscription;
begin
latch := TLatch.Construct(1); // Create with count 1
mockSub1 := TMockSubscriber.Create;
subscription1 := latch.State.Subscribe(mockSub1); // Subscribe before set
latch := TLatch.Construct(1); // Create with count 1
mockSub1 := TMockSubscriber.Create;
subscription1 := latch.State.Subscribe(mockSub1); // Subscribe before set
latch.Notify; // Latch becomes set. mockSub1 is notified.
latch.Notify; // Latch becomes set. mockSub1 is notified.
Assert.IsTrue(latch.State.IsSet, 'Latch should be set after initial trigger.');
Assert.AreEqual(1, mockSub1.NotifyCount, 'MockSub1 should have been notified once.');
Assert.IsTrue(latch.State.IsSet, 'Latch should be set after initial trigger.');
Assert.AreEqual(1, mockSub1.NotifyCount, 'MockSub1 should have been notified once.');
// Attempt to subscribe mockSub2 after the latch is already set.
mockSub2 := TMockSubscriber.Create;
subscription2 := latch.State.Subscribe(mockSub2); // TMycLatch.Subscribe (via TMycAbstractFlag) notifies immediately if already set.
// Attempt to subscribe mockSub2 after the latch is already set.
mockSub2 := TMockSubscriber.Create;
subscription2 := latch.State.Subscribe(mockSub2); // TMycLatch.Subscribe (via TMycAbstractFlag) notifies immediately if already set.
Assert.AreEqual(1, mockSub2.NotifyCount, 'MockSub2 should be notified immediately upon subscribing to an already set latch.');
Assert.AreEqual(1, mockSub2.NotifyCount, 'MockSub2 should be notified immediately upon subscribing to an already set latch.');
latch.Notify; // Call Notify on latch again (FCount becomes more negative).
Assert.AreEqual(1, mockSub1.NotifyCount, 'MockSub1 notify count should remain 1 (was unadvised).');
Assert.AreEqual(1, mockSub2.NotifyCount, 'MockSub2 notify count should remain 1 (was only notified on subscribe, not added to list).');
latch.Notify; // Call Notify on latch again (FCount becomes more negative).
Assert.AreEqual(1, mockSub1.NotifyCount, 'MockSub1 notify count should remain 1 (was unadvised).');
Assert.AreEqual(1, mockSub2.NotifyCount, 'MockSub2 notify count should remain 1 (was only notified on subscribe, not added to list).');
end;
// --- Category 3: Chaining and Cascading Latches ---
procedure TTestMycLatch.TestChaining_A_Notifies_B;
var
latchA, latchB: IMycLatch;
mockSubForB: TMockSubscriber;
subHandle_B_listens_A, subHandle_Mock_listens_B: TState.TSubscription;
latchA, latchB: IMycLatch;
mockSubForB: TMockSubscriber;
subHandle_B_listens_A, subHandle_Mock_listens_B: TState.TSubscription;
begin
latchA := TLatch.Construct(1);
latchB := TLatch.Construct(1); // latchB is an IMycSubscriber
mockSubForB := TMockSubscriber.Create;
latchA := TLatch.Construct(1);
latchB := TLatch.Construct(1); // latchB is an IMycSubscriber
mockSubForB := TMockSubscriber.Create;
subHandle_Mock_listens_B := latchB.State.Subscribe(mockSubForB);
// LatchA's state is an IMycSignal. LatchB (as IMycSubscriber) subscribes to it.
subHandle_B_listens_A := latchA.State.Subscribe(latchB);
subHandle_Mock_listens_B := latchB.State.Subscribe(mockSubForB);
// LatchA's state is an IMycSignal. LatchB (as IMycSubscriber) subscribes to it.
subHandle_B_listens_A := latchA.State.Subscribe(latchB);
Assert.IsFalse(latchA.State.IsSet, 'LatchA initially not set.');
Assert.IsFalse(latchB.State.IsSet, 'LatchB initially not set.');
Assert.AreEqual(0, mockSubForB.NotifyCount, 'MockSubForB initially not notified.');
Assert.IsFalse(latchA.State.IsSet, 'LatchA initially not set.');
Assert.IsFalse(latchB.State.IsSet, 'LatchB initially not set.');
Assert.AreEqual(0, mockSubForB.NotifyCount, 'MockSubForB initially not notified.');
latchA.Notify; // Call Notify on LatchA (as IMycSubscriber)
latchA.Notify; // Call Notify on LatchA (as IMycSubscriber)
Assert.IsTrue(latchA.State.IsSet, 'LatchA should be set after notify.');
Assert.IsTrue(latchB.State.IsSet, 'LatchB should be set after being notified by LatchA.');
Assert.AreEqual(1, mockSubForB.NotifyCount, 'MockSubForB should have been notified by LatchB.');
Assert.IsTrue(latchA.State.IsSet, 'LatchA should be set after notify.');
Assert.IsTrue(latchB.State.IsSet, 'LatchB should be set after being notified by LatchA.');
Assert.AreEqual(1, mockSubForB.NotifyCount, 'MockSubForB should have been notified by LatchB.');
end;
procedure TTestMycLatch.TestCascade_A_Notifies_B_Notifies_C;
var
latchA, latchB, latchC: IMycLatch;
mockSubForC: TMockSubscriber;
sub_Mock_C, sub_C_B, sub_B_A: TState.TSubscription;
latchA, latchB, latchC: IMycLatch;
mockSubForC: TMockSubscriber;
sub_Mock_C, sub_C_B, sub_B_A: TState.TSubscription;
begin
latchA := TLatch.Construct(1);
latchB := TLatch.Construct(1);
latchC := TLatch.Construct(1);
mockSubForC := TMockSubscriber.Create;
latchA := TLatch.Construct(1);
latchB := TLatch.Construct(1);
latchC := TLatch.Construct(1);
mockSubForC := TMockSubscriber.Create;
sub_Mock_C := latchC.State.Subscribe(mockSubForC);
sub_C_B := latchB.State.Subscribe(latchC); // LatchC subscribes to LatchB's state
sub_B_A := latchA.State.Subscribe(latchB); // LatchB subscribes to LatchA's state
sub_Mock_C := latchC.State.Subscribe(mockSubForC);
sub_C_B := latchB.State.Subscribe(latchC); // LatchC subscribes to LatchB's state
sub_B_A := latchA.State.Subscribe(latchB); // LatchB subscribes to LatchA's state
latchA.Notify; // Call Notify on LatchA
latchA.Notify; // Call Notify on LatchA
Assert.IsTrue(latchA.State.IsSet, 'LatchA state mismatch in cascade.');
Assert.IsTrue(latchB.State.IsSet, 'LatchB state mismatch in cascade.');
Assert.IsTrue(latchC.State.IsSet, 'LatchC state mismatch in cascade.');
Assert.AreEqual(1, mockSubForC.NotifyCount, 'MockSubForC notification count mismatch in cascade.');
Assert.IsTrue(latchA.State.IsSet, 'LatchA state mismatch in cascade.');
Assert.IsTrue(latchB.State.IsSet, 'LatchB state mismatch in cascade.');
Assert.IsTrue(latchC.State.IsSet, 'LatchC state mismatch in cascade.');
Assert.AreEqual(1, mockSubForC.NotifyCount, 'MockSubForC notification count mismatch in cascade.');
end;
procedure TTestMycLatch.TestChaining_B_NeedsMultipleNotifiesFromA_WithSubscriberOnB;
var
latchA, latchB: IMycLatch;
mockSubForB: TMockSubscriber;
sub_Mock_B, sub_B_A: TState.TSubscription;
latchA, latchB: IMycLatch;
mockSubForB: TMockSubscriber;
sub_Mock_B, sub_B_A: TState.TSubscription;
begin
// LatchA needs 2 notifies to become set. LatchB needs 1 notify to become set.
// LatchB subscribes to LatchA. So LatchB will be notified once LatchA becomes set.
latchA := TLatch.Construct(2);
latchB := TLatch.Construct(1);
mockSubForB := TMockSubscriber.Create;
// LatchA needs 2 notifies to become set. LatchB needs 1 notify to become set.
// LatchB subscribes to LatchA. So LatchB will be notified once LatchA becomes set.
latchA := TLatch.Construct(2);
latchB := TLatch.Construct(1);
mockSubForB := TMockSubscriber.Create;
sub_Mock_B := latchB.State.Subscribe(mockSubForB);
sub_B_A := latchA.State.Subscribe(latchB);
sub_Mock_B := latchB.State.Subscribe(mockSubForB);
sub_B_A := latchA.State.Subscribe(latchB);
latchA.Notify; // First notify for LatchA (count becomes 1)
Assert.IsFalse(latchA.State.IsSet, 'LatchA should not be set after first notify of two.');
Assert.IsFalse(latchB.State.IsSet, 'LatchB should not have been triggered yet by LatchA.');
Assert.AreEqual(0, mockSubForB.NotifyCount, 'MockSubForB should not have been notified yet.');
latchA.Notify; // First notify for LatchA (count becomes 1)
Assert.IsFalse(latchA.State.IsSet, 'LatchA should not be set after first notify of two.');
Assert.IsFalse(latchB.State.IsSet, 'LatchB should not have been triggered yet by LatchA.');
Assert.AreEqual(0, mockSubForB.NotifyCount, 'MockSubForB should not have been notified yet.');
latchA.Notify; // Second notify for LatchA (count becomes 0, LatchA becomes set)
Assert.IsTrue(latchA.State.IsSet, 'LatchA should be set after second notify.');
// When LatchA becomes set, it notifies its subscribers (LatchB). LatchB.Notify is called.
Assert.IsTrue(latchB.State.IsSet, 'LatchB should now be set by LatchA.');
Assert.AreEqual(1, mockSubForB.NotifyCount, 'MockSubForB should have been notified by LatchB.');
latchA.Notify; // Second notify for LatchA (count becomes 0, LatchA becomes set)
Assert.IsTrue(latchA.State.IsSet, 'LatchA should be set after second notify.');
// When LatchA becomes set, it notifies its subscribers (LatchB). LatchB.Notify is called.
Assert.IsTrue(latchB.State.IsSet, 'LatchB should now be set by LatchA.');
Assert.AreEqual(1, mockSubForB.NotifyCount, 'MockSubForB should have been notified by LatchB.');
end;
// --- Category 4: Special Cases ---
procedure TTestMycLatch.TestInitiallySetLatch_NotifiesNewSubscriberImmediately;
var
latch: IMycLatch; // Will be TMycLatch.Null
mockSub: TMockSubscriber;
subscription: TState.TSubscription;
latch: IMycLatch; // Will be TMycLatch.Null
mockSub: TMockSubscriber;
subscription: TState.TSubscription;
begin
latch := TLatch.Construct(0); // Returns TMycLatch.Null which is set.
mockSub := TMockSubscriber.Create;
latch := TLatch.Construct(0); // Returns TMycLatch.Null which is set.
mockSub := TMockSubscriber.Create;
subscription := latch.State.Subscribe(mockSub); // TMycLatch.Subscribe notifies immediately if already set.
subscription := latch.State.Subscribe(mockSub); // TMycLatch.Subscribe notifies immediately if already set.
Assert.IsTrue(latch.State.IsSet, 'Latch IsSet property mismatch (should be true for Null latch).');
Assert.AreEqual(1, mockSub.NotifyCount, 'MockSub should be notified immediately upon subscribing to an initially set latch.');
Assert.IsTrue(latch.State.IsSet, 'Latch IsSet property mismatch (should be true for Null latch).');
Assert.AreEqual(1, mockSub.NotifyCount, 'MockSub should be notified immediately upon subscribing to an initially set latch.');
end;
procedure TTestMycLatch.TestUnsubscribe_SubscriberNotNotified;
var
latch: IMycLatch;
mockSub: TMockSubscriber;
subscription: TState.TSubscription;
latch: IMycLatch;
mockSub: TMockSubscriber;
subscription: TState.TSubscription;
begin
latch := TLatch.Construct(1);
mockSub := TMockSubscriber.Create;
latch := TLatch.Construct(1);
mockSub := TMockSubscriber.Create;
subscription := latch.State.Subscribe(mockSub);
subscription.Unsubscribe; // Explicitly call Unsubscribe on the record
subscription := latch.State.Subscribe(mockSub);
subscription.Unsubscribe; // Explicitly call Unsubscribe on the record
latch.Notify; // Latch becomes set
latch.Notify; // Latch becomes set
Assert.AreEqual(0, mockSub.NotifyCount, 'Unsubscribed MockSub should not be notified.');
Assert.AreEqual(0, mockSub.NotifyCount, 'Unsubscribed MockSub should not be notified.');
end;
// --- Category 5: Counter Integrity / State for Later Subscribers ---
procedure TTestMycLatch.TestMultipleTriggersNoSubscriber_StateCorrectForLaterSubscriber;
var
latch: IMycLatch;
mockSub: TMockSubscriber;
subscription: TState.TSubscription;
latch: IMycLatch;
mockSub: TMockSubscriber;
subscription: TState.TSubscription;
begin
latch := TLatch.Construct(3);
latch := TLatch.Construct(3);
latch.Notify; // Count -> 2
latch.Notify; // Count -> 1
Assert.IsFalse(latch.State.IsSet, 'Latch should not be set yet after partial notifies.');
latch.Notify; // Count -> 2
latch.Notify; // Count -> 1
Assert.IsFalse(latch.State.IsSet, 'Latch should not be set yet after partial notifies.');
mockSub := TMockSubscriber.Create;
subscription := latch.State.Subscribe(mockSub);
Assert.AreEqual(0, mockSub.NotifyCount, 'MockSub should not be notified on subscribe if latch not yet set.');
mockSub := TMockSubscriber.Create;
subscription := latch.State.Subscribe(mockSub);
Assert.AreEqual(0, mockSub.NotifyCount, 'MockSub should not be notified on subscribe if latch not yet set.');
latch.Notify; // Count -> 0, Latch becomes set and notifies mockSub
Assert.IsTrue(latch.State.IsSet, 'Latch should now be set.');
Assert.AreEqual(1, mockSub.NotifyCount, 'MockSub should have been notified when latch becomes set.');
latch.Notify; // Count -> 0, Latch becomes set and notifies mockSub
Assert.IsTrue(latch.State.IsSet, 'Latch should now be set.');
Assert.AreEqual(1, mockSub.NotifyCount, 'MockSub should have been notified when latch becomes set.');
end;
// --- Category 6: UnadviseAll Behavior on Latch Set ---
procedure TTestMycLatch.TestLatchSet_ClearsSubscribers_NoFurtherNotification;
var
latch: IMycLatch;
mockSub1, mockSub2: TMockSubscriber;
subscription1, subscription2: TState.TSubscription;
latch: IMycLatch;
mockSub1, mockSub2: TMockSubscriber;
subscription1, subscription2: TState.TSubscription;
begin
latch := TLatch.Construct(1);
mockSub1 := TMockSubscriber.Create;
mockSub2 := TMockSubscriber.Create;
latch := TLatch.Construct(1);
mockSub1 := TMockSubscriber.Create;
mockSub2 := TMockSubscriber.Create;
subscription1 := latch.State.Subscribe(mockSub1);
subscription2 := latch.State.Subscribe(mockSub2);
subscription1 := latch.State.Subscribe(mockSub1);
subscription2 := latch.State.Subscribe(mockSub2);
Assert.AreEqual(0, mockSub1.NotifyCount, 'MockSub1 initial NotifyCount should be 0.');
Assert.AreEqual(0, mockSub2.NotifyCount, 'MockSub2 initial NotifyCount should be 0.');
Assert.AreEqual(0, mockSub1.NotifyCount, 'MockSub1 initial NotifyCount should be 0.');
Assert.AreEqual(0, mockSub2.NotifyCount, 'MockSub2 initial NotifyCount should be 0.');
latch.Notify; // FCount becomes 0. Subscribers notified, then UnadviseAll called.
latch.Notify; // FCount becomes 0. Subscribers notified, then UnadviseAll called.
Assert.IsTrue(latch.State.IsSet, 'Latch should be set.');
Assert.AreEqual(1, mockSub1.NotifyCount, 'MockSub1 should have been notified once when latch became set.');
Assert.AreEqual(1, mockSub2.NotifyCount, 'MockSub2 should have been notified once when latch became set.');
Assert.IsTrue(latch.State.IsSet, 'Latch should be set.');
Assert.AreEqual(1, mockSub1.NotifyCount, 'MockSub1 should have been notified once when latch became set.');
Assert.AreEqual(1, mockSub2.NotifyCount, 'MockSub2 should have been notified once when latch became set.');
latch.Notify; // Call Notify on the latch again (FCount becomes -1)
latch.Notify; // Call Notify on the latch again (FCount becomes -1)
Assert.AreEqual(1, mockSub1.NotifyCount, 'MockSub1 should NOT be notified again after UnadviseAll.');
Assert.AreEqual(1, mockSub2.NotifyCount, 'MockSub2 should NOT be notified again after UnadviseAll.');
Assert.AreEqual(1, mockSub1.NotifyCount, 'MockSub1 should NOT be notified again after UnadviseAll.');
Assert.AreEqual(1, mockSub2.NotifyCount, 'MockSub2 should NOT be notified again after UnadviseAll.');
end;
procedure TTestMycLatch.TestLatchSet_SubscriptionFinalize_IsSafePostUnadviseAll;
var
latch: IMycLatch;
mockSub: TMockSubscriber;
// 'subscription' will be declared in an inner scope to control its finalization
latch: IMycLatch;
mockSub: TMockSubscriber;
// 'subscription' will be declared in an inner scope to control its finalization
begin
latch := TLatch.Construct(1);
mockSub := TMockSubscriber.Create;
latch := TLatch.Construct(1);
mockSub := TMockSubscriber.Create;
var noException: Boolean := True;
try
begin // Inner block to control lifetime of 'subscription'
var subscription: TState.TSubscription; // Local to this block
subscription := latch.State.Subscribe(mockSub);
var noException: Boolean := True;
try
begin // Inner block to control lifetime of 'subscription'
var subscription: TState.TSubscription; // Local to this block
subscription := latch.State.Subscribe(mockSub);
latch.Notify; // Sets the latch, mockSub is notified, UnadviseAll is called internally.
Assert.AreEqual(1, mockSub.NotifyCount, 'MockSub was notified when latch set.');
latch.Notify; // Sets the latch, mockSub is notified, UnadviseAll is called internally.
Assert.AreEqual(1, mockSub.NotifyCount, 'MockSub was notified when latch set.');
// When 'subscription' goes out of scope at the end of this 'begin..end' block,
// its Finalize operator will be called, which in turn calls subscription.Unsubscribe.
// This happens *after* UnadviseAll was triggered by latch.Notify.
end; // <-- subscription.Finalize (and thus Unsubscribe) is called here.
except
on E: Exception do
begin
noException := False;
// Optional: Log.Error('Exception in TestLatchSet_SubscriptionFinalize_IsSafePostUnadviseAll: ' + E.Message);
// When 'subscription' goes out of scope at the end of this 'begin..end' block,
// its Finalize operator will be called, which in turn calls subscription.Unsubscribe.
// This happens *after* UnadviseAll was triggered by latch.Notify.
end; // <-- subscription.Finalize (and thus Unsubscribe) is called here.
except
on E: Exception do
begin
noException := False;
// Optional: Log.Error('Exception in TestLatchSet_SubscriptionFinalize_IsSafePostUnadviseAll: ' + E.Message);
end;
end;
end;
Assert.IsTrue(noException, 'Finalizing subscription after Latch set (and UnadviseAll) should not raise an exception.');
Assert.IsTrue(noException, 'Finalizing subscription after Latch set (and UnadviseAll) should not raise an exception.');
// Further check: calling Notify on latch again should not affect the original mockSub
latch.Notify;
Assert.AreEqual(1, mockSub.NotifyCount, 'MockSub should not be notified after its subscription was finalized post UnadviseAll.');
// Further check: calling Notify on latch again should not affect the original mockSub
latch.Notify;
Assert.AreEqual(1, mockSub.NotifyCount, 'MockSub should not be notified after its subscription was finalized post UnadviseAll.');
end;
procedure TTestMycLatch.TestLatchSet_NewSubscriberToSetLatch_NotifiedImmediatelyButNotPersistedForLatchNotify;
var
latch: IMycLatch;
mockSubInitial, mockSubNew: TMockSubscriber;
subscriptionInitial, subscriptionNew: TState.TSubscription;
latch: IMycLatch;
mockSubInitial, mockSubNew: TMockSubscriber;
subscriptionInitial, subscriptionNew: TState.TSubscription;
begin
latch := TLatch.Construct(1);
mockSubInitial := TMockSubscriber.Create;
subscriptionInitial := latch.State.Subscribe(mockSubInitial);
latch := TLatch.Construct(1);
mockSubInitial := TMockSubscriber.Create;
subscriptionInitial := latch.State.Subscribe(mockSubInitial);
// Set the latch; mockSubInitial is notified, UnadviseAll is called.
latch.Notify;
Assert.AreEqual(1, mockSubInitial.NotifyCount, 'Initial subscriber notified.');
// Set the latch; mockSubInitial is notified, UnadviseAll is called.
latch.Notify;
Assert.AreEqual(1, mockSubInitial.NotifyCount, 'Initial subscriber notified.');
// Subscribe a new subscriber to the already set latch
mockSubNew := TMockSubscriber.Create;
subscriptionNew := latch.State.Subscribe(mockSubNew);
// Subscribe a new subscriber to the already set latch
mockSubNew := TMockSubscriber.Create;
subscriptionNew := latch.State.Subscribe(mockSubNew);
// New subscriber should be notified immediately upon subscription to an already set latch
Assert.AreEqual(1, mockSubNew.NotifyCount, 'New subscriber should be notified immediately upon subscription.');
// The direct check of subscriptionNew.FTag was removed as FTag is private.
// The correct behavior (no persistent subscription) is verified by the next step.
// New subscriber should be notified immediately upon subscription to an already set latch
Assert.AreEqual(1, mockSubNew.NotifyCount, 'New subscriber should be notified immediately upon subscription.');
// The direct check of subscriptionNew.FTag was removed as FTag is private.
// The correct behavior (no persistent subscription) is verified by the next step.
// Call Notify on the latch again.
latch.Notify;
// Call Notify on the latch again.
latch.Notify;
// mockSubInitial should not be notified again (was unadvised).
Assert.AreEqual(1, mockSubInitial.NotifyCount, 'Initial subscriber (unadvised) not notified again.');
// mockSubNew should also not be notified again, as it was only notified immediately
// and not persistently added to FSubscribers for subsequent Latch.Notify calls.
Assert.AreEqual(1, mockSubNew.NotifyCount, 'New subscriber (notified once on subscribe) not notified by subsequent Latch.Notify calls.');
// mockSubInitial should not be notified again (was unadvised).
Assert.AreEqual(1, mockSubInitial.NotifyCount, 'Initial subscriber (unadvised) not notified again.');
// mockSubNew should also not be notified again, as it was only notified immediately
// and not persistently added to FSubscribers for subsequent Latch.Notify calls.
Assert.AreEqual(
1,
mockSubNew.NotifyCount,
'New subscriber (notified once on subscribe) not notified by subsequent Latch.Notify calls.'
);
end;
initialization
TDUnitX.RegisterTestFixture(TTestMycLatch);
TDUnitX.RegisterTestFixture(TTestMycLatch);
end.
Test/TestTasks.pas
+54 -56
View File
@@ -8,7 +8,8 @@ uses
System.Classes,
System.SyncObjs,
Myc.Core.Tasks,
Myc.Signals, Myc.Core.Signals,
Myc.Signals,
Myc.Core.Signals,
Myc.Core.Atomic;
type
@@ -73,10 +74,7 @@ var
procWrapper: TProc;
begin
executed := False;
procWrapper := procedure
begin
executed := True;
end;
procWrapper := procedure begin executed := True; end;
threadState := FFactory.CreateThread(procWrapper); // CreateThread in TaskFactory now uses TMycLatch.CreateLatch
Assert.IsNotNull(threadState, 'CreateThread should return a valid state object');
@@ -93,12 +91,14 @@ begin
jobExecuted := False;
jobCompletedLatch := TLatch.Construct(1); // Changed from Signals.CreateLatch
FFactory.Run(
procedure
begin
jobExecuted := True;
jobCompletedLatch.Notify;
end).Notify;
FFactory
.Run(
procedure
begin
jobExecuted := True;
jobCompletedLatch.Notify;
end)
.Notify;
FFactory.WaitFor(jobCompletedLatch.State);
Assert.IsTrue(jobExecuted, 'Immediate job should have executed');
@@ -113,12 +113,14 @@ begin
jobExecuted := False;
jobCompletedLatch := TLatch.Construct(1); // Changed from Signals.CreateLatch
subscriber := FFactory.Run(
procedure
begin
jobExecuted := True;
jobCompletedLatch.Notify;
end);
subscriber :=
FFactory.Run(
procedure
begin
jobExecuted := True;
jobCompletedLatch.Notify;
end
);
Assert.IsNotNull(subscriber, 'Run should return a subscriber for delayed job');
// Use TMycLatch.Null for comparison
@@ -130,7 +132,6 @@ begin
Assert.IsTrue(jobExecuted, 'Delayed job should execute after all notifications');
end;
procedure TMycTaskFactoryTests.TestWaitForAlreadySetState;
var
alreadySetLatch: IMycLatch;
@@ -161,12 +162,13 @@ begin
Assert.IsFalse(FFactory.InWorkerThread, 'Test method itself should not be in a factory worker thread');
FFactory.EnqueueJob(
procedure
begin
inMainThreadInJob := FFactory.InMainThread;
inWorkerThreadInJob := FFactory.InWorkerThread;
jobDoneLatch.Notify;
end);
procedure
begin
inMainThreadInJob := FFactory.InMainThread;
inWorkerThreadInJob := FFactory.InWorkerThread;
jobDoneLatch.Notify;
end
);
FFactory.WaitFor(jobDoneLatch.State);
@@ -181,22 +183,20 @@ begin
jobDoneLatch := TLatch.Construct(1);
FFactory.EnqueueJob(
procedure
begin
try
raise TMycTaskFactory.ETaskException.Create('Test Exception From Job');
finally
jobDoneLatch.Notify;
end;
end);
procedure
begin
try
raise TMycTaskFactory.ETaskException.Create('Test Exception From Job');
finally
jobDoneLatch.Notify;
end;
end
);
Assert.WillRaise(
procedure
begin
FFactory.WaitFor(jobDoneLatch.State);
end,
TMycTaskFactory.ETaskException,
'WaitFor should re-raise the exception from the job'
procedure begin FFactory.WaitFor(jobDoneLatch.State); end,
TMycTaskFactory.ETaskException,
'WaitFor should re-raise the exception from the job'
);
var noExceptionRaised: Boolean := True;
@@ -213,12 +213,9 @@ begin
FFactory.Teardown;
Assert.WillRaise(
procedure
begin
FFactory.EnqueueJob(procedure begin end);
end,
TMycTaskFactory.ETaskException,
'Running a job on a torn-down factory should raise ETaskException'
procedure begin FFactory.EnqueueJob(procedure begin end); end,
TMycTaskFactory.ETaskException,
'Running a job on a torn-down factory should raise ETaskException'
);
end;
@@ -233,18 +230,19 @@ begin
dummyStateToWaitFor := TLatch.Construct(1).State;
FFactory.EnqueueJob(
procedure
begin
try
FFactory.WaitFor(dummyStateToWaitFor);
except
on E: TMycTaskFactory.ETaskException do
begin
exceptionCaughtInJob := True;
end;
end;
jobDoneLatch.Notify;
end);
procedure
begin
try
FFactory.WaitFor(dummyStateToWaitFor);
except
on E: TMycTaskFactory.ETaskException do
begin
exceptionCaughtInJob := True;
end;
end;
jobDoneLatch.Notify;
end
);
FFactory.WaitFor(jobDoneLatch.State);
Assert.IsTrue(exceptionCaughtInJob, 'WaitFor called within a worker thread job should raise ETaskException');