added Futures
This commit is contained in:
+4
-2
@@ -12,7 +12,6 @@ uses
|
||||
TestInsight.DUnitX,
|
||||
{$ELSE}
|
||||
DUnitX.Loggers.Console,
|
||||
DUnitX.Loggers.Xml.NUnit,
|
||||
{$ENDIF }
|
||||
DUnitX.TestFramework,
|
||||
TestNotifier in 'TestNotifier.pas',
|
||||
@@ -22,7 +21,10 @@ uses
|
||||
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';
|
||||
TestTasks in 'TestTasks.pas',
|
||||
TestSignals_Dirty in 'TestSignals_Dirty.pas',
|
||||
Myc.Futures in '..\Src\Myc.Futures.pas',
|
||||
TestFutures in 'TestFutures.pas';
|
||||
|
||||
{ keep comment here to protect the following conditional from being removed by the IDE when adding a unit }
|
||||
{$IFNDEF TESTINSIGHT}
|
||||
|
||||
@@ -63,6 +63,10 @@
|
||||
<VerInfo_Locale>1031</VerInfo_Locale>
|
||||
<VerInfo_Keys>CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=</VerInfo_Keys>
|
||||
<Debugger_RunParams>--exitbehavior:Pause</Debugger_RunParams>
|
||||
<DCC_Define>TESTINSIGHT;$(DCC_Define)</DCC_Define>
|
||||
<PostBuildEvent><![CDATA[T:\DelphiIntfExtract\Win64\Debug\ExtractPascalInterfaces.exe -o T:\Myc\intf.txt T:\Myc\src
|
||||
$(PostBuildEvent)]]></PostBuildEvent>
|
||||
<PostBuildEventExecuteWhen>TargetOutOfDate</PostBuildEventExecuteWhen>
|
||||
</PropertyGroup>
|
||||
<PropertyGroup Condition="'$(Base_Win32)'!=''">
|
||||
<DCC_UsePackage>vclwinx;fmx;vclie;DbxCommonDriver;bindengine;IndyIPCommon;VCLRESTComponents;FireDACCommonODBC;FireDACCommonDriver;IndyProtocols;vclx;Skia.Package.RTL;IndyIPClient;dbxcds;vcledge;bindcompvclwinx;FmxTeeUI;bindcompfmx;inetdb;FireDACSqliteDriver;DbxClientDriver;Tee;soapmidas;vclactnband;TeeUI;fmxFireDAC;dbexpress;DBXMySQLDriver;VclSmp;inet;vcltouch;fmxase;dbrtl;Skia.Package.FMX;fmxdae;TeeDB;FireDACMSAccDriver;CustomIPTransport;vcldsnap;DBXInterBaseDriver;IndySystem;Skia.Package.VCL;vcldb;vclFireDAC;bindcomp;FireDACCommon;inetstn;IndyCore;RESTBackendComponents;bindcompdbx;rtl;FireDACMySQLDriver;FireDACADSDriver;RESTComponents;DBXSqliteDriver;vcl;IndyIPServer;dsnapxml;dsnapcon;adortl;vclimg;FireDACPgDriver;FireDAC;inetdbxpress;xmlrtl;tethering;bindcompvcl;dsnap;CloudService;fmxobj;bindcompvclsmp;FMXTee;soaprtl;soapserver;FireDACIBDriver;$(DCC_UsePackage)</DCC_UsePackage>
|
||||
@@ -117,6 +121,9 @@
|
||||
<DCCReference Include="TestSignals_Latch.pas"/>
|
||||
<DCCReference Include="..\Src\Myc.Core.Tasks.pas"/>
|
||||
<DCCReference Include="TestTasks.pas"/>
|
||||
<DCCReference Include="TestSignals_Dirty.pas"/>
|
||||
<DCCReference Include="..\Src\Myc.Futures.pas"/>
|
||||
<DCCReference Include="TestFutures.pas"/>
|
||||
<BuildConfiguration Include="Base">
|
||||
<Key>Base</Key>
|
||||
</BuildConfiguration>
|
||||
@@ -1128,4 +1135,36 @@
|
||||
<Import Project="$(BDS)\Bin\CodeGear.Delphi.Targets" Condition="Exists('$(BDS)\Bin\CodeGear.Delphi.Targets')"/>
|
||||
<Import Project="$(APPDATA)\Embarcadero\$(BDSAPPDATABASEDIR)\$(PRODUCTVERSION)\UserTools.proj" Condition="Exists('$(APPDATA)\Embarcadero\$(BDSAPPDATABASEDIR)\$(PRODUCTVERSION)\UserTools.proj')"/>
|
||||
<Import Project="$(MSBuildProjectName).deployproj" Condition="Exists('$(MSBuildProjectName).deployproj')"/>
|
||||
<PropertyGroup Condition="'$(Config)'=='Debug' And '$(Platform)'=='Win32'">
|
||||
<PreBuildEvent/>
|
||||
<PreBuildEventIgnoreExitCode>False</PreBuildEventIgnoreExitCode>
|
||||
<PreLinkEvent/>
|
||||
<PreLinkEventIgnoreExitCode>False</PreLinkEventIgnoreExitCode>
|
||||
<PostBuildEvent>T:\DelphiIntfExtract\Win64\Debug\ExtractPascalInterfaces.exe -o T:\Myc\intf.txt T:\Myc\src</PostBuildEvent>
|
||||
<PostBuildEventIgnoreExitCode>False</PostBuildEventIgnoreExitCode>
|
||||
</PropertyGroup>
|
||||
<PropertyGroup Condition="'$(Config)'=='Debug' And '$(Platform)'=='Win64'">
|
||||
<PreBuildEvent/>
|
||||
<PreBuildEventIgnoreExitCode>False</PreBuildEventIgnoreExitCode>
|
||||
<PreLinkEvent/>
|
||||
<PreLinkEventIgnoreExitCode>False</PreLinkEventIgnoreExitCode>
|
||||
<PostBuildEvent>T:\DelphiIntfExtract\Win64\Debug\ExtractPascalInterfaces.exe -o T:\Myc\intf.txt T:\Myc\src</PostBuildEvent>
|
||||
<PostBuildEventIgnoreExitCode>False</PostBuildEventIgnoreExitCode>
|
||||
</PropertyGroup>
|
||||
<PropertyGroup Condition="'$(Config)'=='Release' And '$(Platform)'=='Win32'">
|
||||
<PreBuildEvent/>
|
||||
<PreBuildEventIgnoreExitCode>False</PreBuildEventIgnoreExitCode>
|
||||
<PreLinkEvent/>
|
||||
<PreLinkEventIgnoreExitCode>False</PreLinkEventIgnoreExitCode>
|
||||
<PostBuildEvent>T:\DelphiIntfExtract\Win64\Debug\ExtractPascalInterfaces.exe -o T:\Myc\intf.txt T:\Myc\src</PostBuildEvent>
|
||||
<PostBuildEventIgnoreExitCode>False</PostBuildEventIgnoreExitCode>
|
||||
</PropertyGroup>
|
||||
<PropertyGroup Condition="'$(Config)'=='Release' And '$(Platform)'=='Win64'">
|
||||
<PreBuildEvent/>
|
||||
<PreBuildEventIgnoreExitCode>False</PreBuildEventIgnoreExitCode>
|
||||
<PreLinkEvent/>
|
||||
<PreLinkEventIgnoreExitCode>False</PreLinkEventIgnoreExitCode>
|
||||
<PostBuildEvent>T:\DelphiIntfExtract\Win64\Debug\ExtractPascalInterfaces.exe -o T:\Myc\intf.txt T:\Myc\src</PostBuildEvent>
|
||||
<PostBuildEventIgnoreExitCode>False</PostBuildEventIgnoreExitCode>
|
||||
</PropertyGroup>
|
||||
</Project>
|
||||
|
||||
@@ -0,0 +1,370 @@
|
||||
unit TestFutures;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
DUnitX.TestFramework,
|
||||
System.SysUtils, System.Generics.Collections, // Added for TObjectList if needed, not strictly for this
|
||||
System.SyncObjs,
|
||||
Myc.Signals, // For IMycLatch, TMycLatch, IMycState, IMycSubscriber [cite: 62, 68, 53, 45]
|
||||
Myc.Core.Tasks, // For IMycTaskFactory, TMycTaskFactory [cite: 97, 113]
|
||||
Myc.Futures; // For IMycFuture, TMycInitStateFuncFuture
|
||||
|
||||
type
|
||||
// Helper class to notify a latch when its Notify method is called.
|
||||
TLatchNotifierSubscriber = class(TInterfacedObject, IMycSubscriber)
|
||||
private
|
||||
FGateLatch: IMycLatch;
|
||||
public
|
||||
constructor Create(AGateLatch: IMycLatch);
|
||||
// IMycSubscriber
|
||||
function Notify: Boolean; // Implements IMycSubscriber.Notify [cite: 46, 181, 299]
|
||||
end;
|
||||
|
||||
[TestFixture]
|
||||
[IgnoreMemoryLeaks(true)]
|
||||
TTestMycInitStateFuncFuture = class(TObject)
|
||||
private
|
||||
FTaskFactory: IMycTaskFactory;
|
||||
FProcExecutionCount: Integer; // Counter for side effects of AProc
|
||||
FSharedCounter: Integer; // For Fan-Out test side effects
|
||||
public
|
||||
[Setup]
|
||||
procedure Setup;
|
||||
[TearDown]
|
||||
procedure TearDown;
|
||||
|
||||
[Test]
|
||||
procedure Test_BasicSuccess_WithImmediateInitState;
|
||||
[Test]
|
||||
procedure Test_ChainedExecution_WithDelayedInitState;
|
||||
[Test]
|
||||
procedure Test_ExceptionInProc_HandledAsPlanned;
|
||||
[Test]
|
||||
procedure Test_GetResult_BeforeDone_RaisesException;
|
||||
[Test]
|
||||
procedure Test_FanIn_OneFutureWaitsForMultipleOthers;
|
||||
[Test]
|
||||
procedure Test_FanOut_MultipleFuturesWaitForOneTrigger;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
{ TLatchNotifierSubscriber }
|
||||
|
||||
constructor TLatchNotifierSubscriber.Create(AGateLatch: IMycLatch);
|
||||
begin
|
||||
inherited Create;
|
||||
FGateLatch := AGateLatch;
|
||||
end;
|
||||
|
||||
function TLatchNotifierSubscriber.Notify: Boolean;
|
||||
begin
|
||||
if Assigned(FGateLatch) then
|
||||
begin
|
||||
FGateLatch.Notify; // Notify the provided gate latch [cite: 80, 215, 333]
|
||||
end;
|
||||
Result := False; // This subscriber is typically one-shot for this purpose.
|
||||
end;
|
||||
|
||||
{ TTestMycInitStateFuncFuture }
|
||||
|
||||
procedure TTestMycInitStateFuncFuture.Setup;
|
||||
begin
|
||||
FTaskFactory := TMycTaskFactory.Create; // Create a new task factory instance for each test [cite: 113, 235, 353]
|
||||
FProcExecutionCount := 0;
|
||||
FSharedCounter := 0;
|
||||
end;
|
||||
|
||||
procedure TTestMycInitStateFuncFuture.TearDown;
|
||||
begin
|
||||
if Assigned(FTaskFactory) then
|
||||
begin
|
||||
FTaskFactory.Teardown; // Teardown the factory, this may re-raise exceptions [cite: 107, 234, 352]
|
||||
FTaskFactory := nil;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TTestMycInitStateFuncFuture.Test_BasicSuccess_WithImmediateInitState;
|
||||
var
|
||||
LFuture: IMycFuture<Integer>;
|
||||
LInitStateAsState: IMycState; // Parameter for Create
|
||||
LResultValue: Integer;
|
||||
const
|
||||
CExpectedResult = 42;
|
||||
begin
|
||||
// Use TMycLatch.Null for an already set init state [cite: 71, 81, 206, 216, 324, 334]
|
||||
LInitStateAsState := TMycLatch.Null.State; // Get IMycState from IMycLatch [cite: 61, 196, 314]
|
||||
|
||||
LFuture := TMycInitStateFuncFuture<Integer>.Create(FTaskFactory, LInitStateAsState,
|
||||
function: Integer
|
||||
begin
|
||||
Inc(Self.FProcExecutionCount);
|
||||
Result := CExpectedResult;
|
||||
end);
|
||||
|
||||
FTaskFactory.WaitFor(LFuture.Done); // Accesses IMycFuture.GetDone [cite: 110, 234, 352]
|
||||
|
||||
Assert.IsTrue(LFuture.Done.IsSet, 'Future should be marked as done.'); // Accesses IMycState.IsSet [cite: 57, 194, 312]
|
||||
Assert.AreEqual(1, FProcExecutionCount, 'AProc should have been executed once.');
|
||||
|
||||
LResultValue := LFuture.GetResult; // Accesses IMycFuture.GetResult
|
||||
Assert.AreEqual(CExpectedResult, LResultValue, 'GetResult returned an unexpected value.');
|
||||
end;
|
||||
|
||||
procedure TTestMycInitStateFuncFuture.Test_ChainedExecution_WithDelayedInitState;
|
||||
var
|
||||
LFuture: IMycFuture<string>;
|
||||
LInitLatch: IMycLatch;
|
||||
LResultValue: string;
|
||||
const
|
||||
CExpectedResult = 'ChainCompleted';
|
||||
begin
|
||||
LInitLatch := TMycLatch.CreateLatch(1); // Create an init state that is not yet set [cite: 77, 212, 330]
|
||||
|
||||
LFuture := TMycInitStateFuncFuture<string>.Create(FTaskFactory, LInitLatch.State,
|
||||
function: string
|
||||
begin
|
||||
Inc(Self.FProcExecutionCount);
|
||||
Result := CExpectedResult;
|
||||
end);
|
||||
|
||||
Assert.AreEqual(0, FProcExecutionCount, 'AProc should not have executed yet.');
|
||||
Assert.IsFalse(LFuture.Done.IsSet, 'Future should not be done yet.');
|
||||
|
||||
LInitLatch.Notify; // Trigger the initial state [cite: 80, 215, 333]
|
||||
|
||||
FTaskFactory.WaitFor(LFuture.Done);
|
||||
|
||||
Assert.IsTrue(LFuture.Done.IsSet, 'Future should be marked as done after init state trigger.');
|
||||
Assert.AreEqual(1, FProcExecutionCount, 'AProc should have been executed once after init state.');
|
||||
|
||||
LResultValue := LFuture.GetResult;
|
||||
Assert.AreEqual(CExpectedResult, LResultValue, 'GetResult returned an unexpected value after delayed init.');
|
||||
end;
|
||||
|
||||
procedure TTestMycInitStateFuncFuture.Test_ExceptionInProc_HandledAsPlanned;
|
||||
var
|
||||
LFuture: IMycFuture<Integer>;
|
||||
LLocalTaskFactory: IMycTaskFactory;
|
||||
LInitStateAsState: IMycState;
|
||||
LResultValue: Integer;
|
||||
LExpectedExceptionRaisedByFactory: Boolean;
|
||||
const
|
||||
CExceptionMessage = 'Test exception from AProc';
|
||||
begin
|
||||
LExpectedExceptionRaisedByFactory := False;
|
||||
LLocalTaskFactory := TMycTaskFactory.Create;
|
||||
LInitStateAsState := TMycLatch.Null.State; // Immediate execution
|
||||
|
||||
LFuture := TMycInitStateFuncFuture<Integer>.Create(LLocalTaskFactory, LInitStateAsState,
|
||||
function: Integer
|
||||
begin
|
||||
Inc(Self.FProcExecutionCount);
|
||||
raise Exception.Create(CExceptionMessage);
|
||||
end);
|
||||
|
||||
try
|
||||
LLocalTaskFactory.WaitFor(LFuture.Done);
|
||||
except
|
||||
on E: Exception do
|
||||
begin
|
||||
if E.Message = CExceptionMessage then
|
||||
LExpectedExceptionRaisedByFactory := True;
|
||||
end;
|
||||
end;
|
||||
|
||||
Assert.IsTrue(LFuture.Done.IsSet, 'Future should be done even if AProc raised an exception.');
|
||||
Assert.AreEqual(1, FProcExecutionCount, 'AProc (which raised) should have been executed once.');
|
||||
|
||||
LResultValue := LFuture.GetResult;
|
||||
Assert.AreEqual(Default(Integer), LResultValue, 'GetResult should return Default(T) when AProc raises an exception.');
|
||||
|
||||
if not LExpectedExceptionRaisedByFactory then
|
||||
begin
|
||||
try
|
||||
LLocalTaskFactory.Teardown; // This should re-raise the exception [cite: 108, 234, 352]
|
||||
except
|
||||
on E: Exception do
|
||||
begin
|
||||
Assert.AreEqual(CExceptionMessage, E.Message, 'TaskFactory did not re-raise the correct exception message on Teardown.');
|
||||
LExpectedExceptionRaisedByFactory := True;
|
||||
end;
|
||||
end;
|
||||
Assert.IsTrue(LExpectedExceptionRaisedByFactory, 'TaskFactory Teardown did not raise any exception as expected.');
|
||||
end;
|
||||
|
||||
if LExpectedExceptionRaisedByFactory then // Factory was torn down (implicitly or explicitly) and did its job
|
||||
LLocalTaskFactory := nil
|
||||
else if Assigned(LLocalTaskFactory) then // Teardown didn't raise as expected, or wasn't called due to earlier exception path
|
||||
begin
|
||||
LLocalTaskFactory.Teardown; // Ensure it's torn down if test logic failed to confirm exception
|
||||
LLocalTaskFactory := nil;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TTestMycInitStateFuncFuture.Test_GetResult_BeforeDone_RaisesException;
|
||||
var
|
||||
LFuture: IMycFuture<Integer>;
|
||||
LInitLatch: IMycLatch;
|
||||
LExpectedExceptionRaised: Boolean;
|
||||
const
|
||||
CExpectedExceptionMessage = 'Result is not yet available for the future.';
|
||||
begin
|
||||
LExpectedExceptionRaised := False;
|
||||
LInitLatch := TMycLatch.CreateLatch(1); // Create a latch that is not yet set [cite: 77, 212, 330]
|
||||
|
||||
LFuture := TMycInitStateFuncFuture<Integer>.Create(FTaskFactory, LInitLatch.State,
|
||||
function: Integer
|
||||
begin
|
||||
Inc(Self.FProcExecutionCount);
|
||||
Result := 123;
|
||||
end);
|
||||
|
||||
Assert.IsFalse(LFuture.Done.IsSet, 'Future should not be marked as done initially.');
|
||||
|
||||
try
|
||||
LFuture.GetResult;
|
||||
except
|
||||
on E: Exception do
|
||||
begin
|
||||
Assert.AreEqual(CExpectedExceptionMessage, E.Message, 'Exception message mismatch.');
|
||||
LExpectedExceptionRaised := True;
|
||||
end;
|
||||
end;
|
||||
Assert.IsTrue(LExpectedExceptionRaised, 'Calling GetResult before done should raise an exception.');
|
||||
|
||||
LInitLatch.Notify; // [cite: 80, 215, 333]
|
||||
FTaskFactory.WaitFor(LFuture.Done); //
|
||||
end;
|
||||
|
||||
procedure TTestMycInitStateFuncFuture.Test_FanIn_OneFutureWaitsForMultipleOthers;
|
||||
var
|
||||
LPrerequisiteFuture1, LPrerequisiteFuture2: IMycFuture<Integer>;
|
||||
LMainFuture: IMycFuture<string>;
|
||||
LGateLatch: IMycLatch;
|
||||
LSub1, LSub2: IMycSubscriber; // To hold the TLatchNotifierSubscriber instances
|
||||
LInitStateP1, LInitStateP2: IMycLatch;
|
||||
Subscriptions: array[1..2] of TMycSubscription; // To manage subscriptions
|
||||
const
|
||||
CMainFutureResult = 'AllPrerequisitesCompleted';
|
||||
begin
|
||||
FProcExecutionCount := 0; // Reset for this test
|
||||
|
||||
// Gate Latch: MainFuture waits for this latch, which needs 2 notifications.
|
||||
LGateLatch := TMycLatch.CreateLatch(2); // [cite: 77, 212, 330]
|
||||
|
||||
// Create MainFuture, AInitState is the GateLatch's state.
|
||||
LMainFuture := TMycInitStateFuncFuture<string>.Create(FTaskFactory, LGateLatch.State,
|
||||
function: string
|
||||
begin
|
||||
Inc(Self.FProcExecutionCount, 10); // Indicate MainFuture's proc ran
|
||||
Result := CMainFutureResult;
|
||||
end);
|
||||
|
||||
// Setup Prerequisite Futures
|
||||
// PrerequisiteFuture1
|
||||
LInitStateP1 := TMycLatch.CreateLatch(1); // Controllable init state for PF1
|
||||
LPrerequisiteFuture1 := TMycInitStateFuncFuture<Integer>.Create(FTaskFactory, LInitStateP1.State,
|
||||
function: Integer
|
||||
begin
|
||||
Inc(Self.FProcExecutionCount, 1); // PF1 ran
|
||||
Result := 1;
|
||||
end);
|
||||
LSub1 := TLatchNotifierSubscriber.Create(LGateLatch);
|
||||
Subscriptions[1] := LPrerequisiteFuture1.Done.Subscribe(LSub1); // Subscribe to PF1's completion [cite: 56, 188, 306]
|
||||
|
||||
// PrerequisiteFuture2
|
||||
LInitStateP2 := TMycLatch.CreateLatch(1); // Controllable init state for PF2
|
||||
LPrerequisiteFuture2 := TMycInitStateFuncFuture<Integer>.Create(FTaskFactory, LInitStateP2.State,
|
||||
function: Integer
|
||||
begin
|
||||
Inc(Self.FProcExecutionCount, 1); // PF2 ran
|
||||
Result := 2;
|
||||
end);
|
||||
LSub2 := TLatchNotifierSubscriber.Create(LGateLatch);
|
||||
Subscriptions[2] := LPrerequisiteFuture2.Done.Subscribe(LSub2); // Subscribe to PF2's completion
|
||||
|
||||
// --- Execution & Verification ---
|
||||
Assert.IsFalse(LMainFuture.Done.IsSet, 'MainFuture should not be done yet.');
|
||||
Assert.AreEqual(0, FProcExecutionCount, 'No AProc should have executed yet.');
|
||||
|
||||
// Trigger PrerequisiteFuture1
|
||||
LInitStateP1.Notify; //
|
||||
FTaskFactory.WaitFor(LPrerequisiteFuture1.Done); // Ensure PF1 completes and notifies GateLatch
|
||||
Assert.IsFalse(LGateLatch.State.IsSet, 'GateLatch should not be set after only one prerequisite.');
|
||||
Assert.IsFalse(LMainFuture.Done.IsSet, 'MainFuture should still not be done.');
|
||||
Assert.AreEqual(1, FProcExecutionCount mod 10, 'Only PF1 AProc should have run.');
|
||||
|
||||
|
||||
// Trigger PrerequisiteFuture2
|
||||
LInitStateP2.Notify; //
|
||||
FTaskFactory.WaitFor(LPrerequisiteFuture2.Done); // Ensure PF2 completes and notifies GateLatch
|
||||
|
||||
// Now GateLatch should be set, and MainFuture should execute
|
||||
FTaskFactory.WaitFor(LMainFuture.Done);
|
||||
|
||||
Assert.IsTrue(LGateLatch.State.IsSet, 'GateLatch should be set after both prerequisites.');
|
||||
Assert.IsTrue(LMainFuture.Done.IsSet, 'MainFuture should be done now.');
|
||||
Assert.AreEqual(12, FProcExecutionCount, 'All AProcs (PF1, PF2, Main) should have run.'); // 1+1+10
|
||||
Assert.AreEqual(CMainFutureResult, LMainFuture.GetResult, 'MainFuture returned an unexpected result.');
|
||||
|
||||
// Clean up subscriptions explicitly, though ARC + managed records handle much
|
||||
Subscriptions[1].Unsubscribe; // [cite: 52, 186, 304]
|
||||
Subscriptions[2].Unsubscribe; //
|
||||
end;
|
||||
|
||||
procedure TTestMycInitStateFuncFuture.Test_FanOut_MultipleFuturesWaitForOneTrigger;
|
||||
var
|
||||
LTriggerLatch: IMycLatch;
|
||||
LFutureA, LFutureB: IMycFuture<Integer>;
|
||||
LFlagFutureARan, LFlagFutureBRan: Boolean;
|
||||
begin
|
||||
LFlagFutureARan := False;
|
||||
LFlagFutureBRan := False;
|
||||
Self.FSharedCounter := 0; // Reset shared counter for this test
|
||||
|
||||
LTriggerLatch := TMycLatch.CreateLatch(1); // Single trigger [cite: 77, 212, 330]
|
||||
|
||||
// Future A
|
||||
LFutureA := TMycInitStateFuncFuture<Integer>.Create(FTaskFactory, LTriggerLatch.State,
|
||||
function: Integer
|
||||
begin
|
||||
LFlagFutureARan := True;
|
||||
System.SyncObjs.TInterlocked.Increment(Self.FSharedCounter); // Thread-safe increment
|
||||
Result := 100;
|
||||
end);
|
||||
|
||||
// Future B
|
||||
LFutureB := TMycInitStateFuncFuture<Integer>.Create(FTaskFactory, LTriggerLatch.State,
|
||||
function: Integer
|
||||
begin
|
||||
LFlagFutureBRan := True;
|
||||
System.SyncObjs.TInterlocked.Increment(Self.FSharedCounter); // Thread-safe increment
|
||||
Result := 200;
|
||||
end);
|
||||
|
||||
Assert.IsFalse(LFutureA.Done.IsSet, 'FutureA should not be done yet.');
|
||||
Assert.IsFalse(LFutureB.Done.IsSet, 'FutureB should not be done yet.');
|
||||
Assert.AreEqual(0, Self.FSharedCounter, 'No future AProcs should have executed yet.');
|
||||
|
||||
// Trigger the common latch
|
||||
LTriggerLatch.Notify; // [cite: 80, 215, 333]
|
||||
|
||||
// Wait for both futures to complete
|
||||
FTaskFactory.WaitFor(LFutureA.Done);
|
||||
FTaskFactory.WaitFor(LFutureB.Done);
|
||||
|
||||
Assert.IsTrue(LFutureA.Done.IsSet, 'FutureA should be done.');
|
||||
Assert.IsTrue(LFutureB.Done.IsSet, 'FutureB should be done.');
|
||||
Assert.IsTrue(LFlagFutureARan, 'FutureA AProc should have run.');
|
||||
Assert.IsTrue(LFlagFutureBRan, 'FutureB AProc should have run.');
|
||||
Assert.AreEqual(2, Self.FSharedCounter, 'Both future AProcs should have incremented the counter.');
|
||||
Assert.AreEqual(100, LFutureA.GetResult, 'FutureA GetResult value mismatch.');
|
||||
Assert.AreEqual(200, LFutureB.GetResult, 'FutureB GetResult value mismatch.');
|
||||
end;
|
||||
|
||||
initialization
|
||||
// For DUnitX, attributes typically handle registration.
|
||||
// If needed for older DUnit: RegisterTest(TTestMycInitStateFuncFuture.Suite);
|
||||
end.
|
||||
@@ -313,7 +313,6 @@ var
|
||||
threads: array of TStressWorkerThread;
|
||||
i: Integer;
|
||||
LThreadError: Exception;
|
||||
LMessage: string;
|
||||
totalExpectedLiveByThreadsAtEnd, actualLiveInNotifierAtEnd: Integer;
|
||||
actualLiveReceiversInNotifier: TList<IMyStressTestInterface>; // Store interface type from Notify
|
||||
receiver: IMyStressTestInterface;
|
||||
|
||||
@@ -116,7 +116,6 @@ end;
|
||||
procedure TAdviseWorkerThread.Execute;
|
||||
var
|
||||
i: Integer;
|
||||
tag: TMycNotifyList<IMyTestInterface>.TTag; // Tag is not used further in this test design
|
||||
begin
|
||||
inherited; // Important for TThread
|
||||
try
|
||||
@@ -128,7 +127,7 @@ begin
|
||||
// Acquire lock before calling Advise
|
||||
FOwnerFixture.FNotifier.Lock;
|
||||
try
|
||||
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
|
||||
|
||||
@@ -51,7 +51,6 @@ type
|
||||
|
||||
// --- TSList Parallel Access Test ---
|
||||
[Test]
|
||||
[Timeout(30000)] // Timeout in milliseconds
|
||||
procedure TestTSList_ParallelPushPop;
|
||||
end;
|
||||
|
||||
|
||||
@@ -0,0 +1,529 @@
|
||||
unit TestSignals_Dirty;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
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
|
||||
|
||||
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;
|
||||
|
||||
// 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 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;
|
||||
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
{ TMockSubscriber }
|
||||
|
||||
constructor TMockSubscriber.Create(AShouldReturn: Boolean = True);
|
||||
begin
|
||||
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;
|
||||
end;
|
||||
|
||||
{ TTestMycDirtyFlag }
|
||||
|
||||
function TTestMycDirtyFlag.CreateAndPrepareDirtyFlag(StartDirty: Boolean = True): IMycDirty;
|
||||
begin
|
||||
Result := TMycDirty.CreateDirty; // 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
|
||||
end;
|
||||
|
||||
procedure TTestMycDirtyFlag.TearDown;
|
||||
begin
|
||||
// Per-test teardown
|
||||
end;
|
||||
|
||||
// Category 1: Basic State, Notify (as Subscriber method), and Reset
|
||||
|
||||
procedure TTestMycDirtyFlag.TestCreate_InitialStateIsDirty;
|
||||
var
|
||||
dirtyFlag: IMycDirty;
|
||||
begin
|
||||
dirtyFlag := TMycDirty.CreateDirty;
|
||||
Assert.IsTrue(dirtyFlag.State.IsSet, 'Newly created dirty flag should be IsSet (dirty).');
|
||||
end;
|
||||
|
||||
procedure TTestMycDirtyFlag.TestReset_FromDirtyState_BecomesCleanAndReturnsTrue;
|
||||
var
|
||||
dirtyFlag: IMycDirty;
|
||||
resetResult: Boolean;
|
||||
begin
|
||||
dirtyFlag := CreateAndPrepareDirtyFlag(True); // Start dirty
|
||||
|
||||
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.');
|
||||
end;
|
||||
|
||||
procedure TTestMycDirtyFlag.TestReset_FromCleanState_StaysCleanAndReturnsFalse;
|
||||
var
|
||||
dirtyFlag: IMycDirty;
|
||||
resetResult: Boolean;
|
||||
begin
|
||||
dirtyFlag := CreateAndPrepareDirtyFlag(False); // Start clean
|
||||
|
||||
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.');
|
||||
end;
|
||||
|
||||
procedure TTestMycDirtyFlag.TestNotify_OnCleanFlag_SetsDirtyAndReturnsTrue;
|
||||
var
|
||||
dirtyFlag: IMycDirty;
|
||||
notifyResult: Boolean;
|
||||
begin
|
||||
dirtyFlag := CreateAndPrepareDirtyFlag(False); // Start clean
|
||||
|
||||
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.');
|
||||
end;
|
||||
|
||||
procedure TTestMycDirtyFlag.TestNotify_OnDirtyFlag_StaysDirtyAndReturnsFalse;
|
||||
var
|
||||
dirtyFlag: IMycDirty;
|
||||
notifyResult: Boolean;
|
||||
begin
|
||||
dirtyFlag := CreateAndPrepareDirtyFlag(True); // Start dirty
|
||||
|
||||
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).');
|
||||
end;
|
||||
|
||||
// Category 2: Subscriber Notifications
|
||||
|
||||
procedure TTestMycDirtyFlag.TestSubscribe_ToAlreadyDirtyFlag_NotifiesSubscriberImmediately;
|
||||
var
|
||||
dirtyFlag: IMycDirty;
|
||||
subscriber: TMockSubscriber;
|
||||
subscription: TMycSubscription;
|
||||
begin
|
||||
dirtyFlag := CreateAndPrepareDirtyFlag(True); // Start dirty
|
||||
subscriber := TMockSubscriber.Create;
|
||||
|
||||
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.');
|
||||
end;
|
||||
|
||||
procedure TTestMycDirtyFlag.TestSubscribe_ToCleanFlag_DoesNotNotifySubscriberImmediately;
|
||||
var
|
||||
dirtyFlag: IMycDirty;
|
||||
subscriber: TMockSubscriber;
|
||||
subscription: TMycSubscription;
|
||||
begin
|
||||
dirtyFlag := CreateAndPrepareDirtyFlag(False); // Start clean
|
||||
subscriber := TMockSubscriber.Create;
|
||||
|
||||
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.');
|
||||
end;
|
||||
|
||||
procedure TTestMycDirtyFlag.TestSubscriber_Notified_WhenFlagTransitionsToDirty;
|
||||
var
|
||||
dirtyFlag: IMycDirty;
|
||||
subscriber: TMockSubscriber;
|
||||
subscription: TMycSubscription;
|
||||
begin
|
||||
dirtyFlag := CreateAndPrepareDirtyFlag(False); // Start clean
|
||||
subscriber := TMockSubscriber.Create;
|
||||
subscription := dirtyFlag.State.Subscribe(subscriber);
|
||||
|
||||
Assert.AreEqual(0, subscriber.NotifyCount, 'Subscriber initially not notified.');
|
||||
|
||||
dirtyFlag.Notify; // Make the flag 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: TMycSubscription;
|
||||
begin
|
||||
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.');
|
||||
|
||||
dirtyFlag.Notify; // Notify again, 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: TMycSubscription;
|
||||
begin
|
||||
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.');
|
||||
|
||||
// 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: TMycSubscription;
|
||||
begin
|
||||
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
|
||||
|
||||
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: TMycSubscription;
|
||||
begin
|
||||
dirtyFlag := CreateAndPrepareDirtyFlag(False); // Start clean
|
||||
subscriber := TMockSubscriber.Create;
|
||||
subscription := dirtyFlag.State.Subscribe(subscriber);
|
||||
|
||||
subscription.Unsubscribe; // Explicitly unsubscribe
|
||||
|
||||
dirtyFlag.Notify; // Make flag dirty
|
||||
|
||||
Assert.AreEqual(0, subscriber.NotifyCount, 'Unsubscribed subscriber should not be notified.');
|
||||
end;
|
||||
|
||||
// Category 3: Chaining Dirty Flags
|
||||
// In these tests, FlagX.Notify means calling the IMycSubscriber.Notify method on FlagX.
|
||||
// This makes FlagX dirty and potentially notifies its subscribers (like FlagY).
|
||||
|
||||
procedure TTestMycDirtyFlag.TestChain_A_Notifies_B_SimplePropagation;
|
||||
var
|
||||
flagA, flagB: IMycDirty;
|
||||
subToB: TMockSubscriber;
|
||||
subscriptionA_B, subscriptionMock_B: TMycSubscription;
|
||||
begin
|
||||
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)
|
||||
|
||||
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.');
|
||||
end;
|
||||
|
||||
procedure TTestMycDirtyFlag.TestChain_A_Notifies_B_Notifies_C_SimplePropagation;
|
||||
var
|
||||
flagA, flagB, flagC: IMycDirty;
|
||||
subToC: TMockSubscriber;
|
||||
subscriptionB_A, subscriptionC_B, subscriptionMock_C: TMycSubscription;
|
||||
begin
|
||||
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
|
||||
|
||||
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.');
|
||||
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: TMycSubscription;
|
||||
begin
|
||||
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.');
|
||||
|
||||
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;
|
||||
|
||||
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: TMycSubscription;
|
||||
begin
|
||||
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.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.
|
||||
|
||||
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: TMycSubscription;
|
||||
begin
|
||||
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);
|
||||
|
||||
// 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.');
|
||||
|
||||
// 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.
|
||||
|
||||
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: TMycSubscription;
|
||||
begin
|
||||
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);
|
||||
|
||||
// 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.
|
||||
|
||||
// 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.');
|
||||
end;
|
||||
|
||||
procedure TTestMycDirtyFlag.TestChain_A_B_C_TriggerA_ResetA_TriggerA_EnsureCNotifiedCorrectly;
|
||||
var
|
||||
flagA, flagB, flagC: IMycDirty;
|
||||
subToC: TMockSubscriber;
|
||||
subscriptionB_A, subscriptionC_B, subscriptionMock_C: TMycSubscription;
|
||||
begin
|
||||
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);
|
||||
|
||||
// 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.');
|
||||
|
||||
// 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);
|
||||
end.
|
||||
+199
-75
@@ -1,22 +1,22 @@
|
||||
// Suggested filename: TestSignals_Latch.pas
|
||||
unit TestSignals_Latch;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
DUnitX.TestFramework,
|
||||
Myc.Signals, // Unit under test, using TMycLatch static members
|
||||
System.SysUtils,
|
||||
System.StrUtils;
|
||||
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;
|
||||
NotifyShouldReturn: Boolean; // Determines what this mock's Notify method returns
|
||||
WasCalled: Boolean;
|
||||
|
||||
constructor Create(ShouldReturn: Boolean = True);
|
||||
constructor Create(AShouldReturn: Boolean = True); // Parameter name AShouldReturn for clarity
|
||||
function Notify: Boolean; // IMycSubscriber implementation.
|
||||
end;
|
||||
|
||||
@@ -30,15 +30,15 @@ type
|
||||
|
||||
// --- Category 1: Basic Counter and State Functionality (Parameterized) ---
|
||||
[TestCase('InitialPositive', '1,False')]
|
||||
[TestCase('InitialZero', '0,True')] // TMycLatch.CreateLatch(0) will return TMycLatch.Null
|
||||
[TestCase('InitialNegative', '-1,True')] // TMycLatch.CreateLatch(-1) will return TMycLatch.Null
|
||||
[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')]
|
||||
[TestCase('DecrementPositiveToZero', '1,False,True')] // InitialCount, ExpectedReturnFromLatchNotify, ExpectedIsSetAfterNotify
|
||||
[TestCase('DecrementPositiveToPositive', '2,True,False')]
|
||||
[TestCase('DecrementZeroToNegative', '0,False,True')]
|
||||
[TestCase('DecrementNegativeToNegative', '-1,False,True')]
|
||||
[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]
|
||||
@@ -54,11 +54,11 @@ type
|
||||
[Test]
|
||||
procedure TestSubscriber_NotNotified_BeforeLatchSet;
|
||||
[Test]
|
||||
procedure TestSubscriber_NotifiedOnlyOnce_AfterLatchSet;
|
||||
procedure TestSubscriber_NotifiedOnlyOnce_AfterLatchSetAndUnadvised; // Clarified name
|
||||
[Test]
|
||||
procedure TestSubscribe_ToAlreadySetLatch_NotifiesImmediately;
|
||||
|
||||
// --- Category 3: Chaining and Cascading ---
|
||||
// --- Category 3: Chaining and Cascading Latches ---
|
||||
[Test]
|
||||
procedure TestChaining_A_Notifies_B;
|
||||
[Test]
|
||||
@@ -68,25 +68,33 @@ type
|
||||
|
||||
// --- Category 4: Special Cases ---
|
||||
[Test]
|
||||
procedure TestInitiallySetLatch_NotifiesNewSubscriberImmediately;
|
||||
procedure TestInitiallySetLatch_NotifiesNewSubscriberImmediately; // Using CreateLatch(0)
|
||||
|
||||
[Test]
|
||||
procedure TestUnsubscribe_SubscriberNotNotified;
|
||||
|
||||
// --- Category 5: Signal Loss / Counter Integrity ---
|
||||
// --- 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;
|
||||
|
||||
implementation
|
||||
|
||||
{ TMockSubscriber }
|
||||
|
||||
constructor TMockSubscriber.Create(ShouldReturn: Boolean = True);
|
||||
constructor TMockSubscriber.Create(AShouldReturn: Boolean = True);
|
||||
begin
|
||||
inherited Create;
|
||||
NotifyCount := 0;
|
||||
NotifyShouldReturn := ShouldReturn;
|
||||
NotifyShouldReturn := AShouldReturn;
|
||||
WasCalled := False;
|
||||
end;
|
||||
|
||||
@@ -94,7 +102,7 @@ function TMockSubscriber.Notify: Boolean;
|
||||
begin
|
||||
Inc(NotifyCount);
|
||||
WasCalled := True;
|
||||
Result := NotifyShouldReturn;
|
||||
Result := NotifyShouldReturn; // This mock subscriber returns what it's configured to.
|
||||
end;
|
||||
|
||||
{ TTestMycLatch }
|
||||
@@ -109,61 +117,66 @@ begin
|
||||
// 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;
|
||||
begin
|
||||
latch := TMycLatch.CreateLatch(InitialCount); // Changed to use TMycLatch.CreateLatch
|
||||
Assert.AreEqual(ExpectedIsSet, latch.State.IsSet, 'Latch initial IsSet state mismatch.');
|
||||
// TMycLatch.CreateLatch returns TMycLatch.Null if InitialCount <= 0
|
||||
latch := TMycLatch.CreateLatch(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);
|
||||
var
|
||||
latch: IMycLatch;
|
||||
returnedValue: Boolean;
|
||||
returnedValueFromNotify: Boolean;
|
||||
begin
|
||||
latch := TMycLatch.CreateLatch(InitialCount); // Changed to use TMycLatch.CreateLatch
|
||||
returnedValue := latch.Notify;
|
||||
latch := TMycLatch.CreateLatch(InitialCount);
|
||||
returnedValueFromNotify := latch.Notify; // This is IMycLatch (as IMycSubscriber).Notify
|
||||
|
||||
Assert.AreEqual(ExpectedReturn, returnedValue, 'Unexpected return value from Latch.Notify call.');
|
||||
Assert.AreEqual(ExpectedIsSet, latch.State.IsSet, 'Unexpected IsSet state after Latch.Notify call.');
|
||||
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;
|
||||
begin
|
||||
latch := TMycLatch.CreateLatch(1); // Changed to use TMycLatch.CreateLatch
|
||||
Assert.IsFalse(latch.State.IsSet, 'Latch should initially not be set.');
|
||||
latch.Notify;
|
||||
Assert.IsTrue(latch.State.IsSet, 'Latch should be set after Notify.');
|
||||
latch := TMycLatch.CreateLatch(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;
|
||||
begin
|
||||
latch := TMycLatch.CreateLatch(1); // Changed to use TMycLatch.CreateLatch
|
||||
latch.Notify;
|
||||
latch := TMycLatch.CreateLatch(1);
|
||||
latch.Notify; // Count becomes 0, IsSet = True
|
||||
Assert.IsTrue(latch.State.IsSet, 'Latch should be set after first Notify.');
|
||||
latch.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: TMycSubscription;
|
||||
begin
|
||||
latch := TMycLatch.CreateLatch(1); // Changed to use TMycLatch.CreateLatch
|
||||
latch := TMycLatch.CreateLatch(1);
|
||||
mockSub := TMockSubscriber.Create;
|
||||
subscription := latch.State.Subscribe(mockSub);
|
||||
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).');
|
||||
|
||||
latch.Notify;
|
||||
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.');
|
||||
@@ -173,9 +186,9 @@ procedure TTestMycLatch.TestSubscriber_Multiple_AreNotifiedWhenLatchSet;
|
||||
var
|
||||
latch: IMycLatch;
|
||||
mockSub1, mockSub2, mockSub3: TMockSubscriber;
|
||||
sub1, sub2, sub3: TMycSubscription;
|
||||
sub1, sub2, sub3: TMycSubscription; // Keep subscriptions in scope
|
||||
begin
|
||||
latch := TMycLatch.CreateLatch(1); // Changed to use TMycLatch.CreateLatch
|
||||
latch := TMycLatch.CreateLatch(1);
|
||||
mockSub1 := TMockSubscriber.Create;
|
||||
mockSub2 := TMockSubscriber.Create;
|
||||
mockSub3 := TMockSubscriber.Create;
|
||||
@@ -184,7 +197,7 @@ begin
|
||||
sub2 := latch.State.Subscribe(mockSub2);
|
||||
sub3 := latch.State.Subscribe(mockSub3);
|
||||
|
||||
latch.Notify;
|
||||
latch.Notify; // Latch becomes set
|
||||
|
||||
Assert.AreEqual(1, mockSub1.NotifyCount, 'MockSub1 notification count mismatch.');
|
||||
Assert.AreEqual(1, mockSub2.NotifyCount, 'MockSub2 notification count mismatch.');
|
||||
@@ -197,29 +210,29 @@ var
|
||||
mockSub: TMockSubscriber;
|
||||
subscription: TMycSubscription;
|
||||
begin
|
||||
latch := TMycLatch.CreateLatch(2); // Changed to use TMycLatch.CreateLatch
|
||||
latch := TMycLatch.CreateLatch(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;
|
||||
Assert.AreEqual(0, mockSub.NotifyCount, 'MockSub should still not be notified as latch is not yet 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_AfterLatchSet;
|
||||
procedure TTestMycLatch.TestSubscriber_NotifiedOnlyOnce_AfterLatchSetAndUnadvised;
|
||||
var
|
||||
latch: IMycLatch;
|
||||
mockSub: TMockSubscriber;
|
||||
subscription: TMycSubscription;
|
||||
begin
|
||||
latch := TMycLatch.CreateLatch(1); // Changed to use TMycLatch.CreateLatch
|
||||
latch := TMycLatch.CreateLatch(1);
|
||||
mockSub := TMockSubscriber.Create;
|
||||
subscription := latch.State.Subscribe(mockSub);
|
||||
|
||||
latch.Notify;
|
||||
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;
|
||||
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;
|
||||
|
||||
@@ -229,42 +242,47 @@ var
|
||||
mockSub1, mockSub2: TMockSubscriber;
|
||||
subscription1, subscription2: TMycSubscription;
|
||||
begin
|
||||
latch := TMycLatch.CreateLatch(1); // Changed to use TMycLatch.CreateLatch
|
||||
latch := TMycLatch.CreateLatch(1); // Create with count 1
|
||||
mockSub1 := TMockSubscriber.Create;
|
||||
subscription1 := latch.State.Subscribe(mockSub1);
|
||||
latch.Notify;
|
||||
subscription1 := latch.State.Subscribe(mockSub1); // Subscribe before set
|
||||
|
||||
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.');
|
||||
|
||||
// Attempt to subscribe mockSub2 after the latch is already set.
|
||||
mockSub2 := TMockSubscriber.Create;
|
||||
subscription2 := latch.State.Subscribe(mockSub2);
|
||||
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.');
|
||||
|
||||
latch.Notify;
|
||||
Assert.AreEqual(1, mockSub1.NotifyCount, 'MockSub1 notify count should remain 1.');
|
||||
Assert.AreEqual(1, mockSub2.NotifyCount, 'MockSub2 notify count should remain 1 after re-triggering.');
|
||||
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: TMycSubscription;
|
||||
begin
|
||||
latchA := TMycLatch.CreateLatch(1); // Changed to use TMycLatch.CreateLatch
|
||||
latchB := TMycLatch.CreateLatch(1); // Changed to use TMycLatch.CreateLatch
|
||||
latchA := TMycLatch.CreateLatch(1);
|
||||
latchB := TMycLatch.CreateLatch(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);
|
||||
|
||||
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;
|
||||
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.');
|
||||
@@ -277,16 +295,16 @@ var
|
||||
mockSubForC: TMockSubscriber;
|
||||
sub_Mock_C, sub_C_B, sub_B_A: TMycSubscription;
|
||||
begin
|
||||
latchA := TMycLatch.CreateLatch(1); // Changed to use TMycLatch.CreateLatch
|
||||
latchB := TMycLatch.CreateLatch(1); // Changed to use TMycLatch.CreateLatch
|
||||
latchC := TMycLatch.CreateLatch(1); // Changed to use TMycLatch.CreateLatch
|
||||
latchA := TMycLatch.CreateLatch(1);
|
||||
latchB := TMycLatch.CreateLatch(1);
|
||||
latchC := TMycLatch.CreateLatch(1);
|
||||
mockSubForC := TMockSubscriber.Create;
|
||||
|
||||
sub_Mock_C := latchC.State.Subscribe(mockSubForC);
|
||||
sub_C_B := latchB.State.Subscribe(latchC);
|
||||
sub_B_A := latchA.State.Subscribe(latchB);
|
||||
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;
|
||||
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.');
|
||||
@@ -300,37 +318,42 @@ var
|
||||
mockSubForB: TMockSubscriber;
|
||||
sub_Mock_B, sub_B_A: TMycSubscription;
|
||||
begin
|
||||
latchA := TMycLatch.CreateLatch(2); // Changed to use TMycLatch.CreateLatch
|
||||
latchB := TMycLatch.CreateLatch(1); // Changed to use TMycLatch.CreateLatch
|
||||
// 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 := TMycLatch.CreateLatch(2);
|
||||
latchB := TMycLatch.CreateLatch(1);
|
||||
mockSubForB := TMockSubscriber.Create;
|
||||
|
||||
sub_Mock_B := latchB.State.Subscribe(mockSubForB);
|
||||
sub_B_A := latchA.State.Subscribe(latchB);
|
||||
|
||||
latchA.Notify;
|
||||
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;
|
||||
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;
|
||||
latch: IMycLatch; // Will be TMycLatch.Null
|
||||
mockSub: TMockSubscriber;
|
||||
subscription: TMycSubscription;
|
||||
begin
|
||||
latch := TMycLatch.CreateLatch(0); // Changed to use TMycLatch.CreateLatch. Will return TMycLatch.Null.
|
||||
latch := TMycLatch.CreateLatch(0); // Returns TMycLatch.Null which is set.
|
||||
mockSub := TMockSubscriber.Create;
|
||||
|
||||
subscription := latch.State.Subscribe(mockSub);
|
||||
subscription := latch.State.Subscribe(mockSub); // TMycLatch.Subscribe notifies immediately if already set.
|
||||
|
||||
Assert.IsTrue(latch.State.IsSet, 'Latch IsSet property mismatch after creation with count 0.');
|
||||
Assert.AreEqual(1, mockSub.NotifyCount, 'MockSub should be notified immediately upon subscribing to an already 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;
|
||||
@@ -339,38 +362,139 @@ var
|
||||
mockSub: TMockSubscriber;
|
||||
subscription: TMycSubscription;
|
||||
begin
|
||||
latch := TMycLatch.CreateLatch(1); // Changed to use TMycLatch.CreateLatch
|
||||
latch := TMycLatch.CreateLatch(1);
|
||||
mockSub := TMockSubscriber.Create;
|
||||
|
||||
subscription := latch.State.Subscribe(mockSub);
|
||||
subscription := Default(TMycSubscription); // Simulates leaving scope / destruction, calls Finalize for unsubscription.
|
||||
subscription.Unsubscribe; // Explicitly call Unsubscribe on the record
|
||||
|
||||
latch.Notify;
|
||||
latch.Notify; // Latch becomes set
|
||||
|
||||
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: TMycSubscription;
|
||||
begin
|
||||
latch := TMycLatch.CreateLatch(3); // Changed to use TMycLatch.CreateLatch
|
||||
latch := TMycLatch.CreateLatch(3);
|
||||
|
||||
latch.Notify;
|
||||
latch.Notify;
|
||||
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.');
|
||||
|
||||
latch.Notify;
|
||||
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: TMycSubscription;
|
||||
begin
|
||||
latch := TMycLatch.CreateLatch(1);
|
||||
mockSub1 := TMockSubscriber.Create;
|
||||
mockSub2 := TMockSubscriber.Create;
|
||||
|
||||
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.');
|
||||
|
||||
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.');
|
||||
|
||||
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.');
|
||||
end;
|
||||
|
||||
procedure TTestMycLatch.TestLatchSet_SubscriptionFinalize_IsSafePostUnadviseAll;
|
||||
var
|
||||
latch: IMycLatch;
|
||||
mockSub: TMockSubscriber;
|
||||
// 'subscription' will be declared in an inner scope to control its finalization
|
||||
begin
|
||||
latch := TMycLatch.CreateLatch(1);
|
||||
mockSub := TMockSubscriber.Create;
|
||||
|
||||
var noException: Boolean := True;
|
||||
try
|
||||
begin // Inner block to control lifetime of 'subscription'
|
||||
var subscription: TMycSubscription; // 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.');
|
||||
|
||||
// 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;
|
||||
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.');
|
||||
end;
|
||||
|
||||
procedure TTestMycLatch.TestLatchSet_NewSubscriberToSetLatch_NotifiedImmediatelyButNotPersistedForLatchNotify;
|
||||
var
|
||||
latch: IMycLatch;
|
||||
mockSubInitial, mockSubNew: TMockSubscriber;
|
||||
subscriptionInitial, subscriptionNew: TMycSubscription;
|
||||
begin
|
||||
latch := TMycLatch.CreateLatch(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.');
|
||||
|
||||
// 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.
|
||||
|
||||
// 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.');
|
||||
end;
|
||||
|
||||
initialization
|
||||
TDUnitX.RegisterTestFixture(TTestMycLatch);
|
||||
end.
|
||||
|
||||
@@ -453,7 +453,6 @@ var
|
||||
stack: TMycAtomicStack<ITestInterface>;
|
||||
nilIntf: ITestInterface; // This is already nil by default
|
||||
nonNilIntf: ITestInterface;
|
||||
popped: ITestInterface;
|
||||
begin
|
||||
nilIntf := nil; // Explicitly nil
|
||||
nonNilIntf := TTestImplementingObject.Create(999);
|
||||
|
||||
+18
-32
@@ -13,10 +13,10 @@ uses
|
||||
|
||||
type
|
||||
[TestFixture]
|
||||
[IgnoreMemoryLeaks(true)]
|
||||
TMycTaskFactoryTests = class(TObject)
|
||||
private
|
||||
FFactory: IMycTaskFactory;
|
||||
procedure TestProcExecute(var executed: Boolean; signal: IMycLatch); // Parameter type is IMycLatch
|
||||
public
|
||||
[Setup]
|
||||
procedure Setup;
|
||||
@@ -63,20 +63,9 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TMycTaskFactoryTests.TestProcExecute(var executed: Boolean; signal: IMycLatch);
|
||||
begin
|
||||
executed := True;
|
||||
if Assigned(signal) then
|
||||
signal.Notify;
|
||||
end;
|
||||
|
||||
procedure TMycTaskFactoryTests.TestFactoryCreationAndTeardown;
|
||||
var
|
||||
threadCount: Integer;
|
||||
begin
|
||||
Assert.IsNotNull(FFactory, 'Factory should be created');
|
||||
threadCount := FFactory.ThreadCount;
|
||||
Assert.AreEqual(TThread.ProcessorCount, threadCount, 'Thread count should match processor count');
|
||||
end;
|
||||
|
||||
procedure TMycTaskFactoryTests.TestCreateThreadExecutesAndSignals;
|
||||
@@ -149,22 +138,22 @@ end;
|
||||
procedure TMycTaskFactoryTests.TestRunDelayedJobDoesNotExecutePrematurely;
|
||||
var
|
||||
jobExecuted: Boolean;
|
||||
jobCompletedLatch: IMycLatch;
|
||||
jobCompleted: IMycLatch;
|
||||
subscriber: IMycSubscriber;
|
||||
startCount: Integer;
|
||||
dummyWaitLatch: IMycLatch;
|
||||
dummyWait: IMycLatch;
|
||||
begin
|
||||
jobExecuted := False;
|
||||
startCount := 3;
|
||||
jobCompletedLatch := TMycLatch.CreateLatch(1); // Changed from Signals.CreateLatch
|
||||
dummyWaitLatch := TMycLatch.CreateLatch(1); // Changed from Signals.CreateLatch
|
||||
jobCompleted := TMycLatch.CreateLatch(1); // Changed from Signals.CreateLatch
|
||||
dummyWait := TMycLatch.CreateLatch(1); // Changed from Signals.CreateLatch
|
||||
|
||||
|
||||
subscriber := FFactory.Run(startCount,
|
||||
procedure
|
||||
begin
|
||||
jobExecuted := True;
|
||||
jobCompletedLatch.Notify;
|
||||
jobCompleted.Notify;
|
||||
end);
|
||||
|
||||
Assert.IsNotNull(subscriber, 'Run should return a subscriber for delayed job_P2');
|
||||
@@ -175,8 +164,8 @@ begin
|
||||
subscriber.Notify;
|
||||
Assert.IsFalse(jobExecuted, 'Job should not execute after two notifications_P2');
|
||||
|
||||
FFactory.Run(0, procedure begin dummyWaitLatch.Notify; end);
|
||||
FFactory.WaitFor(dummyWaitLatch.State);
|
||||
FFactory.Run(0, procedure begin dummyWait.Notify; end);
|
||||
FFactory.WaitFor(dummyWait.State);
|
||||
|
||||
Assert.IsFalse(jobExecuted, 'Job should still not have executed before third notify_P2');
|
||||
end;
|
||||
@@ -229,28 +218,25 @@ procedure TMycTaskFactoryTests.TestExceptionPropagationFromJob;
|
||||
var
|
||||
jobDoneLatch: IMycLatch;
|
||||
begin
|
||||
jobDoneLatch := TMycLatch.CreateLatch(1); // Changed from Signals.CreateLatch
|
||||
jobDoneLatch := TMycLatch.CreateLatch(1);
|
||||
|
||||
FFactory.Run(0,
|
||||
procedure
|
||||
var
|
||||
dummy: Integer;
|
||||
begin
|
||||
dummy := 0;
|
||||
raise TMycTaskFactory.ETaskException.Create('Test Exception From Job');
|
||||
// jobDoneLatch.Notify; // This line will not be reached
|
||||
try
|
||||
raise TMycTaskFactory.ETaskException.Create('Test Exception From Job');
|
||||
finally
|
||||
jobDoneLatch.Notify;
|
||||
end;
|
||||
end);
|
||||
|
||||
FFactory.Run(0, procedure begin jobDoneLatch.Notify; end);
|
||||
FFactory.WaitFor(jobDoneLatch.State);
|
||||
|
||||
Assert.WillRaise(
|
||||
procedure
|
||||
begin
|
||||
(FFactory as TMycTaskFactory).HandleException;
|
||||
FFactory.WaitFor(jobDoneLatch.State);
|
||||
end,
|
||||
TMycTaskFactory.ETaskException,
|
||||
'HandleException should re-raise the exception from the job'
|
||||
'WaitFor should re-raise the exception from the job'
|
||||
);
|
||||
|
||||
var noExceptionRaised: Boolean := True;
|
||||
@@ -283,8 +269,8 @@ var
|
||||
dummyStateToWaitFor: IMycState;
|
||||
begin
|
||||
exceptionCaughtInJob := False;
|
||||
jobDoneLatch := TMycLatch.CreateLatch(1); // Changed from Signals.CreateLatch
|
||||
dummyStateToWaitFor := TMycLatch.CreateLatch(1).State; // Changed from Signals.CreateLatch
|
||||
jobDoneLatch := TMycLatch.CreateLatch(1);
|
||||
dummyStateToWaitFor := TMycLatch.CreateLatch(1).State;
|
||||
|
||||
FFactory.Run(0,
|
||||
procedure
|
||||
|
||||
Reference in New Issue
Block a user