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

Refactoring

Browse Source
This commit is contained in:
Michael Schimmel
2025-06-05 22:59:39 +02:00
parent e06a023742
commit 7ba42b0c7c
13 changed files with 860 additions and 306 deletions
Download Patch File Download Diff File Expand all files Collapse all files
Src/Myc.Core.Futures.pas
+3 -3
View File
@@ -23,8 +23,8 @@ type
TMycGateFuncFuture<T> = class(TMycFuture<T>)
private
FInit: TState.TSubscription;
FDone: IMycEvent;
FInit: TSubscription;
FDone: IMycLatch;
FResult: T;
protected
function GetResult: T; override;
@@ -54,7 +54,7 @@ constructor TMycGateFuncFuture<T>.Create(const ATaskManager: IMycTaskManager; co
begin
inherited Create;
FDone := TEvent.CreateLatch(1);
FDone := TLatch.CreateLatch(1);
// Subscribe the job execution to AGate.
// The job will run when AGate notifies the subscriber returned by Run.
Src/Myc.Core.Lazy.pas
+5 -43
View File
@@ -18,7 +18,7 @@ type
TMycLazyBase<T> = class(TInterfacedObject, IMycLazy<T>)
strict private
FChanged: TFlag;
FChangeState: TState.TSubscription;
FChangeState: TSubscription;
function GetChanged: TState;
protected
function GetValue: T; virtual; abstract;
@@ -46,18 +46,6 @@ type
constructor Create(const AValue: IMycLazy<T>);
end;
TMycMutable<T> = class(TInterfacedObject, IMycLazy<T>, IMycMutable<T>)
private
FNotifier: TEvent;
FValue: T;
protected
function GetChanged: TState;
public
constructor Create;
function Pop(out Res: T): Boolean;
procedure SendValue(const Value: T);
end;
implementation
{ TMycNullLazy<T> }
@@ -107,54 +95,28 @@ end;
constructor TMycFuncLazy<T>.Create(const AChanged: TState; const AProc: TFunc<T>);
begin
inherited Create( AChanged );
inherited Create(AChanged);
FProc := AProc;
Assert( Assigned(FProc) );
end;
function TMycFuncLazy<T>.GetValue: T;
begin
Result := FProc();
Result := FProc();
end;
{ TMycChainedLazy<T> }
constructor TMycChainedLazy<T>.Create(const AValue: IMycLazy<T>);
begin
inherited Create( AValue.Changed );
inherited Create(AValue.Changed);
FValue := AValue;
end;
function TMycChainedLazy<T>.GetValue: T;
begin
if not FValue.Pop( Result ) then
if not FValue.Pop(Result) then
raise Exception.Create('Lazy chain already popped');
end;
{ TMycMutable<T> }
constructor TMycMutable<T>.Create;
begin
inherited Create;
FNotifier := TEvent.CreateNotifier;
FValue := Default(T);
end;
function TMycMutable<T>.GetChanged: TState;
begin
Result := FNotifier.State;
end;
function TMycMutable<T>.Pop(out Res: T): Boolean;
begin
Res := FValue;
exit(true);
end;
procedure TMycMutable<T>.SendValue(const Value: T);
begin
FValue := Value;
FNotifier.Notify;
end;
end.
Src/Myc.Core.Signals.pas
+51 -50
View File
@@ -8,38 +8,46 @@ uses
Myc.Signals;
type
// TMycNullState implements a "null object" pattern for IMycState.
// TMycNullSignal implements a "null object" pattern for IMycState.
// This state is always considered "set".
TMycNullState = class(TInterfacedObject, IMycState)
protected
// IMycState
function GetIsSet: Boolean;
TMycNullSignal = class(TInterfacedObject, IMycSignal)
public
constructor Create;
function Subscribe(Subscriber: IMycSubscriber): Pointer;
procedure Unsubscribe(Tag: TMycNotifyList<IMycSubscriber>.TTag);
end;
// A state that acts as an event. It's state ist always set and it will always notify it's subscribers, if it gets notified by itself.
TMycNotifyEvent = class(TInterfacedObject, IMycState, IMycEvent)
// TMycNullState implements a "null object" pattern for IMycState.
// This state is always considered "set".
TMycNullState = class(TMycNullSignal, IMycState)
protected
// IMycState
function GetIsSet: Boolean;
end;
// A state that acts as an event. It's state ist always set and it will always Trigger it's subscribers, if it gets notified by itself.
TMycEvent = class(TInterfacedObject, IMycSignal, IMycEvent)
strict private
FSubscribers: TMycNotifyList<IMycSubscriber>;
protected
function GetIsSet: Boolean;
function GetState: TState;
public
constructor Create;
destructor Destroy; override;
function Subscribe(Subscriber: IMycSubscriber): Pointer;
procedure Unsubscribe(Tag: TMycNotifyList<IMycSubscriber>.TTag);
function Notify: Boolean;
procedure Trigger;
end;
TMycNullEvent = class(TMycNullSignal, IMycEvent)
private
procedure Trigger;
end;
// TMycLatch implements a countdown latch.
// It is initialized with a count. Calls to its Notify method (as an IMycSubscriber)
// decrement this count. When the count reaches zero, the latch transitions to the "set"
// state (IsSet becomes true), notifies its current subscribers once, and then remains set.
TMycLatch = class(TInterfacedObject, IMycState, IMycEvent)
TMycLatch = class(TInterfacedObject, IMycState, IMycLatch)
strict private
FSubscribers: TMycNotifyList<IMycSubscriber>; // List of subscribers waiting for this latch to be set.
private
@@ -64,7 +72,7 @@ type
function Notify: Boolean;
end;
TMycNullEvent = class(TInterfacedObject, IMycEvent)
TMycNullLatch = class(TInterfacedObject, IMycLatch)
private
function GetState: TState;
function Notify: Boolean;
@@ -113,59 +121,31 @@ implementation
uses
System.SyncObjs; // For TInterlocked
{ TMycNullState }
constructor TMycNullState.Create;
begin
inherited Create;
end;
function TMycNullState.GetIsSet: Boolean;
begin
Result := true; // Null state is always set.
end;
function TMycNullState.Subscribe(Subscriber: IMycSubscriber): Pointer;
begin
// Since the state is always set, notify the subscriber immediately.
if Assigned(Subscriber) then
begin
Subscriber.Notify;
end;
// No ongoing subscription is necessary or meaningful for a null state.
Result := nil;
end;
{ TMycEvent }
procedure TMycNullState.Unsubscribe(Tag: TMycNotifyList<IMycSubscriber>.TTag);
begin
// Unsubscribing from a null state has no effect.
end;
{ TMycNotifyEvent }
constructor TMycNotifyEvent.Create;
constructor TMycEvent.Create;
begin
inherited Create;
FSubscribers.Create;
end;
destructor TMycNotifyEvent.Destroy;
destructor TMycEvent.Destroy;
begin
FSubscribers.Destroy;
inherited;
end;
function TMycNotifyEvent.GetIsSet: Boolean;
function TMycEvent.GetIsSet: Boolean;
begin
Result := true;
end;
function TMycNotifyEvent.GetState: TState;
begin
Result := Self;
end;
function TMycNotifyEvent.Notify: Boolean;
procedure TMycEvent.Trigger;
begin
FSubscribers.Lock;
try
@@ -175,7 +155,7 @@ begin
end;
end;
function TMycNotifyEvent.Subscribe(Subscriber: IMycSubscriber): Pointer;
function TMycEvent.Subscribe(Subscriber: IMycSubscriber): Pointer;
begin
Result := nil;
if not Assigned(Subscriber) then
@@ -190,7 +170,7 @@ begin
end;
end;
procedure TMycNotifyEvent.Unsubscribe(Tag: TMycNotifyList<IMycSubscriber>.TTag);
procedure TMycEvent.Unsubscribe(Tag: TMycNotifyList<IMycSubscriber>.TTag);
begin
if Tag = nil then
exit;
@@ -203,14 +183,14 @@ begin
end;
end;
{ TMycNullEvent }
{ TMycNullLatch }
function TMycNullEvent.GetState: TState;
function TMycNullLatch.GetState: TState;
begin
Result := TState.Null;
end;
function TMycNullEvent.Notify: Boolean;
function TMycNullLatch.Notify: Boolean;
begin
Result := false;
end;
@@ -427,4 +407,25 @@ begin
end;
end;
procedure TMycNullEvent.Trigger;
begin
// nop
end;
function TMycNullSignal.Subscribe(Subscriber: IMycSubscriber): Pointer;
begin
// Since the state is always set, notify the subscriber immediately.
if Assigned(Subscriber) then
begin
Subscriber.Notify;
end;
// No ongoing subscription is necessary or meaningful for a null state.
Result := nil;
end;
procedure TMycNullSignal.Unsubscribe(Tag: TMycNotifyList<IMycSubscriber>.TTag);
begin
// Unsubscribing from a null state has no effect.
end;
end.
Src/Myc.Core.Tasks.pas
+5 -5
View File
@@ -81,7 +81,7 @@ type
procedure HandleException;
procedure EnqueueJob(const Job: TProc);
function Run(Job: TProc): IMycSubscriber;
function CreateTask(const Gate: TState; const Proc: TProc): TState.TSubscription;
function CreateTask(const Gate: TState; const Proc: TProc): TSubscription;
procedure WaitFor(State: IMycState);
procedure Teardown;
function InMainThread: Boolean;
@@ -188,7 +188,7 @@ begin
Result.NameThreadForDebugging(DbgName); // Set thread name for debugging
end;
function TMycTaskFactory.CreateTask(const Gate: TState; const Proc: TProc): TState.TSubscription;
function TMycTaskFactory.CreateTask(const Gate: TState; const Proc: TProc): TSubscription;
begin
if Gate.IsSet then
begin
@@ -203,11 +203,11 @@ end;
function TMycTaskFactory.CreateThread(const Proc: TProc): IMycState;
var
res: IMycEvent;
res: IMycLatch;
capturedProc: TProc;
begin
// Create a latch that will be signaled when the proc finishes
res := TEvent.CreateLatch(1);
res := TLatch.CreateLatch(1);
capturedProc := Proc; // Capture Proc for the anonymous method
CreateAnonymousThread(
@@ -309,7 +309,7 @@ begin
raise ETaskException.Create('Task factory terminated');
if not Assigned(Job) then
exit(TEvent.Null); // Already correct, uses direct static property on TMycLatch
exit(TLatch.Null); // Already correct, uses direct static property on TMycLatch
// Create a pending job
Result := TMycPendingJob.Create(Self, Job);
Src/Myc.Signals.pas
+175 -60
View File
@@ -7,36 +7,79 @@ uses
type
IMycSubscriber = interface
// Interface for an entity that can be notified by a TState or TState.
// Returns true if this subscriber expects further notifications from the source, false otherwise.
function Notify: Boolean;
end;
IMycState = interface
TSubscriptionTag = Pointer;
IMycSignal = interface
function Subscribe(Subscriber: IMycSubscriber): TSubscriptionTag;
procedure Unsubscribe(Tag: TSubscriptionTag);
end;
TSubscription = record
private
FState: IMycSignal;
FTag: TSubscriptionTag;
constructor Create(const AState: IMycSignal; ATag: Pointer);
public
class operator Initialize(out Dest: TSubscription);
// Unsubscribes from the associated TState.
procedure Unsubscribe;
end;
TSignal = record
strict private
class var
FNull: IMycSignal;
class constructor ClassCreate;
private
FSignal: IMycSignal;
public
constructor Create(const ASignal: IMycSignal);
class operator Initialize(out Dest: TSignal);
class operator Implicit(const A: IMycSignal): TSignal; overload;
class operator Implicit(const A: TSignal): IMycSignal; overload;
function Subscribe(Subscriber: IMycSubscriber): TSubscription; inline;
procedure Unsubscribe(Tag: Pointer); inline;
class property Null: IMycSignal read FNull;
end;
IMycEvent = interface( IMycSignal )
procedure Trigger;
end;
TEvent = record
strict private
class var
FNull: IMycEvent;
class constructor ClassCreate;
private
FEvent: IMycEvent;
public
constructor Create(const AEvent: IMycEvent);
class operator Initialize(out Dest: TEvent);
class operator Implicit(const A: IMycEvent): TEvent; overload;
class operator Implicit(const A: TEvent): IMycEvent; overload;
class property Null: IMycEvent read FNull;
function Subscribe(Subscriber: IMycSubscriber): TSubscription; inline;
procedure Unsubscribe(Tag: Pointer); inline;
end;
IMycState = interface(IMycSignal)
// Represents a subscribable TState that can be queried.
{$REGION 'property access'}
function GetIsSet: Boolean;
{$ENDREGION}
// Subscribes a given subscriber to this TState.
function Subscribe(Subscriber: IMycSubscriber): Pointer;
procedure Unsubscribe(Tag: Pointer);
// IsSet is true if the TState has been reached or the condition is met.
property IsSet: Boolean read GetIsSet;
end;
TState = record // helper for IMycState
type
TSubscription = record
private
FState: IMycState;
FTag: Pointer; // Tag identifying this subscription within the notifier list.
constructor Create(const AState: IMycState; ATag: Pointer);
public
class operator Initialize(out Dest: TSubscription);
// Unsubscribes from the associated TState.
procedure Unsubscribe;
end;
strict private
class var
FNull: IMycState;
@@ -46,7 +89,7 @@ type
function GetIsSet: Boolean; inline;
public
constructor Create(const AState: IMycState);
class operator Initialize(out Dest: TState);
class operator Implicit(const A: IMycState): TState; overload;
class operator Implicit(const A: TState): IMycState; overload;
@@ -61,36 +104,33 @@ type
property IsSet: Boolean read GetIsSet;
end;
IMycEvent = interface(IMycSubscriber)
IMycLatch = interface(IMycSubscriber)
function GetState: TState;
property State: TState read GetState;
end;
TEvent = record
TLatch = record
strict private
class var
FNull: IMycEvent;
FNull: IMycLatch;
class constructor ClassCreate;
private
FLatch: IMycEvent;
FLatch: IMycLatch;
function GetState: TState; inline;
public
constructor Create(const ALatch: IMycEvent);
class operator Initialize(out Dest: TEvent);
class operator Implicit(const A: IMycEvent): TEvent; overload;
class operator Implicit(const A: TEvent): IMycEvent; overload;
// A notifier is an event that acts as a multi-cast event. Its state is always set and it forwards all notifications the all subscribers.
class function CreateNotifier: TEvent; static;
constructor Create(const ALatch: IMycLatch);
class operator Initialize(out Dest: TLatch);
class operator Implicit(const A: IMycLatch): TLatch; overload;
class operator Implicit(const A: TLatch): IMycLatch; overload;
// A latch is a specific type of event that, once set, remains set (non-resettable).
// It becomes set when the internal countdown reaches zero.
class function CreateLatch(Count: Integer): TEvent; static;
class function CreateLatch(Count: Integer): TLatch; static;
class function Enqueue(var Gate: TEvent; Count: Integer = 1): TState; static;
class function Enqueue(var Gate: TLatch; Count: Integer = 1): TState; static;
class property Null: IMycEvent read FNull;
class property Null: IMycLatch read FNull;
function Notify: Boolean; inline;
@@ -118,9 +158,9 @@ type
public
constructor Create(const ADirty: IMycFlag);
class operator Initialize(out Dest: TFlag);
class operator Implicit(const A: IMycFlag): TFlag; overload;
class operator Implicit(const A: TFlag): IMycFlag; overload;
class operator Initialize(out Dest: TFlag);
class function CreateFlag: IMycFlag; static;
class property Null: IMycFlag read FNull;
@@ -139,21 +179,21 @@ uses
{ TState.TSubscription }
constructor TState.TSubscription.Create(const AState: IMycState; ATag: TMycNotifyList<IMycSubscriber>.TTag);
constructor TSubscription.Create(const AState: IMycSignal; ATag: Pointer);
begin
Assert(Assigned(AState));
FState := AState;
FTag := ATag;
end;
procedure TState.TSubscription.Unsubscribe;
procedure TSubscription.Unsubscribe;
begin
FState.Unsubscribe(FTag);
FState := TState.Null;
FTag := nil;
end;
class operator TState.TSubscription.Initialize(out Dest: TSubscription);
class operator TSubscription.Initialize(out Dest: TSubscription);
begin
Dest.FState := TState.Null;
Dest.FTag := nil;
@@ -176,9 +216,9 @@ end;
class function TState.All(const States: TArray<TState>): TState;
var
Latch: IMycEvent;
Latch: IMycLatch;
begin
Latch := TEvent.CreateLatch(Length(States));
Latch := TLatch.CreateLatch(Length(States));
for var i := 0 to High(States) do
States[i].Subscribe(Latch);
Result := Latch.State;
@@ -186,7 +226,7 @@ end;
class function TState.Any(const States: TArray<TState>): TState;
var
Latch: IMycEvent;
Latch: IMycLatch;
begin
if Length(States) = 0 then
begin
@@ -194,7 +234,7 @@ begin
end
else
begin
Latch := TEvent.CreateLatch(1);
Latch := TLatch.CreateLatch(1);
for var i := 0 to High(States) do
States[i].Subscribe(Latch);
Result := Latch.State;
@@ -226,6 +266,50 @@ begin
Result.Create(A);
end;
class operator TState.Initialize(out Dest: TState);
begin
Dest.FState := FNull;
end;
{ TEvent }
constructor TEvent.Create(const AEvent: IMycEvent);
begin
FEvent := AEvent;
if not Assigned(FEvent) then
FEvent := FNull;
end;
class constructor TEvent.ClassCreate;
begin
FNull := TMycNullEvent.Create();
end;
function TEvent.Subscribe(Subscriber: IMycSubscriber): TSubscription;
begin
Result := TSubscription.Create(FEvent, FEvent.Subscribe(Subscriber));
end;
procedure TEvent.Unsubscribe(Tag: Pointer);
begin
FEvent.Unsubscribe(Tag);
end;
class operator TEvent.Implicit(const A: TEvent): IMycEvent;
begin
Result := A.FEvent;
end;
class operator TEvent.Implicit(const A: IMycEvent): TEvent;
begin
Result.Create(A);
end;
class operator TEvent.Initialize(out Dest: TEvent);
begin
Dest.FEvent := FNull;
end;
{ TFlag }
class constructor TFlag.ClassCreate;
@@ -233,8 +317,6 @@ begin
FNull := TMycNullFlag.Create;
end;
{ TFlag }
constructor TFlag.Create(const ADirty: IMycFlag);
begin
FDirty := ADirty;
@@ -277,24 +359,23 @@ begin
Dest.FDirty := FNull;
end;
{ TEvent }
{ TLatch }
class constructor TEvent.ClassCreate;
class constructor TLatch.ClassCreate;
begin
// Create a singleton null latch instance that is initially (and always) set.
FNull := TMycNullEvent.Create;
FNull := TMycNullLatch.Create;
end;
{ TEvent }
constructor TEvent.Create(const ALatch: IMycEvent);
constructor TLatch.Create(const ALatch: IMycLatch);
begin
FLatch := ALatch;
if not Assigned(FLatch) then
FLatch := FNull;
end;
class function TEvent.CreateLatch(Count: Integer): TEvent;
class function TLatch.CreateLatch(Count: Integer): TLatch;
begin
if Count > 0 then
Result := TMycLatch.Create(Count)
@@ -302,12 +383,7 @@ begin
Result := FNull;
end;
class function TEvent.CreateNotifier: TEvent;
begin
Result := TMycNotifyEvent.Create;
end;
class function TEvent.Enqueue(var Gate: TEvent; Count: Integer = 1): TState;
class function TLatch.Enqueue(var Gate: TLatch; Count: Integer = 1): TState;
begin
var gateState := Gate.State;
Gate := TMycLatch.Create(Count);
@@ -315,29 +391,68 @@ begin
exit(Gate.State);
end;
function TEvent.GetState: TState;
function TLatch.GetState: TState;
begin
Result := FLatch.State;
end;
function TEvent.Notify: Boolean;
function TLatch.Notify: Boolean;
begin
Result := FLatch.Notify;
end;
class operator TEvent.Implicit(const A: IMycEvent): TEvent;
class operator TLatch.Implicit(const A: IMycLatch): TLatch;
begin
Result.Create(A);
end;
class operator TEvent.Implicit(const A: TEvent): IMycEvent;
class operator TLatch.Implicit(const A: TLatch): IMycLatch;
begin
Result := A.FLatch;
end;
class operator TEvent.Initialize(out Dest: TEvent);
class operator TLatch.Initialize(out Dest: TLatch);
begin
Dest.FLatch := FNull;
end;
class constructor TSignal.ClassCreate;
begin
FNull := TMycNullSignal.Create();
end;
{ TSignal }
constructor TSignal.Create(const ASignal: IMycSignal);
begin
FSignal := ASignal;
if not Assigned(FSignal) then
FSignal := FNull;
end;
function TSignal.Subscribe(Subscriber: IMycSubscriber): TSubscription;
begin
Result := TSubscription.Create(FSignal, FSignal.Subscribe(Subscriber));
end;
procedure TSignal.Unsubscribe(Tag: Pointer);
begin
FSignal.Unsubscribe(Tag);
end;
class operator TSignal.Implicit(const A: TSignal): IMycSignal;
begin
Result := A.FSignal;
end;
class operator TSignal.Implicit(const A: IMycSignal): TSignal;
begin
Result.Create(A);
end;
class operator TSignal.Initialize(out Dest: TSignal);
begin
Dest.FSignal := FNull;
end;
end.
Src/Myc.TaskManager.pas
+3 -3
View File
@@ -9,7 +9,7 @@ uses
type
IMycTaskManager = interface
// TOD Dokumentation
function CreateTask(const Gate: TState; const Proc: TProc): TState.TSubscription;
function CreateTask(const Gate: TState; const Proc: TProc): TSubscription;
// Waits for the operation associated with State to complete.
// Must not be called from a worker thread of this factory.
@@ -41,7 +41,7 @@ type
TMycTaskManagerMock = class(TInterfacedObject, IMycTaskManager)
public
// IMycTaskManager
function CreateTask(const Gate: TState; const Proc: TProc): TState.TSubscription;
function CreateTask(const Gate: TState; const Proc: TProc): TSubscription;
procedure WaitFor(State: IMycState);
constructor Create;
@@ -72,7 +72,7 @@ begin
inherited Create;
end;
function TMycTaskManagerMock.CreateTask(const Gate: TState; const Proc: TProc): TState.TSubscription;
function TMycTaskManagerMock.CreateTask(const Gate: TState; const Proc: TProc): TSubscription;
begin
Result := Gate.Subscribe(TMycExecMock.Create(Proc));
end;
Src/Myc.Test.Core.Lazy.pas
-28
View File
@@ -36,9 +36,6 @@ type
procedure TestFuncLazy_GetChanged_IsAlwaysTrueAfterCreation;
[Test]
procedure TestFuncLazy_FirstPop_AlwaysEvaluatesAndResetsChanged;
[Test]
procedure TestFuncLazy_Pop_WhenProcIsNull_FirstPopReturnsTrueAndValueUnchanged_ResetsChanged;
// Tests for behavior after the initial "changed" state is consumed
[Test]
procedure TestFuncLazy_AfterFirstPop_IfNoSourceChange_GetChangedIsFalse;
@@ -205,31 +202,6 @@ begin
Assert.IsFalse(funcLazy.GetChanged.IsSet, 'Changed.IsSet should be false after the first Pop, as Pop resets it');
end;
procedure TTestMycCoreLazy.TestFuncLazy_Pop_WhenProcIsNull_FirstPopReturnsTrueAndValueUnchanged_ResetsChanged;
var
funcLazy: IMycLazy<Integer>;
value: Integer;
preCallValue: Integer;
result: Boolean;
sourceDirty: IMycFlag;
begin
sourceDirty := TFlag.CreateFlag;
sourceDirty.Reset;
funcLazy := TMycFuncLazy<Integer>.Create(sourceDirty.State, nil);
Assert.IsNotNull(funcLazy, 'TMycFuncLazy<Integer> instance should not be nil');
Assert.IsTrue(funcLazy.GetChanged.IsSet, 'Changed state should be true before Pop by design');
preCallValue := 123;
value := preCallValue;
result := funcLazy.Pop(value);
Assert.IsTrue(result, 'First Pop should return true by design, even if FProc is nil');
Assert.AreEqual(
preCallValue,
value,
'Value should be unchanged as FProc was nil and current Pop implementation does not assign Default(T)'
);
Assert.IsFalse(funcLazy.GetChanged.IsSet, 'Changed state should be false after Pop');
end;
// == Tests for TMycFuncLazy<T> - Behavior After Initial Pop ==
procedure TTestMycCoreLazy.TestFuncLazy_AfterFirstPop_IfNoSourceChange_GetChangedIsFalse;
Src/Myc.Test.Lazy.pas
-25
View File
@@ -37,8 +37,6 @@ type
[Test]
procedure TestConstruct_FirstPop_SucceedsAndResetsChanged;
[Test]
procedure TestConstruct_WithNilProc_FirstPopReturnsTrueAndValueUnchanged;
[Test]
procedure TestConstruct_StateInteraction_SignalTriggersChanged;
[Test]
procedure TestConstruct_StateInteraction_PopResetsChangedAfterSignal;
@@ -185,29 +183,6 @@ begin
Assert.IsTrue(procExecuted, 'Proc should have been executed by the initial Pop');
end;
procedure TTestMyLazy.TestConstruct_WithNilProc_FirstPopReturnsTrueAndValueUnchanged;
var
lazyIntf: IMycLazy<Integer>;
lazyRec: TLazy<Integer>;
val: Integer;
preVal: Integer;
popResult: Boolean;
begin
lazyIntf := TLazy<Integer>.Construct(FChangingSignal.State, nil); // Proc is nil
lazyRec := lazyIntf;
Assert.IsTrue(lazyRec.Changed.IsSet, 'Constructed lazy (nil Proc): Initial Changed.IsSet should be true');
preVal := 77;
val := preVal;
popResult := lazyRec.Pop(val);
Assert.IsTrue(popResult, 'Constructed lazy (nil Proc): First Pop should return true');
// As per TMycFuncLazy behavior, if FProc is nil, Pop does not assign Default(T) to Res,
// Res remains unchanged.
Assert.AreEqual(preVal, val, 'Constructed lazy (nil Proc): Res should be unchanged by Pop as Proc was nil');
Assert.IsFalse(lazyRec.Changed.IsSet, 'Constructed lazy (nil Proc): Changed.IsSet should be false after Pop');
end;
procedure TTestMyLazy.TestConstruct_StateInteraction_SignalTriggersChanged;
var
lazyIntf: IMycLazy<Integer>;
Src/Myc.Test.Signals.Dirty.pas
+529
View File
@@ -0,0 +1,529 @@
unit Myc.Test.Signals.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): IMycFlag;
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): IMycFlag;
begin
Result := TFlag.CreateFlag; // 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: IMycFlag;
begin
dirtyFlag := TFlag.CreateFlag;
Assert.IsTrue(dirtyFlag.State.IsSet, 'Newly created dirty flag should be IsSet (dirty).');
end;
procedure TTestMycDirtyFlag.TestReset_FromDirtyState_BecomesCleanAndReturnsTrue;
var
dirtyFlag: IMycFlag;
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: IMycFlag;
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: IMycFlag;
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: IMycFlag;
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: IMycFlag;
subscriber: TMockSubscriber;
subscription: TSubscription;
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: IMycFlag;
subscriber: TMockSubscriber;
subscription: TSubscription;
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: IMycFlag;
subscriber: TMockSubscriber;
subscription: TSubscription;
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: IMycFlag;
subscriber: TMockSubscriber;
subscription: TSubscription;
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: IMycFlag;
subscriber: TMockSubscriber;
subscription: TSubscription;
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: IMycFlag;
sub1, sub2: TMockSubscriber;
subscription1, subscription2: TSubscription;
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: IMycFlag;
subscriber: TMockSubscriber;
subscription: TSubscription;
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: IMycFlag;
subToB: TMockSubscriber;
subscriptionA_B, subscriptionMock_B: TSubscription;
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: IMycFlag;
subToC: TMockSubscriber;
subscriptionB_A, subscriptionC_B, subscriptionMock_C: TSubscription;
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: IMycFlag;
subToB: TMockSubscriber;
subscriptionA_B, subscriptionMock_B: TSubscription;
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: IMycFlag;
subToB: TMockSubscriber;
subscriptionA_B, subscriptionMock_B: TSubscription;
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: IMycFlag;
subToC: TMockSubscriber;
subscriptionB_A, subscriptionC_B, subscriptionMock_C: TSubscription;
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: IMycFlag;
subToC: TMockSubscriber;
subscriptionB_A, subscriptionC_B, subscriptionMock_C: TSubscription;
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: IMycFlag;
subToC: TMockSubscriber;
subscriptionB_A, subscriptionC_B, subscriptionMock_C: TSubscription;
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.
Src/Myc.Test.Signals.Latch.pas
+55 -55
View File
@@ -120,10 +120,10 @@ end;
procedure TTestMycLatch.TestCreate_InitialState(InitialCount: Integer; ExpectedIsSet: Boolean);
var
latch: IMycEvent;
latch: IMycLatch;
begin
// TMycLatch.CreateLatch returns TMycLatch.Null if InitialCount <= 0
latch := TEvent.CreateLatch(InitialCount);
latch := TLatch.CreateLatch(InitialCount);
Assert.AreEqual(ExpectedIsSet, latch.State.IsSet, 'Latch initial IsSet state mismatch for count ' + IntToStr(InitialCount) + '.');
end;
@@ -133,11 +133,11 @@ procedure TTestMycLatch.TestNotify_ReturnValueAndState_AfterOneNotify(
ExpectedIsSet: Boolean
);
var
latch: IMycEvent;
latch: IMycLatch;
returnedValueFromNotify: Boolean;
begin
latch := TEvent.CreateLatch(InitialCount);
returnedValueFromNotify := latch.Notify; // This is IMycEvent (as IMycSubscriber).Notify
latch := TLatch.CreateLatch(InitialCount);
returnedValueFromNotify := latch.Notify; // This is IMycLatch (as IMycSubscriber).Notify
Assert.AreEqual(
ExpectedReturn,
@@ -153,9 +153,9 @@ end;
procedure TTestMycLatch.TestNotify_DecrementsCounter_StateChanges;
var
latch: IMycEvent;
latch: IMycLatch;
begin
latch := TEvent.CreateLatch(1);
latch := TLatch.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).');
@@ -163,9 +163,9 @@ end;
procedure TTestMycLatch.TestNotify_MultipleNotifies_CounterBecomesNegativeAndStaysSet;
var
latch: IMycEvent;
latch: IMycLatch;
begin
latch := TEvent.CreateLatch(1);
latch := TLatch.CreateLatch(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
@@ -176,11 +176,11 @@ end;
procedure TTestMycLatch.TestSubscriber_Single_IsNotifiedWhenLatchSet;
var
latch: IMycEvent;
latch: IMycLatch;
mockSub: TMockSubscriber;
subscription: TState.TSubscription;
subscription: TSubscription;
begin
latch := TEvent.CreateLatch(1);
latch := TLatch.CreateLatch(1);
mockSub := TMockSubscriber.Create;
subscription := latch.State.Subscribe(mockSub); // Subscribing to the Latch's state
@@ -195,11 +195,11 @@ end;
procedure TTestMycLatch.TestSubscriber_Multiple_AreNotifiedWhenLatchSet;
var
latch: IMycEvent;
latch: IMycLatch;
mockSub1, mockSub2, mockSub3: TMockSubscriber;
sub1, sub2, sub3: TState.TSubscription; // Keep subscriptions in scope
sub1, sub2, sub3: TSubscription; // Keep subscriptions in scope
begin
latch := TEvent.CreateLatch(1);
latch := TLatch.CreateLatch(1);
mockSub1 := TMockSubscriber.Create;
mockSub2 := TMockSubscriber.Create;
mockSub3 := TMockSubscriber.Create;
@@ -217,11 +217,11 @@ end;
procedure TTestMycLatch.TestSubscriber_NotNotified_BeforeLatchSet;
var
latch: IMycEvent;
latch: IMycLatch;
mockSub: TMockSubscriber;
subscription: TState.TSubscription;
subscription: TSubscription;
begin
latch := TEvent.CreateLatch(2); // Count = 2
latch := TLatch.CreateLatch(2); // Count = 2
mockSub := TMockSubscriber.Create;
subscription := latch.State.Subscribe(mockSub);
@@ -232,11 +232,11 @@ end;
procedure TTestMycLatch.TestSubscriber_NotifiedOnlyOnce_AfterLatchSetAndUnadvised;
var
latch: IMycEvent;
latch: IMycLatch;
mockSub: TMockSubscriber;
subscription: TState.TSubscription;
subscription: TSubscription;
begin
latch := TEvent.CreateLatch(1);
latch := TLatch.CreateLatch(1);
mockSub := TMockSubscriber.Create;
subscription := latch.State.Subscribe(mockSub);
@@ -249,11 +249,11 @@ end;
procedure TTestMycLatch.TestSubscribe_ToAlreadySetLatch_NotifiesImmediately;
var
latch: IMycEvent;
latch: IMycLatch;
mockSub1, mockSub2: TMockSubscriber;
subscription1, subscription2: TState.TSubscription;
subscription1, subscription2: TSubscription;
begin
latch := TEvent.CreateLatch(1); // Create with count 1
latch := TLatch.CreateLatch(1); // Create with count 1
mockSub1 := TMockSubscriber.Create;
subscription1 := latch.State.Subscribe(mockSub1); // Subscribe before set
@@ -277,12 +277,12 @@ end;
procedure TTestMycLatch.TestChaining_A_Notifies_B;
var
latchA, latchB: IMycEvent;
latchA, latchB: IMycLatch;
mockSubForB: TMockSubscriber;
subHandle_B_listens_A, subHandle_Mock_listens_B: TState.TSubscription;
subHandle_B_listens_A, subHandle_Mock_listens_B: TSubscription;
begin
latchA := TEvent.CreateLatch(1);
latchB := TEvent.CreateLatch(1); // latchB is an IMycSubscriber
latchA := TLatch.CreateLatch(1);
latchB := TLatch.CreateLatch(1); // latchB is an IMycSubscriber
mockSubForB := TMockSubscriber.Create;
subHandle_Mock_listens_B := latchB.State.Subscribe(mockSubForB);
@@ -302,13 +302,13 @@ end;
procedure TTestMycLatch.TestCascade_A_Notifies_B_Notifies_C;
var
latchA, latchB, latchC: IMycEvent;
latchA, latchB, latchC: IMycLatch;
mockSubForC: TMockSubscriber;
sub_Mock_C, sub_C_B, sub_B_A: TState.TSubscription;
sub_Mock_C, sub_C_B, sub_B_A: TSubscription;
begin
latchA := TEvent.CreateLatch(1);
latchB := TEvent.CreateLatch(1);
latchC := TEvent.CreateLatch(1);
latchA := TLatch.CreateLatch(1);
latchB := TLatch.CreateLatch(1);
latchC := TLatch.CreateLatch(1);
mockSubForC := TMockSubscriber.Create;
sub_Mock_C := latchC.State.Subscribe(mockSubForC);
@@ -325,14 +325,14 @@ end;
procedure TTestMycLatch.TestChaining_B_NeedsMultipleNotifiesFromA_WithSubscriberOnB;
var
latchA, latchB: IMycEvent;
latchA, latchB: IMycLatch;
mockSubForB: TMockSubscriber;
sub_Mock_B, sub_B_A: TState.TSubscription;
sub_Mock_B, sub_B_A: 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 := TEvent.CreateLatch(2);
latchB := TEvent.CreateLatch(1);
latchA := TLatch.CreateLatch(2);
latchB := TLatch.CreateLatch(1);
mockSubForB := TMockSubscriber.Create;
sub_Mock_B := latchB.State.Subscribe(mockSubForB);
@@ -354,11 +354,11 @@ end;
procedure TTestMycLatch.TestInitiallySetLatch_NotifiesNewSubscriberImmediately;
var
latch: IMycEvent; // Will be TMycLatch.Null
latch: IMycLatch; // Will be TMycLatch.Null
mockSub: TMockSubscriber;
subscription: TState.TSubscription;
subscription: TSubscription;
begin
latch := TEvent.CreateLatch(0); // Returns TMycLatch.Null which is set.
latch := TLatch.CreateLatch(0); // Returns TMycLatch.Null which is set.
mockSub := TMockSubscriber.Create;
subscription := latch.State.Subscribe(mockSub); // TMycLatch.Subscribe notifies immediately if already set.
@@ -369,11 +369,11 @@ end;
procedure TTestMycLatch.TestUnsubscribe_SubscriberNotNotified;
var
latch: IMycEvent;
latch: IMycLatch;
mockSub: TMockSubscriber;
subscription: TState.TSubscription;
subscription: TSubscription;
begin
latch := TEvent.CreateLatch(1);
latch := TLatch.CreateLatch(1);
mockSub := TMockSubscriber.Create;
subscription := latch.State.Subscribe(mockSub);
@@ -388,11 +388,11 @@ end;
procedure TTestMycLatch.TestMultipleTriggersNoSubscriber_StateCorrectForLaterSubscriber;
var
latch: IMycEvent;
latch: IMycLatch;
mockSub: TMockSubscriber;
subscription: TState.TSubscription;
subscription: TSubscription;
begin
latch := TEvent.CreateLatch(3);
latch := TLatch.CreateLatch(3);
latch.Notify; // Count -> 2
latch.Notify; // Count -> 1
@@ -411,11 +411,11 @@ end;
procedure TTestMycLatch.TestLatchSet_ClearsSubscribers_NoFurtherNotification;
var
latch: IMycEvent;
latch: IMycLatch;
mockSub1, mockSub2: TMockSubscriber;
subscription1, subscription2: TState.TSubscription;
subscription1, subscription2: TSubscription;
begin
latch := TEvent.CreateLatch(1);
latch := TLatch.CreateLatch(1);
mockSub1 := TMockSubscriber.Create;
mockSub2 := TMockSubscriber.Create;
@@ -439,17 +439,17 @@ end;
procedure TTestMycLatch.TestLatchSet_SubscriptionFinalize_IsSafePostUnadviseAll;
var
latch: IMycEvent;
latch: IMycLatch;
mockSub: TMockSubscriber;
// 'subscription' will be declared in an inner scope to control its finalization
begin
latch := TEvent.CreateLatch(1);
latch := TLatch.CreateLatch(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
var subscription: TSubscription; // Local to this block
subscription := latch.State.Subscribe(mockSub);
latch.Notify; // Sets the latch, mockSub is notified, UnadviseAll is called internally.
@@ -475,11 +475,11 @@ end;
procedure TTestMycLatch.TestLatchSet_NewSubscriberToSetLatch_NotifiedImmediatelyButNotPersistedForLatchNotify;
var
latch: IMycEvent;
latch: IMycLatch;
mockSubInitial, mockSubNew: TMockSubscriber;
subscriptionInitial, subscriptionNew: TState.TSubscription;
subscriptionInitial, subscriptionNew: TSubscription;
begin
latch := TEvent.CreateLatch(1);
latch := TLatch.CreateLatch(1);
mockSubInitial := TMockSubscriber.Create;
subscriptionInitial := latch.State.Subscribe(mockSubInitial);
Test/TestCoreFutures.pas
+15 -15
View File
@@ -16,9 +16,9 @@ type
// Helper class to notify a latch when its Notify method is called.
TLatchNotifierSubscriber = class(TInterfacedObject, IMycSubscriber)
private
FGateLatch: IMycEvent;
FGateLatch: IMycLatch;
public
constructor Create(AGateLatch: IMycEvent);
constructor Create(AGateLatch: IMycLatch);
// IMycSubscriber
function Notify: Boolean; // Implements IMycSubscriber.Notify [cite: 46, 181, 299]
end;
@@ -54,7 +54,7 @@ implementation
{ TLatchNotifierSubscriber }
constructor TLatchNotifierSubscriber.Create(AGateLatch: IMycEvent);
constructor TLatchNotifierSubscriber.Create(AGateLatch: IMycLatch);
begin
inherited Create;
FGateLatch := AGateLatch;
@@ -121,12 +121,12 @@ end;
procedure TTestMycGateFuncFuture.Test_ChainedExecution_WithDelayedInitState;
var
LFuture: IMycFuture<string>;
LInitLatch: IMycEvent;
LInitLatch: IMycLatch;
LResultValue: string;
const
CExpectedResult = 'ChainCompleted';
begin
LInitLatch := TEvent.CreateLatch(1); // Create an init state that is not yet set [cite: 77, 212, 330]
LInitLatch := TLatch.CreateLatch(1); // Create an init state that is not yet set [cite: 77, 212, 330]
LFuture :=
TMycGateFuncFuture<string>.Create(
@@ -220,9 +220,9 @@ end;
procedure TTestMycGateFuncFuture.Test_GetResult_BeforeDone_RaisesException;
var
LFuture: IMycFuture<Integer>;
LInitLatch: IMycEvent;
LInitLatch: IMycLatch;
begin
LInitLatch := TEvent.CreateLatch(1);
LInitLatch := TLatch.CreateLatch(1);
LFuture :=
TMycGateFuncFuture<Integer>.Create(
@@ -250,17 +250,17 @@ procedure TTestMycGateFuncFuture.Test_FanIn_OneFutureWaitsForMultipleOthers;
var
LPrerequisiteFuture1, LPrerequisiteFuture2: IMycFuture<Integer>;
LMainFuture: IMycFuture<string>;
LGateLatch: IMycEvent;
LGateLatch: IMycLatch;
LSub1, LSub2: IMycSubscriber; // To hold the TLatchNotifierSubscriber instances
LInitStateP1, LInitStateP2: IMycEvent;
Subscriptions: array[1..2] of TState.TSubscription; // To manage subscriptions
LInitStateP1, LInitStateP2: IMycLatch;
Subscriptions: array[1..2] of TSubscription; // To manage subscriptions
const
CMainFutureResult = 'AllPrerequisitesCompleted';
begin
FProcExecutionCount := 0; // Reset for this test
// Gate Latch: MainFuture waits for this latch, which needs 2 notifications.
LGateLatch := TEvent.CreateLatch(2); // [cite: 77, 212, 330]
LGateLatch := TLatch.CreateLatch(2); // [cite: 77, 212, 330]
// Create MainFuture, AInitState is the GateLatch's state.
LMainFuture :=
@@ -276,7 +276,7 @@ begin
// Setup Prerequisite Futures
// PrerequisiteFuture1
LInitStateP1 := TEvent.CreateLatch(1); // Controllable init state for PF1
LInitStateP1 := TLatch.CreateLatch(1); // Controllable init state for PF1
LPrerequisiteFuture1 :=
TMycGateFuncFuture<Integer>.Create(
FTaskFactory,
@@ -291,7 +291,7 @@ begin
Subscriptions[1] := LPrerequisiteFuture1.Done.Subscribe(LSub1); // Subscribe to PF1's completion [cite: 56, 188, 306]
// PrerequisiteFuture2
LInitStateP2 := TEvent.CreateLatch(1); // Controllable init state for PF2
LInitStateP2 := TLatch.CreateLatch(1); // Controllable init state for PF2
LPrerequisiteFuture2 :=
TMycGateFuncFuture<Integer>.Create(
FTaskFactory,
@@ -335,7 +335,7 @@ end;
procedure TTestMycGateFuncFuture.Test_FanOut_MultipleFuturesWaitForOneTrigger;
var
LTriggerLatch: IMycEvent;
LTriggerLatch: IMycLatch;
LFutureA, LFutureB: IMycFuture<Integer>;
LFlagFutureARan, LFlagFutureBRan: Boolean;
begin
@@ -343,7 +343,7 @@ begin
LFlagFutureBRan := False;
Self.FSharedCounter := 0; // Reset shared counter for this test
LTriggerLatch := TEvent.CreateLatch(1); // Single trigger [cite: 77, 212, 330]
LTriggerLatch := TLatch.CreateLatch(1); // Single trigger [cite: 77, 212, 330]
// Future A
LFutureA :=
Test/TestFutures.pas
+5 -5
View File
@@ -148,11 +148,11 @@ end;
procedure TTestFuture.TestConstructWithDelayedGate;
var
fut: TFuture<Integer>;
delayedGate: IMycEvent; // IMycEvent implements IMycState [cite: 58]
delayedGate: IMycLatch; // IMycLatch implements IMycState [cite: 58]
resultValue: Integer;
begin
delayedGate := TEvent.CreateLatch(1); // Create a latch that requires one notification to be set [cite: 66]
Assert.IsNotNull(delayedGate, 'The delayed gate (IMycEvent) should not be nil.'); // Static string
delayedGate := TLatch.CreateLatch(1); // Create a latch that requires one notification to be set [cite: 66]
Assert.IsNotNull(delayedGate, 'The delayed gate (IMycLatch) should not be nil.'); // Static string
Assert.IsFalse(delayedGate.State.IsSet, 'The delayed gate should not be initially set.'); // Static string [cite: 59, 55]
// Construct a future with a gate that is not yet set
@@ -220,10 +220,10 @@ procedure TTestFuture.TestChainWithGate;
var
fut1: TFuture<Integer>;
fut2: TFuture<string>;
delayedGate: IMycEvent;
delayedGate: IMycLatch;
resultValue: string;
begin
delayedGate := TEvent.CreateLatch(1); // [cite: 66]
delayedGate := TLatch.CreateLatch(1); // [cite: 66]
Assert.IsFalse(delayedGate.State.IsSet, 'The delayed gate for chain test should not be initially set.');
// Static string [cite: 59, 55]
Test/TestTasks.pas
+14 -14
View File
@@ -86,10 +86,10 @@ end;
procedure TMycTaskFactoryTests.TestRunImmediateJob;
var
jobExecuted: Boolean;
jobCompletedLatch: IMycEvent;
jobCompletedLatch: IMycLatch;
begin
jobExecuted := False;
jobCompletedLatch := TEvent.CreateLatch(1); // Changed from Signals.CreateLatch
jobCompletedLatch := TLatch.CreateLatch(1); // Changed from Signals.CreateLatch
FFactory
.Run(
@@ -107,11 +107,11 @@ end;
procedure TMycTaskFactoryTests.TestRunDelayedJobExecutesAfterAllNotifies;
var
jobExecuted: Boolean;
jobCompletedLatch: IMycEvent;
jobCompletedLatch: IMycLatch;
subscriber: IMycSubscriber;
begin
jobExecuted := False;
jobCompletedLatch := TEvent.CreateLatch(1); // Changed from Signals.CreateLatch
jobCompletedLatch := TLatch.CreateLatch(1); // Changed from Signals.CreateLatch
subscriber :=
FFactory.Run(
@@ -124,7 +124,7 @@ begin
Assert.IsNotNull(subscriber, 'Run should return a subscriber for delayed job');
// Use TMycLatch.Null for comparison
Assert.AreNotEqual<IMycSubscriber>(TEvent.Null, subscriber, 'Subscriber should not be TMycLatch.Null for StartCount > 0');
Assert.AreNotEqual<IMycSubscriber>(TLatch.Null, subscriber, 'Subscriber should not be TMycLatch.Null for StartCount > 0');
subscriber.Notify;
@@ -134,11 +134,11 @@ end;
procedure TMycTaskFactoryTests.TestWaitForAlreadySetState;
var
alreadySetLatch: IMycEvent;
alreadySetLatch: IMycLatch;
startTime, endTime: Cardinal;
begin
// TMycLatch.CreateLatch(0) will return TMycLatch.Null
alreadySetLatch := TEvent.CreateLatch(0); // Changed from Signals.CreateLatch
alreadySetLatch := TLatch.CreateLatch(0); // Changed from Signals.CreateLatch
Assert.IsTrue(alreadySetLatch.State.IsSet, 'Latch should be initially set');
startTime := TThread.GetTickCount;
@@ -152,11 +152,11 @@ procedure TMycTaskFactoryTests.TestThreadInfoMethods;
var
inMainThreadInJob: Boolean;
inWorkerThreadInJob: Boolean;
jobDoneLatch: IMycEvent;
jobDoneLatch: IMycLatch;
begin
inMainThreadInJob := True;
inWorkerThreadInJob := False;
jobDoneLatch := TEvent.CreateLatch(1); // Changed from Signals.CreateLatch
jobDoneLatch := TLatch.CreateLatch(1); // Changed from Signals.CreateLatch
Assert.IsTrue(FFactory.InMainThread, 'Test method itself should be in main thread');
Assert.IsFalse(FFactory.InWorkerThread, 'Test method itself should not be in a factory worker thread');
@@ -178,9 +178,9 @@ end;
procedure TMycTaskFactoryTests.TestExceptionPropagationFromJob;
var
jobDoneLatch: IMycEvent;
jobDoneLatch: IMycLatch;
begin
jobDoneLatch := TEvent.CreateLatch(1);
jobDoneLatch := TLatch.CreateLatch(1);
FFactory.EnqueueJob(
procedure
@@ -222,12 +222,12 @@ end;
procedure TMycTaskFactoryTests.TestWaitForInWorkerThreadRaisesException;
var
exceptionCaughtInJob: Boolean;
jobDoneLatch: IMycEvent;
jobDoneLatch: IMycLatch;
dummyStateToWaitFor: IMycState;
begin
exceptionCaughtInJob := False;
jobDoneLatch := TEvent.CreateLatch(1);
dummyStateToWaitFor := TEvent.CreateLatch(1).State;
jobDoneLatch := TLatch.CreateLatch(1);
dummyStateToWaitFor := TLatch.CreateLatch(1).State;
FFactory.EnqueueJob(
procedure