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

Code formatting

Browse Source
This commit is contained in:
Michael Schimmel
2025-06-05 10:26:28 +02:00
parent f033ef2c0f
commit 6bed68748d
22 changed files with 1884 additions and 1743 deletions
Download Patch File Download Diff File Expand all files Collapse all files
Src/Myc.Core.Atomic.pas
+12 -11
View File
@@ -4,9 +4,9 @@ interface
{$align on} {$align on}
uses uses
{$ifndef NO_FASTMM} {$ifndef NO_FASTMM}
FastMM5, FastMM5,
{$endif} {$endif}
Winapi.Windows; Winapi.Windows;
type type
@@ -33,15 +33,16 @@ type
end; end;
TMycAtomicStack<T> = record TMycAtomicStack<T> = record
private type private
PItem = ^TItem; type
TItem = packed record PItem = ^TItem;
Next: TSListEntry; TItem = packed record
Data: T; Next: TSListEntry;
end; Data: T;
end;
var var
FSList: PSList; FSList: PSList;
public public
// Initializes the atomic stack, creating the underlying SList. // Initializes the atomic stack, creating the underlying SList.
@@ -212,7 +213,7 @@ begin
begin begin
item.Data := Default(T); item.Data := Default(T);
FreeMemAligned(item); // Global procedure FreeMemAligned(item); // Global procedure
item := PopPtr; // Call instance method PopPtr via Dest item := PopPtr; // Call instance method PopPtr via Dest
end; end;
end; end;
Src/Myc.Core.Futures.pas
+29 -25
View File
@@ -4,22 +4,24 @@ interface
uses uses
System.SysUtils, System.SysUtils,
Myc.Signals, Myc.TaskManager, Myc.Futures; Myc.Signals,
Myc.TaskManager,
Myc.Futures;
type type
TMycFuture<T> = class abstract( TInterfacedObject, IMycFuture<T> ) TMycFuture<T> = class abstract(TInterfacedObject, IMycFuture<T>)
protected protected
function GetResult: T; virtual; abstract; function GetResult: T; virtual; abstract;
function GetDone: TState; virtual; abstract; function GetDone: TState; virtual; abstract;
end; end;
TMycNullFuture<T> = class( TMycFuture<T> ) TMycNullFuture<T> = class(TMycFuture<T>)
protected protected
function GetResult: T; override; function GetResult: T; override;
function GetDone: TState; override; function GetDone: TState; override;
end; end;
TMycGateFuncFuture<T> = class( TMycFuture<T> ) TMycGateFuncFuture<T> = class(TMycFuture<T>)
private private
FInit: TState.TSubscription; FInit: TState.TSubscription;
FDone: IMycLatch; FDone: IMycLatch;
@@ -28,7 +30,7 @@ type
function GetResult: T; override; function GetResult: T; override;
function GetDone: TState; override; function GetDone: TState; override;
public public
constructor Create( const ATaskManager: IMycTaskManager; const AGate: IMycState; AProc: TFunc<T> ); constructor Create(const ATaskManager: IMycTaskManager; const AGate: IMycState; AProc: TFunc<T>);
destructor Destroy; override; destructor Destroy; override;
end; end;
@@ -43,39 +45,41 @@ end;
function TMycNullFuture<T>.GetResult: T; function TMycNullFuture<T>.GetResult: T;
begin begin
Result := Default ( T ); Result := Default(T);
end; end;
{ TMycGateFuncFuture<T> } { TMycGateFuncFuture<T> }
constructor TMycGateFuncFuture<T>.Create( const ATaskManager: IMycTaskManager; const AGate: IMycState; AProc: TFunc<T> ); constructor TMycGateFuncFuture<T>.Create(const ATaskManager: IMycTaskManager; const AGate: IMycState; AProc: TFunc<T>);
begin begin
inherited Create; inherited Create;
FDone := TLatch.Construct( 1 ); FDone := TLatch.Construct(1);
// Subscribe the job execution to AGate. // Subscribe the job execution to AGate.
// The job will run when AGate notifies the subscriber returned by Run. // The job will run when AGate notifies the subscriber returned by Run.
FInit := ATaskManager.CreateTask( FInit :=
AGate, ATaskManager.CreateTask(
procedure AGate,
begin procedure
try begin
try try
Self.FResult := AProc( ); try
except Self.FResult := AProc();
Self.FResult := Default ( T ); // Set result to Default(T) on error except
raise; // Re-raise for TaskFactory to handle Self.FResult := Default(T); // Set result to Default(T) on error
end; raise; // Re-raise for TaskFactory to handle
finally end;
Self.FDone.Notify; // Signal that this future is done (successfully or with error) finally
end; Self.FDone.Notify; // Signal that this future is done (successfully or with error)
end ); end;
end
);
end; end;
destructor TMycGateFuncFuture<T>.Destroy; destructor TMycGateFuncFuture<T>.Destroy;
begin begin
Assert( FDone.State.IsSet ); Assert(FDone.State.IsSet);
FInit.Unsubscribe; FInit.Unsubscribe;
inherited Destroy; inherited Destroy;
@@ -88,7 +92,7 @@ end;
function TMycGateFuncFuture<T>.GetResult: T; function TMycGateFuncFuture<T>.GetResult: T;
begin begin
Assert( FDone.State.IsSet, 'Result is not yet available.' ); Assert(FDone.State.IsSet, 'Result is not yet available.');
Result := FResult; Result := FResult;
end; end;
Src/Myc.Core.Lazy.pas
+11 -11
View File
@@ -8,21 +8,21 @@ uses
Myc.Lazy; Myc.Lazy;
type type
TMycLazy<T> = class abstract( TInterfacedObject, IMycLazy<T> ) TMycLazy<T> = class abstract(TInterfacedObject, IMycLazy<T>)
protected protected
function GetChanged: IMycState; virtual; abstract; function GetChanged: IMycState; virtual; abstract;
public public
function Pop( out Res: T ): Boolean; virtual; abstract; function Pop(out Res: T): Boolean; virtual; abstract;
end; end;
TMycNullLazy<T> = class( TMycLazy<T> ) TMycNullLazy<T> = class(TMycLazy<T>)
protected protected
function GetChanged: IMycState; override; function GetChanged: IMycState; override;
public public
function Pop( out Res: T ): Boolean; override; function Pop(out Res: T): Boolean; override;
end; end;
TMycFuncLazy<T> = class( TMycLazy<T> ) TMycFuncLazy<T> = class(TMycLazy<T>)
private private
FChanged: IMycDirty; FChanged: IMycDirty;
FChangeState: TState.TSubscription; FChangeState: TState.TSubscription;
@@ -32,7 +32,7 @@ type
public public
constructor Create(const AChanged: TState; const AProc: TFunc<T>); constructor Create(const AChanged: TState; const AProc: TFunc<T>);
destructor Destroy; override; destructor Destroy; override;
function Pop( out Res: T ): Boolean; override; function Pop(out Res: T): Boolean; override;
end; end;
implementation implementation
@@ -44,9 +44,9 @@ begin
Result := TState.Null; Result := TState.Null;
end; end;
function TMycNullLazy<T>.Pop( out Res: T ): Boolean; function TMycNullLazy<T>.Pop(out Res: T): Boolean;
begin begin
Res := Default ( T ); Res := Default(T);
Result := true; Result := true;
end; end;
@@ -57,7 +57,7 @@ begin
inherited Create; inherited Create;
FChanged := TDirty.Construct; FChanged := TDirty.Construct;
FProc := AProc; FProc := AProc;
FChangeState := AChanged.Subscribe( FChanged ); FChangeState := AChanged.Subscribe(FChanged);
end; end;
destructor TMycFuncLazy<T>.Destroy; destructor TMycFuncLazy<T>.Destroy;
@@ -71,12 +71,12 @@ begin
Result := FChanged.State; Result := FChanged.State;
end; end;
function TMycFuncLazy<T>.Pop( out Res: T ): Boolean; function TMycFuncLazy<T>.Pop(out Res: T): Boolean;
begin begin
Result := FChanged.State.IsSet; Result := FChanged.State.IsSet;
if Result then if Result then
begin begin
if Assigned( FProc ) then if Assigned(FProc) then
Res := FProc; Res := FProc;
FChanged.Reset; FChanged.Reset;
end; end;
Src/Myc.Core.Notifier.pas
+53 -50
View File
@@ -3,7 +3,8 @@ unit Myc.Core.Notifier;
interface interface
uses uses
System.SysUtils, System.SyncObjs; System.SysUtils,
System.SyncObjs;
type type
// Low-level implementation for thread-safe multicast events. // Low-level implementation for thread-safe multicast events.
@@ -13,35 +14,37 @@ type
// `UnadviseAll` removes all registered interfaces. // `UnadviseAll` removes all registered interfaces.
// After `Finalize` is called, the list is cleared, and no new interfaces can be added (closed state). // After `Finalize` is called, the list is cleared, and no new interfaces can be added (closed state).
TMycNotifyList<T: IInterface> = record TMycNotifyList<T: IInterface> = record
type type
TTag = Pointer; // Opaque tag used to identify a registered receiver for unsubscription. TTag = Pointer; // Opaque tag used to identify a registered receiver for unsubscription.
PItem = ^TItem; // Pointer to an internal list item. PItem = ^TItem; // Pointer to an internal list item.
TItem = record // Internal structure for storing a receiver and list linkage. TItem = record // Internal structure for storing a receiver and list linkage.
Next, Prev: PItem; // Pointers to the next and previous items in the doubly linked list. Next, Prev: PItem; // Pointers to the next and previous items in the doubly linked list.
Receiver: T; // The registered interface instance (the event sink). Receiver: T; // The registered interface instance (the event sink).
end; end;
strict private strict private
FFirst: NativeUInt; // Stores the first receiver if no list is allocated, or acts as a combined lock and state field. FFirst: NativeUInt; // Stores the first receiver if no list is allocated, or acts as a combined lock and state field.
// Bit 0: Lock state (0 = locked, 1 = unlocked). // Bit 0: Lock state (0 = locked, 1 = unlocked).
// Bit 1: Finalized state (0 = not finalized, 1 = finalized). // Bit 1: Finalized state (0 = not finalized, 1 = finalized).
// Other bits (if not 0 and bit 0 is 1) can be a direct interface pointer if FList is nil. // Other bits (if not 0 and bit 0 is 1) can be a direct interface pointer if FList is nil.
FList: PItem; // Head of the linked list for additional receivers beyond the first one. FList: PItem; // Head of the linked list for additional receivers beyond the first one.
class function AllocItem: PItem; static; inline; // Allocates and initializes memory for a new TItem. class function AllocItem: PItem; static; inline; // Allocates and initializes memory for a new TItem.
class procedure FreeItem( Item: PItem ); static; inline; // Frees memory previously allocated for a TItem. class procedure FreeItem(Item: PItem); static; inline; // Frees memory previously allocated for a TItem.
public public
procedure Create; // Initializes the notification list, preparing it for use. procedure Create; // Initializes the notification list, preparing it for use.
procedure Destroy; // Cleans up all resources, including unadvising all receivers. Assumes no concurrent access. procedure Destroy; // Cleans up all resources, including unadvising all receivers. Assumes no concurrent access.
function Advise(const Receiver: T): TTag; // Registers a receiver interface and returns an opaque tag for later unsubscription. function Advise(const Receiver: T): TTag; // Registers a receiver interface and returns an opaque tag for later unsubscription.
procedure Unadvise(Tag: TTag); // Unregisters a specific receiver using the tag obtained from Advise. procedure Unadvise(Tag: TTag); // Unregisters a specific receiver using the tag obtained from Advise.
procedure UnadviseAll; // Unregisters all currently advised receivers. procedure UnadviseAll; // Unregisters all currently advised receivers.
procedure Lock; inline; // Acquires an exclusive lock for thread-safe operations on the list. procedure Lock; inline; // Acquires an exclusive lock for thread-safe operations on the list.
procedure Release; inline;// Releases the previously acquired exclusive lock. procedure Release; inline; // Releases the previously acquired exclusive lock.
function IsLocked: Boolean; inline; // Checks if the list is currently locked by any thread. function IsLocked: Boolean; inline; // Checks if the list is currently locked by any thread.
procedure Notify(Func: TPredicate<T>); // Iterates through registered receivers and invokes the predicate; removes receiver if predicate returns false. procedure Notify(
Func: TPredicate<T>
); // Iterates through registered receivers and invokes the predicate; removes receiver if predicate returns false.
end; end;
implementation implementation
@@ -56,7 +59,7 @@ procedure TMycNotifyList<T>.Destroy;
begin begin
// Because refcounting is thread-safe, this will always be entered once after all references // Because refcounting is thread-safe, this will always be entered once after all references
// to Self are dropped. No locking needed! // to Self are dropped. No locking needed!
Assert( not IsLocked ); Assert(not IsLocked);
FFirst := FFirst and not 3; FFirst := FFirst and not 3;
UnadviseAll; UnadviseAll;
end; end;
@@ -65,24 +68,24 @@ function TMycNotifyList<T>.Advise(const Receiver: T): TTag;
var var
Item: PItem; Item: PItem;
begin begin
Assert( IsLocked ); Assert(IsLocked);
if FFirst=0 then if FFirst = 0 then
begin begin
IInterface( FFirst ) := Receiver; IInterface(FFirst) := Receiver;
exit( PPointer(@Receiver)^ ); exit(PPointer(@Receiver)^);
end; end;
Item := AllocItem; Item := AllocItem;
Item.Receiver := Receiver; Item.Receiver := Receiver;
Item.Prev := nil; Item.Prev := nil;
Item.Next := FList; Item.Next := FList;
if Item.Next<>nil then if Item.Next <> nil then
Item.Next.Prev := Item; Item.Next.Prev := Item;
FList := Item; FList := Item;
exit( Item ); exit(Item);
end; end;
procedure TMycNotifyList<T>.Lock; procedure TMycNotifyList<T>.Lock;
@@ -93,19 +96,19 @@ begin
YieldProcessor; YieldProcessor;
continue; continue;
end; end;
until TInterlocked.BitTestAndClear( PNativeUint( @FFirst )^, 0 ); until TInterlocked.BitTestAndClear(PNativeUint(@FFirst)^, 0);
Assert( IsLocked, 'Locking failed' ); Assert(IsLocked, 'Locking failed');
end; end;
class function TMycNotifyList<T>.AllocItem: PItem; class function TMycNotifyList<T>.AllocItem: PItem;
begin begin
Result := AllocMem( sizeof( TItem ) ); Result := AllocMem(sizeof(TItem));
end; end;
class procedure TMycNotifyList<T>.FreeItem(Item: PItem); class procedure TMycNotifyList<T>.FreeItem(Item: PItem);
begin begin
FreeMem( Item, sizeof( TItem ) ); FreeMem(Item, sizeof(TItem));
end; end;
function TMycNotifyList<T>.IsLocked: Boolean; function TMycNotifyList<T>.IsLocked: Boolean;
@@ -117,65 +120,65 @@ procedure TMycNotifyList<T>.Notify(Func: TPredicate<T>);
var var
Item, P: PItem; Item, P: PItem;
begin begin
Assert( IsLocked ); Assert(IsLocked);
if FFirst<>0 then if FFirst <> 0 then
if not Func( IInterface( FFirst ) ) then if not Func(IInterface(FFirst)) then
IInterface( FFirst ) := nil; IInterface(FFirst) := nil;
Item := FList; Item := FList;
while Item<>nil do while Item <> nil do
begin begin
P := Item.Next; P := Item.Next;
if not Func( Item.Receiver ) then if not Func(Item.Receiver) then
Unadvise( TTag( Item ) ); Unadvise(TTag(Item));
Item := P; Item := P;
end; end;
end; end;
procedure TMycNotifyList<T>.Release; procedure TMycNotifyList<T>.Release;
begin begin
Assert( IsLocked ); Assert(IsLocked);
TInterlocked.Exchange( Pointer( FFirst ), Pointer( FFirst or 1 ) ); TInterlocked.Exchange(Pointer(FFirst), Pointer(FFirst or 1));
end; end;
procedure TMycNotifyList<T>.Unadvise(Tag: TTag); procedure TMycNotifyList<T>.Unadvise(Tag: TTag);
var var
Item: PItem; Item: PItem;
begin begin
Assert( IsLocked ); Assert(IsLocked);
if NativeUInt(Tag) = FFirst then if NativeUInt(Tag) = FFirst then
begin begin
IInterface( FFirst ) := nil; IInterface(FFirst) := nil;
exit; exit;
end; end;
if FList = nil then if FList = nil then
exit; exit;
Item := PItem( Tag ); Item := PItem(Tag);
if Item = FList then if Item = FList then
FList := Item.Next; FList := Item.Next;
if Item.Prev<>nil then if Item.Prev <> nil then
Item.Prev.Next := Item.Next; Item.Prev.Next := Item.Next;
if Item.Next<>nil then if Item.Next <> nil then
Item.Next.Prev := Item.Prev; Item.Next.Prev := Item.Prev;
Item.Receiver := nil; Item.Receiver := nil;
FreeItem( Item ); FreeItem(Item);
end; end;
procedure TMycNotifyList<T>.UnadviseAll; procedure TMycNotifyList<T>.UnadviseAll;
begin begin
Assert( IsLocked ); Assert(IsLocked);
IInterface( FFirst ) := nil; IInterface(FFirst) := nil;
while FList<>nil do while FList <> nil do
Unadvise( TTag( FList ) ); Unadvise(TTag(FList));
end; end;
end. end.
Src/Myc.Core.Signals.pas
+12 -18
View File
@@ -8,7 +8,7 @@ uses
Myc.Signals; Myc.Signals;
type type
TMycState = class abstract( TInterfacedObject, IMycState ) TMycState = class abstract(TInterfacedObject, IMycState)
protected protected
function GetIsSet: Boolean; virtual; abstract; function GetIsSet: Boolean; virtual; abstract;
public public
@@ -37,10 +37,11 @@ type
strict private strict private
FSubscribers: TMycNotifyList<IMycSubscriber>; // List of subscribers waiting for this latch to be set. FSubscribers: TMycNotifyList<IMycSubscriber>; // List of subscribers waiting for this latch to be set.
private private
[volatile] FCount: Integer; // The internal countdown value for the latch. [volatile]
FCount: Integer; // The internal countdown value for the latch.
function GetState: TState; // Implementation for IMycLatch.GetState and IMycFlag.GetState. function GetState: TState; // Implementation for IMycLatch.GetState and IMycFlag.GetState.
protected protected
function GetIsSet: Boolean; override; final; // Implementation for IMycState.GetIsSet. function GetIsSet: Boolean; override; final; // Implementation for IMycState.GetIsSet.
public public
// Creates the latch with an initial count. // Creates the latch with an initial count.
// If ACount is 0 or less, the latch is effectively pre-set (delegates to FNull via CreateLatch factory). // If ACount is 0 or less, the latch is effectively pre-set (delegates to FNull via CreateLatch factory).
@@ -57,7 +58,7 @@ type
function Notify: Boolean; function Notify: Boolean;
end; end;
TMycNullLatch = class( TInterfacedObject, IMycLatch ) TMycNullLatch = class(TInterfacedObject, IMycLatch)
private private
function GetState: TState; function GetState: TState;
function Notify: Boolean; function Notify: Boolean;
@@ -70,10 +71,11 @@ type
strict private strict private
FSubscribers: TMycNotifyList<IMycSubscriber>; // List of subscribers interested in state changes of this dirty flag. FSubscribers: TMycNotifyList<IMycSubscriber>; // List of subscribers interested in state changes of this dirty flag.
private private
[volatile] FFlag: Boolean; // Internal state: true if dirty/set, false if clean/reset. [volatile]
FFlag: Boolean; // Internal state: true if dirty/set, false if clean/reset.
function GetState: TState; function GetState: TState;
protected protected
function GetIsSet: Boolean; override; final; // Implementation for IMycState.GetIsSet (true if dirty). function GetIsSet: Boolean; override; final; // Implementation for IMycState.GetIsSet (true if dirty).
public public
// Creates a new dirty flag, initially set to dirty (true). // Creates a new dirty flag, initially set to dirty (true).
constructor Create; constructor Create;
@@ -93,7 +95,7 @@ type
function Reset: Boolean; function Reset: Boolean;
end; end;
TMycNullDirty = class( TInterfacedObject, IMycDirty ) TMycNullDirty = class(TInterfacedObject, IMycDirty)
private private
function GetState: TState; function GetState: TState;
function Notify: Boolean; function Notify: Boolean;
@@ -150,7 +152,7 @@ end;
constructor TMycLatch.Create(ACount: Integer); constructor TMycLatch.Create(ACount: Integer);
begin begin
inherited Create; inherited Create;
Assert( ACount >= 0 ); Assert(ACount >= 0);
FCount := ACount; FCount := ACount;
FSubscribers.Create; FSubscribers.Create;
end; end;
@@ -177,11 +179,7 @@ begin
if shouldNotifySubscribers then if shouldNotifySubscribers then
begin begin
FSubscribers.Notify( FSubscribers.Notify(function(Subscriber: IMycSubscriber): Boolean begin Result := Subscriber.Notify; end);
function(Subscriber: IMycSubscriber): Boolean
begin
Result := Subscriber.Notify;
end);
end; end;
// Returns true if the latch has not yet been set by this Notify call (count > 0). // Returns true if the latch has not yet been set by this Notify call (count > 0).
@@ -315,11 +313,7 @@ begin
if wasPreviouslyClean then // Only notify subscribers if state changed from clean to dirty. if wasPreviouslyClean then // Only notify subscribers if state changed from clean to dirty.
begin begin
FSubscribers.Notify( FSubscribers.Notify(function(Subscriber: IMycSubscriber): Boolean begin Result := Subscriber.Notify; end);
function(Subscriber: IMycSubscriber): Boolean
begin
Result := Subscriber.Notify;
end);
end; end;
// The return value of this Notify (as an IMycSubscriber) indicates if this // The return value of this Notify (as an IMycSubscriber) indicates if this
// TMycDirty instance itself would want more notifications if it were subscribed to something. // TMycDirty instance itself would want more notifications if it were subscribed to something.
Src/Myc.Core.Tasks.pas
+38 -35
View File
@@ -3,11 +3,15 @@ unit Myc.Core.Tasks;
interface interface
uses uses
System.SysUtils, System.Classes, System.SyncObjs, System.SysUtils,
Myc.Core.Atomic, Myc.TaskManager, Myc.Signals; System.Classes,
System.SyncObjs,
Myc.Core.Atomic,
Myc.TaskManager,
Myc.Signals;
type type
IMycTaskFactory = interface( IMycTaskManager ) IMycTaskFactory = interface(IMycTaskManager)
{$region 'property access'} {$region 'property access'}
// Retrieves the number of worker threads. // Retrieves the number of worker threads.
function GetThreadCount: Integer; function GetThreadCount: Integer;
@@ -46,8 +50,9 @@ type
end; end;
TMycTaskFactory = class(TInterfacedObject, IMycTaskManager, IMycTaskFactory) TMycTaskFactory = class(TInterfacedObject, IMycTaskManager, IMycTaskFactory)
type type
ETaskException = class(Exception) end; ETaskException = class(Exception)
end;
private private
[volatile] [volatile]
FException: TObject; // Holds the first exception object from a worker thread FException: TObject; // Holds the first exception object from a worker thread
@@ -60,8 +65,8 @@ type
FWorkStack: TMycAtomicStack<TProc>; // Stack of pending jobs FWorkStack: TMycAtomicStack<TProc>; // Stack of pending jobs
FWorkThreads: TArray<TThread>; // Array of worker threads FWorkThreads: TArray<TThread>; // Array of worker threads
procedure WorkerThread; procedure WorkerThread;
class var class var
FTaskManagerLock: Integer; FTaskManagerLock: Integer;
protected protected
procedure ExecuteJob; procedure ExecuteJob;
@@ -139,7 +144,7 @@ begin
for var i := 0 to High(FWorkThreads) do for var i := 0 to High(FWorkThreads) do
FWorkThreads[i].Start; FWorkThreads[i].Start;
FWaitSemaphores.Push( TSemaphore.Create(nil, 0, 1, '') ); FWaitSemaphores.Push(TSemaphore.Create(nil, 0, 1, ''));
end; end;
destructor TMycTaskFactory.Destroy; destructor TMycTaskFactory.Destroy;
@@ -159,14 +164,14 @@ end;
class function TMycTaskFactory.CreateAnonymousThread(const DbgName: String; const Proc: TProc): TThread; class function TMycTaskFactory.CreateAnonymousThread(const DbgName: String; const Proc: TProc): TThread;
{$IFDEF MSWINDOWS} {$IFDEF MSWINDOWS}
{$WARN SYMBOL_PLATFORM OFF} {$WARN SYMBOL_PLATFORM OFF}
var var
prio: TThreadPriority; prio: TThreadPriority;
{$ENDIF MSWINDOWS} {$ENDIF MSWINDOWS}
begin begin
Result := TThread.CreateAnonymousThread(Proc); Result := TThread.CreateAnonymousThread(Proc);
{$IFDEF MSWINDOWS} {$IFDEF MSWINDOWS}
// Set priority lower than MainThread priority if created from main thread // Set priority lower than MainThread priority if created from main thread
if TThread.CurrentThread.ThreadID = MainThreadID then if TThread.CurrentThread.ThreadID = MainThreadID then
begin begin
@@ -177,7 +182,7 @@ begin
Result.Priority := prio; Result.Priority := prio;
end; end;
{$WARN SYMBOL_PLATFORM ON} {$WARN SYMBOL_PLATFORM ON}
{$ENDIF MSWINDOWS} {$ENDIF MSWINDOWS}
if DbgName <> '' then if DbgName <> '' then
Result.NameThreadForDebugging(DbgName); // Set thread name for debugging Result.NameThreadForDebugging(DbgName); // Set thread name for debugging
@@ -187,12 +192,12 @@ function TMycTaskFactory.CreateTask(const Gate: TState; const Proc: TProc): TSta
begin begin
if Gate.IsSet then if Gate.IsSet then
begin begin
EnqueueJob( Proc ); EnqueueJob(Proc);
end end
else else
begin begin
// The job will run when Gate notifies the subscriber returned by Run. // The job will run when Gate notifies the subscriber returned by Run.
Result := Gate.Subscribe( Run( Proc ) ); Result := Gate.Subscribe(Run(Proc));
end; end;
end; end;
@@ -205,16 +210,18 @@ begin
res := TLatch.Construct(1); // Changed to use direct static call on TMycLatch res := TLatch.Construct(1); // Changed to use direct static call on TMycLatch
capturedProc := Proc; // Capture Proc for the anonymous method capturedProc := Proc; // Capture Proc for the anonymous method
CreateAnonymousThread('Thread', CreateAnonymousThread(
procedure 'Thread',
begin procedure
try begin
capturedProc(); // Execute the provided procedure try
finally capturedProc(); // Execute the provided procedure
capturedProc := nil; // Clear the captured proc finally
res.Notify; // Signal completion via the latch's Notify method capturedProc := nil; // Clear the captured proc
end; res.Notify; // Signal completion via the latch's Notify method
end).Start; end;
end)
.Start;
// Return the state interface of the latch // Return the state interface of the latch
exit(res.State); exit(res.State);
@@ -286,12 +293,12 @@ class procedure TMycTaskFactory.AquireTaskManager;
begin begin
if not Assigned(TaskManager) then if not Assigned(TaskManager) then
TaskManager := TMycTaskFactory.Create; TaskManager := TMycTaskFactory.Create;
inc( FTaskManagerLock ); inc(FTaskManagerLock);
end; end;
class procedure TMycTaskFactory.ReleaseTaskManager; class procedure TMycTaskFactory.ReleaseTaskManager;
begin begin
dec( FTaskManagerLock ); dec(FTaskManagerLock);
if FTaskManagerLock = 0 then if FTaskManagerLock = 0 then
TaskManager := nil; TaskManager := nil;
end; end;
@@ -322,11 +329,7 @@ begin
for i := 0 to High(FWorkThreads) do for i := 0 to High(FWorkThreads) do
FWorkGate.Release; FWorkGate.Release;
TSpinWait.SpinUntil( TSpinWait.SpinUntil(function: Boolean begin Result := FThreadsRunning = 0; end);
function: Boolean
begin
Result := FThreadsRunning = 0;
end);
Assert(FThreadsRunning = 0); Assert(FThreadsRunning = 0);
@@ -357,7 +360,8 @@ begin
if lock = nil then if lock = nil then
lock := TSemaphore.Create(nil, 0, 1, ''); lock := TSemaphore.Create(nil, 0, 1, '');
try try
{var subscription :=} State.Subscribe(TMycTaskWait.Create(lock)); {var subscription :=}
State.Subscribe(TMycTaskWait.Create(lock));
lock.Acquire; lock.Acquire;
finally finally
FWaitSemaphores.Push(lock); FWaitSemaphores.Push(lock);
@@ -386,8 +390,7 @@ end;
{ TMycPendingJob } { TMycPendingJob }
constructor TMycPendingJob.Create(OwnerTaskFactory: TMycTaskFactory; const constructor TMycPendingJob.Create(OwnerTaskFactory: TMycTaskFactory; const JobProc: TProc);
JobProc: TProc);
begin begin
inherited Create; inherited Create;
FOwner := OwnerTaskFactory; FOwner := OwnerTaskFactory;
@@ -398,13 +401,13 @@ function TMycPendingJob.Notify: Boolean;
var var
P: TProc; P: TProc;
begin begin
PPointer(@P)^ := TInterlocked.Exchange( PPointer(@FJob)^, nil ); PPointer(@P)^ := TInterlocked.Exchange(PPointer(@FJob)^, nil);
Result := Assigned(P); Result := Assigned(P);
if Result then if Result then
begin begin
if Assigned(FOwner) then if Assigned(FOwner) then
FOwner.EnqueueJob(P); FOwner.EnqueueJob(P);
P := nil; P := nil;
end; end;
end; end;
Src/Myc.Futures.pas
+23 -26
View File
@@ -4,7 +4,8 @@ interface
uses uses
System.SysUtils, System.SysUtils,
Myc.Signals, Myc.TaskManager; Myc.Signals,
Myc.TaskManager;
type type
// Represents the eventual result of an asynchronous operation. // Represents the eventual result of an asynchronous operation.
@@ -32,17 +33,17 @@ type
class destructor DestroyClass; class destructor DestroyClass;
public public
constructor Create( const AFuture: IMycFuture<T> ); constructor Create(const AFuture: IMycFuture<T>);
class operator Implicit( const A: IMycFuture<T> ): TFuture<T>; overload; class operator Implicit(const A: IMycFuture<T>): TFuture<T>; overload;
class operator Implicit( const A: TFuture<T> ): IMycFuture<T>; overload; class operator Implicit(const A: TFuture<T>): IMycFuture<T>; overload;
class function Construct( const Proc: TFunc<T> ): TFuture<T>; overload; static; class function Construct(const Proc: TFunc<T>): TFuture<T>; overload; static;
class function Construct( const Gate: IMycState; const Proc: TFunc<T> ): TFuture<T>; overload; static; class function Construct(const Gate: IMycState; const Proc: TFunc<T>): TFuture<T>; overload; static;
class property Null: IMycFuture<T> read FNull; class property Null: IMycFuture<T> read FNull;
function Chain<S>( const Proc: TFunc<T, S> ): TFuture<S>; function Chain<S>(const Proc: TFunc<T, S>): TFuture<S>;
function WaitFor: T; function WaitFor: T;
@@ -53,12 +54,13 @@ type
implementation implementation
uses uses
Myc.Core.Futures, Myc.Core.Tasks; Myc.Core.Futures,
Myc.Core.Tasks;
constructor TFuture<T>.Create( const AFuture: IMycFuture<T> ); constructor TFuture<T>.Create(const AFuture: IMycFuture<T>);
begin begin
FFuture := AFuture; FFuture := AFuture;
if not Assigned( FFuture ) then if not Assigned(FFuture) then
FFuture := FNull; FFuture := FNull;
end; end;
@@ -73,26 +75,21 @@ begin
TMycTaskFactory.ReleaseTaskManager; TMycTaskFactory.ReleaseTaskManager;
end; end;
function TFuture<T>.Chain<S>( const Proc: TFunc<T, S> ): TFuture<S>; function TFuture<T>.Chain<S>(const Proc: TFunc<T, S>): TFuture<S>;
begin begin
var var Cap := FFuture;
Cap := FFuture;
Result := TFuture<S>.Construct( FFuture.Done, Result := TFuture<S>.Construct(FFuture.Done, function: S begin Result := Proc(Cap.Result); end);
function: S
begin
Result := Proc( Cap.Result );
end );
end; end;
class function TFuture<T>.Construct( const Proc: TFunc<T> ): TFuture<T>; class function TFuture<T>.Construct(const Proc: TFunc<T>): TFuture<T>;
begin begin
Result := TMycGateFuncFuture<T>.Create( TaskManager, nil, Proc ); Result := TMycGateFuncFuture<T>.Create(TaskManager, nil, Proc);
end; end;
class function TFuture<T>.Construct( const Gate: IMycState; const Proc: TFunc<T> ): TFuture<T>; class function TFuture<T>.Construct(const Gate: IMycState; const Proc: TFunc<T>): TFuture<T>;
begin begin
Result := TMycGateFuncFuture<T>.Create( TaskManager, Gate, Proc ); Result := TMycGateFuncFuture<T>.Create(TaskManager, Gate, Proc);
end; end;
function TFuture<T>.GetDone: IMycState; function TFuture<T>.GetDone: IMycState;
@@ -107,16 +104,16 @@ end;
function TFuture<T>.WaitFor: T; function TFuture<T>.WaitFor: T;
begin begin
TaskManager.WaitFor( FFuture.Done ); TaskManager.WaitFor(FFuture.Done);
Result := FFuture.Result; Result := FFuture.Result;
end; end;
class operator TFuture<T>.Implicit( const A: IMycFuture<T> ): TFuture<T>; class operator TFuture<T>.Implicit(const A: IMycFuture<T>): TFuture<T>;
begin begin
Result.Create( A ); Result.Create(A);
end; end;
class operator TFuture<T>.Implicit( const A: TFuture<T> ): IMycFuture<T>; class operator TFuture<T>.Implicit(const A: TFuture<T>): IMycFuture<T>;
begin begin
Result := A.FFuture; Result := A.FFuture;
end; end;
Src/Myc.Lazy.pas
+15 -15
View File
@@ -11,7 +11,7 @@ type
{$REGION 'property access'} {$REGION 'property access'}
function GetChanged: IMycState; function GetChanged: IMycState;
{$ENDREGION} {$ENDREGION}
function Pop( out Res: T ): Boolean; function Pop(out Res: T): Boolean;
property Changed: IMycState read GetChanged; property Changed: IMycState read GetChanged;
end; end;
@@ -24,14 +24,14 @@ type
class constructor CreateClass; class constructor CreateClass;
public public
constructor Create( const ALazy: IMycLazy<T> ); constructor Create(const ALazy: IMycLazy<T>);
class function Construct( const Changing: IMycState; const Proc: TFunc<T> ): IMycLazy<T>; static; class function Construct(const Changing: IMycState; const Proc: TFunc<T>): IMycLazy<T>; static;
class operator Implicit( const A: IMycLazy<T> ): TLazy<T>; overload; class operator Implicit(const A: IMycLazy<T>): TLazy<T>; overload;
class operator Implicit( const A: TLazy<T> ): IMycLazy<T>; overload; class operator Implicit(const A: TLazy<T>): IMycLazy<T>; overload;
function Pop( out Res: T ): Boolean; inline; function Pop(out Res: T): Boolean; inline;
property Changed: IMycState read GetChanged; property Changed: IMycState read GetChanged;
end; end;
@@ -41,16 +41,16 @@ implementation
uses uses
Myc.Core.Lazy; Myc.Core.Lazy;
constructor TLazy<T>.Create( const ALazy: IMycLazy<T> ); constructor TLazy<T>.Create(const ALazy: IMycLazy<T>);
begin begin
FLazy := ALazy; FLazy := ALazy;
if not Assigned( FLazy ) then if not Assigned(FLazy) then
FLazy := FNull; FLazy := FNull;
end; end;
class function TLazy<T>.Construct( const Changing: IMycState; const Proc: TFunc<T> ): IMycLazy<T>; class function TLazy<T>.Construct(const Changing: IMycState; const Proc: TFunc<T>): IMycLazy<T>;
begin begin
Result := TMycFuncLazy<T>.Create( Changing, Proc ); Result := TMycFuncLazy<T>.Create(Changing, Proc);
end; end;
class constructor TLazy<T>.CreateClass; class constructor TLazy<T>.CreateClass;
@@ -63,17 +63,17 @@ begin
Result := FLazy.Changed; Result := FLazy.Changed;
end; end;
function TLazy<T>.Pop( out Res: T ): Boolean; function TLazy<T>.Pop(out Res: T): Boolean;
begin begin
Result := FLazy.Pop( Res ); Result := FLazy.Pop(Res);
end; end;
class operator TLazy<T>.Implicit( const A: IMycLazy<T> ): TLazy<T>; class operator TLazy<T>.Implicit(const A: IMycLazy<T>): TLazy<T>;
begin begin
Result.Create( A ); Result.Create(A);
end; end;
class operator TLazy<T>.Implicit( const A: TLazy<T> ): IMycLazy<T>; class operator TLazy<T>.Implicit(const A: TLazy<T>): IMycLazy<T>;
begin begin
Result := A.FLazy; Result := A.FLazy;
end; end;
Src/Myc.Signals.pas
+55 -55
View File
@@ -18,24 +18,24 @@ type
function GetIsSet: Boolean; function GetIsSet: Boolean;
{$ENDREGION} {$ENDREGION}
// Subscribes a given subscriber to this TState. // Subscribes a given subscriber to this TState.
function Subscribe( Subscriber: IMycSubscriber ): Pointer; function Subscribe(Subscriber: IMycSubscriber): Pointer;
procedure Unsubscribe( Tag: Pointer ); procedure Unsubscribe(Tag: Pointer);
// IsSet is true if the TState has been reached or the condition is met. // IsSet is true if the TState has been reached or the condition is met.
property IsSet: Boolean read GetIsSet; property IsSet: Boolean read GetIsSet;
end; end;
TState = record // helper for IMycState TState = record // helper for IMycState
type type
TSubscription = record TSubscription = record
private private
FState: IMycState; FState: IMycState;
FTag: Pointer; // Tag identifying this subscription within the notifier list. FTag: Pointer; // Tag identifying this subscription within the notifier list.
constructor Create( const AState: IMycState; ATag: Pointer ); constructor Create(const AState: IMycState; ATag: Pointer);
public public
class operator Initialize( out Dest: TSubscription ); class operator Initialize(out Dest: TSubscription);
// Unsubscribes from the associated TState. // Unsubscribes from the associated TState.
procedure Unsubscribe; procedure Unsubscribe;
end; end;
strict private strict private
class var class var
@@ -45,25 +45,25 @@ type
FState: IMycState; FState: IMycState;
function GetIsSet: Boolean; inline; function GetIsSet: Boolean; inline;
public public
constructor Create( const AState: IMycState ); constructor Create(const AState: IMycState);
class operator Implicit( const A: IMycState ): TState; overload; class operator Implicit(const A: IMycState): TState; overload;
class operator Implicit( const A: TState ): IMycState; overload; class operator Implicit(const A: TState): IMycState; overload;
class function All( const States: TArray<TState> ): TState; static; class function All(const States: TArray<TState>): TState; static;
class function Any( const States: TArray<TState> ): TState; static; class function Any(const States: TArray<TState>): TState; static;
class property Null: IMycState read FNull; class property Null: IMycState read FNull;
function Subscribe( Subscriber: IMycSubscriber ): TSubscription; inline; function Subscribe(Subscriber: IMycSubscriber): TSubscription; inline;
procedure Unsubscribe( Tag: Pointer ); inline; procedure Unsubscribe(Tag: Pointer); inline;
property IsSet: Boolean read GetIsSet; property IsSet: Boolean read GetIsSet;
end; end;
// IMycLatch is a specific type of flag that, once set, remains set (non-resettable). // IMycLatch is a specific type of flag that, once set, remains set (non-resettable).
// It typically becomes set when an internal countdown reaches zero. // It typically becomes set when an internal countdown reaches zero.
IMycLatch = interface( IMycSubscriber ) IMycLatch = interface(IMycSubscriber)
// Provides access to the IMycState interface of the flag. // Provides access to the IMycState interface of the flag.
function GetState: TState; function GetState: TState;
property State: TState read GetState; property State: TState read GetState;
@@ -86,7 +86,7 @@ type
class function Construct(Count: Integer): TLatch; static; class function Construct(Count: Integer): TLatch; static;
class function Enqueue(var Gate: TLatch; Count: Integer=1): TState; static; class function Enqueue(var Gate: TLatch; Count: Integer = 1): TState; static;
class property Null: IMycLatch read FNull; class property Null: IMycLatch read FNull;
@@ -97,7 +97,7 @@ type
// IMycDirty represents a resettable flag, typically indicating if a State is "dirty" (requiring attention) or "clean". // IMycDirty represents a resettable flag, typically indicating if a State is "dirty" (requiring attention) or "clean".
// It inherits from IMycFlag, meaning it has a State, can be notified, and subscribed to. // It inherits from IMycFlag, meaning it has a State, can be notified, and subscribed to.
IMycDirty = interface( IMycSubscriber ) IMycDirty = interface(IMycSubscriber)
// Provides access to the IMycState interface of the flag. // Provides access to the IMycState interface of the flag.
function GetState: TState; function GetState: TState;
// Resets the flag to its "clean" (not set / not dirty) State. // Resets the flag to its "clean" (not set / not dirty) State.
@@ -119,26 +119,26 @@ type
implementation implementation
uses uses
Myc.Core.Notifier, Myc.Core.Signals; Myc.Core.Notifier,
Myc.Core.Signals;
{ TState.TSubscription } { TState.TSubscription }
constructor TState.TSubscription.Create( const AState: IMycState; ATag: constructor TState.TSubscription.Create(const AState: IMycState; ATag: TMycNotifyList<IMycSubscriber>.TTag);
TMycNotifyList<IMycSubscriber>.TTag );
begin begin
Assert( Assigned( AState ) ); Assert(Assigned(AState));
FState := AState; FState := AState;
FTag := ATag; FTag := ATag;
end; end;
procedure TState.TSubscription.Unsubscribe; procedure TState.TSubscription.Unsubscribe;
begin begin
FState.Unsubscribe( FTag ); FState.Unsubscribe(FTag);
FState := TState.Null; FState := TState.Null;
FTag := nil; FTag := nil;
end; end;
class operator TState.TSubscription.Initialize( out Dest: TSubscription ); class operator TState.TSubscription.Initialize(out Dest: TSubscription);
begin begin
Dest.FState := TState.Null; Dest.FState := TState.Null;
Dest.FTag := nil; Dest.FTag := nil;
@@ -146,42 +146,42 @@ end;
{ TState } { TState }
constructor TState.Create( const AState: IMycState ); constructor TState.Create(const AState: IMycState);
begin begin
FState := AState; FState := AState;
if not Assigned( FState ) then if not Assigned(FState) then
FState := FNull; FState := FNull;
end; end;
class constructor TState.ClassCreate; class constructor TState.ClassCreate;
begin begin
// Create a singleton null latch instance that is initially (and always) set. // Create a singleton null latch instance that is initially (and always) set.
FNull := TMycNullState.Create( ); // Calls the instance constructor FNull := TMycNullState.Create(); // Calls the instance constructor
end; end;
class function TState.All( const States: TArray<TState> ): TState; class function TState.All(const States: TArray<TState>): TState;
var var
Latch: IMycLatch; Latch: IMycLatch;
begin begin
Latch := TLatch.Construct( Length( States ) ); Latch := TLatch.Construct(Length(States));
for var i := 0 to High( States ) do for var i := 0 to High(States) do
States[i].Subscribe( Latch ); States[i].Subscribe(Latch);
Result := Latch.State; Result := Latch.State;
end; end;
class function TState.Any( const States: TArray<TState> ): TState; class function TState.Any(const States: TArray<TState>): TState;
var var
Latch: IMycLatch; Latch: IMycLatch;
begin begin
if Length( States ) = 0 then if Length(States) = 0 then
begin begin
Result := TState.Null; Result := TState.Null;
end end
else else
begin begin
Latch := TLatch.Construct( 1 ); Latch := TLatch.Construct(1);
for var i := 0 to High( States ) do for var i := 0 to High(States) do
States[i].Subscribe( Latch ); States[i].Subscribe(Latch);
Result := Latch.State; Result := Latch.State;
end; end;
end; end;
@@ -191,24 +191,24 @@ begin
Result := FState.IsSet; Result := FState.IsSet;
end; end;
function TState.Subscribe( Subscriber: IMycSubscriber ): TSubscription; function TState.Subscribe(Subscriber: IMycSubscriber): TSubscription;
begin begin
Result := TSubscription.Create( FState, FState.Subscribe( Subscriber ) ); Result := TSubscription.Create(FState, FState.Subscribe(Subscriber));
end; end;
procedure TState.Unsubscribe( Tag: Pointer ); procedure TState.Unsubscribe(Tag: Pointer);
begin begin
FState.Unsubscribe( Tag ); FState.Unsubscribe(Tag);
end; end;
class operator TState.Implicit( const A: TState ): IMycState; class operator TState.Implicit(const A: TState): IMycState;
begin begin
Result := A.FState; Result := A.FState;
end; end;
class operator TState.Implicit( const A: IMycState ): TState; class operator TState.Implicit(const A: IMycState): TState;
begin begin
Result.Create( A ); Result.Create(A);
end; end;
{ TLatch } { TLatch }
@@ -224,24 +224,24 @@ end;
constructor TLatch.Create(const ALatch: IMycLatch); constructor TLatch.Create(const ALatch: IMycLatch);
begin begin
FLatch := ALatch; FLatch := ALatch;
if not Assigned( FLatch ) then if not Assigned(FLatch) then
FLatch := FNull; FLatch := FNull;
end; end;
class function TLatch.Construct(Count: Integer): TLatch; class function TLatch.Construct(Count: Integer): TLatch;
begin begin
if Count > 0 then if Count > 0 then
Result := TMycLatch.Create( Count ) Result := TMycLatch.Create(Count)
else else
Result := FNull; Result := FNull;
end; end;
class function TLatch.Enqueue(var Gate: TLatch; Count: Integer=1): TState; class function TLatch.Enqueue(var Gate: TLatch; Count: Integer = 1): TState;
begin begin
var gateState := Gate.State; var gateState := Gate.State;
Gate := TMycLatch.Create( Count ); Gate := TMycLatch.Create(Count);
gateState.Subscribe( Gate ); gateState.Subscribe(Gate);
exit( Gate.State ); exit(Gate.State);
end; end;
function TLatch.GetState: TState; function TLatch.GetState: TState;
@@ -256,7 +256,7 @@ end;
class operator TLatch.Implicit(const A: IMycLatch): TLatch; class operator TLatch.Implicit(const A: IMycLatch): TLatch;
begin begin
Result.Create( A ); Result.Create(A);
end; end;
class operator TLatch.Implicit(const A: TLatch): IMycLatch; class operator TLatch.Implicit(const A: TLatch): IMycLatch;
Src/Myc.TaskManager.pas
+3 -3
View File
@@ -9,7 +9,7 @@ uses
type type
IMycTaskManager = interface IMycTaskManager = interface
// TOD Dokumentation // TOD Dokumentation
function CreateTask( const Gate: TState; const Proc: TProc ): TState.TSubscription; function CreateTask(const Gate: TState; const Proc: TProc): TState.TSubscription;
// Waits for the operation associated with State to complete. // Waits for the operation associated with State to complete.
// Must not be called from a worker thread of this factory. // Must not be called from a worker thread of this factory.
@@ -74,12 +74,12 @@ end;
function TMycTaskManagerMock.CreateTask(const Gate: TState; const Proc: TProc): TState.TSubscription; function TMycTaskManagerMock.CreateTask(const Gate: TState; const Proc: TProc): TState.TSubscription;
begin begin
Result := Gate.Subscribe( TMycExecMock.Create( Proc ) ); Result := Gate.Subscribe(TMycExecMock.Create(Proc));
end; end;
procedure TMycTaskManagerMock.WaitFor(State: IMycState); procedure TMycTaskManagerMock.WaitFor(State: IMycState);
begin begin
Assert( State.IsSet ); Assert(State.IsSet);
end; end;
procedure SetupTaskManagerMock; procedure SetupTaskManagerMock;
Src/Myc.Test.Core.Atomic.pas
+12 -13
View File
@@ -18,7 +18,7 @@ type
PTestSListEntryData = ^TTestSListEntryData; PTestSListEntryData = ^TTestSListEntryData;
TTestSListEntryData = record TTestSListEntryData = record
Entry: TSListEntry; // The SList entry structure Entry: TSListEntry; // The SList entry structure
ID: Integer; // Sample data associated with the entry ID: Integer; // Sample data associated with the entry
end; end;
[TestFixture] [TestFixture]
@@ -109,7 +109,8 @@ type
implementation implementation
uses System.TypInfo; uses
System.TypInfo;
{ TTestSList } { TTestSList }
@@ -147,14 +148,14 @@ begin
// Popping to empty the list if not already empty // Popping to empty the list if not already empty
end; end;
tempList := FList; // Store to call Free tempList := FList; // Store to call Free
FList := nil; // Prevent using FList after Free FList := nil; // Prevent using FList after Free
tempList.Free; // Free the TSList structure itself tempList.Free; // Free the TSList structure itself
end; end;
// Free all allocated PTestSListEntryData // Free all allocated PTestSListEntryData
for entryNode in FEntries do for entryNode in FEntries do
begin begin
var P:= entryNode; var P := entryNode;
FreeMemAligned(P); FreeMemAligned(P);
end; end;
SetLength(FEntries, 0); SetLength(FEntries, 0);
@@ -277,10 +278,11 @@ begin
// This test confirms that using an aligned entry from AllocEntryData works. // This test confirms that using an aligned entry from AllocEntryData works.
entryData := AllocEntryData(123); entryData := AllocEntryData(123);
// This should not raise an assertion error from TSList.Push. // This should not raise an assertion error from TSList.Push.
Assert.WillNotRaise(procedure Assert.WillNotRaise(
begin procedure begin FList.Push(@entryData.Entry); end,
FList.Push(@entryData.Entry); nil,
end, nil, 'Pushing an aligned entry should not raise an exception/assertion.'); 'Pushing an aligned entry should not raise an exception/assertion.'
);
Assert.AreEqual(1, FList.QueryDepth, 'QueryDepth should be 1 after pushing an aligned entry.'); Assert.AreEqual(1, FList.QueryDepth, 'QueryDepth should be 1 after pushing an aligned entry.');
end; end;
@@ -391,10 +393,7 @@ end;
procedure TTestMycAtomicStack_Integer.TestClear_OnEmptyStack; procedure TTestMycAtomicStack_Integer.TestClear_OnEmptyStack;
begin begin
// Clearing an already empty stack should not cause issues // Clearing an already empty stack should not cause issues
Assert.WillNotRaise(procedure Assert.WillNotRaise(procedure begin FStack.Clear; end, nil, 'Clear on an empty stack should not raise an exception.');
begin
FStack.Clear;
end, nil, 'Clear on an empty stack should not raise an exception.');
Assert.AreEqual(Default(Integer), FStack.Pop, 'Stack should remain empty after Clear on empty stack.'); Assert.AreEqual(Default(Integer), FStack.Pop, 'Stack should remain empty after Clear on empty stack.');
end; end;
Src/Myc.Test.Core.Lazy.pas
+75 -50
View File
@@ -5,9 +5,9 @@ interface
uses uses
System.SysUtils, System.SysUtils,
DUnitX.TestFramework, DUnitX.TestFramework,
Myc.Signals, // For IMycState, TState, IMycDirty Myc.Signals, // For IMycState, TState, IMycDirty
Myc.Lazy, // For IMycLazy<T> Myc.Lazy, // For IMycLazy<T>
Myc.Core.Lazy; // Unit to be tested Myc.Core.Lazy; // Unit to be tested
type type
[TestFixture] [TestFixture]
@@ -186,12 +186,15 @@ begin
sourceDirty.Reset; sourceDirty.Reset;
procExecuted := False; procExecuted := False;
expectedValue := 50; expectedValue := 50;
funcLazy := TMycFuncLazy<Integer>.Create(sourceDirty.State, funcLazy :=
function: Integer TMycFuncLazy<Integer>.Create(
begin sourceDirty.State,
procExecuted := True; function: Integer
Result := expectedValue; begin
end); procExecuted := True;
Result := expectedValue;
end
);
Assert.IsNotNull(funcLazy, 'TMycFuncLazy<Integer> instance should not be nil'); Assert.IsNotNull(funcLazy, 'TMycFuncLazy<Integer> instance should not be nil');
Assert.IsTrue(funcLazy.GetChanged.IsSet, 'Changed.IsSet should be true before the first Pop by design'); Assert.IsTrue(funcLazy.GetChanged.IsSet, 'Changed.IsSet should be true before the first Pop by design');
value := 0; value := 0;
@@ -219,7 +222,11 @@ begin
value := preCallValue; value := preCallValue;
result := funcLazy.Pop(value); result := funcLazy.Pop(value);
Assert.IsTrue(result, 'First Pop should return true by design, even if FProc is nil'); 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.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'); Assert.IsFalse(funcLazy.GetChanged.IsSet, 'Changed state should be false after Pop');
end; end;
@@ -252,12 +259,15 @@ begin
sourceDirty.Reset; sourceDirty.Reset;
initialProcValue := 44; initialProcValue := 44;
procExecutedCount := 0; procExecutedCount := 0;
funcLazy := TMycFuncLazy<Integer>.Create(sourceDirty.State, funcLazy :=
function: Integer TMycFuncLazy<Integer>.Create(
begin sourceDirty.State,
Inc(procExecutedCount); function: Integer
Result := initialProcValue; begin
end); Inc(procExecutedCount);
Result := initialProcValue;
end
);
Helper_ConsumeInitialPop(funcLazy, initialProcValue); Helper_ConsumeInitialPop(funcLazy, initialProcValue);
Assert.AreEqual(1, procExecutedCount, 'Proc should have executed once for initial pop'); Assert.AreEqual(1, procExecutedCount, 'Proc should have executed once for initial pop');
result := funcLazy.Pop(value); result := funcLazy.Pop(value);
@@ -294,13 +304,18 @@ begin
sourceDirty := TDirty.Construct; sourceDirty := TDirty.Construct;
sourceDirty.Reset; sourceDirty.Reset;
procCallCount := 0; procCallCount := 0;
funcLazy := TMycFuncLazy<Integer>.Create(sourceDirty.State, funcLazy :=
function: Integer TMycFuncLazy<Integer>.Create(
begin sourceDirty.State,
Inc(procCallCount); function: Integer
if procCallCount = 1 then Result := 30 begin
else Result := 300 + procCallCount; Inc(procCallCount);
end); if procCallCount = 1 then
Result := 30
else
Result := 300 + procCallCount;
end
);
currentExpectedValue := 30; currentExpectedValue := 30;
Helper_ConsumeInitialPop(funcLazy, currentExpectedValue); Helper_ConsumeInitialPop(funcLazy, currentExpectedValue);
Assert.AreEqual(1, procCallCount, 'Proc executed for initial Pop'); Assert.AreEqual(1, procCallCount, 'Proc executed for initial Pop');
@@ -326,12 +341,15 @@ begin
sourceDirty := TDirty.Construct; sourceDirty := TDirty.Construct;
sourceDirty.Reset; sourceDirty.Reset;
procCallCount := 0; procCallCount := 0;
funcLazy := TMycFuncLazy<Integer>.Create(sourceDirty.State, funcLazy :=
function: Integer TMycFuncLazy<Integer>.Create(
begin sourceDirty.State,
Inc(procCallCount); function: Integer
Result := 40; begin
end); Inc(procCallCount);
Result := 40;
end
);
resultPop1 := funcLazy.Pop(value); resultPop1 := funcLazy.Pop(value);
Assert.IsTrue(resultPop1, 'First Pop should return true by design'); Assert.IsTrue(resultPop1, 'First Pop should return true by design');
Assert.AreEqual(40, value, 'Value from first Pop'); Assert.AreEqual(40, value, 'Value from first Pop');
@@ -359,14 +377,20 @@ begin
initialValue := 51; initialValue := 51;
firstSourceChangeValue := 52; firstSourceChangeValue := 52;
funcLazy := TMycFuncLazy<Integer>.Create(sourceDirty.State, funcLazy :=
function: Integer TMycFuncLazy<Integer>.Create(
begin sourceDirty.State,
Inc(procCallCount); function: Integer
if procCallCount = 1 then Result := initialValue // For initial pop begin
else if procCallCount = 2 then Result := firstSourceChangeValue // For pop after first effective source change Inc(procCallCount);
else Result := 999; // Should not be reached in this specific test logic if procCallCount = 1 then
end); Result := initialValue // For initial pop
else if procCallCount = 2 then
Result := firstSourceChangeValue // For pop after first effective source change
else
Result := 999; // Should not be reached in this specific test logic
end
);
// 1. Initial Pop (consumes "by design" changed state) // 1. Initial Pop (consumes "by design" changed state)
Assert.IsTrue(funcLazy.GetChanged.IsSet, 'Changed state should be true before first Pop (by design)'); Assert.IsTrue(funcLazy.GetChanged.IsSet, 'Changed state should be true before first Pop (by design)');
@@ -389,7 +413,7 @@ begin
// 3. Notify sourceDirty again (sourceDirty is already TRUE) // 3. Notify sourceDirty again (sourceDirty is already TRUE)
Assert.IsTrue(sourceDirty.State.IsSet, 'sourceDirty is still set before second Notify attempt'); Assert.IsTrue(sourceDirty.State.IsSet, 'sourceDirty is still set before second Notify attempt');
sourceDirty.Notify; // Since sourceDirty is already set, this does NOT notify funcLazy.FChanged. sourceDirty.Notify; // Since sourceDirty is already set, this does NOT notify funcLazy.FChanged.
// funcLazy.GetChanged.IsSet remains FALSE. // funcLazy.GetChanged.IsSet remains FALSE.
Assert.IsFalse(funcLazy.GetChanged.IsSet, 'Changed state should REMAIN false after Notify on an already-set source'); Assert.IsFalse(funcLazy.GetChanged.IsSet, 'Changed state should REMAIN false after Notify on an already-set source');
@@ -412,12 +436,10 @@ begin
Assert.IsTrue(funcLazyObj.Pop(tempVal), 'Initial Pop should succeed'); Assert.IsTrue(funcLazyObj.Pop(tempVal), 'Initial Pop should succeed');
funcLazyObj.Destroy; funcLazyObj.Destroy;
Assert.WillNotRaise( Assert.WillNotRaise(
procedure procedure begin sourceDirty.Notify; end,
begin nil,
sourceDirty.Notify; 'Destroy test assumes TMycSubscription.Unsubscribe works. Verified by no crash on source notify post-destroy.'
end, );
nil,
'Destroy test assumes TMycSubscription.Unsubscribe works. Verified by no crash on source notify post-destroy.');
sourceDirty := nil; sourceDirty := nil;
end; end;
@@ -434,12 +456,15 @@ begin
Assert.IsTrue(sourceDirty.State.IsSet, 'SourceDirty should be initially set for this test scenario'); Assert.IsTrue(sourceDirty.State.IsSet, 'SourceDirty should be initially set for this test scenario');
expectedValue := 70; expectedValue := 70;
procExecuted := False; procExecuted := False;
funcLazy := TMycFuncLazy<Integer>.Create(sourceDirty.State, funcLazy :=
function: Integer TMycFuncLazy<Integer>.Create(
begin sourceDirty.State,
procExecuted := True; function: Integer
Result := expectedValue; begin
end); procExecuted := True;
Result := expectedValue;
end
);
Assert.IsNotNull(funcLazy, 'TMycFuncLazy<Integer> instance should not be nil'); Assert.IsNotNull(funcLazy, 'TMycFuncLazy<Integer> instance should not be nil');
Assert.IsTrue(funcLazy.GetChanged.IsSet, 'funcLazy.GetChanged.IsSet should be true after creation (by design)'); Assert.IsTrue(funcLazy.GetChanged.IsSet, 'funcLazy.GetChanged.IsSet should be true after creation (by design)');
value := 0; value := 0;
Src/Myc.Test.Lazy.pas
+64 -46
View File
@@ -5,8 +5,8 @@ interface
uses uses
System.SysUtils, System.SysUtils,
DUnitX.TestFramework, DUnitX.TestFramework,
Myc.Signals, // For IMycState, TState, IMycDirty Myc.Signals, // For IMycState, TState, IMycDirty
Myc.Lazy; // The unit under test Myc.Lazy; // The unit under test
type type
[TestFixture] [TestFixture]
@@ -145,12 +145,15 @@ var
begin begin
procExecuted := False; procExecuted := False;
// FChangingSignal is reset in Setup // FChangingSignal is reset in Setup
lazyIntf := TLazy<Integer>.Construct(FChangingSignal.State, lazyIntf :=
function: Integer TLazy<Integer>.Construct(
begin FChangingSignal.State,
procExecuted := True; function: Integer
Result := 10; begin
end); procExecuted := True;
Result := 10;
end
);
Assert.IsNotNull(lazyIntf, 'TLazy.Construct should return a valid interface'); Assert.IsNotNull(lazyIntf, 'TLazy.Construct should return a valid interface');
lazyRec := lazyIntf; // Implicit conversion lazyRec := lazyIntf; // Implicit conversion
@@ -167,12 +170,15 @@ var
begin begin
procExecuted := False; procExecuted := False;
expectedValue := 20; expectedValue := 20;
lazyIntf := TLazy<Integer>.Construct(FChangingSignal.State, lazyIntf :=
function: Integer TLazy<Integer>.Construct(
begin FChangingSignal.State,
procExecuted := True; function: Integer
Result := expectedValue; begin
end); procExecuted := True;
Result := expectedValue;
end
);
lazyRec := lazyIntf; lazyRec := lazyIntf;
ConsumeInitialPop(lazyRec, expectedValue, 'TestConstruct_FirstPop'); ConsumeInitialPop(lazyRec, expectedValue, 'TestConstruct_FirstPop');
@@ -229,12 +235,15 @@ var
procCallCount: Integer; procCallCount: Integer;
begin begin
procCallCount := 0; procCallCount := 0;
lazyIntf := TLazy<Integer>.Construct(FChangingSignal.State, lazyIntf :=
function: Integer TLazy<Integer>.Construct(
begin FChangingSignal.State,
Inc(procCallCount); function: Integer
Result := 100 + procCallCount; // Value changes per call begin
end); Inc(procCallCount);
Result := 100 + procCallCount; // Value changes per call
end
);
lazyRec := lazyIntf; lazyRec := lazyIntf;
ConsumeInitialPop(lazyRec, 101, 'TestConstruct_StateInteraction_PopResetsChangedAfterSignal (Initial)'); // procCallCount = 1 ConsumeInitialPop(lazyRec, 101, 'TestConstruct_StateInteraction_PopResetsChangedAfterSignal (Initial)'); // procCallCount = 1
@@ -257,12 +266,15 @@ var
procCallCount: Integer; procCallCount: Integer;
begin begin
procCallCount := 0; procCallCount := 0;
lazyIntf := TLazy<Integer>.Construct(FChangingSignal.State, lazyIntf :=
function: Integer TLazy<Integer>.Construct(
begin FChangingSignal.State,
Inc(procCallCount); function: Integer
Result := 200 + procCallCount; begin
end); Inc(procCallCount);
Result := 200 + procCallCount;
end
);
lazyRec := lazyIntf; lazyRec := lazyIntf;
// 1. Initial Pop // 1. Initial Pop
@@ -307,20 +319,20 @@ begin
ConsumeInitialPop(lazyRec, 1, 'TestConstruct_Destruction (Initial)'); ConsumeInitialPop(lazyRec, 1, 'TestConstruct_Destruction (Initial)');
lazyIntf := nil; // Release the IMycLazy interface. ARC should destroy the TMycFuncLazy object. lazyIntf := nil; // Release the IMycLazy interface. ARC should destroy the TMycFuncLazy object.
// This should trigger its destructor, which should unsubscribe from localChangingSignal. // This should trigger its destructor, which should unsubscribe from localChangingSignal.
Assert.WillNotRaise( Assert.WillNotRaise(
procedure procedure
begin begin
localChangingSignal.Notify; // Notify the source AFTER the lazy object is supposed to be gone. localChangingSignal.Notify; // Notify the source AFTER the lazy object is supposed to be gone.
end, end,
nil, // Default: any exception is a failure nil, // Default: any exception is a failure
'Notifying source after lazy object is freed should not crash, indicating unsubscription.'); 'Notifying source after lazy object is freed should not crash, indicating unsubscription.'
);
localChangingSignal := nil; // Clean up the local signal itself. localChangingSignal := nil; // Clean up the local signal itself.
end; end;
// == Tests for TLazy<T>.Create with a pre-existing (non-nil) IMycLazy == // == Tests for TLazy<T>.Create with a pre-existing (non-nil) IMycLazy ==
procedure TTestMyLazy.TestCreateWithExistingLazy_DelegatesChangedCorrectly; procedure TTestMyLazy.TestCreateWithExistingLazy_DelegatesChangedCorrectly;
@@ -355,12 +367,15 @@ var
procCallCount: Integer; procCallCount: Integer;
begin begin
procCallCount := 0; procCallCount := 0;
originalLazyIntf := TLazy<Integer>.Construct(FChangingSignal.State, originalLazyIntf :=
function: Integer TLazy<Integer>.Construct(
begin FChangingSignal.State,
Inc(procCallCount); function: Integer
Result := 70 + procCallCount; begin
end); Inc(procCallCount);
Result := 70 + procCallCount;
end
);
wrappedLazyRec := TLazy<Integer>.Create(originalLazyIntf); wrappedLazyRec := TLazy<Integer>.Create(originalLazyIntf);
// First Pop via wrapper (initial pop) // First Pop via wrapper (initial pop)
@@ -434,12 +449,15 @@ var
procExecuted: Boolean; procExecuted: Boolean;
begin begin
procExecuted := False; procExecuted := False;
lazyIntf := TLazy<Integer>.Construct(FChangingSignal.State, lazyIntf :=
function: Integer TLazy<Integer>.Construct(
begin FChangingSignal.State,
procExecuted := True; function: Integer
Result := 100; begin
end); procExecuted := True;
Result := 100;
end
);
lazyRec := lazyIntf; lazyRec := lazyIntf;
ConsumeInitialPop(lazyRec, 100, 'TestPop_AfterInitialAndNoSignal (Initial)'); ConsumeInitialPop(lazyRec, 100, 'TestPop_AfterInitialAndNoSignal (Initial)');
Test/MycTests.dpr
+66 -66
View File
@@ -1,87 +1,87 @@
program MycTests; program MycTests;
{$IFNDEF TESTINSIGHT} {$IFNDEF TESTINSIGHT}
{$APPTYPE CONSOLE} {$APPTYPE CONSOLE}
{$ENDIF} {$ENDIF}
{$STRONGLINKTYPES ON} {$STRONGLINKTYPES ON}
uses uses
FastMM5, FastMM5,
DUnitX.MemoryLeakMonitor.FastMM5, DUnitX.MemoryLeakMonitor.FastMM5,
System.SysUtils, System.SysUtils,
{$IFDEF TESTINSIGHT} {$IFDEF TESTINSIGHT}
TestInsight.DUnitX, TestInsight.DUnitX,
{$ELSE} {$ELSE}
DUnitX.Loggers.Console, DUnitX.Loggers.Console,
{$ENDIF } {$ENDIF }
DUnitX.TestFramework, DUnitX.TestFramework,
TestNotifier in 'TestNotifier.pas', TestNotifier in 'TestNotifier.pas',
TestNotifier_Threading in 'TestNotifier_Threading.pas' {/TestNotifier_ChaosStress in 'TestNotifier_ChaosStress.pas',}, TestNotifier_Threading in 'TestNotifier_Threading.pas' {/TestNotifier_ChaosStress in 'TestNotifier_ChaosStress.pas',},
TestNotifier_ChaosStress in 'TestNotifier_ChaosStress.pas', TestNotifier_ChaosStress in 'TestNotifier_ChaosStress.pas',
TestSignals_Latch in 'TestSignals_Latch.pas', TestSignals_Latch in 'TestSignals_Latch.pas',
Myc.Core.Tasks in '..\Src\Myc.Core.Tasks.pas', Myc.Core.Tasks in '..\Src\Myc.Core.Tasks.pas',
TestTasks in 'TestTasks.pas', TestTasks in 'TestTasks.pas',
TestSignals_Dirty in 'TestSignals_Dirty.pas', TestSignals_Dirty in 'TestSignals_Dirty.pas',
Myc.Futures in '..\Src\Myc.Futures.pas', Myc.Futures in '..\Src\Myc.Futures.pas',
TestCoreFutures in 'TestCoreFutures.pas', TestCoreFutures in 'TestCoreFutures.pas',
Myc.TaskManager in '..\Src\Myc.TaskManager.pas', Myc.TaskManager in '..\Src\Myc.TaskManager.pas',
Myc.Core.Futures in '..\Src\Myc.Core.Futures.pas', Myc.Core.Futures in '..\Src\Myc.Core.Futures.pas',
Myc.Core.Signals in '..\Src\Myc.Core.Signals.pas', Myc.Core.Signals in '..\Src\Myc.Core.Signals.pas',
TestFutures in 'TestFutures.pas', TestFutures in 'TestFutures.pas',
Myc.Lazy in '..\Src\Myc.Lazy.pas', Myc.Lazy in '..\Src\Myc.Lazy.pas',
Myc.Core.Lazy in '..\Src\Myc.Core.Lazy.pas', Myc.Core.Lazy in '..\Src\Myc.Core.Lazy.pas',
Myc.Test.Core.Lazy in '..\Src\Myc.Test.Core.Lazy.pas', Myc.Test.Core.Lazy in '..\Src\Myc.Test.Core.Lazy.pas',
Myc.Test.Lazy in '..\Src\Myc.Test.Lazy.pas', Myc.Test.Lazy in '..\Src\Myc.Test.Lazy.pas',
Myc.Test.Core.Atomic in '..\Src\Myc.Test.Core.Atomic.pas'; Myc.Test.Core.Atomic in '..\Src\Myc.Test.Core.Atomic.pas';
{ keep comment here to protect the following conditional from being removed by the IDE when adding a unit } { keep comment here to protect the following conditional from being removed by the IDE when adding a unit }
{$IFNDEF TESTINSIGHT} {$IFNDEF TESTINSIGHT}
var var
runner: ITestRunner; runner: ITestRunner;
results: IRunResults; results: IRunResults;
logger: ITestLogger; logger: ITestLogger;
nunitLogger : ITestLogger; nunitLogger: ITestLogger;
{$ENDIF} {$ENDIF}
begin begin
{$IFDEF TESTINSIGHT} {$IFDEF TESTINSIGHT}
TestInsight.DUnitX.RunRegisteredTests; TestInsight.DUnitX.RunRegisteredTests;
{$ELSE} {$ELSE}
try try
//Check command line options, will exit if invalid //Check command line options, will exit if invalid
TDUnitX.CheckCommandLine; TDUnitX.CheckCommandLine;
//Create the test runner //Create the test runner
runner := TDUnitX.CreateRunner; runner := TDUnitX.CreateRunner;
//Tell the runner to use RTTI to find Fixtures //Tell the runner to use RTTI to find Fixtures
runner.UseRTTI := True; runner.UseRTTI := True;
//When true, Assertions must be made during tests; //When true, Assertions must be made during tests;
runner.FailsOnNoAsserts := False; runner.FailsOnNoAsserts := False;
//tell the runner how we will log things //tell the runner how we will log things
//Log to the console window if desired //Log to the console window if desired
if TDUnitX.Options.ConsoleMode <> TDunitXConsoleMode.Off then if TDUnitX.Options.ConsoleMode <> TDunitXConsoleMode.Off then
begin begin
logger := TDUnitXConsoleLogger.Create(TDUnitX.Options.ConsoleMode = TDunitXConsoleMode.Quiet); logger := TDUnitXConsoleLogger.Create(TDUnitX.Options.ConsoleMode = TDunitXConsoleMode.Quiet);
runner.AddLogger(logger); runner.AddLogger(logger);
end; end;
//Generate an NUnit compatible XML File //Generate an NUnit compatible XML File
nunitLogger := TDUnitXXMLNUnitFileLogger.Create(TDUnitX.Options.XMLOutputFile); nunitLogger := TDUnitXXMLNUnitFileLogger.Create(TDUnitX.Options.XMLOutputFile);
runner.AddLogger(nunitLogger); runner.AddLogger(nunitLogger);
//Run tests //Run tests
results := runner.Execute; results := runner.Execute;
if not results.AllPassed then if not results.AllPassed then
System.ExitCode := EXIT_ERRORS; System.ExitCode := EXIT_ERRORS;
{$IFNDEF CI} {$IFNDEF CI}
//We don't want this happening when running under CI. //We don't want this happening when running under CI.
if TDUnitX.Options.ExitBehavior = TDUnitXExitBehavior.Pause then if TDUnitX.Options.ExitBehavior = TDUnitXExitBehavior.Pause then
begin begin
System.Write('Done.. press <Enter> key to quit.'); System.Write('Done.. press <Enter> key to quit.');
System.Readln; System.Readln;
end; end;
{$ENDIF} {$ENDIF}
except except
on E: Exception do on E: Exception do
System.Writeln(E.ClassName, ': ', E.Message); System.Writeln(E.ClassName, ': ', E.Message);
end; end;
{$ENDIF} {$ENDIF}
end. end.
Test/TestCoreFutures.pas
+290 -261
View File
@@ -3,50 +3,52 @@ unit TestCoreFutures;
interface interface
uses uses
DUnitX.TestFramework, DUnitX.TestFramework,
System.SysUtils, System.Generics.Collections, // Added for TObjectList if needed, not strictly for this System.SysUtils,
System.SyncObjs, System.Generics.Collections, // Added for TObjectList if needed, not strictly for this
Myc.Signals, // For IMycLatch, TMycLatch, IMycState, IMycSubscriber [cite: 62, 68, 53, 45] System.SyncObjs,
Myc.Core.Tasks, // For IMycTaskFactory, TMycTaskFactory [cite: 97, 113] Myc.Signals, // For IMycLatch, TMycLatch, IMycState, IMycSubscriber [cite: 62, 68, 53, 45]
Myc.Futures, Myc.Core.Futures; // For IMycFuture, TMycInitStateFuncFuture Myc.Core.Tasks, // For IMycTaskFactory, TMycTaskFactory [cite: 97, 113]
Myc.Futures,
Myc.Core.Futures; // For IMycFuture, TMycInitStateFuncFuture
type type
// Helper class to notify a latch when its Notify method is called. // Helper class to notify a latch when its Notify method is called.
TLatchNotifierSubscriber = class(TInterfacedObject, IMycSubscriber) TLatchNotifierSubscriber = class(TInterfacedObject, IMycSubscriber)
private private
FGateLatch: IMycLatch; FGateLatch: IMycLatch;
public public
constructor Create(AGateLatch: IMycLatch); constructor Create(AGateLatch: IMycLatch);
// IMycSubscriber // IMycSubscriber
function Notify: Boolean; // Implements IMycSubscriber.Notify [cite: 46, 181, 299] function Notify: Boolean; // Implements IMycSubscriber.Notify [cite: 46, 181, 299]
end; end;
[TestFixture] [TestFixture]
[IgnoreMemoryLeaks(true)] [IgnoreMemoryLeaks(true)]
TTestMycGateFuncFuture = class(TObject) TTestMycGateFuncFuture = class(TObject)
private private
FTaskFactory: IMycTaskFactory; FTaskFactory: IMycTaskFactory;
FProcExecutionCount: Integer; // Counter for side effects of AProc FProcExecutionCount: Integer; // Counter for side effects of AProc
FSharedCounter: Integer; // For Fan-Out test side effects FSharedCounter: Integer; // For Fan-Out test side effects
public public
[Setup] [Setup]
procedure Setup; procedure Setup;
[TearDown] [TearDown]
procedure TearDown; procedure TearDown;
[Test] [Test]
procedure Test_BasicSuccess_WithImmediateInitState; procedure Test_BasicSuccess_WithImmediateInitState;
[Test] [Test]
procedure Test_ChainedExecution_WithDelayedInitState; procedure Test_ChainedExecution_WithDelayedInitState;
[Test] [Test]
procedure Test_ExceptionInProc_HandledAsPlanned; procedure Test_ExceptionInProc_HandledAsPlanned;
[Test] [Test]
procedure Test_GetResult_BeforeDone_RaisesException; procedure Test_GetResult_BeforeDone_RaisesException;
[Test] [Test]
procedure Test_FanIn_OneFutureWaitsForMultipleOthers; procedure Test_FanIn_OneFutureWaitsForMultipleOthers;
[Test] [Test]
procedure Test_FanOut_MultipleFuturesWaitForOneTrigger; procedure Test_FanOut_MultipleFuturesWaitForOneTrigger;
end; end;
implementation implementation
@@ -54,315 +56,342 @@ implementation
constructor TLatchNotifierSubscriber.Create(AGateLatch: IMycLatch); constructor TLatchNotifierSubscriber.Create(AGateLatch: IMycLatch);
begin begin
inherited Create; inherited Create;
FGateLatch := AGateLatch; FGateLatch := AGateLatch;
end; end;
function TLatchNotifierSubscriber.Notify: Boolean; function TLatchNotifierSubscriber.Notify: Boolean;
begin begin
if Assigned(FGateLatch) then if Assigned(FGateLatch) then
begin begin
FGateLatch.Notify; // Notify the provided gate latch [cite: 80, 215, 333] FGateLatch.Notify; // Notify the provided gate latch [cite: 80, 215, 333]
end; end;
Result := False; // This subscriber is typically one-shot for this purpose. Result := False; // This subscriber is typically one-shot for this purpose.
end; end;
{ TTestMycGateFuncFuture } { TTestMycGateFuncFuture }
procedure TTestMycGateFuncFuture.Setup; procedure TTestMycGateFuncFuture.Setup;
begin begin
FTaskFactory := TMycTaskFactory.Create; // Create a new task factory instance for each test [cite: 113, 235, 353] FTaskFactory := TMycTaskFactory.Create; // Create a new task factory instance for each test [cite: 113, 235, 353]
FProcExecutionCount := 0; FProcExecutionCount := 0;
FSharedCounter := 0; FSharedCounter := 0;
end; end;
procedure TTestMycGateFuncFuture.TearDown; procedure TTestMycGateFuncFuture.TearDown;
begin begin
if Assigned(FTaskFactory) then if Assigned(FTaskFactory) then
begin begin
FTaskFactory.Teardown; // Teardown the factory, this may re-raise exceptions [cite: 107, 234, 352] FTaskFactory.Teardown; // Teardown the factory, this may re-raise exceptions [cite: 107, 234, 352]
FTaskFactory := nil; FTaskFactory := nil;
end; end;
end; end;
procedure TTestMycGateFuncFuture.Test_BasicSuccess_WithImmediateInitState; procedure TTestMycGateFuncFuture.Test_BasicSuccess_WithImmediateInitState;
var var
LFuture: IMycFuture<Integer>; LFuture: IMycFuture<Integer>;
LInitStateAsState: IMycState; // Parameter for Create LInitStateAsState: IMycState; // Parameter for Create
LResultValue: Integer; LResultValue: Integer;
const const
CExpectedResult = 42; CExpectedResult = 42;
begin begin
// Use TMycLatch.Null for an already set init state [cite: 71, 81, 206, 216, 324, 334] // Use TMycLatch.Null for an already set init state [cite: 71, 81, 206, 216, 324, 334]
LInitStateAsState := TState.Null; LInitStateAsState := TState.Null;
LFuture := TMycGateFuncFuture<Integer>.Create(FTaskFactory, LInitStateAsState, LFuture :=
function: Integer TMycGateFuncFuture<Integer>.Create(
begin FTaskFactory,
Inc(Self.FProcExecutionCount); LInitStateAsState,
Result := CExpectedResult; function: Integer
end); begin
Inc(Self.FProcExecutionCount);
Result := CExpectedResult;
end
);
FTaskFactory.WaitFor(LFuture.Done); // Accesses IMycFuture.GetDone [cite: 110, 234, 352] FTaskFactory.WaitFor(LFuture.Done); // Accesses IMycFuture.GetDone [cite: 110, 234, 352]
Assert.IsTrue(LFuture.Done.IsSet, 'Future should be marked as done.'); // Accesses IMycState.IsSet [cite: 57, 194, 312] Assert.IsTrue(LFuture.Done.IsSet, 'Future should be marked as done.'); // Accesses IMycState.IsSet [cite: 57, 194, 312]
Assert.AreEqual(1, FProcExecutionCount, 'AProc should have been executed once.'); Assert.AreEqual(1, FProcExecutionCount, 'AProc should have been executed once.');
LResultValue := LFuture.GetResult; // Accesses IMycFuture.GetResult LResultValue := LFuture.GetResult; // Accesses IMycFuture.GetResult
Assert.AreEqual(CExpectedResult, LResultValue, 'GetResult returned an unexpected value.'); Assert.AreEqual(CExpectedResult, LResultValue, 'GetResult returned an unexpected value.');
end; end;
procedure TTestMycGateFuncFuture.Test_ChainedExecution_WithDelayedInitState; procedure TTestMycGateFuncFuture.Test_ChainedExecution_WithDelayedInitState;
var var
LFuture: IMycFuture<string>; LFuture: IMycFuture<string>;
LInitLatch: IMycLatch; LInitLatch: IMycLatch;
LResultValue: string; LResultValue: string;
const const
CExpectedResult = 'ChainCompleted'; CExpectedResult = 'ChainCompleted';
begin begin
LInitLatch := TLatch.Construct(1); // Create an init state that is not yet set [cite: 77, 212, 330] LInitLatch := TLatch.Construct(1); // Create an init state that is not yet set [cite: 77, 212, 330]
LFuture := TMycGateFuncFuture<string>.Create(FTaskFactory, LInitLatch.State, LFuture :=
function: string TMycGateFuncFuture<string>.Create(
begin FTaskFactory,
Inc(Self.FProcExecutionCount); LInitLatch.State,
Result := CExpectedResult; function: string
end); begin
Inc(Self.FProcExecutionCount);
Result := CExpectedResult;
end
);
Assert.AreEqual(0, FProcExecutionCount, 'AProc should not have executed yet.'); Assert.AreEqual(0, FProcExecutionCount, 'AProc should not have executed yet.');
Assert.IsFalse(LFuture.Done.IsSet, 'Future should not be done yet.'); Assert.IsFalse(LFuture.Done.IsSet, 'Future should not be done yet.');
LInitLatch.Notify; // Trigger the initial state [cite: 80, 215, 333] LInitLatch.Notify; // Trigger the initial state [cite: 80, 215, 333]
FTaskFactory.WaitFor(LFuture.Done); FTaskFactory.WaitFor(LFuture.Done);
Assert.IsTrue(LFuture.Done.IsSet, 'Future should be marked as done after init state trigger.'); Assert.IsTrue(LFuture.Done.IsSet, 'Future should be marked as done after init state trigger.');
Assert.AreEqual(1, FProcExecutionCount, 'AProc should have been executed once after init state.'); Assert.AreEqual(1, FProcExecutionCount, 'AProc should have been executed once after init state.');
LResultValue := LFuture.GetResult; LResultValue := LFuture.GetResult;
Assert.AreEqual(CExpectedResult, LResultValue, 'GetResult returned an unexpected value after delayed init.'); Assert.AreEqual(CExpectedResult, LResultValue, 'GetResult returned an unexpected value after delayed init.');
end; end;
procedure TTestMycGateFuncFuture.Test_ExceptionInProc_HandledAsPlanned; procedure TTestMycGateFuncFuture.Test_ExceptionInProc_HandledAsPlanned;
var var
LFuture: IMycFuture<Integer>; LFuture: IMycFuture<Integer>;
LLocalTaskFactory: IMycTaskFactory; LLocalTaskFactory: IMycTaskFactory;
LInitStateAsState: IMycState; LInitStateAsState: IMycState;
LResultValue: Integer; LResultValue: Integer;
LExpectedExceptionRaisedByFactory: Boolean; LExpectedExceptionRaisedByFactory: Boolean;
const const
CExceptionMessage = 'Test exception from AProc'; CExceptionMessage = 'Test exception from AProc';
begin begin
LExpectedExceptionRaisedByFactory := False; LExpectedExceptionRaisedByFactory := False;
LLocalTaskFactory := TMycTaskFactory.Create; LLocalTaskFactory := TMycTaskFactory.Create;
LInitStateAsState := TState.Null; // Immediate execution LInitStateAsState := TState.Null; // Immediate execution
LFuture := TMycGateFuncFuture<Integer>.Create(LLocalTaskFactory, LInitStateAsState, LFuture :=
function: Integer TMycGateFuncFuture<Integer>.Create(
begin LLocalTaskFactory,
Inc(Self.FProcExecutionCount); LInitStateAsState,
raise Exception.Create(CExceptionMessage); function: Integer
end); 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 try
LLocalTaskFactory.Teardown; // This should re-raise the exception [cite: 108, 234, 352] LLocalTaskFactory.WaitFor(LFuture.Done);
except except
on E: Exception do on E: Exception do
begin begin
Assert.AreEqual(CExceptionMessage, E.Message, 'TaskFactory did not re-raise the correct exception message on Teardown.'); if E.Message = CExceptionMessage then
LExpectedExceptionRaisedByFactory := True; LExpectedExceptionRaisedByFactory := True;
end; end;
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 Assert.IsTrue(LFuture.Done.IsSet, 'Future should be done even if AProc raised an exception.');
LLocalTaskFactory := nil Assert.AreEqual(1, FProcExecutionCount, 'AProc (which raised) should have been executed once.');
else if Assigned(LLocalTaskFactory) then // Teardown didn't raise as expected, or wasn't called due to earlier exception path
begin LResultValue := LFuture.GetResult;
LLocalTaskFactory.Teardown; // Ensure it's torn down if test logic failed to confirm exception Assert.AreEqual(Default(Integer), LResultValue, 'GetResult should return Default(T) when AProc raises an exception.');
LLocalTaskFactory := nil;
end; 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; end;
procedure TTestMycGateFuncFuture.Test_GetResult_BeforeDone_RaisesException; procedure TTestMycGateFuncFuture.Test_GetResult_BeforeDone_RaisesException;
var var
LFuture: IMycFuture<Integer>; LFuture: IMycFuture<Integer>;
LInitLatch: IMycLatch; LInitLatch: IMycLatch;
begin begin
LInitLatch := TLatch.Construct(1); LInitLatch := TLatch.Construct(1);
LFuture := TMycGateFuncFuture<Integer>.Create(FTaskFactory, LInitLatch.State, LFuture :=
function: Integer TMycGateFuncFuture<Integer>.Create(
begin FTaskFactory,
Inc(Self.FProcExecutionCount); LInitLatch.State,
Result := 123; function: Integer
end); begin
Inc(Self.FProcExecutionCount);
Result := 123;
end
);
Assert.IsFalse(LFuture.Done.IsSet, 'Future should not be marked as done initially.'); Assert.IsFalse(LFuture.Done.IsSet, 'Future should not be marked as done initially.');
Assert.WillRaise( Assert.WillRaise(procedure begin LFuture.GetResult; end);
procedure
begin
LFuture.GetResult;
end );
LInitLatch.Notify; LInitLatch.Notify;
FTaskFactory.WaitFor(LFuture.Done); FTaskFactory.WaitFor(LFuture.Done);
Assert.WillNotRaise( Assert.WillNotRaise(procedure begin LFuture.GetResult; end);
procedure
begin
LFuture.GetResult;
end );
end; end;
procedure TTestMycGateFuncFuture.Test_FanIn_OneFutureWaitsForMultipleOthers; procedure TTestMycGateFuncFuture.Test_FanIn_OneFutureWaitsForMultipleOthers;
var var
LPrerequisiteFuture1, LPrerequisiteFuture2: IMycFuture<Integer>; LPrerequisiteFuture1, LPrerequisiteFuture2: IMycFuture<Integer>;
LMainFuture: IMycFuture<string>; LMainFuture: IMycFuture<string>;
LGateLatch: IMycLatch; LGateLatch: IMycLatch;
LSub1, LSub2: IMycSubscriber; // To hold the TLatchNotifierSubscriber instances LSub1, LSub2: IMycSubscriber; // To hold the TLatchNotifierSubscriber instances
LInitStateP1, LInitStateP2: IMycLatch; LInitStateP1, LInitStateP2: IMycLatch;
Subscriptions: array[1..2] of TState.TSubscription; // To manage subscriptions Subscriptions: array[1..2] of TState.TSubscription; // To manage subscriptions
const const
CMainFutureResult = 'AllPrerequisitesCompleted'; CMainFutureResult = 'AllPrerequisitesCompleted';
begin begin
FProcExecutionCount := 0; // Reset for this test FProcExecutionCount := 0; // Reset for this test
// Gate Latch: MainFuture waits for this latch, which needs 2 notifications. // Gate Latch: MainFuture waits for this latch, which needs 2 notifications.
LGateLatch := TLatch.Construct(2); // [cite: 77, 212, 330] LGateLatch := TLatch.Construct(2); // [cite: 77, 212, 330]
// Create MainFuture, AInitState is the GateLatch's state. // Create MainFuture, AInitState is the GateLatch's state.
LMainFuture := TMycGateFuncFuture<string>.Create(FTaskFactory, LGateLatch.State, LMainFuture :=
function: string TMycGateFuncFuture<string>.Create(
begin FTaskFactory,
Inc(Self.FProcExecutionCount, 10); // Indicate MainFuture's proc ran LGateLatch.State,
Result := CMainFutureResult; function: string
end); begin
Inc(Self.FProcExecutionCount, 10); // Indicate MainFuture's proc ran
Result := CMainFutureResult;
end
);
// Setup Prerequisite Futures // Setup Prerequisite Futures
// PrerequisiteFuture1 // PrerequisiteFuture1
LInitStateP1 := TLatch.Construct(1); // Controllable init state for PF1 LInitStateP1 := TLatch.Construct(1); // Controllable init state for PF1
LPrerequisiteFuture1 := TMycGateFuncFuture<Integer>.Create(FTaskFactory, LInitStateP1.State, LPrerequisiteFuture1 :=
function: Integer TMycGateFuncFuture<Integer>.Create(
begin FTaskFactory,
Inc(Self.FProcExecutionCount, 1); // PF1 ran LInitStateP1.State,
Result := 1; function: Integer
end); begin
LSub1 := TLatchNotifierSubscriber.Create(LGateLatch); Inc(Self.FProcExecutionCount, 1); // PF1 ran
Subscriptions[1] := LPrerequisiteFuture1.Done.Subscribe(LSub1); // Subscribe to PF1's completion [cite: 56, 188, 306] Result := 1;
end
);
LSub1 := TLatchNotifierSubscriber.Create(LGateLatch);
Subscriptions[1] := LPrerequisiteFuture1.Done.Subscribe(LSub1); // Subscribe to PF1's completion [cite: 56, 188, 306]
// PrerequisiteFuture2 // PrerequisiteFuture2
LInitStateP2 := TLatch.Construct(1); // Controllable init state for PF2 LInitStateP2 := TLatch.Construct(1); // Controllable init state for PF2
LPrerequisiteFuture2 := TMycGateFuncFuture<Integer>.Create(FTaskFactory, LInitStateP2.State, LPrerequisiteFuture2 :=
function: Integer TMycGateFuncFuture<Integer>.Create(
begin FTaskFactory,
Inc(Self.FProcExecutionCount, 1); // PF2 ran LInitStateP2.State,
Result := 2; function: Integer
end); begin
LSub2 := TLatchNotifierSubscriber.Create(LGateLatch); Inc(Self.FProcExecutionCount, 1); // PF2 ran
Subscriptions[2] := LPrerequisiteFuture2.Done.Subscribe(LSub2); // Subscribe to PF2's completion Result := 2;
end
);
LSub2 := TLatchNotifierSubscriber.Create(LGateLatch);
Subscriptions[2] := LPrerequisiteFuture2.Done.Subscribe(LSub2); // Subscribe to PF2's completion
// --- Execution & Verification --- // --- Execution & Verification ---
Assert.IsFalse(LMainFuture.Done.IsSet, 'MainFuture should not be done yet.'); Assert.IsFalse(LMainFuture.Done.IsSet, 'MainFuture should not be done yet.');
Assert.AreEqual(0, FProcExecutionCount, 'No AProc should have executed yet.'); Assert.AreEqual(0, FProcExecutionCount, 'No AProc should have executed yet.');
// Trigger PrerequisiteFuture1 // Trigger PrerequisiteFuture1
LInitStateP1.Notify; // LInitStateP1.Notify; //
FTaskFactory.WaitFor(LPrerequisiteFuture1.Done); // Ensure PF1 completes and notifies GateLatch 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(LGateLatch.State.IsSet, 'GateLatch should not be set after only one prerequisite.');
Assert.IsFalse(LMainFuture.Done.IsSet, 'MainFuture should still not be done.'); Assert.IsFalse(LMainFuture.Done.IsSet, 'MainFuture should still not be done.');
Assert.AreEqual(1, FProcExecutionCount mod 10, 'Only PF1 AProc should have run.'); Assert.AreEqual(1, FProcExecutionCount mod 10, 'Only PF1 AProc should have run.');
// Trigger PrerequisiteFuture2
LInitStateP2.Notify; //
FTaskFactory.WaitFor(LPrerequisiteFuture2.Done); // Ensure PF2 completes and notifies GateLatch
// Trigger PrerequisiteFuture2 // Now GateLatch should be set, and MainFuture should execute
LInitStateP2.Notify; // FTaskFactory.WaitFor(LMainFuture.Done);
FTaskFactory.WaitFor(LPrerequisiteFuture2.Done); // Ensure PF2 completes and notifies GateLatch
// Now GateLatch should be set, and MainFuture should execute Assert.IsTrue(LGateLatch.State.IsSet, 'GateLatch should be set after both prerequisites.');
FTaskFactory.WaitFor(LMainFuture.Done); Assert.IsTrue(LMainFuture.Done.IsSet, 'MainFuture should be done now.');
Assert.AreEqual(12, FProcExecutionCount, 'All AProcs (PF1, PF2, Main) should have run.'); // 1+1+10
Assert.AreEqual(CMainFutureResult, LMainFuture.GetResult, 'MainFuture returned an unexpected result.');
Assert.IsTrue(LGateLatch.State.IsSet, 'GateLatch should be set after both prerequisites.'); // Clean up subscriptions explicitly, though ARC + managed records handle much
Assert.IsTrue(LMainFuture.Done.IsSet, 'MainFuture should be done now.'); Subscriptions[1].Unsubscribe; // [cite: 52, 186, 304]
Assert.AreEqual(12, FProcExecutionCount, 'All AProcs (PF1, PF2, Main) should have run.'); // 1+1+10 Subscriptions[2].Unsubscribe; //
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; end;
procedure TTestMycGateFuncFuture.Test_FanOut_MultipleFuturesWaitForOneTrigger; procedure TTestMycGateFuncFuture.Test_FanOut_MultipleFuturesWaitForOneTrigger;
var var
LTriggerLatch: IMycLatch; LTriggerLatch: IMycLatch;
LFutureA, LFutureB: IMycFuture<Integer>; LFutureA, LFutureB: IMycFuture<Integer>;
LFlagFutureARan, LFlagFutureBRan: Boolean; LFlagFutureARan, LFlagFutureBRan: Boolean;
begin begin
LFlagFutureARan := False; LFlagFutureARan := False;
LFlagFutureBRan := False; LFlagFutureBRan := False;
Self.FSharedCounter := 0; // Reset shared counter for this test Self.FSharedCounter := 0; // Reset shared counter for this test
LTriggerLatch := TLatch.Construct(1); // Single trigger [cite: 77, 212, 330] LTriggerLatch := TLatch.Construct(1); // Single trigger [cite: 77, 212, 330]
// Future A // Future A
LFutureA := TMycGateFuncFuture<Integer>.Create(FTaskFactory, LTriggerLatch.State, LFutureA :=
function: Integer TMycGateFuncFuture<Integer>.Create(
begin FTaskFactory,
LFlagFutureARan := True; LTriggerLatch.State,
System.SyncObjs.TInterlocked.Increment(Self.FSharedCounter); // Thread-safe increment function: Integer
Result := 100; begin
end); LFlagFutureARan := True;
System.SyncObjs.TInterlocked.Increment(Self.FSharedCounter); // Thread-safe increment
Result := 100;
end
);
// Future B // Future B
LFutureB := TMycGateFuncFuture<Integer>.Create(FTaskFactory, LTriggerLatch.State, LFutureB :=
function: Integer TMycGateFuncFuture<Integer>.Create(
begin FTaskFactory,
LFlagFutureBRan := True; LTriggerLatch.State,
System.SyncObjs.TInterlocked.Increment(Self.FSharedCounter); // Thread-safe increment function: Integer
Result := 200; begin
end); 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(LFutureA.Done.IsSet, 'FutureA should not be done yet.');
Assert.IsFalse(LFutureB.Done.IsSet, 'FutureB should not be done yet.'); Assert.IsFalse(LFutureB.Done.IsSet, 'FutureB should not be done yet.');
Assert.AreEqual(0, Self.FSharedCounter, 'No future AProcs should have executed yet.'); Assert.AreEqual(0, Self.FSharedCounter, 'No future AProcs should have executed yet.');
// Trigger the common latch // Trigger the common latch
LTriggerLatch.Notify; // [cite: 80, 215, 333] LTriggerLatch.Notify; // [cite: 80, 215, 333]
// Wait for both futures to complete // Wait for both futures to complete
FTaskFactory.WaitFor(LFutureA.Done); FTaskFactory.WaitFor(LFutureA.Done);
FTaskFactory.WaitFor(LFutureB.Done); FTaskFactory.WaitFor(LFutureB.Done);
Assert.IsTrue(LFutureA.Done.IsSet, 'FutureA should be done.'); Assert.IsTrue(LFutureA.Done.IsSet, 'FutureA should be done.');
Assert.IsTrue(LFutureB.Done.IsSet, 'FutureB should be done.'); Assert.IsTrue(LFutureB.Done.IsSet, 'FutureB should be done.');
Assert.IsTrue(LFlagFutureARan, 'FutureA AProc should have run.'); Assert.IsTrue(LFlagFutureARan, 'FutureA AProc should have run.');
Assert.IsTrue(LFlagFutureBRan, 'FutureB 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(2, Self.FSharedCounter, 'Both future AProcs should have incremented the counter.');
Assert.AreEqual(100, LFutureA.GetResult, 'FutureA GetResult value mismatch.'); Assert.AreEqual(100, LFutureA.GetResult, 'FutureA GetResult value mismatch.');
Assert.AreEqual(200, LFutureB.GetResult, 'FutureB GetResult value mismatch.'); Assert.AreEqual(200, LFutureB.GetResult, 'FutureB GetResult value mismatch.');
end; end;
initialization initialization
// For DUnitX, attributes typically handle registration. // For DUnitX, attributes typically handle registration.
// If needed for older DUnit: RegisterTest(TTestMycGateFuncFuture.Suite); // If needed for older DUnit: RegisterTest(TTestMycGateFuncFuture.Suite);
end. end.
Test/TestFutures.pas
+269 -247
View File
@@ -16,7 +16,7 @@ uses
type type
[TestFixture] [TestFixture]
TTestFuture = class( TObject ) TTestFuture = class(TObject)
public public
[Setup] [Setup]
procedure Setup; procedure Setup;
@@ -38,9 +38,9 @@ type
[Test] [Test]
procedure TestMultipleChains; procedure TestMultipleChains;
[Test] [Test]
[TestCase( 'StringFutureTest', 'Test String' )] [TestCase('StringFutureTest', 'Test String')]
[TestCase( 'IntegerFutureTestForParam', '12345' )] [TestCase('IntegerFutureTestForParam', '12345')]
procedure TestConstructSimple_Parametric( const ParamValue: string ); procedure TestConstructSimple_Parametric(const ParamValue: string);
[Test] [Test]
procedure TestStress_StateAll; procedure TestStress_StateAll;
@@ -59,7 +59,7 @@ implementation
procedure TTestFuture.Setup; procedure TTestFuture.Setup;
begin begin
// SetupTaskManagerMock; // SetupTaskManagerMock;
end; end;
procedure TTestFuture.TearDown; procedure TTestFuture.TearDown;
@@ -74,20 +74,21 @@ var
resultValue: Integer; resultValue: Integer;
begin begin
// Test construction with a simple function that returns an Integer // Test construction with a simple function that returns an Integer
fut := TFuture<Integer>.Construct( // [cite: 146] fut :=
function: Integer TFuture<Integer>.Construct( // [cite: 146]
begin function: Integer
TThread.Sleep( 20 ); // Simulate some background work begin
Result := 42; TThread.Sleep(20); // Simulate some background work
end Result := 42;
); end
);
Assert.IsNotNull( fut.Done, 'Future.Done property should not be nil after construction.' ); // Static string [cite: 148] Assert.IsNotNull(fut.Done, 'Future.Done property should not be nil after construction.'); // Static string [cite: 148]
fut.WaitFor( ); // Wait for the future to complete its execution [cite: 148] fut.WaitFor(); // Wait for the future to complete its execution [cite: 148]
Assert.IsTrue( fut.Done.IsSet, 'Future.Done.IsSet should be true after completion.' ); // Static string [cite: 148] Assert.IsTrue(fut.Done.IsSet, 'Future.Done.IsSet should be true after completion.'); // Static string [cite: 148]
resultValue := fut.Result; // Retrieve the result of the future [cite: 148] resultValue := fut.Result; // Retrieve the result of the future [cite: 148]
Assert.AreEqual( 42, resultValue, 'The result of the future is not the expected value.' ); // Static string Assert.AreEqual(42, resultValue, 'The result of the future is not the expected value.'); // Static string
end; end;
[Test] [Test]
@@ -97,20 +98,22 @@ var
resultValue: Integer; resultValue: Integer;
begin begin
// Test construction with a nil gate, which should execute the task immediately // Test construction with a nil gate, which should execute the task immediately
fut := TFuture<Integer>.Construct( nil, // Explicitly providing a nil gate [cite: 147] fut :=
function: Integer TFuture<Integer>.Construct(
begin nil, // Explicitly providing a nil gate [cite: 147]
TThread.Sleep( 20 ); // Simulate work function: Integer
Result := 43; begin
end TThread.Sleep(20); // Simulate work
); Result := 43;
end
);
Assert.IsNotNull( fut.Done, 'Future.Done should not be nil when constructed with a nil gate.' ); // Static string [cite: 148] Assert.IsNotNull(fut.Done, 'Future.Done should not be nil when constructed with a nil gate.'); // Static string [cite: 148]
fut.WaitFor( ); // [cite: 148] fut.WaitFor(); // [cite: 148]
Assert.IsTrue( fut.Done.IsSet, 'Future.Done.IsSet should be true for nil gate construct.' ); // Static string [cite: 148] Assert.IsTrue(fut.Done.IsSet, 'Future.Done.IsSet should be true for nil gate construct.'); // Static string [cite: 148]
resultValue := fut.Result; // [cite: 148] resultValue := fut.Result; // [cite: 148]
Assert.AreEqual( 43, resultValue, 'Future result is incorrect for nil gate construct.' ); // Static string Assert.AreEqual(43, resultValue, 'Future result is incorrect for nil gate construct.'); // Static string
end; end;
[Test] [Test]
@@ -121,22 +124,24 @@ var
resultValue: Integer; resultValue: Integer;
begin begin
presetGate := TState.Null; // State.Null is an IMycState that is always set [cite: 68] presetGate := TState.Null; // State.Null is an IMycState that is always set [cite: 68]
Assert.IsTrue( presetGate.IsSet, 'The preset gate (State.Null) should be initially set.' ); // Static string [cite: 55] Assert.IsTrue(presetGate.IsSet, 'The preset gate (State.Null) should be initially set.'); // Static string [cite: 55]
// Construct a future with a gate that is already set // Construct a future with a gate that is already set
fut := TFuture<Integer>.Construct( presetGate, // [cite: 147] fut :=
function: Integer TFuture<Integer>.Construct(
begin presetGate, // [cite: 147]
Result := 44; // This should execute quickly function: Integer
end begin
); Result := 44; // This should execute quickly
end
);
Assert.IsNotNull( fut.Done, 'Future.Done should not be nil for preset gate construct.' ); // Static string [cite: 148] Assert.IsNotNull(fut.Done, 'Future.Done should not be nil for preset gate construct.'); // Static string [cite: 148]
fut.WaitFor( ); // [cite: 148] fut.WaitFor(); // [cite: 148]
Assert.IsTrue( fut.Done.IsSet, 'Future.Done.IsSet should be true for preset gate construct.' ); // Static string [cite: 148] Assert.IsTrue(fut.Done.IsSet, 'Future.Done.IsSet should be true for preset gate construct.'); // Static string [cite: 148]
resultValue := fut.Result; // [cite: 148] resultValue := fut.Result; // [cite: 148]
Assert.AreEqual( 44, resultValue, 'Future result is incorrect for preset gate construct.' ); // Static string Assert.AreEqual(44, resultValue, 'Future result is incorrect for preset gate construct.'); // Static string
end; end;
[Test] [Test]
@@ -146,34 +151,33 @@ var
delayedGate: IMycLatch; // IMycLatch implements IMycState [cite: 58] delayedGate: IMycLatch; // IMycLatch implements IMycState [cite: 58]
resultValue: Integer; resultValue: Integer;
begin begin
delayedGate := TLatch.Construct( 1 ); // Create a latch that requires one notification to be set [cite: 66] delayedGate := TLatch.Construct(1); // Create a latch that requires one notification to be set [cite: 66]
Assert.IsNotNull( delayedGate, 'The delayed gate (IMycLatch) should not be nil.' ); // Static string Assert.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] 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 // Construct a future with a gate that is not yet set
fut := TFuture<Integer>.Construct( delayedGate.State, // Get the IMycState interface from the latch [cite: 147, 59] fut :=
function: Integer TFuture<Integer>.Construct(
begin delayedGate.State, // Get the IMycState interface from the latch [cite: 147, 59]
Result := 45; function: Integer begin Result := 45; end
end );
);
Assert.IsNotNull( fut.Done, 'Future.Done should not be nil for delayed gate construct.' ); // Static string [cite: 148] Assert.IsNotNull(fut.Done, 'Future.Done should not be nil for delayed gate construct.'); // Static string [cite: 148]
// Verify the future is not yet done as the gate is not set // Verify the future is not yet done as the gate is not set
TThread.Sleep( 50 ); // Allow some time for task scheduling TThread.Sleep(50); // Allow some time for task scheduling
Assert.IsFalse( fut.Done.IsSet, 'Future.Done.IsSet should be false before the delayed gate is triggered.' ); Assert.IsFalse(fut.Done.IsSet, 'Future.Done.IsSet should be false before the delayed gate is triggered.');
// Static string [cite: 148, 55] // Static string [cite: 148, 55]
delayedGate.Notify; // Trigger the latch [cite: 46, 94] (IMycSubscriber.Notify) delayedGate.Notify; // Trigger the latch [cite: 46, 94] (IMycSubscriber.Notify)
fut.WaitFor( ); // Wait for the future to complete now that the gate is set [cite: 148] fut.WaitFor(); // Wait for the future to complete now that the gate is set [cite: 148]
Assert.IsTrue( delayedGate.State.IsSet, 'The delayed gate should be set after Notify.' ); // Static string [cite: 59, 55] Assert.IsTrue(delayedGate.State.IsSet, 'The delayed gate should be set after Notify.'); // Static string [cite: 59, 55]
Assert.IsTrue( fut.Done.IsSet, 'Future.Done.IsSet should be true after the delayed gate is triggered.' ); Assert.IsTrue(fut.Done.IsSet, 'Future.Done.IsSet should be true after the delayed gate is triggered.');
// Static string [cite: 148, 55] // Static string [cite: 148, 55]
resultValue := fut.Result; // [cite: 148] resultValue := fut.Result; // [cite: 148]
Assert.AreEqual( 45, resultValue, 'Future result is incorrect for delayed gate construct.' ); // Static string Assert.AreEqual(45, resultValue, 'Future result is incorrect for delayed gate construct.'); // Static string
end; end;
[Test] [Test]
@@ -184,29 +188,31 @@ var
resultValue: string; resultValue: string;
begin begin
// Create an initial future // Create an initial future
fut1 := TFuture<Integer>.Construct( // [cite: 146] fut1 :=
function: Integer TFuture<Integer>.Construct( // [cite: 146]
begin function: Integer
TThread.Sleep( 20 ); // Simulate work begin
Result := 100; TThread.Sleep(20); // Simulate work
end Result := 100;
); end
);
// Chain a second future that depends on the result of the first // Chain a second future that depends on the result of the first
fut2 := fut1.Chain<string>( // [cite: 147] fut2 :=
function( Input: Integer ): string // This function receives the result of fut1 fut1.Chain<string>( // [cite: 147]
begin function(Input: Integer): string // This function receives the result of fut1
TThread.Sleep( 20 ); // Simulate further work begin
Result := 'Value: ' + Input.ToString; // Use ToString for converting Integer to String TThread.Sleep(20); // Simulate further work
end Result := 'Value: ' + Input.ToString; // Use ToString for converting Integer to String
); end
);
Assert.IsNotNull( fut2.Done, 'Chained Future.Done should not be nil.' ); // Static string [cite: 148] Assert.IsNotNull(fut2.Done, 'Chained Future.Done should not be nil.'); // Static string [cite: 148]
fut2.WaitFor( ); // Wait for the chained future to complete [cite: 148] fut2.WaitFor(); // Wait for the chained future to complete [cite: 148]
Assert.IsTrue( fut2.Done.IsSet, 'Chained Future.Done.IsSet should be true after completion.' ); // Static string [cite: 148, 55] Assert.IsTrue(fut2.Done.IsSet, 'Chained Future.Done.IsSet should be true after completion.'); // Static string [cite: 148, 55]
resultValue := fut2.Result; // [cite: 148] resultValue := fut2.Result; // [cite: 148]
Assert.AreEqual( 'Value: 100', resultValue, 'Chained Future result is incorrect.' ); // Static string Assert.AreEqual('Value: 100', resultValue, 'Chained Future result is incorrect.'); // Static string
end; end;
[Test] [Test]
@@ -217,42 +223,39 @@ var
delayedGate: IMycLatch; delayedGate: IMycLatch;
resultValue: string; resultValue: string;
begin begin
delayedGate := TLatch.Construct( 1 ); // [cite: 66] delayedGate := TLatch.Construct(1); // [cite: 66]
Assert.IsFalse( delayedGate.State.IsSet, 'The delayed gate for chain test should not be initially set.' ); Assert.IsFalse(delayedGate.State.IsSet, 'The delayed gate for chain test should not be initially set.');
// Static string [cite: 59, 55] // Static string [cite: 59, 55]
// First future depends on the delayedGate // First future depends on the delayedGate
fut1 := TFuture<Integer>.Construct( delayedGate.State, // [cite: 147, 59] fut1 :=
function: Integer TFuture<Integer>.Construct(
begin delayedGate.State, // [cite: 147, 59]
Result := 200; function: Integer begin Result := 200; end
end );
);
// Second future is chained to the first // Second future is chained to the first
fut2 := fut1.Chain<string>( // [cite: 147] fut2 :=
function( Input: Integer ): string fut1.Chain<string>( // [cite: 147]
begin function(Input: Integer): string begin Result := 'ChainVal: ' + Input.ToString; end
Result := 'ChainVal: ' + Input.ToString; );
end
);
Assert.IsNotNull( fut2.Done, 'Chained (with gate) Future.Done should not be nil.' ); // Static string [cite: 148] Assert.IsNotNull(fut2.Done, 'Chained (with gate) Future.Done should not be nil.'); // Static string [cite: 148]
// Verify futures are not done yet // Verify futures are not done yet
TThread.Sleep( 50 ); TThread.Sleep(50);
Assert.IsFalse( fut1.Done.IsSet, 'Initial future (gated) should not be done before gate is set.' ); // Static string [cite: 148, 55] Assert.IsFalse(fut1.Done.IsSet, 'Initial future (gated) should not be done before gate is set.'); // Static string [cite: 148, 55]
Assert.IsFalse( fut2.Done.IsSet, 'Chained future (gated) should not be done before gate is set.' ); // Static string [cite: 148, 55] Assert.IsFalse(fut2.Done.IsSet, 'Chained future (gated) should not be done before gate is set.'); // Static string [cite: 148, 55]
delayedGate.Notify; // Trigger the gate [cite: 46, 94] delayedGate.Notify; // Trigger the gate [cite: 46, 94]
fut2.WaitFor( ); // Wait for the final chained future to complete [cite: 148] fut2.WaitFor(); // Wait for the final chained future to complete [cite: 148]
Assert.IsTrue( fut1.Done.IsSet, 'Initial future (gated) should be done after gate is set.' ); // Static string [cite: 148, 55] Assert.IsTrue(fut1.Done.IsSet, 'Initial future (gated) should be done after gate is set.'); // Static string [cite: 148, 55]
Assert.IsTrue( fut2.Done.IsSet, 'Chained future (gated) should be done after gate is set.' ); // Static string [cite: 148, 55] Assert.IsTrue(fut2.Done.IsSet, 'Chained future (gated) should be done after gate is set.'); // Static string [cite: 148, 55]
resultValue := fut2.Result; // [cite: 148] resultValue := fut2.Result; // [cite: 148]
Assert.AreEqual( 'ChainVal: 200', resultValue, 'Chained future (gated) result is incorrect.' ); // Static string Assert.AreEqual('ChainVal: 200', resultValue, 'Chained future (gated) result is incorrect.'); // Static string
end; end;
[Test] [Test]
@@ -264,67 +267,71 @@ var
finalResult: string; finalResult: string;
begin begin
// Initial future A // Initial future A
futA := TFuture<Integer>.Construct( // [cite: 146] futA :=
function: Integer TFuture<Integer>.Construct( // [cite: 146]
begin function: Integer
TThread.Sleep( 10 ); begin
Result := 10; TThread.Sleep(10);
end Result := 10;
); end
);
// Future B, chained from A // Future B, chained from A
futB := futA.Chain<Real>( // [cite: 147] futB :=
function( InputA: Integer ): Real futA.Chain<Real>( // [cite: 147]
begin function(InputA: Integer): Real
TThread.Sleep( 10 ); begin
Result := InputA * 2.5; // Calculation: 10 * 2.5 = 25.0 TThread.Sleep(10);
end Result := InputA * 2.5; // Calculation: 10 * 2.5 = 25.0
); end
);
// Future C, chained from B // Future C, chained from B
futC := futB.Chain<string>( // [cite: 147] futC :=
function( InputB: Real ): string futB.Chain<string>( // [cite: 147]
begin function(InputB: Real): string
TThread.Sleep( 10 ); begin
Result := 'Final: ' + FloatToStr( InputB ); // Convert Real to String TThread.Sleep(10);
end Result := 'Final: ' + FloatToStr(InputB); // Convert Real to String
); end
);
Assert.IsNotNull( futC.Done, 'Multi-chained Future.Done should not be nil.' ); // Static string [cite: 148] Assert.IsNotNull(futC.Done, 'Multi-chained Future.Done should not be nil.'); // Static string [cite: 148]
futC.WaitFor( ); // Wait for the last future in the chain [cite: 148] futC.WaitFor(); // Wait for the last future in the chain [cite: 148]
Assert.IsTrue( futA.Done.IsSet, 'Future A in chain should be done.' ); // Static string [cite: 148, 55] Assert.IsTrue(futA.Done.IsSet, 'Future A in chain should be done.'); // Static string [cite: 148, 55]
Assert.IsTrue( futB.Done.IsSet, 'Future B in chain should be done.' ); // Static string [cite: 148, 55] Assert.IsTrue(futB.Done.IsSet, 'Future B in chain should be done.'); // Static string [cite: 148, 55]
Assert.IsTrue( futC.Done.IsSet, 'Future C (multi-chained) should be done.' ); // Static string [cite: 148, 55] Assert.IsTrue(futC.Done.IsSet, 'Future C (multi-chained) should be done.'); // Static string [cite: 148, 55]
finalResult := futC.Result; // [cite: 148] finalResult := futC.Result; // [cite: 148]
// Ensure FloatToStr conversion is consistent for comparison // Ensure FloatToStr conversion is consistent for comparison
Assert.AreEqual( 'Final: ' + FloatToStr( 25.0 ), finalResult, 'Multi-chained Future result is incorrect.' ); // Static string Assert.AreEqual('Final: ' + FloatToStr(25.0), finalResult, 'Multi-chained Future result is incorrect.'); // Static string
end; end;
[Test] [Test]
[TestCase( 'StringFutureTest', 'Test String' )] [TestCase('StringFutureTest', 'Test String')]
[TestCase( 'IntegerFutureTestForParam', '12345' )] [TestCase('IntegerFutureTestForParam', '12345')]
procedure TTestFuture.TestConstructSimple_Parametric( const ParamValue: string ); procedure TTestFuture.TestConstructSimple_Parametric(const ParamValue: string);
var var
fut: TFuture<string>; fut: TFuture<string>;
resultValue: string; resultValue: string;
begin begin
// Parametric test for Future<string> // Parametric test for Future<string>
fut := TFuture<string>.Construct( // [cite: 146] fut :=
function: string TFuture<string>.Construct( // [cite: 146]
begin function: string
TThread.Sleep( 10 ); begin
Result := ParamValue; // Use the parameter in the future's function TThread.Sleep(10);
end Result := ParamValue; // Use the parameter in the future's function
); end
);
Assert.IsNotNull( fut.Done, 'Parametric Future.Done should not be nil.' ); // Static string [cite: 148] Assert.IsNotNull(fut.Done, 'Parametric Future.Done should not be nil.'); // Static string [cite: 148]
fut.WaitFor( ); // [cite: 148] fut.WaitFor(); // [cite: 148]
Assert.IsTrue( fut.Done.IsSet, 'Parametric Future.Done.IsSet should be true.' ); // Static string [cite: 148, 55] Assert.IsTrue(fut.Done.IsSet, 'Parametric Future.Done.IsSet should be true.'); // Static string [cite: 148, 55]
resultValue := fut.Result; // [cite: 148] resultValue := fut.Result; // [cite: 148]
Assert.AreEqual( ParamValue, resultValue, 'Parametric Future result does not match input parameter.' ); // Static string Assert.AreEqual(ParamValue, resultValue, 'Parametric Future result does not match input parameter.'); // Static string
end; end;
[Test] [Test]
@@ -338,53 +345,58 @@ var
masterFuture: TFuture<Boolean>; masterFuture: TFuture<Boolean>;
i: Integer; i: Integer;
begin begin
SetLength( Futures, StressTestFutureCount ); SetLength(Futures, StressTestFutureCount);
SetLength( doneStates, StressTestFutureCount ); SetLength(doneStates, StressTestFutureCount);
Randomize; // Initialize random number generator for varied delays Randomize; // Initialize random number generator for varied delays
// Create multiple futures, each with a small random delay // Create multiple futures, each with a small random delay
for i := 0 to High( Futures ) do for i := 0 to High(Futures) do
begin begin
// Capture loop variable for use in anonymous method // Capture loop variable for use in anonymous method
Futures[i] := TFuture<Integer>.Construct( // [cite: 146] Futures[i] :=
( TFuture<Integer>.Construct( // [cite: 146]
function( captureIndex: Integer ): TFunc<Integer> (
begin function(captureIndex: Integer): TFunc<Integer>
Result := function: Integer begin
var Result :=
delay: Integer; function: Integer
begin var
delay := 10 + Random( 40 ); // Random delay between 10ms and 49ms delay: Integer;
TThread.Sleep( delay ); begin
Result := captureIndex; // Return the captured index delay := 10 + Random(40); // Random delay between 10ms and 49ms
end; TThread.Sleep(delay);
end )( i ) Result := captureIndex; // Return the captured index
); end;
end
)(i)
);
doneStates[i] := Futures[i].Done; // [cite: 148] doneStates[i] := Futures[i].Done; // [cite: 148]
end; end;
combinedStateAll := TState.All( doneStates ); // [cite: 67] combinedStateAll := TState.All(doneStates); // [cite: 67]
Assert.IsNotNull( combinedStateAll, 'State.All should return a valid IMycState.' ); // Static string Assert.IsNotNull(combinedStateAll, 'State.All should return a valid IMycState.'); // Static string
// Create a master future that waits on the combined State.All state // Create a master future that waits on the combined State.All state
masterFuture := TFuture<Boolean>.Construct( combinedStateAll, // [cite: 147] masterFuture :=
function: Boolean TFuture<Boolean>.Construct(
begin combinedStateAll, // [cite: 147]
Result := True; // This function executes when combinedStateAll is set function: Boolean
end begin
); Result := True; // This function executes when combinedStateAll is set
masterFuture.WaitFor( ); // Wait for all futures to complete via the master future [cite: 148] end
);
masterFuture.WaitFor(); // Wait for all futures to complete via the master future [cite: 148]
Assert.IsTrue( combinedStateAll.IsSet, 'Combined State.All should be set after masterFuture.WaitFor().' ); // Static string [cite: 55] Assert.IsTrue(combinedStateAll.IsSet, 'Combined State.All should be set after masterFuture.WaitFor().'); // Static string [cite: 55]
// Verify all individual futures are done and their results are correct // Verify all individual futures are done and their results are correct
for i := 0 to High( Futures ) do for i := 0 to High(Futures) do
begin begin
Assert.IsTrue( Futures[i].Done.IsSet, 'An individual future was not set after State.All completed.' ); Assert.IsTrue(Futures[i].Done.IsSet, 'An individual future was not set after State.All completed.');
// Static string [cite: 148, 55] // Static string [cite: 148, 55]
if Futures[i].Done.IsSet then // Additional check to safely access Result if Futures[i].Done.IsSet then // Additional check to safely access Result
begin begin
Assert.AreEqual( i, Futures[i].Result, 'A future''s result was incorrect in State.All stress test.' ); Assert.AreEqual(i, Futures[i].Result, 'A future''s result was incorrect in State.All stress test.');
// Static string [cite: 148] // Static string [cite: 148]
end; end;
end; end;
@@ -403,65 +415,70 @@ var
i: Integer; i: Integer;
isAtLeastOneSet: Boolean; isAtLeastOneSet: Boolean;
begin begin
SetLength( Futures, StressTestFutureCount ); SetLength(Futures, StressTestFutureCount);
SetLength( doneStates, StressTestFutureCount ); SetLength(doneStates, StressTestFutureCount);
Randomize; // Initialize random number generator Randomize; // Initialize random number generator
// Create multiple futures, one of which is designed to finish quickly // Create multiple futures, one of which is designed to finish quickly
for i := 0 to High( Futures ) do for i := 0 to High(Futures) do
begin begin
// Capture loop variable // Capture loop variable
Futures[i] := TFuture<Integer>.Construct( // [cite: 146] Futures[i] :=
( TFuture<Integer>.Construct( // [cite: 146]
function( captureIndex: Integer ): TFunc<Integer> (
begin function(captureIndex: Integer): TFunc<Integer>
Result := function: Integer begin
var Result :=
delay: Integer; function: Integer
begin var
if captureIndex = QuickFutureIndex then delay: Integer;
delay := 5 // Short delay for the 'quick' future begin
else if captureIndex = QuickFutureIndex then
delay := 50 + Random( 100 ); // Longer random delay (50-149ms) for others delay := 5 // Short delay for the 'quick' future
TThread.Sleep( delay ); else
Result := captureIndex; delay := 50 + Random(100); // Longer random delay (50-149ms) for others
end; TThread.Sleep(delay);
end )( i ) Result := captureIndex;
); end;
end
)(i)
);
doneStates[i] := Futures[i].Done; // [cite: 148] doneStates[i] := Futures[i].Done; // [cite: 148]
end; end;
combinedStateAny := TState.Any( doneStates ); // [cite: 68] combinedStateAny := TState.Any(doneStates); // [cite: 68]
Assert.IsNotNull( combinedStateAny, 'State.Any should return a valid IMycState.' ); // Static string Assert.IsNotNull(combinedStateAny, 'State.Any should return a valid IMycState.'); // Static string
// Create a master future that waits on the combined State.Any state // Create a master future that waits on the combined State.Any state
masterFuture := TFuture<Boolean>.Construct( combinedStateAny, // [cite: 147] masterFuture :=
function: Boolean TFuture<Boolean>.Construct(
begin combinedStateAny, // [cite: 147]
Result := True; // This function executes when combinedStateAny is set function: Boolean
end begin
); Result := True; // This function executes when combinedStateAny is set
masterFuture.WaitFor( ); // Wait for at least one future to complete [cite: 148] end
);
masterFuture.WaitFor(); // Wait for at least one future to complete [cite: 148]
Assert.IsTrue( combinedStateAny.IsSet, 'Combined State.Any should be set after masterFuture.WaitFor().' ); // Static string [cite: 55] Assert.IsTrue(combinedStateAny.IsSet, 'Combined State.Any should be set after masterFuture.WaitFor().'); // Static string [cite: 55]
// Verify that at least one of the original futures is now set // Verify that at least one of the original futures is now set
isAtLeastOneSet := False; isAtLeastOneSet := False;
for i := 0 to High( Futures ) do for i := 0 to High(Futures) do
begin begin
if Futures[i].Done.IsSet then // [cite: 148, 55] if Futures[i].Done.IsSet then // [cite: 148, 55]
begin begin
isAtLeastOneSet := True; isAtLeastOneSet := True;
end; end;
end; end;
Assert.IsTrue( isAtLeastOneSet, 'At least one underlying future should be set after State.Any completed.' ); // Static string Assert.IsTrue(isAtLeastOneSet, 'At least one underlying future should be set after State.Any completed.'); // Static string
// It's good practice to ensure all futures complete // It's good practice to ensure all futures complete
for i := 0 to High( Futures ) do for i := 0 to High(Futures) do
begin begin
if not Futures[i].Done.IsSet then // [cite: 148, 55] if not Futures[i].Done.IsSet then // [cite: 148, 55]
begin begin
Futures[i].WaitFor( ); // Wait for any remaining futures [cite: 148] Futures[i].WaitFor(); // Wait for any remaining futures [cite: 148]
end; end;
end; end;
end; end;
@@ -474,32 +491,34 @@ var
finalResult: Integer; finalResult: Integer;
begin begin
// Create an outer future that, when resolved, produces another (inner) future. // Create an outer future that, when resolved, produces another (inner) future.
outerFuture := TFuture < TFuture < Integer >>.Construct( // [cite: 146] outerFuture :=
function: TFuture<Integer> // This lambda returns a Future<Integer> TFuture<TFuture<Integer>>.Construct( // [cite: 146]
begin function: TFuture<Integer> // This lambda returns a Future<Integer>
TThread.Sleep( 10 ); // Simulate work for the outer future to produce the inner one begin
Result := TFuture<Integer>.Construct( // [cite: 146] TThread.Sleep(10); // Simulate work for the outer future to produce the inner one
function: Integer Result :=
begin TFuture<Integer>.Construct( // [cite: 146]
TThread.Sleep( 10 ); // Simulate work for the inner future function: Integer
Result := 123; // The final value begin
end TThread.Sleep(10); // Simulate work for the inner future
); Result := 123; // The final value
end end
); );
end
);
Assert.IsNotNull( outerFuture.Done, 'Outer future''s Done state should not be nil.' ); // Static string [cite: 148] Assert.IsNotNull(outerFuture.Done, 'Outer future''s Done state should not be nil.'); // Static string [cite: 148]
outerFuture.WaitFor( ); // Wait for the outer future to complete and yield the inner future [cite: 148] outerFuture.WaitFor(); // Wait for the outer future to complete and yield the inner future [cite: 148]
Assert.IsTrue( outerFuture.Done.IsSet, 'Outer future should be done after WaitFor.' ); // Static string [cite: 148, 55] Assert.IsTrue(outerFuture.Done.IsSet, 'Outer future should be done after WaitFor.'); // Static string [cite: 148, 55]
innerFuture := outerFuture.Result; // Retrieve the inner future [cite: 148] innerFuture := outerFuture.Result; // Retrieve the inner future [cite: 148]
Assert.IsNotNull( innerFuture.Done, 'Inner future (from outer.Result) should have a non-nil Done state.' ); // Static string [cite: 148] Assert.IsNotNull(innerFuture.Done, 'Inner future (from outer.Result) should have a non-nil Done state.'); // Static string [cite: 148]
innerFuture.WaitFor( ); // Wait for the inner future to complete and yield the final result [cite: 148] innerFuture.WaitFor(); // Wait for the inner future to complete and yield the final result [cite: 148]
Assert.IsTrue( innerFuture.Done.IsSet, 'Inner future should be done after its WaitFor.' ); // Static string [cite: 148, 55] Assert.IsTrue(innerFuture.Done.IsSet, 'Inner future should be done after its WaitFor.'); // Static string [cite: 148, 55]
finalResult := innerFuture.Result; // Retrieve the final integer result [cite: 148] finalResult := innerFuture.Result; // Retrieve the final integer result [cite: 148]
Assert.AreEqual( 123, finalResult, 'Nested future final result from Construct is incorrect.' ); // Static string Assert.AreEqual(123, finalResult, 'Nested future final result from Construct is incorrect.'); // Static string
end; end;
[Test] [Test]
@@ -511,43 +530,46 @@ var
finalResult: string; finalResult: string;
begin begin
// Create an initial future // Create an initial future
initialFuture := TFuture<Integer>.Construct( // [cite: 146] initialFuture :=
function: Integer TFuture<Integer>.Construct( // [cite: 146]
begin function: Integer
TThread.Sleep( 10 ); begin
Result := 77; TThread.Sleep(10);
end Result := 77;
); end
);
// Chain it with a function that itself returns a new Future<string> // Chain it with a function that itself returns a new Future<string>
outerChainedFuture := initialFuture.Chain < TFuture < string >> ( // [cite: 147] outerChainedFuture :=
function( Input: Integer ): TFuture<string> // This lambda returns a Future<string> initialFuture.Chain<TFuture<string>>( // [cite: 147]
begin function(Input: Integer): TFuture<string> // This lambda returns a Future<string>
TThread.Sleep( 10 ); // Simulate work in the chain function begin
// Input is the result of initialFuture (77) TThread.Sleep(10); // Simulate work in the chain function
Result := TFuture<string>.Construct( // [cite: 146] // Input is the result of initialFuture (77)
function: string Result :=
begin TFuture<string>.Construct( // [cite: 146]
TThread.Sleep( 10 ); // Simulate work for the inner-most future function: string
Result := 'Value: ' + Input.ToString; // Input is captured (77) begin
end TThread.Sleep(10); // Simulate work for the inner-most future
); Result := 'Value: ' + Input.ToString; // Input is captured (77)
end end
); );
end
);
Assert.IsNotNull( outerChainedFuture.Done, 'Outer chained future''s Done state should not be nil.' ); // Static string [cite: 148] Assert.IsNotNull(outerChainedFuture.Done, 'Outer chained future''s Done state should not be nil.'); // Static string [cite: 148]
outerChainedFuture.WaitFor( ); // Wait for initialFuture to complete AND the chain function to execute [cite: 148] outerChainedFuture.WaitFor(); // Wait for initialFuture to complete AND the chain function to execute [cite: 148]
Assert.IsTrue( outerChainedFuture.Done.IsSet, 'Outer chained future should be done after WaitFor.' ); // Static string [cite: 148, 55] Assert.IsTrue(outerChainedFuture.Done.IsSet, 'Outer chained future should be done after WaitFor.'); // Static string [cite: 148, 55]
innerStringFuture := outerChainedFuture.Result; // Get the Future<string> produced by the chain function [cite: 148] innerStringFuture := outerChainedFuture.Result; // Get the Future<string> produced by the chain function [cite: 148]
Assert.IsNotNull( innerStringFuture.Done, 'Inner string future (from chain) should have a non-nil Done state.' ); Assert.IsNotNull(innerStringFuture.Done, 'Inner string future (from chain) should have a non-nil Done state.');
// Static string [cite: 148] // Static string [cite: 148]
innerStringFuture.WaitFor( ); // Wait for the inner Future<string> to complete [cite: 148] innerStringFuture.WaitFor(); // Wait for the inner Future<string> to complete [cite: 148]
Assert.IsTrue( innerStringFuture.Done.IsSet, 'Inner string future should be done after its WaitFor.' ); // Static string [cite: 148, 55] Assert.IsTrue(innerStringFuture.Done.IsSet, 'Inner string future should be done after its WaitFor.'); // Static string [cite: 148, 55]
finalResult := innerStringFuture.Result; // Get the final string result [cite: 148] finalResult := innerStringFuture.Result; // Get the final string result [cite: 148]
Assert.AreEqual( 'Value: 77', finalResult, 'Nested future (via Chain) final result is incorrect.' ); // Static string Assert.AreEqual('Value: 77', finalResult, 'Nested future (via Chain) final result is incorrect.'); // Static string
end; end;
end. end.
Test/TestNotifier.pas
+70 -69
View File
@@ -9,19 +9,19 @@ uses
type type
// Dummy interface and class for testing // Dummy interface and class for testing
IMyTestInterface = interface( IInterface ) IMyTestInterface = interface(IInterface)
['{7A8C1A01-1C6B-4A7A-B9D8-28E6A8D02A0F}'] ['{7A8C1A01-1C6B-4A7A-B9D8-28E6A8D02A0F}']
// Unique GUID // Unique GUID
procedure Foo; procedure Foo;
function GetValue: Integer; function GetValue: Integer;
end; end;
TMyTestReceiver = class( TInterfacedObject, IMyTestInterface ) TMyTestReceiver = class(TInterfacedObject, IMyTestInterface)
private private
FValue: Integer; FValue: Integer;
FCallCount: Integer; FCallCount: Integer;
public public
constructor Create( AValue: Integer ); constructor Create(AValue: Integer);
procedure Foo; procedure Foo;
function GetValue: Integer; function GetValue: Integer;
property CallCount: Integer read FCallCount write FCallCount; property CallCount: Integer read FCallCount write FCallCount;
@@ -53,7 +53,7 @@ implementation
{ TMyTestReceiver } { TMyTestReceiver }
constructor TMyTestReceiver.Create( AValue: Integer ); constructor TMyTestReceiver.Create(AValue: Integer);
begin begin
inherited Create; inherited Create;
FValue := AValue; FValue := AValue;
@@ -62,7 +62,7 @@ end;
procedure TMyTestReceiver.Foo; procedure TMyTestReceiver.Foo;
begin begin
Inc( FCallCount ); Inc(FCallCount);
end; end;
function TMyTestReceiver.GetValue: Integer; function TMyTestReceiver.GetValue: Integer;
@@ -93,7 +93,7 @@ begin
// This call is expected to succeed without raising EAssertionFailed or other exceptions // This call is expected to succeed without raising EAssertionFailed or other exceptions
// if TMycNotifyList.Destroy is implemented correctly. // if TMycNotifyList.Destroy is implemented correctly.
FNotifier.Destroy; FNotifier.Destroy;
Assert.IsTrue( True, 'FNotifier.Destroy completed without raising an exception.' ); Assert.IsTrue(True, 'FNotifier.Destroy completed without raising an exception.');
end; end;
// Test for: Correct execution of Notify on an empty, locked, and finalized list. // Test for: Correct execution of Notify on an empty, locked, and finalized list.
@@ -105,22 +105,23 @@ var
dummyPredicate: TPredicate<IMyTestInterface>; dummyPredicate: TPredicate<IMyTestInterface>;
begin begin
predicateCallCount := 0; predicateCallCount := 0;
dummyPredicate := function( Item: IMyTestInterface ): Boolean dummyPredicate :=
begin function(Item: IMyTestInterface): Boolean
Inc( predicateCallCount ); begin
Result := True; Inc(predicateCallCount);
end; Result := True;
end;
FNotifier.Lock; FNotifier.Lock;
Assert.IsTrue( FNotifier.IsLocked, 'Notifier should be locked.' ); Assert.IsTrue(FNotifier.IsLocked, 'Notifier should be locked.');
// FNotifier.Finalize; // Internally, FFirst becomes 2 (locked & finalized state bits) if it was 0 after Lock // FNotifier.Finalize; // Internally, FFirst becomes 2 (locked & finalized state bits) if it was 0 after Lock
// Assert.IsTrue( FNotifier.IsFinalized, 'Notifier should be finalized.' ); // Assert.IsTrue( FNotifier.IsFinalized, 'Notifier should be finalized.' );
// In a corrected Notifier, this call should not cause an AV and not call the predicate. // In a corrected Notifier, this call should not cause an AV and not call the predicate.
FNotifier.Notify( dummyPredicate ); FNotifier.Notify(dummyPredicate);
Assert.AreEqual( 0, predicateCallCount, 'Notify predicate should not have been called for an empty, finalized list.' ); Assert.AreEqual(0, predicateCallCount, 'Notify predicate should not have been called for an empty, finalized list.');
Assert.IsTrue( True, 'FNotifier.Notify on finalized locked empty list completed without AV.' ); Assert.IsTrue(True, 'FNotifier.Notify on finalized locked empty list completed without AV.');
if FNotifier.IsLocked then // Release lock for subsequent operations or cleanup if FNotifier.IsLocked then // Release lock for subsequent operations or cleanup
begin begin
@@ -134,14 +135,14 @@ end;
procedure TMycTestNotifierTests.Test03_UnadviseAllOnFinalizedLockedEmptyListExecutesWithoutErrors; procedure TMycTestNotifierTests.Test03_UnadviseAllOnFinalizedLockedEmptyListExecutesWithoutErrors;
begin begin
FNotifier.Lock; FNotifier.Lock;
Assert.IsTrue( FNotifier.IsLocked, 'Notifier should be locked.' ); Assert.IsTrue(FNotifier.IsLocked, 'Notifier should be locked.');
// FNotifier.Finalize; // FFirst becomes 2 internally // FNotifier.Finalize; // FFirst becomes 2 internally
// Assert.IsTrue( FNotifier.IsFinalized, 'Notifier should be finalized.' ); // Assert.IsTrue( FNotifier.IsFinalized, 'Notifier should be finalized.' );
// In a corrected Notifier, this call should not cause an AV. // In a corrected Notifier, this call should not cause an AV.
FNotifier.UnadviseAll; FNotifier.UnadviseAll;
Assert.IsTrue( True, 'FNotifier.UnadviseAll on finalized locked empty list completed without AV.' ); Assert.IsTrue(True, 'FNotifier.UnadviseAll on finalized locked empty list completed without AV.');
if FNotifier.IsLocked then // Release lock if FNotifier.IsLocked then // Release lock
begin begin
@@ -156,37 +157,37 @@ var
tag1, tag2: TMycNotifyList<IMyTestInterface>.TTag; tag1, tag2: TMycNotifyList<IMyTestInterface>.TTag;
receiver1, receiver2: IMyTestInterface; receiver1, receiver2: IMyTestInterface;
begin begin
receiver1 := TMyTestReceiver.Create( 1 ); receiver1 := TMyTestReceiver.Create(1);
receiver2 := TMyTestReceiver.Create( 2 ); receiver2 := TMyTestReceiver.Create(2);
FNotifier.Lock; FNotifier.Lock;
try try
tag1 := FNotifier.Advise( receiver1 ); tag1 := FNotifier.Advise(receiver1);
Assert.AreNotEqual( TMycNotifyList<IMyTestInterface>.TTag( nil ), tag1, 'Tag1 should not be nil.' ); Assert.AreNotEqual(TMycNotifyList<IMyTestInterface>.TTag(nil), tag1, 'Tag1 should not be nil.');
FNotifier.Unadvise( tag1 ); FNotifier.Unadvise(tag1);
tag1 := FNotifier.Advise( receiver1 ); tag1 := FNotifier.Advise(receiver1);
Assert.AreNotEqual( TMycNotifyList<IMyTestInterface>.TTag( nil ), tag1, 'Tag1 should not be nil.' ); Assert.AreNotEqual(TMycNotifyList<IMyTestInterface>.TTag(nil), tag1, 'Tag1 should not be nil.');
tag2 := FNotifier.Advise( receiver2 ); tag2 := FNotifier.Advise(receiver2);
Assert.AreNotEqual( TMycNotifyList<IMyTestInterface>.TTag( nil ), tag2, 'Tag2 should not be nil.' ); Assert.AreNotEqual(TMycNotifyList<IMyTestInterface>.TTag(nil), tag2, 'Tag2 should not be nil.');
Assert.AreNotEqual( tag1, tag2, 'Tag1 and Tag2 should be different.' ); Assert.AreNotEqual(tag1, tag2, 'Tag1 and Tag2 should be different.');
FNotifier.Unadvise( tag1 ); FNotifier.Unadvise(tag1);
FNotifier.Unadvise( tag2 ); FNotifier.Unadvise(tag2);
// Re-add and unadvise in different order // Re-add and unadvise in different order
tag1 := FNotifier.Advise( receiver1 ); tag1 := FNotifier.Advise(receiver1);
tag2 := FNotifier.Advise( receiver2 ); tag2 := FNotifier.Advise(receiver2);
Assert.AreNotEqual( TMycNotifyList<IMyTestInterface>.TTag( nil ), tag1 ); Assert.AreNotEqual(TMycNotifyList<IMyTestInterface>.TTag(nil), tag1);
Assert.AreNotEqual( TMycNotifyList<IMyTestInterface>.TTag( nil ), tag2 ); Assert.AreNotEqual(TMycNotifyList<IMyTestInterface>.TTag(nil), tag2);
FNotifier.Unadvise( tag2 ); FNotifier.Unadvise(tag2);
FNotifier.Unadvise( tag1 ); FNotifier.Unadvise(tag1);
finally finally
FNotifier.Release; FNotifier.Release;
end; end;
Assert.IsFalse( FNotifier.IsLocked, 'Notifier should be unlocked.' ); Assert.IsFalse(FNotifier.IsLocked, 'Notifier should be unlocked.');
end; end;
// Test for: Notify calls advised items and can remove items based on the predicate. // Test for: Notify calls advised items and can remove items based on the predicate.
@@ -196,30 +197,30 @@ var
rcv1, rcv2, rcv3: TMyTestReceiver; rcv1, rcv2, rcv3: TMyTestReceiver;
itemsProcessedCount: Integer; itemsProcessedCount: Integer;
begin begin
rcv1 := TMyTestReceiver.Create( 10 ); // Keep rcv1 := TMyTestReceiver.Create(10); // Keep
rcv2 := TMyTestReceiver.Create( 20 ); // Remove rcv2 := TMyTestReceiver.Create(20); // Remove
rcv3 := TMyTestReceiver.Create( 30 ); // Keep rcv3 := TMyTestReceiver.Create(30); // Keep
FNotifier.Lock; FNotifier.Lock;
try try
FNotifier.Advise( rcv1 ); FNotifier.Advise(rcv1);
FNotifier.Advise( rcv2 ); FNotifier.Advise(rcv2);
FNotifier.Advise( rcv3 ); FNotifier.Advise(rcv3);
itemsProcessedCount := 0; itemsProcessedCount := 0;
FNotifier.Notify( FNotifier.Notify(
function( Item: IMyTestInterface ): Boolean function(Item: IMyTestInterface): Boolean
begin begin
Inc( itemsProcessedCount ); Inc(itemsProcessedCount);
TMyTestReceiver( Item ).Foo; TMyTestReceiver(Item).Foo;
Result := Item.GetValue <> 20; // Remove item with value 20 Result := Item.GetValue <> 20; // Remove item with value 20
end end
); );
Assert.AreEqual( 3, itemsProcessedCount, 'Notify predicate called for all 3 items.' ); Assert.AreEqual(3, itemsProcessedCount, 'Notify predicate called for all 3 items.');
Assert.AreEqual( 1, rcv1.CallCount, 'Receiver1 called once.' ); Assert.AreEqual(1, rcv1.CallCount, 'Receiver1 called once.');
Assert.AreEqual( 1, rcv2.CallCount, 'Receiver2 called once (before removal).' ); Assert.AreEqual(1, rcv2.CallCount, 'Receiver2 called once (before removal).');
Assert.AreEqual( 1, rcv3.CallCount, 'Receiver3 called once.' ); Assert.AreEqual(1, rcv3.CallCount, 'Receiver3 called once.');
// Reset counts and check again // Reset counts and check again
rcv1.CallCount := 0; rcv1.CallCount := 0;
@@ -228,17 +229,17 @@ begin
itemsProcessedCount := 0; itemsProcessedCount := 0;
FNotifier.Notify( FNotifier.Notify(
function( Item: IMyTestInterface ): Boolean function(Item: IMyTestInterface): Boolean
begin begin
Inc( itemsProcessedCount ); Inc(itemsProcessedCount);
TMyTestReceiver( Item ).Foo; TMyTestReceiver(Item).Foo;
Result := True; // Keep remaining Result := True; // Keep remaining
end end
); );
Assert.AreEqual( 2, itemsProcessedCount, 'Notify predicate called for 2 remaining items.' ); Assert.AreEqual(2, itemsProcessedCount, 'Notify predicate called for 2 remaining items.');
Assert.AreEqual( 1, rcv1.CallCount, 'Receiver1 called again.' ); Assert.AreEqual(1, rcv1.CallCount, 'Receiver1 called again.');
Assert.AreEqual( 0, rcv2.CallCount, 'Receiver2 (removed) not called again.' ); Assert.AreEqual(0, rcv2.CallCount, 'Receiver2 (removed) not called again.');
Assert.AreEqual( 1, rcv3.CallCount, 'Receiver3 called again.' ); Assert.AreEqual(1, rcv3.CallCount, 'Receiver3 called again.');
finally finally
FNotifier.Release; FNotifier.Release;
@@ -257,6 +258,6 @@ end;
initialization initialization
TDUnitX.RegisterTestFixture( TMycTestNotifierTests ); TDUnitX.RegisterTestFixture(TMycTestNotifierTests);
end. end.
Test/TestNotifier_ChaosStress.pas
+55 -34
View File
@@ -20,8 +20,7 @@ type
function GetInstanceID: Integer; function GetInstanceID: Integer;
function GetExpectedToBeAdvised: Boolean; function GetExpectedToBeAdvised: Boolean;
procedure SetExpectedToBeAdvised(const Value: Boolean); procedure SetExpectedToBeAdvised(const Value: Boolean);
property ExpectedToBeAdvised: Boolean read GetExpectedToBeAdvised write property ExpectedToBeAdvised: Boolean read GetExpectedToBeAdvised write SetExpectedToBeAdvised;
SetExpectedToBeAdvised;
end; end;
TMyStressReceiver = class(TInterfacedObject, IMyStressTestInterface) TMyStressReceiver = class(TInterfacedObject, IMyStressTestInterface)
@@ -39,8 +38,7 @@ type
function GetValue: Integer; function GetValue: Integer;
function GetNotificationCount: Integer; function GetNotificationCount: Integer;
function GetInstanceID: Integer; function GetInstanceID: Integer;
property ExpectedToBeAdvised: Boolean read GetExpectedToBeAdvised write property ExpectedToBeAdvised: Boolean read GetExpectedToBeAdvised write SetExpectedToBeAdvised;
SetExpectedToBeAdvised;
end; end;
// Record type to store an advised receiver and its tag // Record type to store an advised receiver and its tag
@@ -66,7 +64,7 @@ type
destructor Destroy; override; destructor Destroy; override;
property Error: Exception read FError; property Error: Exception read FError;
function GetAdvisedReceiverCountByThread: Integer; function GetAdvisedReceiverCountByThread: Integer;
// procedure GetMyExpectedLiveReceivers(AList: TList<TMyStressReceiver>); // Not strictly needed with current verification // procedure GetMyExpectedLiveReceivers(AList: TList<TMyStressReceiver>); // Not strictly needed with current verification
end; end;
[TestFixture] [TestFixture]
@@ -165,7 +163,8 @@ begin
try try
for i := 1 to FIterations do for i := 1 to FIterations do
begin begin
if Terminated then Break; // Respond to termination request if Terminated then
Break; // Respond to termination request
op := Random(100); op := Random(100);
@@ -211,21 +210,23 @@ begin
begin begin
FOwnerFixture.FNotifier.Lock; FOwnerFixture.FNotifier.Lock;
try try
// if not FOwnerFixture.FNotifier.IsFinalized then // Don't notify if finalized // if not FOwnerFixture.FNotifier.IsFinalized then // Don't notify if finalized
begin begin
FOwnerFixture.FNotifier.Notify( FOwnerFixture.FNotifier.Notify(
function(Item: IMyStressTestInterface): Boolean function(Item: IMyStressTestInterface): Boolean
begin begin
Item.Foo(FThreadID); // Pass ThreadID as notification type for context Item.Foo(FThreadID); // Pass ThreadID as notification type for context
Result := True; // Keep item Result := True; // Keep item
end); end
);
end; end;
finally finally
FOwnerFixture.FNotifier.Release; FOwnerFixture.FNotifier.Release;
end; end;
end; end;
if (i mod 75 = 0) then Sleep(0); // Yield occasionally to encourage context switching if (i mod 75 = 0) then
Sleep(0); // Yield occasionally to encourage context switching
end; end;
except except
on E: Exception do on E: Exception do
@@ -250,7 +251,6 @@ end;
// end; // end;
// end; // end;
{ TMycNotifierChaosStressTests } { TMycNotifierChaosStressTests }
procedure TMycNotifierChaosStressTests.Setup; procedure TMycNotifierChaosStressTests.Setup;
begin begin
@@ -263,8 +263,8 @@ end;
procedure TMycNotifierChaosStressTests.TearDown; procedure TMycNotifierChaosStressTests.TearDown;
var var
// receiver: TMyStressReceiver; // Not used directly in this simplified TearDown // receiver: TMyStressReceiver; // Not used directly in this simplified TearDown
i: Integer; i: Integer;
begin begin
// Attempt to shut down the Notifier cleanly. // Attempt to shut down the Notifier cleanly.
try try
@@ -272,7 +272,7 @@ begin
try try
// UnadviseAll should be safe if the IsFinalized guard is present // UnadviseAll should be safe if the IsFinalized guard is present
// and the FFirst state is not pathological. // and the FFirst state is not pathological.
// if not FNotifier.IsFinalized then // if not FNotifier.IsFinalized then
begin begin
FNotifier.UnadviseAll; FNotifier.UnadviseAll;
end; end;
@@ -294,7 +294,7 @@ begin
// as long as no other strong references exist. // as long as no other strong references exist.
// Setting list items to nil is good practice if the list itself isn't immediately freed. // Setting list items to nil is good practice if the list itself isn't immediately freed.
for i := 0 to FAllReceiversCreated.Count - 1 do for i := 0 to FAllReceiversCreated.Count - 1 do
FAllReceiversCreated[i] := nil; // Break reference cycles if any, allow ARC FAllReceiversCreated[i] := nil; // Break reference cycles if any, allow ARC
FAllReceiversCreated.Free; FAllReceiversCreated.Free;
FAllReceiversCreated := nil; FAllReceiversCreated := nil;
end; end;
@@ -307,7 +307,7 @@ end;
procedure TMycNotifierChaosStressTests.Test_MixedOperations_Stress; procedure TMycNotifierChaosStressTests.Test_MixedOperations_Stress;
const const
NumThreads = 24; // Number of concurrent worker threads NumThreads = 24; // Number of concurrent worker threads
IterationsPerThread = 2000; // Number of random operations per thread IterationsPerThread = 2000; // Number of random operations per thread
var var
threads: array of TStressWorkerThread; threads: array of TStressWorkerThread;
@@ -337,8 +337,7 @@ begin
begin begin
// If an error occurred, Assert.IsNull would fail. // If an error occurred, Assert.IsNull would fail.
// The message can safely use LThreadError.Message here. // The message can safely use LThreadError.Message here.
Assert.IsNull(LThreadError, Assert.IsNull(LThreadError, 'Thread ' + threads[i].FThreadID.ToString + ' reported an error: ' + LThreadError.Message);
'Thread ' + threads[i].FThreadID.ToString + ' reported an error: ' + LThreadError.Message);
end end
else else
begin begin
@@ -357,14 +356,15 @@ begin
try try
FNotifier.Lock; FNotifier.Lock;
try try
// if not FNotifier.IsFinalized then // if not FNotifier.IsFinalized then
begin begin
FNotifier.Notify( FNotifier.Notify(
function(Item: IMyStressTestInterface): Boolean function(Item: IMyStressTestInterface): Boolean
begin begin
actualLiveReceiversInNotifier.Add(Item); actualLiveReceiversInNotifier.Add(Item);
Result := True; Result := True;
end); end
);
end; end;
finally finally
FNotifier.Release; FNotifier.Release;
@@ -372,8 +372,14 @@ begin
actualLiveInNotifierAtEnd := actualLiveReceiversInNotifier.Count; actualLiveInNotifierAtEnd := actualLiveReceiversInNotifier.Count;
// 2. Compare overall counts // 2. Compare overall counts
Assert.AreEqual(totalExpectedLiveByThreadsAtEnd, actualLiveInNotifierAtEnd, Assert.AreEqual(
Format('Mismatch in live item count at end. Threads expected %d, Notifier has %d.', [totalExpectedLiveByThreadsAtEnd, actualLiveInNotifierAtEnd])); totalExpectedLiveByThreadsAtEnd,
actualLiveInNotifierAtEnd,
Format(
'Mismatch in live item count at end. Threads expected %d, Notifier has %d.',
[totalExpectedLiveByThreadsAtEnd, actualLiveInNotifierAtEnd]
)
);
// 3. Detailed check: Iterate all receivers ever created. // 3. Detailed check: Iterate all receivers ever created.
// Their 'ExpectedToBeAdvised' flag (last known state from its managing thread) // Their 'ExpectedToBeAdvised' flag (last known state from its managing thread)
@@ -393,14 +399,29 @@ begin
end; end;
end; end;
Assert.AreEqual(receiver.ExpectedToBeAdvised, found, Assert.AreEqual(
Format('Receiver ID %d: Thread expected it to be advised=%d, but its presence in Notifier is %d. NotificationCount=%d', receiver.ExpectedToBeAdvised,
[receiver.GetInstanceID, Integer(receiver.ExpectedToBeAdvised), Integer(found), receiver.GetNotificationCount])); found,
Format(
'Receiver ID %d: Thread expected it to be advised=%d, but its presence in Notifier is %d. NotificationCount=%d',
[
receiver.GetInstanceID,
Integer(receiver.ExpectedToBeAdvised),
Integer(found),
receiver.GetNotificationCount
]
)
);
// Further checks on NotificationCount could be added if specific notification patterns were expected. // Further checks on NotificationCount could be added if specific notification patterns were expected.
// For this chaos test, ensuring count is non-negative and consistent with advised state is a good start. // For this chaos test, ensuring count is non-negative and consistent with advised state is a good start.
Assert.IsTrue(receiver.GetNotificationCount >= 0, Assert.IsTrue(
Format('Receiver ID %d has non-positive notification count: %d', [receiver.GetInstanceID, receiver.GetNotificationCount])); receiver.GetNotificationCount >= 0,
Format(
'Receiver ID %d has non-positive notification count: %d',
[receiver.GetInstanceID, receiver.GetNotificationCount]
)
);
if found and (receiver.GetNotificationCount = 0) then if found and (receiver.GetNotificationCount = 0) then
begin begin
// This might be okay if Notify calls were very sparse or the item was just added and not yet notified. // This might be okay if Notify calls were very sparse or the item was just added and not yet notified.
Test/TestNotifier_Threading.pas
+29 -19
View File
@@ -127,7 +127,8 @@ begin
// Acquire lock before calling Advise // Acquire lock before calling Advise
FOwnerFixture.FNotifier.Lock; FOwnerFixture.FNotifier.Lock;
try try
{var tag :=} FOwnerFixture.FNotifier.Advise(FReceiversToAdd[i]); {var tag :=}
FOwnerFixture.FNotifier.Advise(FReceiversToAdd[i]);
// The 'tag' could be used here if necessary for other test scenarios // The 'tag' could be used here if necessary for other test scenarios
finally finally
// Definitely release lock in the finally block // Definitely release lock in the finally block
@@ -168,7 +169,7 @@ begin
try try
// UnadviseAll should be safe if the IsFinalized guard is present // UnadviseAll should be safe if the IsFinalized guard is present
// and the FFirst state is not pathological. // and the FFirst state is not pathological.
// if not FNotifier.IsFinalized then // if not FNotifier.IsFinalized then
begin begin
FNotifier.UnadviseAll; FNotifier.UnadviseAll;
end; end;
@@ -206,7 +207,7 @@ var
currentNotifyCount: Integer; currentNotifyCount: Integer;
receiver: IMyTestInterface; receiver: IMyTestInterface;
LThreadError: Exception; // For safe error message handling LThreadError: Exception; // For safe error message handling
LMessage: string; // For safe error message handling LMessage: string; // For safe error message handling
begin begin
totalAdvisedExpected := NumThreads * ItemsPerThread; totalAdvisedExpected := NumThreads * ItemsPerThread;
SetLength(threads, NumThreads); SetLength(threads, NumThreads);
@@ -255,18 +256,24 @@ begin
FNotifier.Lock; FNotifier.Lock;
try try
FNotifier.Notify( FNotifier.Notify(
function(Item: IMyTestInterface): Boolean function(Item: IMyTestInterface): Boolean
begin begin
Inc(currentNotifyCount); Inc(currentNotifyCount);
Result := True; // Keep item in the Notifier Result := True; // Keep item in the Notifier
end end
); );
finally finally
FNotifier.Release; FNotifier.Release;
end; end;
Assert.AreEqual(totalAdvisedExpected, currentNotifyCount, Assert.AreEqual(
'The number of items in the Notifier after all Advise operations (' + currentNotifyCount.ToString + totalAdvisedExpected,
') does not match the expected number (' + totalAdvisedExpected.ToString + ').'); currentNotifyCount,
'The number of items in the Notifier after all Advise operations ('
+ currentNotifyCount.ToString
+ ') does not match the expected number ('
+ totalAdvisedExpected.ToString
+ ').'
);
// 2. Execute UnadviseAll // 2. Execute UnadviseAll
FNotifier.Lock; FNotifier.Lock;
@@ -281,21 +288,24 @@ begin
FNotifier.Lock; FNotifier.Lock;
try try
FNotifier.Notify( FNotifier.Notify(
function(Item: IMyTestInterface): Boolean function(Item: IMyTestInterface): Boolean
begin begin
Inc(currentNotifyCount); Inc(currentNotifyCount);
Result := True; Result := True;
end end
); );
finally finally
FNotifier.Release; FNotifier.Release;
end; end;
Assert.AreEqual(0, currentNotifyCount, Assert.AreEqual(
'The Notifier should be empty after UnadviseAll, but still contains ' + currentNotifyCount.ToString + ' items.'); 0,
currentNotifyCount,
'The Notifier should be empty after UnadviseAll, but still contains ' + currentNotifyCount.ToString + ' items.'
);
end; end;
initialization initialization
TDUnitX.RegisterTestFixture(TMycNotifierThreadingTests); TDUnitX.RegisterTestFixture(TMycNotifierThreadingTests);
end. end.
Test/TestSignals_Dirty.pas
+327 -327
View File
@@ -3,81 +3,81 @@ unit TestSignals_Dirty;
interface interface
uses uses
DUnitX.TestFramework, DUnitX.TestFramework,
System.SysUtils, System.SysUtils,
Myc.Signals; // Unit under test Myc.Signals; // Unit under test
type type
// Helper class to mock a subscriber (reuse or redefine if not in common unit) // Helper class to mock a subscriber (reuse or redefine if not in common unit)
TMockSubscriber = class(TInterfacedObject, IMycSubscriber) TMockSubscriber = class(TInterfacedObject, IMycSubscriber)
public public
NotifyCount: Integer; NotifyCount: Integer;
NotifyShouldReturn: Boolean; NotifyShouldReturn: Boolean;
WasCalled: Boolean; WasCalled: Boolean;
LastReturnedValueFromSource: Boolean; // To store what the source's Notify returned LastReturnedValueFromSource: Boolean; // To store what the source's Notify returned
constructor Create(AShouldReturn: Boolean = True); constructor Create(AShouldReturn: Boolean = True);
function Notify: Boolean; // IMycSubscriber implementation. function Notify: Boolean; // IMycSubscriber implementation.
end; end;
[TestFixture] [TestFixture]
TTestMycDirtyFlag = class(TObject) TTestMycDirtyFlag = class(TObject)
private private
// Helper to create a dirty flag and optionally reset it for a clean initial state // Helper to create a dirty flag and optionally reset it for a clean initial state
function CreateAndPrepareDirtyFlag(StartDirty: Boolean = True): IMycDirty; function CreateAndPrepareDirtyFlag(StartDirty: Boolean = True): IMycDirty;
public public
[Setup] [Setup]
procedure Setup; procedure Setup;
[TearDown] [TearDown]
procedure TearDown; procedure TearDown;
// Category 1: Basic State, Notify (as Subscriber method), and Reset // Category 1: Basic State, Notify (as Subscriber method), and Reset
[Test] [Test]
procedure TestCreate_InitialStateIsDirty; procedure TestCreate_InitialStateIsDirty;
[Test] [Test]
procedure TestReset_FromDirtyState_BecomesCleanAndReturnsTrue; procedure TestReset_FromDirtyState_BecomesCleanAndReturnsTrue;
[Test] [Test]
procedure TestReset_FromCleanState_StaysCleanAndReturnsFalse; procedure TestReset_FromCleanState_StaysCleanAndReturnsFalse;
[Test] [Test]
procedure TestNotify_OnCleanFlag_SetsDirtyAndReturnsTrue; procedure TestNotify_OnCleanFlag_SetsDirtyAndReturnsTrue;
[Test] [Test]
procedure TestNotify_OnDirtyFlag_StaysDirtyAndReturnsFalse; procedure TestNotify_OnDirtyFlag_StaysDirtyAndReturnsFalse;
// Category 2: Subscriber Notifications // Category 2: Subscriber Notifications
[Test] [Test]
procedure TestSubscribe_ToAlreadyDirtyFlag_NotifiesSubscriberImmediately; procedure TestSubscribe_ToAlreadyDirtyFlag_NotifiesSubscriberImmediately;
[Test] [Test]
procedure TestSubscribe_ToCleanFlag_DoesNotNotifySubscriberImmediately; procedure TestSubscribe_ToCleanFlag_DoesNotNotifySubscriberImmediately;
[Test] [Test]
procedure TestSubscriber_Notified_WhenFlagTransitionsToDirty; procedure TestSubscriber_Notified_WhenFlagTransitionsToDirty;
[Test] [Test]
procedure TestSubscriber_NotNotified_WhenSettingAlreadyDirtyFlagViaNotify; procedure TestSubscriber_NotNotified_WhenSettingAlreadyDirtyFlagViaNotify;
[Test] [Test]
procedure TestSubscriber_NotNotified_ByResetAction; procedure TestSubscriber_NotNotified_ByResetAction;
[Test] [Test]
procedure TestMultipleSubscribers_Notified_WhenFlagTransitionsToDirty; procedure TestMultipleSubscribers_Notified_WhenFlagTransitionsToDirty;
[Test] [Test]
procedure TestUnsubscribe_SubscriberNotNotified; procedure TestUnsubscribe_SubscriberNotNotified;
// Category 3: Chaining Dirty Flags // Category 3: Chaining Dirty Flags
[Test] [Test]
procedure TestChain_A_Notifies_B_SimplePropagation; procedure TestChain_A_Notifies_B_SimplePropagation;
[Test] [Test]
procedure TestChain_A_Notifies_B_Notifies_C_SimplePropagation; procedure TestChain_A_Notifies_B_Notifies_C_SimplePropagation;
// Category 4: Chaining with Resets and Re-triggering (Consistency) // Category 4: Chaining with Resets and Re-triggering (Consistency)
[Test] [Test]
procedure TestChain_A_B_ResetB_RetriggerA_BStaysCleanIfANotChanged; procedure TestChain_A_B_ResetB_RetriggerA_BStaysCleanIfANotChanged;
[Test] [Test]
procedure TestChain_A_B_ResetA_ThenTriggerA_FullPropagationToB; procedure TestChain_A_B_ResetA_ThenTriggerA_FullPropagationToB;
[Test] [Test]
procedure TestChain_A_B_C_IntermediateBReset_RetriggerA_PropagatesToC; procedure TestChain_A_B_C_IntermediateBReset_RetriggerA_PropagatesToC;
[Test] [Test]
procedure TestChain_A_B_C_AllReset_RetriggerA_FullPropagation; procedure TestChain_A_B_C_AllReset_RetriggerA_FullPropagation;
[Test] [Test]
procedure TestChain_A_B_C_TriggerA_ResetA_TriggerA_EnsureCNotifiedCorrectly; procedure TestChain_A_B_C_TriggerA_ResetA_TriggerA_EnsureCNotifiedCorrectly;
end; end;
implementation implementation
@@ -85,221 +85,221 @@ implementation
constructor TMockSubscriber.Create(AShouldReturn: Boolean = True); constructor TMockSubscriber.Create(AShouldReturn: Boolean = True);
begin begin
inherited Create; inherited Create;
NotifyCount := 0; NotifyCount := 0;
NotifyShouldReturn := AShouldReturn; NotifyShouldReturn := AShouldReturn;
WasCalled := False; WasCalled := False;
LastReturnedValueFromSource := False; // Default LastReturnedValueFromSource := False; // Default
end; end;
function TMockSubscriber.Notify: Boolean; function TMockSubscriber.Notify: Boolean;
begin begin
Inc(NotifyCount); Inc(NotifyCount);
WasCalled := True; WasCalled := True;
// This return value is what this subscriber tells the source signal. // 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. // For testing, we usually want it to return false to signify it doesn't need more from this one event.
Result := NotifyShouldReturn; Result := NotifyShouldReturn;
end; end;
{ TTestMycDirtyFlag } { TTestMycDirtyFlag }
function TTestMycDirtyFlag.CreateAndPrepareDirtyFlag(StartDirty: Boolean = True): IMycDirty; function TTestMycDirtyFlag.CreateAndPrepareDirtyFlag(StartDirty: Boolean = True): IMycDirty;
begin begin
Result := TDirty.Construct; // Initially dirty Result := TDirty.Construct; // Initially dirty
if not StartDirty then if not StartDirty then
Result.Reset; // Reset to make it clean Result.Reset; // Reset to make it clean
Assert.AreEqual(StartDirty, Result.State.IsSet, 'CreateAndPrepareDirtyFlag initial state incorrect.'); Assert.AreEqual(StartDirty, Result.State.IsSet, 'CreateAndPrepareDirtyFlag initial state incorrect.');
end; end;
procedure TTestMycDirtyFlag.Setup; procedure TTestMycDirtyFlag.Setup;
begin begin
// Per-test setup // Per-test setup
end; end;
procedure TTestMycDirtyFlag.TearDown; procedure TTestMycDirtyFlag.TearDown;
begin begin
// Per-test teardown // Per-test teardown
end; end;
// Category 1: Basic State, Notify (as Subscriber method), and Reset // Category 1: Basic State, Notify (as Subscriber method), and Reset
procedure TTestMycDirtyFlag.TestCreate_InitialStateIsDirty; procedure TTestMycDirtyFlag.TestCreate_InitialStateIsDirty;
var var
dirtyFlag: IMycDirty; dirtyFlag: IMycDirty;
begin begin
dirtyFlag := TDirty.Construct; dirtyFlag := TDirty.Construct;
Assert.IsTrue(dirtyFlag.State.IsSet, 'Newly created dirty flag should be IsSet (dirty).'); Assert.IsTrue(dirtyFlag.State.IsSet, 'Newly created dirty flag should be IsSet (dirty).');
end; end;
procedure TTestMycDirtyFlag.TestReset_FromDirtyState_BecomesCleanAndReturnsTrue; procedure TTestMycDirtyFlag.TestReset_FromDirtyState_BecomesCleanAndReturnsTrue;
var var
dirtyFlag: IMycDirty; dirtyFlag: IMycDirty;
resetResult: Boolean; resetResult: Boolean;
begin begin
dirtyFlag := CreateAndPrepareDirtyFlag(True); // Start dirty dirtyFlag := CreateAndPrepareDirtyFlag(True); // Start dirty
resetResult := dirtyFlag.Reset; resetResult := dirtyFlag.Reset;
Assert.IsFalse(dirtyFlag.State.IsSet, 'Flag should be clean (not IsSet) after Reset.'); Assert.IsFalse(dirtyFlag.State.IsSet, 'Flag should be clean (not IsSet) after Reset.');
Assert.IsTrue(resetResult, 'Reset() should return True when resetting a dirty flag.'); Assert.IsTrue(resetResult, 'Reset() should return True when resetting a dirty flag.');
end; end;
procedure TTestMycDirtyFlag.TestReset_FromCleanState_StaysCleanAndReturnsFalse; procedure TTestMycDirtyFlag.TestReset_FromCleanState_StaysCleanAndReturnsFalse;
var var
dirtyFlag: IMycDirty; dirtyFlag: IMycDirty;
resetResult: Boolean; resetResult: Boolean;
begin begin
dirtyFlag := CreateAndPrepareDirtyFlag(False); // Start clean dirtyFlag := CreateAndPrepareDirtyFlag(False); // Start clean
resetResult := dirtyFlag.Reset; resetResult := dirtyFlag.Reset;
Assert.IsFalse(dirtyFlag.State.IsSet, 'Flag should remain clean (not IsSet) after Reset on clean flag.'); Assert.IsFalse(dirtyFlag.State.IsSet, 'Flag should remain clean (not IsSet) after Reset on clean flag.');
Assert.IsFalse(resetResult, 'Reset() should return False when resetting an already clean flag.'); Assert.IsFalse(resetResult, 'Reset() should return False when resetting an already clean flag.');
end; end;
procedure TTestMycDirtyFlag.TestNotify_OnCleanFlag_SetsDirtyAndReturnsTrue; procedure TTestMycDirtyFlag.TestNotify_OnCleanFlag_SetsDirtyAndReturnsTrue;
var var
dirtyFlag: IMycDirty; dirtyFlag: IMycDirty;
notifyResult: Boolean; notifyResult: Boolean;
begin begin
dirtyFlag := CreateAndPrepareDirtyFlag(False); // Start clean dirtyFlag := CreateAndPrepareDirtyFlag(False); // Start clean
notifyResult := dirtyFlag.Notify; // Call IMycSubscriber.Notify to make it dirty notifyResult := dirtyFlag.Notify; // Call IMycSubscriber.Notify to make it dirty
Assert.IsTrue(dirtyFlag.State.IsSet, 'Flag should be dirty (IsSet) after Notify on clean flag.'); Assert.IsTrue(dirtyFlag.State.IsSet, 'Flag should be dirty (IsSet) after Notify on clean flag.');
Assert.IsTrue(notifyResult, 'Notify() should return True indicating a state change from clean to dirty.'); Assert.IsTrue(notifyResult, 'Notify() should return True indicating a state change from clean to dirty.');
end; end;
procedure TTestMycDirtyFlag.TestNotify_OnDirtyFlag_StaysDirtyAndReturnsFalse; procedure TTestMycDirtyFlag.TestNotify_OnDirtyFlag_StaysDirtyAndReturnsFalse;
var var
dirtyFlag: IMycDirty; dirtyFlag: IMycDirty;
notifyResult: Boolean; notifyResult: Boolean;
begin begin
dirtyFlag := CreateAndPrepareDirtyFlag(True); // Start dirty dirtyFlag := CreateAndPrepareDirtyFlag(True); // Start dirty
notifyResult := dirtyFlag.Notify; // Call IMycSubscriber.Notify again notifyResult := dirtyFlag.Notify; // Call IMycSubscriber.Notify again
Assert.IsTrue(dirtyFlag.State.IsSet, 'Flag should remain dirty (IsSet).'); Assert.IsTrue(dirtyFlag.State.IsSet, 'Flag should remain dirty (IsSet).');
Assert.IsFalse(notifyResult, 'Notify() should return False as flag was already dirty (no state change to dirty).'); Assert.IsFalse(notifyResult, 'Notify() should return False as flag was already dirty (no state change to dirty).');
end; end;
// Category 2: Subscriber Notifications // Category 2: Subscriber Notifications
procedure TTestMycDirtyFlag.TestSubscribe_ToAlreadyDirtyFlag_NotifiesSubscriberImmediately; procedure TTestMycDirtyFlag.TestSubscribe_ToAlreadyDirtyFlag_NotifiesSubscriberImmediately;
var var
dirtyFlag: IMycDirty; dirtyFlag: IMycDirty;
subscriber: TMockSubscriber; subscriber: TMockSubscriber;
subscription: TState.TSubscription; subscription: TState.TSubscription;
begin begin
dirtyFlag := CreateAndPrepareDirtyFlag(True); // Start dirty dirtyFlag := CreateAndPrepareDirtyFlag(True); // Start dirty
subscriber := TMockSubscriber.Create; subscriber := TMockSubscriber.Create;
subscription := dirtyFlag.State.Subscribe(subscriber); subscription := dirtyFlag.State.Subscribe(subscriber);
Assert.AreEqual(1, subscriber.NotifyCount, 'Subscriber should be notified immediately when subscribing to an already dirty flag.'); Assert.AreEqual(1, subscriber.NotifyCount, 'Subscriber should be notified immediately when subscribing to an already dirty flag.');
Assert.IsTrue(subscriber.WasCalled, 'Subscriber WasCalled should be true.'); Assert.IsTrue(subscriber.WasCalled, 'Subscriber WasCalled should be true.');
end; end;
procedure TTestMycDirtyFlag.TestSubscribe_ToCleanFlag_DoesNotNotifySubscriberImmediately; procedure TTestMycDirtyFlag.TestSubscribe_ToCleanFlag_DoesNotNotifySubscriberImmediately;
var var
dirtyFlag: IMycDirty; dirtyFlag: IMycDirty;
subscriber: TMockSubscriber; subscriber: TMockSubscriber;
subscription: TState.TSubscription; subscription: TState.TSubscription;
begin begin
dirtyFlag := CreateAndPrepareDirtyFlag(False); // Start clean dirtyFlag := CreateAndPrepareDirtyFlag(False); // Start clean
subscriber := TMockSubscriber.Create; subscriber := TMockSubscriber.Create;
subscription := dirtyFlag.State.Subscribe(subscriber); subscription := dirtyFlag.State.Subscribe(subscriber);
Assert.AreEqual(0, subscriber.NotifyCount, 'Subscriber should NOT be notified immediately when subscribing to a clean flag.'); Assert.AreEqual(0, subscriber.NotifyCount, 'Subscriber should NOT be notified immediately when subscribing to a clean flag.');
Assert.IsFalse(subscriber.WasCalled, 'Subscriber WasCalled should be false.'); Assert.IsFalse(subscriber.WasCalled, 'Subscriber WasCalled should be false.');
end; end;
procedure TTestMycDirtyFlag.TestSubscriber_Notified_WhenFlagTransitionsToDirty; procedure TTestMycDirtyFlag.TestSubscriber_Notified_WhenFlagTransitionsToDirty;
var var
dirtyFlag: IMycDirty; dirtyFlag: IMycDirty;
subscriber: TMockSubscriber; subscriber: TMockSubscriber;
subscription: TState.TSubscription; subscription: TState.TSubscription;
begin begin
dirtyFlag := CreateAndPrepareDirtyFlag(False); // Start clean dirtyFlag := CreateAndPrepareDirtyFlag(False); // Start clean
subscriber := TMockSubscriber.Create; subscriber := TMockSubscriber.Create;
subscription := dirtyFlag.State.Subscribe(subscriber); subscription := dirtyFlag.State.Subscribe(subscriber);
Assert.AreEqual(0, subscriber.NotifyCount, 'Subscriber initially not notified.'); Assert.AreEqual(0, subscriber.NotifyCount, 'Subscriber initially not notified.');
dirtyFlag.Notify; // Make the flag dirty dirtyFlag.Notify; // Make the flag dirty
Assert.AreEqual(1, subscriber.NotifyCount, 'Subscriber should be notified once flag transitions to dirty.'); Assert.AreEqual(1, subscriber.NotifyCount, 'Subscriber should be notified once flag transitions to dirty.');
end; end;
procedure TTestMycDirtyFlag.TestSubscriber_NotNotified_WhenSettingAlreadyDirtyFlagViaNotify; procedure TTestMycDirtyFlag.TestSubscriber_NotNotified_WhenSettingAlreadyDirtyFlagViaNotify;
var var
dirtyFlag: IMycDirty; dirtyFlag: IMycDirty;
subscriber: TMockSubscriber; subscriber: TMockSubscriber;
subscription: TState.TSubscription; subscription: TState.TSubscription;
begin begin
dirtyFlag := CreateAndPrepareDirtyFlag(True); // Start dirty dirtyFlag := CreateAndPrepareDirtyFlag(True); // Start dirty
subscriber := TMockSubscriber.Create; subscriber := TMockSubscriber.Create;
subscription := dirtyFlag.State.Subscribe(subscriber); // Gets initial notification subscription := dirtyFlag.State.Subscribe(subscriber); // Gets initial notification
Assert.AreEqual(1, subscriber.NotifyCount, 'Subscriber notified on subscribe to dirty flag.'); Assert.AreEqual(1, subscriber.NotifyCount, 'Subscriber notified on subscribe to dirty flag.');
dirtyFlag.Notify; // Notify again, flag was already dirty dirtyFlag.Notify; // Notify again, flag was already dirty
Assert.AreEqual(1, subscriber.NotifyCount, 'Subscriber should NOT be notified again if flag was already dirty.'); Assert.AreEqual(1, subscriber.NotifyCount, 'Subscriber should NOT be notified again if flag was already dirty.');
end; end;
procedure TTestMycDirtyFlag.TestSubscriber_NotNotified_ByResetAction; procedure TTestMycDirtyFlag.TestSubscriber_NotNotified_ByResetAction;
var var
dirtyFlag: IMycDirty; dirtyFlag: IMycDirty;
subscriber: TMockSubscriber; subscriber: TMockSubscriber;
subscription: TState.TSubscription; subscription: TState.TSubscription;
begin begin
dirtyFlag := CreateAndPrepareDirtyFlag(True); // Start dirty dirtyFlag := CreateAndPrepareDirtyFlag(True); // Start dirty
subscriber := TMockSubscriber.Create; subscriber := TMockSubscriber.Create;
subscription := dirtyFlag.State.Subscribe(subscriber); // Gets initial notification subscription := dirtyFlag.State.Subscribe(subscriber); // Gets initial notification
Assert.AreEqual(1, subscriber.NotifyCount, 'Subscriber notified on subscribe.'); Assert.AreEqual(1, subscriber.NotifyCount, 'Subscriber notified on subscribe.');
dirtyFlag.Reset; // Reset the flag dirtyFlag.Reset; // Reset the flag
Assert.IsFalse(dirtyFlag.State.IsSet, 'Flag is now clean.'); Assert.IsFalse(dirtyFlag.State.IsSet, 'Flag is now clean.');
// Current TMycDirty.Reset does not notify subscribers. // Current TMycDirty.Reset does not notify subscribers.
Assert.AreEqual(1, subscriber.NotifyCount, 'Subscriber should NOT be notified by Reset action.'); Assert.AreEqual(1, subscriber.NotifyCount, 'Subscriber should NOT be notified by Reset action.');
end; end;
procedure TTestMycDirtyFlag.TestMultipleSubscribers_Notified_WhenFlagTransitionsToDirty; procedure TTestMycDirtyFlag.TestMultipleSubscribers_Notified_WhenFlagTransitionsToDirty;
var var
dirtyFlag: IMycDirty; dirtyFlag: IMycDirty;
sub1, sub2: TMockSubscriber; sub1, sub2: TMockSubscriber;
subscription1, subscription2: TState.TSubscription; subscription1, subscription2: TState.TSubscription;
begin begin
dirtyFlag := CreateAndPrepareDirtyFlag(False); // Start clean dirtyFlag := CreateAndPrepareDirtyFlag(False); // Start clean
sub1 := TMockSubscriber.Create; sub1 := TMockSubscriber.Create;
sub2 := TMockSubscriber.Create; sub2 := TMockSubscriber.Create;
subscription1 := dirtyFlag.State.Subscribe(sub1); subscription1 := dirtyFlag.State.Subscribe(sub1);
subscription2 := dirtyFlag.State.Subscribe(sub2); subscription2 := dirtyFlag.State.Subscribe(sub2);
dirtyFlag.Notify; // Make flag dirty dirtyFlag.Notify; // Make flag dirty
Assert.AreEqual(1, sub1.NotifyCount, 'Subscriber 1 should be notified.'); Assert.AreEqual(1, sub1.NotifyCount, 'Subscriber 1 should be notified.');
Assert.AreEqual(1, sub2.NotifyCount, 'Subscriber 2 should be notified.'); Assert.AreEqual(1, sub2.NotifyCount, 'Subscriber 2 should be notified.');
end; end;
procedure TTestMycDirtyFlag.TestUnsubscribe_SubscriberNotNotified; procedure TTestMycDirtyFlag.TestUnsubscribe_SubscriberNotNotified;
var var
dirtyFlag: IMycDirty; dirtyFlag: IMycDirty;
subscriber: TMockSubscriber; subscriber: TMockSubscriber;
subscription: TState.TSubscription; subscription: TState.TSubscription;
begin begin
dirtyFlag := CreateAndPrepareDirtyFlag(False); // Start clean dirtyFlag := CreateAndPrepareDirtyFlag(False); // Start clean
subscriber := TMockSubscriber.Create; subscriber := TMockSubscriber.Create;
subscription := dirtyFlag.State.Subscribe(subscriber); subscription := dirtyFlag.State.Subscribe(subscriber);
subscription.Unsubscribe; // Explicitly unsubscribe subscription.Unsubscribe; // Explicitly unsubscribe
dirtyFlag.Notify; // Make flag dirty dirtyFlag.Notify; // Make flag dirty
Assert.AreEqual(0, subscriber.NotifyCount, 'Unsubscribed subscriber should not be notified.'); Assert.AreEqual(0, subscriber.NotifyCount, 'Unsubscribed subscriber should not be notified.');
end; end;
// Category 3: Chaining Dirty Flags // Category 3: Chaining Dirty Flags
@@ -308,222 +308,222 @@ end;
procedure TTestMycDirtyFlag.TestChain_A_Notifies_B_SimplePropagation; procedure TTestMycDirtyFlag.TestChain_A_Notifies_B_SimplePropagation;
var var
flagA, flagB: IMycDirty; flagA, flagB: IMycDirty;
subToB: TMockSubscriber; subToB: TMockSubscriber;
subscriptionA_B, subscriptionMock_B: TState.TSubscription; subscriptionA_B, subscriptionMock_B: TState.TSubscription;
begin begin
flagA := CreateAndPrepareDirtyFlag(False); // A starts clean flagA := CreateAndPrepareDirtyFlag(False); // A starts clean
flagB := CreateAndPrepareDirtyFlag(False); // B starts clean flagB := CreateAndPrepareDirtyFlag(False); // B starts clean
subToB := TMockSubscriber.Create; subToB := TMockSubscriber.Create;
subscriptionMock_B := flagB.State.Subscribe(subToB); 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) subscriptionA_B := flagA.State.Subscribe(flagB); // B subscribes to A's state changes (B's Notify will be called)
flagA.Notify; // Make A dirty. This should trigger B.Notify flagA.Notify; // Make A dirty. This should trigger B.Notify
Assert.IsTrue(flagA.State.IsSet, 'Flag A should be dirty.'); Assert.IsTrue(flagA.State.IsSet, 'Flag A should be dirty.');
Assert.IsTrue(flagB.State.IsSet, 'Flag B should become dirty due to A.'); Assert.IsTrue(flagB.State.IsSet, 'Flag B should become dirty due to A.');
Assert.AreEqual(1, subToB.NotifyCount, 'Subscriber to B should be notified once.'); Assert.AreEqual(1, subToB.NotifyCount, 'Subscriber to B should be notified once.');
end; end;
procedure TTestMycDirtyFlag.TestChain_A_Notifies_B_Notifies_C_SimplePropagation; procedure TTestMycDirtyFlag.TestChain_A_Notifies_B_Notifies_C_SimplePropagation;
var var
flagA, flagB, flagC: IMycDirty; flagA, flagB, flagC: IMycDirty;
subToC: TMockSubscriber; subToC: TMockSubscriber;
subscriptionB_A, subscriptionC_B, subscriptionMock_C: TState.TSubscription; subscriptionB_A, subscriptionC_B, subscriptionMock_C: TState.TSubscription;
begin begin
flagA := CreateAndPrepareDirtyFlag(False); flagA := CreateAndPrepareDirtyFlag(False);
flagB := CreateAndPrepareDirtyFlag(False); flagB := CreateAndPrepareDirtyFlag(False);
flagC := CreateAndPrepareDirtyFlag(False); flagC := CreateAndPrepareDirtyFlag(False);
subToC := TMockSubscriber.Create; subToC := TMockSubscriber.Create;
subscriptionMock_C := flagC.State.Subscribe(subToC); subscriptionMock_C := flagC.State.Subscribe(subToC);
subscriptionC_B := flagB.State.Subscribe(flagC); // C subscribes to B subscriptionC_B := flagB.State.Subscribe(flagC); // C subscribes to B
subscriptionB_A := flagA.State.Subscribe(flagB); // B subscribes to A subscriptionB_A := flagA.State.Subscribe(flagB); // B subscribes to A
flagA.Notify; // Make A dirty flagA.Notify; // Make A dirty
Assert.IsTrue(flagA.State.IsSet, 'Flag A should be dirty in cascade.'); Assert.IsTrue(flagA.State.IsSet, 'Flag A should be dirty in cascade.');
Assert.IsTrue(flagB.State.IsSet, 'Flag B 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.IsTrue(flagC.State.IsSet, 'Flag C should be dirty in cascade.');
Assert.AreEqual(1, subToC.NotifyCount, 'Subscriber to C should be notified once in cascade.'); Assert.AreEqual(1, subToC.NotifyCount, 'Subscriber to C should be notified once in cascade.');
end; end;
// Category 4: Chaining with Resets and Re-triggering (Consistency) // Category 4: Chaining with Resets and Re-triggering (Consistency)
procedure TTestMycDirtyFlag.TestChain_A_B_ResetB_RetriggerA_BStaysCleanIfANotChanged; procedure TTestMycDirtyFlag.TestChain_A_B_ResetB_RetriggerA_BStaysCleanIfANotChanged;
var var
flagA, flagB: IMycDirty; flagA, flagB: IMycDirty;
subToB: TMockSubscriber; subToB: TMockSubscriber;
subscriptionA_B, subscriptionMock_B: TState.TSubscription; subscriptionA_B, subscriptionMock_B: TState.TSubscription;
begin begin
flagA := CreateAndPrepareDirtyFlag(False); flagA := CreateAndPrepareDirtyFlag(False);
flagB := CreateAndPrepareDirtyFlag(False); flagB := CreateAndPrepareDirtyFlag(False);
subToB := TMockSubscriber.Create; subToB := TMockSubscriber.Create;
subscriptionMock_B := flagB.State.Subscribe(subToB); subscriptionMock_B := flagB.State.Subscribe(subToB);
subscriptionA_B := flagA.State.Subscribe(flagB); subscriptionA_B := flagA.State.Subscribe(flagB);
flagA.Notify; // A dirty -> B dirty. subToB notified. flagA.Notify; // A dirty -> B dirty. subToB notified.
Assert.IsTrue(flagB.State.IsSet, 'Flag B should be dirty initially.'); Assert.IsTrue(flagB.State.IsSet, 'Flag B should be dirty initially.');
Assert.AreEqual(1, subToB.NotifyCount, 'Subscriber to B initially notified.'); Assert.AreEqual(1, subToB.NotifyCount, 'Subscriber to B initially notified.');
flagB.Reset; // B becomes clean. A is still dirty. flagB.Reset; // B becomes clean. A is still dirty.
Assert.IsFalse(flagB.State.IsSet, 'Flag B should be clean after reset.'); 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.'); 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. // 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. // Thus, B.Notify() is NOT called. B should remain clean.
flagA.Notify; flagA.Notify;
Assert.IsTrue(flagA.State.IsSet, 'Flag A remains dirty.'); 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.IsFalse(flagB.State.IsSet, 'Flag B should remain clean if A did not transition to dirty.');
Assert.AreEqual(1, subToB.NotifyCount, 'Subscriber to B should not be notified again.'); Assert.AreEqual(1, subToB.NotifyCount, 'Subscriber to B should not be notified again.');
end; end;
procedure TTestMycDirtyFlag.TestChain_A_B_ResetA_ThenTriggerA_FullPropagationToB; procedure TTestMycDirtyFlag.TestChain_A_B_ResetA_ThenTriggerA_FullPropagationToB;
var var
flagA, flagB: IMycDirty; flagA, flagB: IMycDirty;
subToB: TMockSubscriber; subToB: TMockSubscriber;
subscriptionA_B, subscriptionMock_B: TState.TSubscription; subscriptionA_B, subscriptionMock_B: TState.TSubscription;
begin begin
flagA := CreateAndPrepareDirtyFlag(False); flagA := CreateAndPrepareDirtyFlag(False);
flagB := CreateAndPrepareDirtyFlag(False); flagB := CreateAndPrepareDirtyFlag(False);
subToB := TMockSubscriber.Create; subToB := TMockSubscriber.Create;
subscriptionMock_B := flagB.State.Subscribe(subToB); subscriptionMock_B := flagB.State.Subscribe(subToB);
subscriptionA_B := flagA.State.Subscribe(flagB); subscriptionA_B := flagA.State.Subscribe(flagB);
flagA.Notify; // A dirty -> B dirty. subToB notified. flagA.Notify; // A dirty -> B dirty. subToB notified.
Assert.IsTrue(flagB.State.IsSet, 'Flag B should be dirty after A triggers.'); Assert.IsTrue(flagB.State.IsSet, 'Flag B should be dirty after A triggers.');
Assert.AreEqual(1, subToB.NotifyCount, 'subToB notified once.'); 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). 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.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 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. 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. // B.Notify() is called. B was dirty. B.Notify() sets FFlag to true (no change), returns false.
// So B does NOT notify subToB again. // So B does NOT notify subToB again.
Assert.IsTrue(flagA.State.IsSet, 'Flag A is dirty 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.IsTrue(flagB.State.IsSet, 'Flag B is dirty (was already, and A.Notify called B.Notify which set it dirty again).');
Assert.AreEqual(1, subToB.NotifyCount, 'subToB should NOT be notified again as B did not transition from clean to dirty.'); Assert.AreEqual(1, subToB.NotifyCount, 'subToB should NOT be notified again as B did not transition from clean to dirty.');
end; end;
procedure TTestMycDirtyFlag.TestChain_A_B_C_IntermediateBReset_RetriggerA_PropagatesToC; procedure TTestMycDirtyFlag.TestChain_A_B_C_IntermediateBReset_RetriggerA_PropagatesToC;
var var
flagA, flagB, flagC: IMycDirty; flagA, flagB, flagC: IMycDirty;
subToC: TMockSubscriber; subToC: TMockSubscriber;
subscriptionB_A, subscriptionC_B, subscriptionMock_C: TState.TSubscription; subscriptionB_A, subscriptionC_B, subscriptionMock_C: TState.TSubscription;
begin begin
flagA := CreateAndPrepareDirtyFlag(False); flagA := CreateAndPrepareDirtyFlag(False);
flagB := CreateAndPrepareDirtyFlag(False); flagB := CreateAndPrepareDirtyFlag(False);
flagC := CreateAndPrepareDirtyFlag(False); flagC := CreateAndPrepareDirtyFlag(False);
subToC := TMockSubscriber.Create; subToC := TMockSubscriber.Create;
subscriptionMock_C := flagC.State.Subscribe(subToC); subscriptionMock_C := flagC.State.Subscribe(subToC);
subscriptionC_B := flagB.State.Subscribe(flagC); subscriptionC_B := flagB.State.Subscribe(flagC);
subscriptionB_A := flagA.State.Subscribe(flagB); subscriptionB_A := flagA.State.Subscribe(flagB);
// Initial full propagation // Initial full propagation
flagA.Notify; // A dirty -> B dirty -> C dirty. subToC notified. flagA.Notify; // A dirty -> B dirty -> C dirty. subToC notified.
Assert.IsTrue(flagC.State.IsSet, 'Flag C should be dirty initially.'); Assert.IsTrue(flagC.State.IsSet, 'Flag C should be dirty initially.');
Assert.AreEqual(1, subToC.NotifyCount, 'subToC initial count.'); Assert.AreEqual(1, subToC.NotifyCount, 'subToC initial count.');
// Intermediate reset // Intermediate reset
flagB.Reset; // B becomes clean. A is dirty, C is dirty. flagB.Reset; // B becomes clean. A is dirty, C is dirty.
Assert.IsFalse(flagB.State.IsSet, 'Flag B is clean.'); Assert.IsFalse(flagB.State.IsSet, 'Flag B is clean.');
// Reset and re-trigger A // Reset and re-trigger A
flagA.Reset; // A becomes clean. flagA.Reset; // A becomes clean.
Assert.IsFalse(flagA.State.IsSet, 'Flag A is clean.'); Assert.IsFalse(flagA.State.IsSet, 'Flag A is clean.');
flagA.Notify; // A (was clean) -> A dirty. A notifies B. flagA.Notify; // A (was clean) -> A dirty. A notifies B.
// B.Notify() called. B was clean -> B dirty. B notifies C. // 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. // C.Notify() called. C was dirty -> C set dirty (no change), C.Notify() returns false.
// So subToC is NOT notified again. // So subToC is NOT notified again.
Assert.IsTrue(flagA.State.IsSet, 'Flag A is dirty again.'); Assert.IsTrue(flagA.State.IsSet, 'Flag A is dirty again.');
Assert.IsTrue(flagB.State.IsSet, 'Flag B becomes dirty again.'); Assert.IsTrue(flagB.State.IsSet, 'Flag B becomes dirty again.');
Assert.IsTrue(flagC.State.IsSet, 'Flag C is dirty (was already).'); Assert.IsTrue(flagC.State.IsSet, 'Flag C is dirty (was already).');
Assert.AreEqual(1, subToC.NotifyCount, 'subToC should NOT be notified again.'); Assert.AreEqual(1, subToC.NotifyCount, 'subToC should NOT be notified again.');
end; end;
procedure TTestMycDirtyFlag.TestChain_A_B_C_AllReset_RetriggerA_FullPropagation; procedure TTestMycDirtyFlag.TestChain_A_B_C_AllReset_RetriggerA_FullPropagation;
var var
flagA, flagB, flagC: IMycDirty; flagA, flagB, flagC: IMycDirty;
subToC: TMockSubscriber; subToC: TMockSubscriber;
subscriptionB_A, subscriptionC_B, subscriptionMock_C: TState.TSubscription; subscriptionB_A, subscriptionC_B, subscriptionMock_C: TState.TSubscription;
begin begin
flagA := CreateAndPrepareDirtyFlag(False); flagA := CreateAndPrepareDirtyFlag(False);
flagB := CreateAndPrepareDirtyFlag(False); flagB := CreateAndPrepareDirtyFlag(False);
flagC := CreateAndPrepareDirtyFlag(False); flagC := CreateAndPrepareDirtyFlag(False);
subToC := TMockSubscriber.Create; subToC := TMockSubscriber.Create;
subscriptionMock_C := flagC.State.Subscribe(subToC); subscriptionMock_C := flagC.State.Subscribe(subToC);
subscriptionC_B := flagB.State.Subscribe(flagC); subscriptionC_B := flagB.State.Subscribe(flagC);
subscriptionB_A := flagA.State.Subscribe(flagB); subscriptionB_A := flagA.State.Subscribe(flagB);
// All are clean. Trigger A. // All are clean. Trigger A.
flagA.Notify; // A dirty -> B dirty -> C dirty. subToC notified. flagA.Notify; // A dirty -> B dirty -> C dirty. subToC notified.
Assert.IsTrue(flagC.State.IsSet, 'Flag C dirty after first full propagation.'); Assert.IsTrue(flagC.State.IsSet, 'Flag C dirty after first full propagation.');
Assert.AreEqual(1, subToC.NotifyCount, 'subToC notified once.'); Assert.AreEqual(1, subToC.NotifyCount, 'subToC notified once.');
// Reset all // Reset all
flagA.Reset; flagA.Reset;
flagB.Reset; flagB.Reset;
flagC.Reset; flagC.Reset;
Assert.IsFalse(flagA.State.IsSet, 'Flag A clean.'); Assert.IsFalse(flagA.State.IsSet, 'Flag A clean.');
Assert.IsFalse(flagB.State.IsSet, 'Flag B clean.'); Assert.IsFalse(flagB.State.IsSet, 'Flag B clean.');
Assert.IsFalse(flagC.State.IsSet, 'Flag C clean.'); Assert.IsFalse(flagC.State.IsSet, 'Flag C clean.');
// subToC count is still 1, it's not notified by resets. // subToC count is still 1, it's not notified by resets.
// Re-trigger A // Re-trigger A
flagA.Notify; // A (was clean) -> A dirty. A notifies B. flagA.Notify; // A (was clean) -> A dirty. A notifies B.
// B.Notify() called. B was clean -> B dirty. B notifies C. // B.Notify() called. B was clean -> B dirty. B notifies C.
// C.Notify() called. C was clean -> C dirty. C notifies subToC. // C.Notify() called. C was clean -> C dirty. C notifies subToC.
Assert.IsTrue(flagA.State.IsSet, 'Flag A dirty on re-trigger.'); Assert.IsTrue(flagA.State.IsSet, 'Flag A dirty on re-trigger.');
Assert.IsTrue(flagB.State.IsSet, 'Flag B 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.IsTrue(flagC.State.IsSet, 'Flag C dirty on re-trigger.');
Assert.AreEqual(2, subToC.NotifyCount, 'subToC should be notified a second time.'); Assert.AreEqual(2, subToC.NotifyCount, 'subToC should be notified a second time.');
end; end;
procedure TTestMycDirtyFlag.TestChain_A_B_C_TriggerA_ResetA_TriggerA_EnsureCNotifiedCorrectly; procedure TTestMycDirtyFlag.TestChain_A_B_C_TriggerA_ResetA_TriggerA_EnsureCNotifiedCorrectly;
var var
flagA, flagB, flagC: IMycDirty; flagA, flagB, flagC: IMycDirty;
subToC: TMockSubscriber; subToC: TMockSubscriber;
subscriptionB_A, subscriptionC_B, subscriptionMock_C: TState.TSubscription; subscriptionB_A, subscriptionC_B, subscriptionMock_C: TState.TSubscription;
begin begin
flagA := CreateAndPrepareDirtyFlag(False); flagA := CreateAndPrepareDirtyFlag(False);
flagB := CreateAndPrepareDirtyFlag(False); flagB := CreateAndPrepareDirtyFlag(False);
flagC := CreateAndPrepareDirtyFlag(False); flagC := CreateAndPrepareDirtyFlag(False);
subToC := TMockSubscriber.Create; subToC := TMockSubscriber.Create;
subscriptionMock_C := flagC.State.Subscribe(subToC); subscriptionMock_C := flagC.State.Subscribe(subToC);
subscriptionC_B := flagB.State.Subscribe(flagC); subscriptionC_B := flagB.State.Subscribe(flagC);
subscriptionB_A := flagA.State.Subscribe(flagB); subscriptionB_A := flagA.State.Subscribe(flagB);
// 1. Trigger A // 1. Trigger A
flagA.Notify; // A, B, C become dirty. subToC notified (count = 1). flagA.Notify; // A, B, C become dirty. subToC notified (count = 1).
Assert.IsTrue(flagC.State.IsSet, 'C is dirty after 1st trigger.'); Assert.IsTrue(flagC.State.IsSet, 'C is dirty after 1st trigger.');
Assert.AreEqual(1, subToC.NotifyCount, 'subToC count after 1st trigger.'); Assert.AreEqual(1, subToC.NotifyCount, 'subToC count after 1st trigger.');
// 2. Reset A (B and C remain dirty) // 2. Reset A (B and C remain dirty)
flagA.Reset; flagA.Reset;
Assert.IsFalse(flagA.State.IsSet, 'A is clean.'); Assert.IsFalse(flagA.State.IsSet, 'A is clean.');
Assert.IsTrue(flagB.State.IsSet, 'B remains dirty.'); Assert.IsTrue(flagB.State.IsSet, 'B remains dirty.');
Assert.IsTrue(flagC.State.IsSet, 'C remains dirty.'); Assert.IsTrue(flagC.State.IsSet, 'C remains dirty.');
// 3. Trigger A again // 3. Trigger A again
flagA.Notify; // A (was clean) becomes dirty. A notifies B. 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.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. // 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(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(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.IsTrue(flagC.State.IsSet, 'C is still dirty.');
Assert.AreEqual(1, subToC.NotifyCount, 'subToC count should remain 1.'); Assert.AreEqual(1, subToC.NotifyCount, 'subToC count should remain 1.');
end; end;
initialization initialization
TDUnitX.RegisterTestFixture(TTestMycDirtyFlag); TDUnitX.RegisterTestFixture(TTestMycDirtyFlag);
end. end.
Test/TestSignals_Latch.pas
+322 -306
View File
@@ -4,87 +4,87 @@ unit TestSignals_Latch;
interface interface
uses uses
DUnitX.TestFramework, DUnitX.TestFramework,
System.SysUtils, System.SysUtils,
Myc.Signals; // Unit under test, using TMycLatch static members Myc.Signals; // Unit under test, using TMycLatch static members
type type
// Helper class to mock a subscriber. // Helper class to mock a subscriber.
TMockSubscriber = class(TInterfacedObject, IMycSubscriber) TMockSubscriber = class(TInterfacedObject, IMycSubscriber)
public public
NotifyCount: Integer; NotifyCount: Integer;
NotifyShouldReturn: Boolean; // Determines what this mock's Notify method returns NotifyShouldReturn: Boolean; // Determines what this mock's Notify method returns
WasCalled: Boolean; WasCalled: Boolean;
constructor Create(AShouldReturn: Boolean = True); // Parameter name AShouldReturn for clarity constructor Create(AShouldReturn: Boolean = True); // Parameter name AShouldReturn for clarity
function Notify: Boolean; // IMycSubscriber implementation. function Notify: Boolean; // IMycSubscriber implementation.
end; end;
[TestFixture] [TestFixture]
TTestMycLatch = class(TObject) TTestMycLatch = class(TObject)
public public
[Setup] [Setup]
procedure Setup; procedure Setup;
[TearDown] [TearDown]
procedure TearDown; procedure TearDown;
// --- Category 1: Basic Counter and State Functionality (Parameterized) --- // --- Category 1: Basic Counter and State Functionality (Parameterized) ---
[TestCase('InitialPositive', '1,False')] [TestCase('InitialPositive', '1,False')]
[TestCase('InitialZero_ReturnsNullLatch', '0,True')] [TestCase('InitialZero_ReturnsNullLatch', '0,True')]
[TestCase('InitialNegative_ReturnsNullLatch', '-1,True')] [TestCase('InitialNegative_ReturnsNullLatch', '-1,True')]
[TestCase('InitialLargePositive', '5,False')] [TestCase('InitialLargePositive', '5,False')]
procedure TestCreate_InitialState(InitialCount: Integer; ExpectedIsSet: Boolean); procedure TestCreate_InitialState(InitialCount: Integer; ExpectedIsSet: Boolean);
[TestCase('DecrementPositiveToZero', '1,False,True')] // InitialCount, ExpectedReturnFromLatchNotify, ExpectedIsSetAfterNotify [TestCase('DecrementPositiveToZero', '1,False,True')] // InitialCount, ExpectedReturnFromLatchNotify, ExpectedIsSetAfterNotify
[TestCase('DecrementPositiveToPositive', '2,True,False')] [TestCase('DecrementPositiveToPositive', '2,True,False')]
[TestCase('DecrementZeroToNegative', '0,False,True')] // Latch.Notify on count 0 returns false (0 > 0 is false) [TestCase('DecrementZeroToNegative', '0,False,True')] // Latch.Notify on count 0 returns false (0 > 0 is false)
[TestCase('DecrementNegativeToNegative', '-1,False,True')] // Latch.Notify on count -1 returns false (-1 > 0 is false) [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); procedure TestNotify_ReturnValueAndState_AfterOneNotify(InitialCount: Integer; ExpectedReturn: Boolean; ExpectedIsSet: Boolean);
[Test] [Test]
procedure TestNotify_DecrementsCounter_StateChanges; procedure TestNotify_DecrementsCounter_StateChanges;
[Test] [Test]
procedure TestNotify_MultipleNotifies_CounterBecomesNegativeAndStaysSet; procedure TestNotify_MultipleNotifies_CounterBecomesNegativeAndStaysSet;
// --- Category 2: Notification to Subscribers --- // --- Category 2: Notification to Subscribers ---
[Test] [Test]
procedure TestSubscriber_Single_IsNotifiedWhenLatchSet; procedure TestSubscriber_Single_IsNotifiedWhenLatchSet;
[Test] [Test]
procedure TestSubscriber_Multiple_AreNotifiedWhenLatchSet; procedure TestSubscriber_Multiple_AreNotifiedWhenLatchSet;
[Test] [Test]
procedure TestSubscriber_NotNotified_BeforeLatchSet; procedure TestSubscriber_NotNotified_BeforeLatchSet;
[Test] [Test]
procedure TestSubscriber_NotifiedOnlyOnce_AfterLatchSetAndUnadvised; // Clarified name procedure TestSubscriber_NotifiedOnlyOnce_AfterLatchSetAndUnadvised; // Clarified name
[Test] [Test]
procedure TestSubscribe_ToAlreadySetLatch_NotifiesImmediately; procedure TestSubscribe_ToAlreadySetLatch_NotifiesImmediately;
// --- Category 3: Chaining and Cascading Latches --- // --- Category 3: Chaining and Cascading Latches ---
[Test] [Test]
procedure TestChaining_A_Notifies_B; procedure TestChaining_A_Notifies_B;
[Test] [Test]
procedure TestCascade_A_Notifies_B_Notifies_C; procedure TestCascade_A_Notifies_B_Notifies_C;
[Test] [Test]
procedure TestChaining_B_NeedsMultipleNotifiesFromA_WithSubscriberOnB; procedure TestChaining_B_NeedsMultipleNotifiesFromA_WithSubscriberOnB;
// --- Category 4: Special Cases --- // --- Category 4: Special Cases ---
[Test] [Test]
procedure TestInitiallySetLatch_NotifiesNewSubscriberImmediately; // Using CreateLatch(0) procedure TestInitiallySetLatch_NotifiesNewSubscriberImmediately; // Using CreateLatch(0)
[Test] [Test]
procedure TestUnsubscribe_SubscriberNotNotified; procedure TestUnsubscribe_SubscriberNotNotified;
// --- Category 5: Counter Integrity / State for Later Subscribers --- // --- Category 5: Counter Integrity / State for Later Subscribers ---
[Test] [Test]
procedure TestMultipleTriggersNoSubscriber_StateCorrectForLaterSubscriber; procedure TestMultipleTriggersNoSubscriber_StateCorrectForLaterSubscriber;
// --- Category 6: UnadviseAll Behavior on Latch Set --- // --- Category 6: UnadviseAll Behavior on Latch Set ---
[Test] [Test]
procedure TestLatchSet_ClearsSubscribers_NoFurtherNotification; procedure TestLatchSet_ClearsSubscribers_NoFurtherNotification;
[Test] [Test]
procedure TestLatchSet_SubscriptionFinalize_IsSafePostUnadviseAll; procedure TestLatchSet_SubscriptionFinalize_IsSafePostUnadviseAll;
[Test] [Test]
procedure TestLatchSet_NewSubscriberToSetLatch_NotifiedImmediatelyButNotPersistedForLatchNotify; procedure TestLatchSet_NewSubscriberToSetLatch_NotifiedImmediatelyButNotPersistedForLatchNotify;
end; end;
implementation implementation
@@ -92,409 +92,425 @@ implementation
constructor TMockSubscriber.Create(AShouldReturn: Boolean = True); constructor TMockSubscriber.Create(AShouldReturn: Boolean = True);
begin begin
inherited Create; inherited Create;
NotifyCount := 0; NotifyCount := 0;
NotifyShouldReturn := AShouldReturn; NotifyShouldReturn := AShouldReturn;
WasCalled := False; WasCalled := False;
end; end;
function TMockSubscriber.Notify: Boolean; function TMockSubscriber.Notify: Boolean;
begin begin
Inc(NotifyCount); Inc(NotifyCount);
WasCalled := True; WasCalled := True;
Result := NotifyShouldReturn; // This mock subscriber returns what it's configured to. Result := NotifyShouldReturn; // This mock subscriber returns what it's configured to.
end; end;
{ TTestMycLatch } { TTestMycLatch }
procedure TTestMycLatch.Setup; procedure TTestMycLatch.Setup;
begin begin
// Per-test setup code can go here (if any). // Per-test setup code can go here (if any).
end; end;
procedure TTestMycLatch.TearDown; procedure TTestMycLatch.TearDown;
begin begin
// Per-test teardown code can go here (if any). // Per-test teardown code can go here (if any).
end; end;
// --- Category 1: Basic Counter and State Functionality (Parameterized) --- // --- Category 1: Basic Counter and State Functionality (Parameterized) ---
procedure TTestMycLatch.TestCreate_InitialState(InitialCount: Integer; ExpectedIsSet: Boolean); procedure TTestMycLatch.TestCreate_InitialState(InitialCount: Integer; ExpectedIsSet: Boolean);
var var
latch: IMycLatch; latch: IMycLatch;
begin begin
// TMycLatch.CreateLatch returns TMycLatch.Null if InitialCount <= 0 // TMycLatch.CreateLatch returns TMycLatch.Null if InitialCount <= 0
latch := TLatch.Construct(InitialCount); latch := TLatch.Construct(InitialCount);
Assert.AreEqual(ExpectedIsSet, latch.State.IsSet, 'Latch initial IsSet state mismatch for count ' + IntToStr(InitialCount) + '.'); Assert.AreEqual(ExpectedIsSet, latch.State.IsSet, 'Latch initial IsSet state mismatch for count ' + IntToStr(InitialCount) + '.');
end; end;
procedure TTestMycLatch.TestNotify_ReturnValueAndState_AfterOneNotify(InitialCount: Integer; ExpectedReturn: Boolean; ExpectedIsSet: Boolean); procedure TTestMycLatch.TestNotify_ReturnValueAndState_AfterOneNotify(
InitialCount: Integer;
ExpectedReturn: Boolean;
ExpectedIsSet: Boolean
);
var var
latch: IMycLatch; latch: IMycLatch;
returnedValueFromNotify: Boolean; returnedValueFromNotify: Boolean;
begin begin
latch := TLatch.Construct(InitialCount); latch := TLatch.Construct(InitialCount);
returnedValueFromNotify := latch.Notify; // This is IMycLatch (as IMycSubscriber).Notify returnedValueFromNotify := latch.Notify; // This is IMycLatch (as IMycSubscriber).Notify
Assert.AreEqual(ExpectedReturn, returnedValueFromNotify, 'Unexpected return value from Latch.Notify call for initial count ' + IntToStr(InitialCount) + '.'); Assert.AreEqual(
Assert.AreEqual(ExpectedIsSet, latch.State.IsSet, 'Unexpected IsSet state after Latch.Notify call for initial count ' + IntToStr(InitialCount) + '.'); 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; end;
procedure TTestMycLatch.TestNotify_DecrementsCounter_StateChanges; procedure TTestMycLatch.TestNotify_DecrementsCounter_StateChanges;
var var
latch: IMycLatch; latch: IMycLatch;
begin begin
latch := TLatch.Construct(1); latch := TLatch.Construct(1);
Assert.IsFalse(latch.State.IsSet, 'Latch should initially not be set (Count=1).'); Assert.IsFalse(latch.State.IsSet, 'Latch should initially not be set (Count=1).');
latch.Notify; // Count becomes 0 latch.Notify; // Count becomes 0
Assert.IsTrue(latch.State.IsSet, 'Latch should be set after Notify (Count became 0).'); Assert.IsTrue(latch.State.IsSet, 'Latch should be set after Notify (Count became 0).');
end; end;
procedure TTestMycLatch.TestNotify_MultipleNotifies_CounterBecomesNegativeAndStaysSet; procedure TTestMycLatch.TestNotify_MultipleNotifies_CounterBecomesNegativeAndStaysSet;
var var
latch: IMycLatch; latch: IMycLatch;
begin begin
latch := TLatch.Construct(1); latch := TLatch.Construct(1);
latch.Notify; // Count becomes 0, IsSet = True latch.Notify; // Count becomes 0, IsSet = True
Assert.IsTrue(latch.State.IsSet, 'Latch should be set after first Notify.'); Assert.IsTrue(latch.State.IsSet, 'Latch should be set after first Notify.');
latch.Notify; // Count becomes -1, IsSet should remain True latch.Notify; // Count becomes -1, IsSet should remain True
Assert.IsTrue(latch.State.IsSet, 'Latch should remain set after second Notify.'); Assert.IsTrue(latch.State.IsSet, 'Latch should remain set after second Notify.');
end; end;
// --- Category 2: Notification to Subscribers --- // --- Category 2: Notification to Subscribers ---
procedure TTestMycLatch.TestSubscriber_Single_IsNotifiedWhenLatchSet; procedure TTestMycLatch.TestSubscriber_Single_IsNotifiedWhenLatchSet;
var var
latch: IMycLatch; latch: IMycLatch;
mockSub: TMockSubscriber; mockSub: TMockSubscriber;
subscription: TState.TSubscription; subscription: TState.TSubscription;
begin begin
latch := TLatch.Construct(1); latch := TLatch.Construct(1);
mockSub := TMockSubscriber.Create; mockSub := TMockSubscriber.Create;
subscription := latch.State.Subscribe(mockSub); // Subscribing to the Latch's state subscription := latch.State.Subscribe(mockSub); // Subscribing to the Latch's state
Assert.IsFalse(latch.State.IsSet, 'Latch should initially not be set.'); Assert.IsFalse(latch.State.IsSet, 'Latch should initially not be set.');
Assert.AreEqual(0, mockSub.NotifyCount, 'MockSub should not have been notified yet (before latch set).'); Assert.AreEqual(0, mockSub.NotifyCount, 'MockSub should not have been notified yet (before latch set).');
latch.Notify; // Latch becomes set, notifies subscribers latch.Notify; // Latch becomes set, notifies subscribers
Assert.IsTrue(latch.State.IsSet, 'Latch should be set after its Notify is called.'); Assert.IsTrue(latch.State.IsSet, 'Latch should be set after its Notify is called.');
Assert.AreEqual(1, mockSub.NotifyCount, 'MockSub should have been notified once when latch becomes set.'); Assert.AreEqual(1, mockSub.NotifyCount, 'MockSub should have been notified once when latch becomes set.');
end; end;
procedure TTestMycLatch.TestSubscriber_Multiple_AreNotifiedWhenLatchSet; procedure TTestMycLatch.TestSubscriber_Multiple_AreNotifiedWhenLatchSet;
var var
latch: IMycLatch; latch: IMycLatch;
mockSub1, mockSub2, mockSub3: TMockSubscriber; mockSub1, mockSub2, mockSub3: TMockSubscriber;
sub1, sub2, sub3: TState.TSubscription; // Keep subscriptions in scope sub1, sub2, sub3: TState.TSubscription; // Keep subscriptions in scope
begin begin
latch := TLatch.Construct(1); latch := TLatch.Construct(1);
mockSub1 := TMockSubscriber.Create; mockSub1 := TMockSubscriber.Create;
mockSub2 := TMockSubscriber.Create; mockSub2 := TMockSubscriber.Create;
mockSub3 := TMockSubscriber.Create; mockSub3 := TMockSubscriber.Create;
sub1 := latch.State.Subscribe(mockSub1); sub1 := latch.State.Subscribe(mockSub1);
sub2 := latch.State.Subscribe(mockSub2); sub2 := latch.State.Subscribe(mockSub2);
sub3 := latch.State.Subscribe(mockSub3); sub3 := latch.State.Subscribe(mockSub3);
latch.Notify; // Latch becomes set latch.Notify; // Latch becomes set
Assert.AreEqual(1, mockSub1.NotifyCount, 'MockSub1 notification count mismatch.'); Assert.AreEqual(1, mockSub1.NotifyCount, 'MockSub1 notification count mismatch.');
Assert.AreEqual(1, mockSub2.NotifyCount, 'MockSub2 notification count mismatch.'); Assert.AreEqual(1, mockSub2.NotifyCount, 'MockSub2 notification count mismatch.');
Assert.AreEqual(1, mockSub3.NotifyCount, 'MockSub3 notification count mismatch.'); Assert.AreEqual(1, mockSub3.NotifyCount, 'MockSub3 notification count mismatch.');
end; end;
procedure TTestMycLatch.TestSubscriber_NotNotified_BeforeLatchSet; procedure TTestMycLatch.TestSubscriber_NotNotified_BeforeLatchSet;
var var
latch: IMycLatch; latch: IMycLatch;
mockSub: TMockSubscriber; mockSub: TMockSubscriber;
subscription: TState.TSubscription; subscription: TState.TSubscription;
begin begin
latch := TLatch.Construct(2); // Count = 2 latch := TLatch.Construct(2); // Count = 2
mockSub := TMockSubscriber.Create; mockSub := TMockSubscriber.Create;
subscription := latch.State.Subscribe(mockSub); subscription := latch.State.Subscribe(mockSub);
Assert.AreEqual(0, mockSub.NotifyCount, 'MockSub should not be notified upon subscription if latch is not set.'); Assert.AreEqual(0, mockSub.NotifyCount, 'MockSub should not be notified upon subscription if latch is not set.');
latch.Notify; // Count becomes 1, still not set latch.Notify; // Count becomes 1, still not set
Assert.AreEqual(0, mockSub.NotifyCount, 'MockSub should still not be notified as latch is not yet set (Count=1).'); Assert.AreEqual(0, mockSub.NotifyCount, 'MockSub should still not be notified as latch is not yet set (Count=1).');
end; end;
procedure TTestMycLatch.TestSubscriber_NotifiedOnlyOnce_AfterLatchSetAndUnadvised; procedure TTestMycLatch.TestSubscriber_NotifiedOnlyOnce_AfterLatchSetAndUnadvised;
var var
latch: IMycLatch; latch: IMycLatch;
mockSub: TMockSubscriber; mockSub: TMockSubscriber;
subscription: TState.TSubscription; subscription: TState.TSubscription;
begin begin
latch := TLatch.Construct(1); latch := TLatch.Construct(1);
mockSub := TMockSubscriber.Create; mockSub := TMockSubscriber.Create;
subscription := latch.State.Subscribe(mockSub); subscription := latch.State.Subscribe(mockSub);
latch.Notify; // Sets latch, notifies MockSub. Subscribers are then unadvised by UnadviseAll. 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.'); Assert.AreEqual(1, mockSub.NotifyCount, 'MockSub notify count should be 1 after latch set.');
latch.Notify; // Call Notify on latch again (FCount becomes more negative). 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).'); Assert.AreEqual(1, mockSub.NotifyCount, 'MockSub notify count should remain 1 (not notified again as it was unadvised).');
end; end;
procedure TTestMycLatch.TestSubscribe_ToAlreadySetLatch_NotifiesImmediately; procedure TTestMycLatch.TestSubscribe_ToAlreadySetLatch_NotifiesImmediately;
var var
latch: IMycLatch; latch: IMycLatch;
mockSub1, mockSub2: TMockSubscriber; mockSub1, mockSub2: TMockSubscriber;
subscription1, subscription2: TState.TSubscription; subscription1, subscription2: TState.TSubscription;
begin begin
latch := TLatch.Construct(1); // Create with count 1 latch := TLatch.Construct(1); // Create with count 1
mockSub1 := TMockSubscriber.Create; mockSub1 := TMockSubscriber.Create;
subscription1 := latch.State.Subscribe(mockSub1); // Subscribe before set subscription1 := latch.State.Subscribe(mockSub1); // Subscribe before set
latch.Notify; // Latch becomes set. mockSub1 is notified. latch.Notify; // Latch becomes set. mockSub1 is notified.
Assert.IsTrue(latch.State.IsSet, 'Latch should be set after initial trigger.'); Assert.IsTrue(latch.State.IsSet, 'Latch should be set after initial trigger.');
Assert.AreEqual(1, mockSub1.NotifyCount, 'MockSub1 should have been notified once.'); Assert.AreEqual(1, mockSub1.NotifyCount, 'MockSub1 should have been notified once.');
// Attempt to subscribe mockSub2 after the latch is already set. // Attempt to subscribe mockSub2 after the latch is already set.
mockSub2 := TMockSubscriber.Create; mockSub2 := TMockSubscriber.Create;
subscription2 := latch.State.Subscribe(mockSub2); // TMycLatch.Subscribe (via TMycAbstractFlag) notifies immediately if already set. subscription2 := latch.State.Subscribe(mockSub2); // TMycLatch.Subscribe (via TMycAbstractFlag) notifies immediately if already set.
Assert.AreEqual(1, mockSub2.NotifyCount, 'MockSub2 should be notified immediately upon subscribing to an already set latch.'); Assert.AreEqual(1, mockSub2.NotifyCount, 'MockSub2 should be notified immediately upon subscribing to an already set latch.');
latch.Notify; // Call Notify on latch again (FCount becomes more negative). 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, 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).'); Assert.AreEqual(1, mockSub2.NotifyCount, 'MockSub2 notify count should remain 1 (was only notified on subscribe, not added to list).');
end; end;
// --- Category 3: Chaining and Cascading Latches --- // --- Category 3: Chaining and Cascading Latches ---
procedure TTestMycLatch.TestChaining_A_Notifies_B; procedure TTestMycLatch.TestChaining_A_Notifies_B;
var var
latchA, latchB: IMycLatch; latchA, latchB: IMycLatch;
mockSubForB: TMockSubscriber; mockSubForB: TMockSubscriber;
subHandle_B_listens_A, subHandle_Mock_listens_B: TState.TSubscription; subHandle_B_listens_A, subHandle_Mock_listens_B: TState.TSubscription;
begin begin
latchA := TLatch.Construct(1); latchA := TLatch.Construct(1);
latchB := TLatch.Construct(1); // latchB is an IMycSubscriber latchB := TLatch.Construct(1); // latchB is an IMycSubscriber
mockSubForB := TMockSubscriber.Create; mockSubForB := TMockSubscriber.Create;
subHandle_Mock_listens_B := latchB.State.Subscribe(mockSubForB); subHandle_Mock_listens_B := latchB.State.Subscribe(mockSubForB);
// LatchA's state is an IMycSignal. LatchB (as IMycSubscriber) subscribes to it. // LatchA's state is an IMycSignal. LatchB (as IMycSubscriber) subscribes to it.
subHandle_B_listens_A := latchA.State.Subscribe(latchB); subHandle_B_listens_A := latchA.State.Subscribe(latchB);
Assert.IsFalse(latchA.State.IsSet, 'LatchA initially not set.'); Assert.IsFalse(latchA.State.IsSet, 'LatchA initially not set.');
Assert.IsFalse(latchB.State.IsSet, 'LatchB initially not set.'); Assert.IsFalse(latchB.State.IsSet, 'LatchB initially not set.');
Assert.AreEqual(0, mockSubForB.NotifyCount, 'MockSubForB initially not notified.'); Assert.AreEqual(0, mockSubForB.NotifyCount, 'MockSubForB initially not notified.');
latchA.Notify; // Call Notify on LatchA (as IMycSubscriber) latchA.Notify; // Call Notify on LatchA (as IMycSubscriber)
Assert.IsTrue(latchA.State.IsSet, 'LatchA should be set after notify.'); Assert.IsTrue(latchA.State.IsSet, 'LatchA should be set after notify.');
Assert.IsTrue(latchB.State.IsSet, 'LatchB should be set after being notified by LatchA.'); Assert.IsTrue(latchB.State.IsSet, 'LatchB should be set after being notified by LatchA.');
Assert.AreEqual(1, mockSubForB.NotifyCount, 'MockSubForB should have been notified by LatchB.'); Assert.AreEqual(1, mockSubForB.NotifyCount, 'MockSubForB should have been notified by LatchB.');
end; end;
procedure TTestMycLatch.TestCascade_A_Notifies_B_Notifies_C; procedure TTestMycLatch.TestCascade_A_Notifies_B_Notifies_C;
var var
latchA, latchB, latchC: IMycLatch; latchA, latchB, latchC: IMycLatch;
mockSubForC: TMockSubscriber; mockSubForC: TMockSubscriber;
sub_Mock_C, sub_C_B, sub_B_A: TState.TSubscription; sub_Mock_C, sub_C_B, sub_B_A: TState.TSubscription;
begin begin
latchA := TLatch.Construct(1); latchA := TLatch.Construct(1);
latchB := TLatch.Construct(1); latchB := TLatch.Construct(1);
latchC := TLatch.Construct(1); latchC := TLatch.Construct(1);
mockSubForC := TMockSubscriber.Create; mockSubForC := TMockSubscriber.Create;
sub_Mock_C := latchC.State.Subscribe(mockSubForC); sub_Mock_C := latchC.State.Subscribe(mockSubForC);
sub_C_B := latchB.State.Subscribe(latchC); // LatchC subscribes to LatchB's state sub_C_B := latchB.State.Subscribe(latchC); // LatchC subscribes to LatchB's state
sub_B_A := latchA.State.Subscribe(latchB); // LatchB subscribes to LatchA's state sub_B_A := latchA.State.Subscribe(latchB); // LatchB subscribes to LatchA's state
latchA.Notify; // Call Notify on LatchA latchA.Notify; // Call Notify on LatchA
Assert.IsTrue(latchA.State.IsSet, 'LatchA state mismatch in cascade.'); Assert.IsTrue(latchA.State.IsSet, 'LatchA state mismatch in cascade.');
Assert.IsTrue(latchB.State.IsSet, 'LatchB state mismatch in cascade.'); Assert.IsTrue(latchB.State.IsSet, 'LatchB state mismatch in cascade.');
Assert.IsTrue(latchC.State.IsSet, 'LatchC state mismatch in cascade.'); Assert.IsTrue(latchC.State.IsSet, 'LatchC state mismatch in cascade.');
Assert.AreEqual(1, mockSubForC.NotifyCount, 'MockSubForC notification count mismatch in cascade.'); Assert.AreEqual(1, mockSubForC.NotifyCount, 'MockSubForC notification count mismatch in cascade.');
end; end;
procedure TTestMycLatch.TestChaining_B_NeedsMultipleNotifiesFromA_WithSubscriberOnB; procedure TTestMycLatch.TestChaining_B_NeedsMultipleNotifiesFromA_WithSubscriberOnB;
var var
latchA, latchB: IMycLatch; latchA, latchB: IMycLatch;
mockSubForB: TMockSubscriber; mockSubForB: TMockSubscriber;
sub_Mock_B, sub_B_A: TState.TSubscription; sub_Mock_B, sub_B_A: TState.TSubscription;
begin begin
// LatchA needs 2 notifies to become set. LatchB needs 1 notify to become set. // 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. // LatchB subscribes to LatchA. So LatchB will be notified once LatchA becomes set.
latchA := TLatch.Construct(2); latchA := TLatch.Construct(2);
latchB := TLatch.Construct(1); latchB := TLatch.Construct(1);
mockSubForB := TMockSubscriber.Create; mockSubForB := TMockSubscriber.Create;
sub_Mock_B := latchB.State.Subscribe(mockSubForB); sub_Mock_B := latchB.State.Subscribe(mockSubForB);
sub_B_A := latchA.State.Subscribe(latchB); sub_B_A := latchA.State.Subscribe(latchB);
latchA.Notify; // First notify for LatchA (count becomes 1) 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(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.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.'); Assert.AreEqual(0, mockSubForB.NotifyCount, 'MockSubForB should not have been notified yet.');
latchA.Notify; // Second notify for LatchA (count becomes 0, LatchA becomes set) latchA.Notify; // Second notify for LatchA (count becomes 0, LatchA becomes set)
Assert.IsTrue(latchA.State.IsSet, 'LatchA should be set after second notify.'); 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. // 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.IsTrue(latchB.State.IsSet, 'LatchB should now be set by LatchA.');
Assert.AreEqual(1, mockSubForB.NotifyCount, 'MockSubForB should have been notified by LatchB.'); Assert.AreEqual(1, mockSubForB.NotifyCount, 'MockSubForB should have been notified by LatchB.');
end; end;
// --- Category 4: Special Cases --- // --- Category 4: Special Cases ---
procedure TTestMycLatch.TestInitiallySetLatch_NotifiesNewSubscriberImmediately; procedure TTestMycLatch.TestInitiallySetLatch_NotifiesNewSubscriberImmediately;
var var
latch: IMycLatch; // Will be TMycLatch.Null latch: IMycLatch; // Will be TMycLatch.Null
mockSub: TMockSubscriber; mockSub: TMockSubscriber;
subscription: TState.TSubscription; subscription: TState.TSubscription;
begin begin
latch := TLatch.Construct(0); // Returns TMycLatch.Null which is set. latch := TLatch.Construct(0); // Returns TMycLatch.Null which is set.
mockSub := TMockSubscriber.Create; mockSub := TMockSubscriber.Create;
subscription := latch.State.Subscribe(mockSub); // TMycLatch.Subscribe notifies immediately if already set. subscription := latch.State.Subscribe(mockSub); // TMycLatch.Subscribe notifies immediately if already set.
Assert.IsTrue(latch.State.IsSet, 'Latch IsSet property mismatch (should be true for Null latch).'); Assert.IsTrue(latch.State.IsSet, 'Latch IsSet property mismatch (should be true for Null latch).');
Assert.AreEqual(1, mockSub.NotifyCount, 'MockSub should be notified immediately upon subscribing to an initially set latch.'); Assert.AreEqual(1, mockSub.NotifyCount, 'MockSub should be notified immediately upon subscribing to an initially set latch.');
end; end;
procedure TTestMycLatch.TestUnsubscribe_SubscriberNotNotified; procedure TTestMycLatch.TestUnsubscribe_SubscriberNotNotified;
var var
latch: IMycLatch; latch: IMycLatch;
mockSub: TMockSubscriber; mockSub: TMockSubscriber;
subscription: TState.TSubscription; subscription: TState.TSubscription;
begin begin
latch := TLatch.Construct(1); latch := TLatch.Construct(1);
mockSub := TMockSubscriber.Create; mockSub := TMockSubscriber.Create;
subscription := latch.State.Subscribe(mockSub); subscription := latch.State.Subscribe(mockSub);
subscription.Unsubscribe; // Explicitly call Unsubscribe on the record subscription.Unsubscribe; // Explicitly call Unsubscribe on the record
latch.Notify; // Latch becomes set latch.Notify; // Latch becomes set
Assert.AreEqual(0, mockSub.NotifyCount, 'Unsubscribed MockSub should not be notified.'); Assert.AreEqual(0, mockSub.NotifyCount, 'Unsubscribed MockSub should not be notified.');
end; end;
// --- Category 5: Counter Integrity / State for Later Subscribers --- // --- Category 5: Counter Integrity / State for Later Subscribers ---
procedure TTestMycLatch.TestMultipleTriggersNoSubscriber_StateCorrectForLaterSubscriber; procedure TTestMycLatch.TestMultipleTriggersNoSubscriber_StateCorrectForLaterSubscriber;
var var
latch: IMycLatch; latch: IMycLatch;
mockSub: TMockSubscriber; mockSub: TMockSubscriber;
subscription: TState.TSubscription; subscription: TState.TSubscription;
begin begin
latch := TLatch.Construct(3); latch := TLatch.Construct(3);
latch.Notify; // Count -> 2 latch.Notify; // Count -> 2
latch.Notify; // Count -> 1 latch.Notify; // Count -> 1
Assert.IsFalse(latch.State.IsSet, 'Latch should not be set yet after partial notifies.'); Assert.IsFalse(latch.State.IsSet, 'Latch should not be set yet after partial notifies.');
mockSub := TMockSubscriber.Create; mockSub := TMockSubscriber.Create;
subscription := latch.State.Subscribe(mockSub); subscription := latch.State.Subscribe(mockSub);
Assert.AreEqual(0, mockSub.NotifyCount, 'MockSub should not be notified on subscribe if latch not yet set.'); Assert.AreEqual(0, mockSub.NotifyCount, 'MockSub should not be notified on subscribe if latch not yet set.');
latch.Notify; // Count -> 0, Latch becomes set and notifies mockSub latch.Notify; // Count -> 0, Latch becomes set and notifies mockSub
Assert.IsTrue(latch.State.IsSet, 'Latch should now be set.'); Assert.IsTrue(latch.State.IsSet, 'Latch should now be set.');
Assert.AreEqual(1, mockSub.NotifyCount, 'MockSub should have been notified when latch becomes set.'); Assert.AreEqual(1, mockSub.NotifyCount, 'MockSub should have been notified when latch becomes set.');
end; end;
// --- Category 6: UnadviseAll Behavior on Latch Set --- // --- Category 6: UnadviseAll Behavior on Latch Set ---
procedure TTestMycLatch.TestLatchSet_ClearsSubscribers_NoFurtherNotification; procedure TTestMycLatch.TestLatchSet_ClearsSubscribers_NoFurtherNotification;
var var
latch: IMycLatch; latch: IMycLatch;
mockSub1, mockSub2: TMockSubscriber; mockSub1, mockSub2: TMockSubscriber;
subscription1, subscription2: TState.TSubscription; subscription1, subscription2: TState.TSubscription;
begin begin
latch := TLatch.Construct(1); latch := TLatch.Construct(1);
mockSub1 := TMockSubscriber.Create; mockSub1 := TMockSubscriber.Create;
mockSub2 := TMockSubscriber.Create; mockSub2 := TMockSubscriber.Create;
subscription1 := latch.State.Subscribe(mockSub1); subscription1 := latch.State.Subscribe(mockSub1);
subscription2 := latch.State.Subscribe(mockSub2); subscription2 := latch.State.Subscribe(mockSub2);
Assert.AreEqual(0, mockSub1.NotifyCount, 'MockSub1 initial NotifyCount should be 0.'); Assert.AreEqual(0, mockSub1.NotifyCount, 'MockSub1 initial NotifyCount should be 0.');
Assert.AreEqual(0, mockSub2.NotifyCount, 'MockSub2 initial NotifyCount should be 0.'); Assert.AreEqual(0, mockSub2.NotifyCount, 'MockSub2 initial NotifyCount should be 0.');
latch.Notify; // FCount becomes 0. Subscribers notified, then UnadviseAll called. latch.Notify; // FCount becomes 0. Subscribers notified, then UnadviseAll called.
Assert.IsTrue(latch.State.IsSet, 'Latch should be set.'); Assert.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, mockSub1.NotifyCount, 'MockSub1 should have been notified once when latch became set.');
Assert.AreEqual(1, mockSub2.NotifyCount, 'MockSub2 should have been notified once when latch became set.'); Assert.AreEqual(1, mockSub2.NotifyCount, 'MockSub2 should have been notified once when latch became set.');
latch.Notify; // Call Notify on the latch again (FCount becomes -1) latch.Notify; // Call Notify on the latch again (FCount becomes -1)
Assert.AreEqual(1, mockSub1.NotifyCount, 'MockSub1 should NOT be notified again after UnadviseAll.'); Assert.AreEqual(1, mockSub1.NotifyCount, 'MockSub1 should NOT be notified again after UnadviseAll.');
Assert.AreEqual(1, mockSub2.NotifyCount, 'MockSub2 should NOT be notified again after UnadviseAll.'); Assert.AreEqual(1, mockSub2.NotifyCount, 'MockSub2 should NOT be notified again after UnadviseAll.');
end; end;
procedure TTestMycLatch.TestLatchSet_SubscriptionFinalize_IsSafePostUnadviseAll; procedure TTestMycLatch.TestLatchSet_SubscriptionFinalize_IsSafePostUnadviseAll;
var var
latch: IMycLatch; latch: IMycLatch;
mockSub: TMockSubscriber; mockSub: TMockSubscriber;
// 'subscription' will be declared in an inner scope to control its finalization // 'subscription' will be declared in an inner scope to control its finalization
begin begin
latch := TLatch.Construct(1); latch := TLatch.Construct(1);
mockSub := TMockSubscriber.Create; mockSub := TMockSubscriber.Create;
var noException: Boolean := True; var noException: Boolean := True;
try try
begin // Inner block to control lifetime of 'subscription' begin // Inner block to control lifetime of 'subscription'
var subscription: TState.TSubscription; // Local to this block var subscription: TState.TSubscription; // Local to this block
subscription := latch.State.Subscribe(mockSub); subscription := latch.State.Subscribe(mockSub);
latch.Notify; // Sets the latch, mockSub is notified, UnadviseAll is called internally. latch.Notify; // Sets the latch, mockSub is notified, UnadviseAll is called internally.
Assert.AreEqual(1, mockSub.NotifyCount, 'MockSub was notified when latch set.'); 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, // 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. // its Finalize operator will be called, which in turn calls subscription.Unsubscribe.
// This happens *after* UnadviseAll was triggered by latch.Notify. // This happens *after* UnadviseAll was triggered by latch.Notify.
end; // <-- subscription.Finalize (and thus Unsubscribe) is called here. end; // <-- subscription.Finalize (and thus Unsubscribe) is called here.
except except
on E: Exception do on E: Exception do
begin begin
noException := False; noException := False;
// Optional: Log.Error('Exception in TestLatchSet_SubscriptionFinalize_IsSafePostUnadviseAll: ' + E.Message); // Optional: Log.Error('Exception in TestLatchSet_SubscriptionFinalize_IsSafePostUnadviseAll: ' + E.Message);
end;
end; end;
end; Assert.IsTrue(noException, 'Finalizing subscription after Latch set (and UnadviseAll) should not raise an exception.');
Assert.IsTrue(noException, 'Finalizing subscription after Latch set (and UnadviseAll) should not raise an exception.');
// Further check: calling Notify on latch again should not affect the original mockSub // Further check: calling Notify on latch again should not affect the original mockSub
latch.Notify; latch.Notify;
Assert.AreEqual(1, mockSub.NotifyCount, 'MockSub should not be notified after its subscription was finalized post UnadviseAll.'); Assert.AreEqual(1, mockSub.NotifyCount, 'MockSub should not be notified after its subscription was finalized post UnadviseAll.');
end; end;
procedure TTestMycLatch.TestLatchSet_NewSubscriberToSetLatch_NotifiedImmediatelyButNotPersistedForLatchNotify; procedure TTestMycLatch.TestLatchSet_NewSubscriberToSetLatch_NotifiedImmediatelyButNotPersistedForLatchNotify;
var var
latch: IMycLatch; latch: IMycLatch;
mockSubInitial, mockSubNew: TMockSubscriber; mockSubInitial, mockSubNew: TMockSubscriber;
subscriptionInitial, subscriptionNew: TState.TSubscription; subscriptionInitial, subscriptionNew: TState.TSubscription;
begin begin
latch := TLatch.Construct(1); latch := TLatch.Construct(1);
mockSubInitial := TMockSubscriber.Create; mockSubInitial := TMockSubscriber.Create;
subscriptionInitial := latch.State.Subscribe(mockSubInitial); subscriptionInitial := latch.State.Subscribe(mockSubInitial);
// Set the latch; mockSubInitial is notified, UnadviseAll is called. // Set the latch; mockSubInitial is notified, UnadviseAll is called.
latch.Notify; latch.Notify;
Assert.AreEqual(1, mockSubInitial.NotifyCount, 'Initial subscriber notified.'); Assert.AreEqual(1, mockSubInitial.NotifyCount, 'Initial subscriber notified.');
// Subscribe a new subscriber to the already set latch // Subscribe a new subscriber to the already set latch
mockSubNew := TMockSubscriber.Create; mockSubNew := TMockSubscriber.Create;
subscriptionNew := latch.State.Subscribe(mockSubNew); subscriptionNew := latch.State.Subscribe(mockSubNew);
// New subscriber should be notified immediately upon subscription to an already set latch // 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.'); 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 direct check of subscriptionNew.FTag was removed as FTag is private.
// The correct behavior (no persistent subscription) is verified by the next step. // The correct behavior (no persistent subscription) is verified by the next step.
// Call Notify on the latch again. // Call Notify on the latch again.
latch.Notify; latch.Notify;
// mockSubInitial should not be notified again (was unadvised). // mockSubInitial should not be notified again (was unadvised).
Assert.AreEqual(1, mockSubInitial.NotifyCount, 'Initial subscriber (unadvised) not notified again.'); Assert.AreEqual(1, mockSubInitial.NotifyCount, 'Initial subscriber (unadvised) not notified again.');
// mockSubNew should also not be notified again, as it was only notified immediately // mockSubNew should also not be notified again, as it was only notified immediately
// and not persistently added to FSubscribers for subsequent Latch.Notify calls. // 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.'); Assert.AreEqual(
1,
mockSubNew.NotifyCount,
'New subscriber (notified once on subscribe) not notified by subsequent Latch.Notify calls.'
);
end; end;
initialization initialization
TDUnitX.RegisterTestFixture(TTestMycLatch); TDUnitX.RegisterTestFixture(TTestMycLatch);
end. end.
Test/TestTasks.pas
+54 -56
View File
@@ -8,7 +8,8 @@ uses
System.Classes, System.Classes,
System.SyncObjs, System.SyncObjs,
Myc.Core.Tasks, Myc.Core.Tasks,
Myc.Signals, Myc.Core.Signals, Myc.Signals,
Myc.Core.Signals,
Myc.Core.Atomic; Myc.Core.Atomic;
type type
@@ -73,10 +74,7 @@ var
procWrapper: TProc; procWrapper: TProc;
begin begin
executed := False; executed := False;
procWrapper := procedure procWrapper := procedure begin executed := True; end;
begin
executed := True;
end;
threadState := FFactory.CreateThread(procWrapper); // CreateThread in TaskFactory now uses TMycLatch.CreateLatch threadState := FFactory.CreateThread(procWrapper); // CreateThread in TaskFactory now uses TMycLatch.CreateLatch
Assert.IsNotNull(threadState, 'CreateThread should return a valid state object'); Assert.IsNotNull(threadState, 'CreateThread should return a valid state object');
@@ -93,12 +91,14 @@ begin
jobExecuted := False; jobExecuted := False;
jobCompletedLatch := TLatch.Construct(1); // Changed from Signals.CreateLatch jobCompletedLatch := TLatch.Construct(1); // Changed from Signals.CreateLatch
FFactory.Run( FFactory
procedure .Run(
begin procedure
jobExecuted := True; begin
jobCompletedLatch.Notify; jobExecuted := True;
end).Notify; jobCompletedLatch.Notify;
end)
.Notify;
FFactory.WaitFor(jobCompletedLatch.State); FFactory.WaitFor(jobCompletedLatch.State);
Assert.IsTrue(jobExecuted, 'Immediate job should have executed'); Assert.IsTrue(jobExecuted, 'Immediate job should have executed');
@@ -113,12 +113,14 @@ begin
jobExecuted := False; jobExecuted := False;
jobCompletedLatch := TLatch.Construct(1); // Changed from Signals.CreateLatch jobCompletedLatch := TLatch.Construct(1); // Changed from Signals.CreateLatch
subscriber := FFactory.Run( subscriber :=
procedure FFactory.Run(
begin procedure
jobExecuted := True; begin
jobCompletedLatch.Notify; jobExecuted := True;
end); jobCompletedLatch.Notify;
end
);
Assert.IsNotNull(subscriber, 'Run should return a subscriber for delayed job'); Assert.IsNotNull(subscriber, 'Run should return a subscriber for delayed job');
// Use TMycLatch.Null for comparison // Use TMycLatch.Null for comparison
@@ -130,7 +132,6 @@ begin
Assert.IsTrue(jobExecuted, 'Delayed job should execute after all notifications'); Assert.IsTrue(jobExecuted, 'Delayed job should execute after all notifications');
end; end;
procedure TMycTaskFactoryTests.TestWaitForAlreadySetState; procedure TMycTaskFactoryTests.TestWaitForAlreadySetState;
var var
alreadySetLatch: IMycLatch; alreadySetLatch: IMycLatch;
@@ -161,12 +162,13 @@ begin
Assert.IsFalse(FFactory.InWorkerThread, 'Test method itself should not be in a factory worker thread'); Assert.IsFalse(FFactory.InWorkerThread, 'Test method itself should not be in a factory worker thread');
FFactory.EnqueueJob( FFactory.EnqueueJob(
procedure procedure
begin begin
inMainThreadInJob := FFactory.InMainThread; inMainThreadInJob := FFactory.InMainThread;
inWorkerThreadInJob := FFactory.InWorkerThread; inWorkerThreadInJob := FFactory.InWorkerThread;
jobDoneLatch.Notify; jobDoneLatch.Notify;
end); end
);
FFactory.WaitFor(jobDoneLatch.State); FFactory.WaitFor(jobDoneLatch.State);
@@ -181,22 +183,20 @@ begin
jobDoneLatch := TLatch.Construct(1); jobDoneLatch := TLatch.Construct(1);
FFactory.EnqueueJob( FFactory.EnqueueJob(
procedure procedure
begin begin
try try
raise TMycTaskFactory.ETaskException.Create('Test Exception From Job'); raise TMycTaskFactory.ETaskException.Create('Test Exception From Job');
finally finally
jobDoneLatch.Notify; jobDoneLatch.Notify;
end; end;
end); end
);
Assert.WillRaise( Assert.WillRaise(
procedure procedure begin FFactory.WaitFor(jobDoneLatch.State); end,
begin TMycTaskFactory.ETaskException,
FFactory.WaitFor(jobDoneLatch.State); 'WaitFor should re-raise the exception from the job'
end,
TMycTaskFactory.ETaskException,
'WaitFor should re-raise the exception from the job'
); );
var noExceptionRaised: Boolean := True; var noExceptionRaised: Boolean := True;
@@ -213,12 +213,9 @@ begin
FFactory.Teardown; FFactory.Teardown;
Assert.WillRaise( Assert.WillRaise(
procedure procedure begin FFactory.EnqueueJob(procedure begin end); end,
begin TMycTaskFactory.ETaskException,
FFactory.EnqueueJob(procedure begin end); 'Running a job on a torn-down factory should raise ETaskException'
end,
TMycTaskFactory.ETaskException,
'Running a job on a torn-down factory should raise ETaskException'
); );
end; end;
@@ -233,18 +230,19 @@ begin
dummyStateToWaitFor := TLatch.Construct(1).State; dummyStateToWaitFor := TLatch.Construct(1).State;
FFactory.EnqueueJob( FFactory.EnqueueJob(
procedure procedure
begin begin
try try
FFactory.WaitFor(dummyStateToWaitFor); FFactory.WaitFor(dummyStateToWaitFor);
except except
on E: TMycTaskFactory.ETaskException do on E: TMycTaskFactory.ETaskException do
begin begin
exceptionCaughtInJob := True; exceptionCaughtInJob := True;
end; end;
end; end;
jobDoneLatch.Notify; jobDoneLatch.Notify;
end); end
);
FFactory.WaitFor(jobDoneLatch.State); FFactory.WaitFor(jobDoneLatch.State);
Assert.IsTrue(exceptionCaughtInJob, 'WaitFor called within a worker thread job should raise ETaskException'); Assert.IsTrue(exceptionCaughtInJob, 'WaitFor called within a worker thread job should raise ETaskException');