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}
uses
{$ifndef NO_FASTMM}
{$ifndef NO_FASTMM}
FastMM5,
{$endif}
{$endif}
Winapi.Windows;
type
@@ -33,15 +33,16 @@ type
end;
TMycAtomicStack<T> = record
private type
PItem = ^TItem;
TItem = packed record
Next: TSListEntry;
Data: T;
end;
private
type
PItem = ^TItem;
TItem = packed record
Next: TSListEntry;
Data: T;
end;
var
FSList: PSList;
var
FSList: PSList;
public
// Initializes the atomic stack, creating the underlying SList.
@@ -212,7 +213,7 @@ begin
begin
item.Data := Default(T);
FreeMemAligned(item); // Global procedure
item := PopPtr; // Call instance method PopPtr via Dest
item := PopPtr; // Call instance method PopPtr via Dest
end;
end;
Src/Myc.Core.Futures.pas
+29 -25
View File
@@ -4,22 +4,24 @@ interface
uses
System.SysUtils,
Myc.Signals, Myc.TaskManager, Myc.Futures;
Myc.Signals,
Myc.TaskManager,
Myc.Futures;
type
TMycFuture<T> = class abstract( TInterfacedObject, IMycFuture<T> )
TMycFuture<T> = class abstract(TInterfacedObject, IMycFuture<T>)
protected
function GetResult: T; virtual; abstract;
function GetDone: TState; virtual; abstract;
end;
TMycNullFuture<T> = class( TMycFuture<T> )
TMycNullFuture<T> = class(TMycFuture<T>)
protected
function GetResult: T; override;
function GetDone: TState; override;
end;
TMycGateFuncFuture<T> = class( TMycFuture<T> )
TMycGateFuncFuture<T> = class(TMycFuture<T>)
private
FInit: TState.TSubscription;
FDone: IMycLatch;
@@ -28,7 +30,7 @@ type
function GetResult: T; override;
function GetDone: TState; override;
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;
end;
@@ -43,39 +45,41 @@ end;
function TMycNullFuture<T>.GetResult: T;
begin
Result := Default ( T );
Result := Default(T);
end;
{ 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
inherited Create;
FDone := TLatch.Construct( 1 );
FDone := TLatch.Construct(1);
// Subscribe the job execution to AGate.
// The job will run when AGate notifies the subscriber returned by Run.
FInit := ATaskManager.CreateTask(
AGate,
procedure
begin
try
try
Self.FResult := AProc( );
except
Self.FResult := Default ( T ); // Set result to Default(T) on error
raise; // Re-raise for TaskFactory to handle
end;
finally
Self.FDone.Notify; // Signal that this future is done (successfully or with error)
end;
end );
FInit :=
ATaskManager.CreateTask(
AGate,
procedure
begin
try
try
Self.FResult := AProc();
except
Self.FResult := Default(T); // Set result to Default(T) on error
raise; // Re-raise for TaskFactory to handle
end;
finally
Self.FDone.Notify; // Signal that this future is done (successfully or with error)
end;
end
);
end;
destructor TMycGateFuncFuture<T>.Destroy;
begin
Assert( FDone.State.IsSet );
Assert(FDone.State.IsSet);
FInit.Unsubscribe;
inherited Destroy;
@@ -88,7 +92,7 @@ end;
function TMycGateFuncFuture<T>.GetResult: T;
begin
Assert( FDone.State.IsSet, 'Result is not yet available.' );
Assert(FDone.State.IsSet, 'Result is not yet available.');
Result := FResult;
end;
Src/Myc.Core.Lazy.pas
+11 -11
View File
@@ -8,21 +8,21 @@ uses
Myc.Lazy;
type
TMycLazy<T> = class abstract( TInterfacedObject, IMycLazy<T> )
TMycLazy<T> = class abstract(TInterfacedObject, IMycLazy<T>)
protected
function GetChanged: IMycState; virtual; abstract;
public
function Pop( out Res: T ): Boolean; virtual; abstract;
function Pop(out Res: T): Boolean; virtual; abstract;
end;
TMycNullLazy<T> = class( TMycLazy<T> )
TMycNullLazy<T> = class(TMycLazy<T>)
protected
function GetChanged: IMycState; override;
public
function Pop( out Res: T ): Boolean; override;
function Pop(out Res: T): Boolean; override;
end;
TMycFuncLazy<T> = class( TMycLazy<T> )
TMycFuncLazy<T> = class(TMycLazy<T>)
private
FChanged: IMycDirty;
FChangeState: TState.TSubscription;
@@ -32,7 +32,7 @@ type
public
constructor Create(const AChanged: TState; const AProc: TFunc<T>);
destructor Destroy; override;
function Pop( out Res: T ): Boolean; override;
function Pop(out Res: T): Boolean; override;
end;
implementation
@@ -44,9 +44,9 @@ begin
Result := TState.Null;
end;
function TMycNullLazy<T>.Pop( out Res: T ): Boolean;
function TMycNullLazy<T>.Pop(out Res: T): Boolean;
begin
Res := Default ( T );
Res := Default(T);
Result := true;
end;
@@ -57,7 +57,7 @@ begin
inherited Create;
FChanged := TDirty.Construct;
FProc := AProc;
FChangeState := AChanged.Subscribe( FChanged );
FChangeState := AChanged.Subscribe(FChanged);
end;
destructor TMycFuncLazy<T>.Destroy;
@@ -71,12 +71,12 @@ begin
Result := FChanged.State;
end;
function TMycFuncLazy<T>.Pop( out Res: T ): Boolean;
function TMycFuncLazy<T>.Pop(out Res: T): Boolean;
begin
Result := FChanged.State.IsSet;
if Result then
begin
if Assigned( FProc ) then
if Assigned(FProc) then
Res := FProc;
FChanged.Reset;
end;
Src/Myc.Core.Notifier.pas
+53 -50
View File
@@ -3,7 +3,8 @@ unit Myc.Core.Notifier;
interface
uses
System.SysUtils, System.SyncObjs;
System.SysUtils,
System.SyncObjs;
type
// Low-level implementation for thread-safe multicast events.
@@ -13,35 +14,37 @@ type
// `UnadviseAll` removes all registered interfaces.
// After `Finalize` is called, the list is cleared, and no new interfaces can be added (closed state).
TMycNotifyList<T: IInterface> = record
type
TTag = Pointer; // Opaque tag used to identify a registered receiver for unsubscription.
type
TTag = Pointer; // Opaque tag used to identify a registered receiver for unsubscription.
PItem = ^TItem; // Pointer to an internal list item.
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.
Receiver: T; // The registered interface instance (the event sink).
end;
PItem = ^TItem; // Pointer to an internal list item.
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.
Receiver: T; // The registered interface instance (the event sink).
end;
strict private
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 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.
FList: PItem; // Head of the linked list for additional receivers beyond the first one.
// Bit 0: Lock state (0 = locked, 1 = unlocked).
// 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.
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 procedure FreeItem( Item: PItem ); static; inline; // Frees memory previously allocated for a 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.
public
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 Create; // Initializes the notification list, preparing it for use.
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.
procedure Unadvise(Tag: TTag); // Unregisters a specific receiver using the tag obtained from Advise.
procedure UnadviseAll; // Unregisters all currently advised receivers.
procedure Lock; inline; // Acquires an exclusive lock for thread-safe operations on the list.
procedure Release; inline;// Releases the previously acquired exclusive lock.
procedure UnadviseAll; // Unregisters all currently advised receivers.
procedure Lock; inline; // Acquires an exclusive lock for thread-safe operations on the list.
procedure Release; inline; // Releases the previously acquired exclusive lock.
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;
implementation
@@ -56,7 +59,7 @@ procedure TMycNotifyList<T>.Destroy;
begin
// Because refcounting is thread-safe, this will always be entered once after all references
// to Self are dropped. No locking needed!
Assert( not IsLocked );
Assert(not IsLocked);
FFirst := FFirst and not 3;
UnadviseAll;
end;
@@ -65,24 +68,24 @@ function TMycNotifyList<T>.Advise(const Receiver: T): TTag;
var
Item: PItem;
begin
Assert( IsLocked );
Assert(IsLocked);
if FFirst=0 then
if FFirst = 0 then
begin
IInterface( FFirst ) := Receiver;
exit( PPointer(@Receiver)^ );
IInterface(FFirst) := Receiver;
exit(PPointer(@Receiver)^);
end;
Item := AllocItem;
Item.Receiver := Receiver;
Item.Prev := nil;
Item.Next := FList;
if Item.Next<>nil then
if Item.Next <> nil then
Item.Next.Prev := Item;
FList := Item;
exit( Item );
exit(Item);
end;
procedure TMycNotifyList<T>.Lock;
@@ -93,19 +96,19 @@ begin
YieldProcessor;
continue;
end;
until TInterlocked.BitTestAndClear( PNativeUint( @FFirst )^, 0 );
until TInterlocked.BitTestAndClear(PNativeUint(@FFirst)^, 0);
Assert( IsLocked, 'Locking failed' );
Assert(IsLocked, 'Locking failed');
end;
class function TMycNotifyList<T>.AllocItem: PItem;
begin
Result := AllocMem( sizeof( TItem ) );
Result := AllocMem(sizeof(TItem));
end;
class procedure TMycNotifyList<T>.FreeItem(Item: PItem);
begin
FreeMem( Item, sizeof( TItem ) );
FreeMem(Item, sizeof(TItem));
end;
function TMycNotifyList<T>.IsLocked: Boolean;
@@ -117,65 +120,65 @@ procedure TMycNotifyList<T>.Notify(Func: TPredicate<T>);
var
Item, P: PItem;
begin
Assert( IsLocked );
Assert(IsLocked);
if FFirst<>0 then
if not Func( IInterface( FFirst ) ) then
IInterface( FFirst ) := nil;
if FFirst <> 0 then
if not Func(IInterface(FFirst)) then
IInterface(FFirst) := nil;
Item := FList;
while Item<>nil do
while Item <> nil do
begin
P := Item.Next;
if not Func( Item.Receiver ) then
Unadvise( TTag( Item ) );
if not Func(Item.Receiver) then
Unadvise(TTag(Item));
Item := P;
end;
end;
procedure TMycNotifyList<T>.Release;
begin
Assert( IsLocked );
TInterlocked.Exchange( Pointer( FFirst ), Pointer( FFirst or 1 ) );
Assert(IsLocked);
TInterlocked.Exchange(Pointer(FFirst), Pointer(FFirst or 1));
end;
procedure TMycNotifyList<T>.Unadvise(Tag: TTag);
var
Item: PItem;
begin
Assert( IsLocked );
Assert(IsLocked);
if NativeUInt(Tag) = FFirst then
begin
IInterface( FFirst ) := nil;
IInterface(FFirst) := nil;
exit;
end;
if FList = nil then
exit;
Item := PItem( Tag );
Item := PItem(Tag);
if Item = FList then
FList := Item.Next;
if Item.Prev<>nil then
if Item.Prev <> nil then
Item.Prev.Next := Item.Next;
if Item.Next<>nil then
if Item.Next <> nil then
Item.Next.Prev := Item.Prev;
Item.Receiver := nil;
FreeItem( Item );
FreeItem(Item);
end;
procedure TMycNotifyList<T>.UnadviseAll;
begin
Assert( IsLocked );
Assert(IsLocked);
IInterface( FFirst ) := nil;
while FList<>nil do
Unadvise( TTag( FList ) );
IInterface(FFirst) := nil;
while FList <> nil do
Unadvise(TTag(FList));
end;
end.
Src/Myc.Core.Signals.pas
+12 -18
View File
@@ -8,7 +8,7 @@ uses
Myc.Signals;
type
TMycState = class abstract( TInterfacedObject, IMycState )
TMycState = class abstract(TInterfacedObject, IMycState)
protected
function GetIsSet: Boolean; virtual; abstract;
public
@@ -37,10 +37,11 @@ type
strict private
FSubscribers: TMycNotifyList<IMycSubscriber>; // List of subscribers waiting for this latch to be set.
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.
protected
function GetIsSet: Boolean; override; final; // Implementation for IMycState.GetIsSet.
function GetIsSet: Boolean; override; final; // Implementation for IMycState.GetIsSet.
public
// Creates the latch with an initial count.
// If ACount is 0 or less, the latch is effectively pre-set (delegates to FNull via CreateLatch factory).
@@ -57,7 +58,7 @@ type
function Notify: Boolean;
end;
TMycNullLatch = class( TInterfacedObject, IMycLatch )
TMycNullLatch = class(TInterfacedObject, IMycLatch)
private
function GetState: TState;
function Notify: Boolean;
@@ -70,10 +71,11 @@ type
strict private
FSubscribers: TMycNotifyList<IMycSubscriber>; // List of subscribers interested in state changes of this dirty flag.
private
[volatile] FFlag: Boolean; // Internal state: true if dirty/set, false if clean/reset.
[volatile]
FFlag: Boolean; // Internal state: true if dirty/set, false if clean/reset.
function GetState: TState;
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
// Creates a new dirty flag, initially set to dirty (true).
constructor Create;
@@ -93,7 +95,7 @@ type
function Reset: Boolean;
end;
TMycNullDirty = class( TInterfacedObject, IMycDirty )
TMycNullDirty = class(TInterfacedObject, IMycDirty)
private
function GetState: TState;
function Notify: Boolean;
@@ -150,7 +152,7 @@ end;
constructor TMycLatch.Create(ACount: Integer);
begin
inherited Create;
Assert( ACount >= 0 );
Assert(ACount >= 0);
FCount := ACount;
FSubscribers.Create;
end;
@@ -177,11 +179,7 @@ begin
if shouldNotifySubscribers then
begin
FSubscribers.Notify(
function(Subscriber: IMycSubscriber): Boolean
begin
Result := Subscriber.Notify;
end);
FSubscribers.Notify(function(Subscriber: IMycSubscriber): Boolean begin Result := Subscriber.Notify; end);
end;
// Returns true if the latch has not yet been set by this Notify call (count > 0).
@@ -315,11 +313,7 @@ begin
if wasPreviouslyClean then // Only notify subscribers if state changed from clean to dirty.
begin
FSubscribers.Notify(
function(Subscriber: IMycSubscriber): Boolean
begin
Result := Subscriber.Notify;
end);
FSubscribers.Notify(function(Subscriber: IMycSubscriber): Boolean begin Result := Subscriber.Notify; end);
end;
// The return value of this Notify (as an IMycSubscriber) indicates if this
// TMycDirty instance itself would want more notifications if it were subscribed to something.
Src/Myc.Core.Tasks.pas
+38 -35
View File
@@ -3,11 +3,15 @@ unit Myc.Core.Tasks;
interface
uses
System.SysUtils, System.Classes, System.SyncObjs,
Myc.Core.Atomic, Myc.TaskManager, Myc.Signals;
System.SysUtils,
System.Classes,
System.SyncObjs,
Myc.Core.Atomic,
Myc.TaskManager,
Myc.Signals;
type
IMycTaskFactory = interface( IMycTaskManager )
IMycTaskFactory = interface(IMycTaskManager)
{$region 'property access'}
// Retrieves the number of worker threads.
function GetThreadCount: Integer;
@@ -46,8 +50,9 @@ type
end;
TMycTaskFactory = class(TInterfacedObject, IMycTaskManager, IMycTaskFactory)
type
ETaskException = class(Exception) end;
type
ETaskException = class(Exception)
end;
private
[volatile]
FException: TObject; // Holds the first exception object from a worker thread
@@ -60,8 +65,8 @@ type
FWorkStack: TMycAtomicStack<TProc>; // Stack of pending jobs
FWorkThreads: TArray<TThread>; // Array of worker threads
procedure WorkerThread;
class var
FTaskManagerLock: Integer;
class var
FTaskManagerLock: Integer;
protected
procedure ExecuteJob;
@@ -139,7 +144,7 @@ begin
for var i := 0 to High(FWorkThreads) do
FWorkThreads[i].Start;
FWaitSemaphores.Push( TSemaphore.Create(nil, 0, 1, '') );
FWaitSemaphores.Push(TSemaphore.Create(nil, 0, 1, ''));
end;
destructor TMycTaskFactory.Destroy;
@@ -159,14 +164,14 @@ end;
class function TMycTaskFactory.CreateAnonymousThread(const DbgName: String; const Proc: TProc): TThread;
{$IFDEF MSWINDOWS}
{$WARN SYMBOL_PLATFORM OFF}
{$WARN SYMBOL_PLATFORM OFF}
var
prio: TThreadPriority;
{$ENDIF MSWINDOWS}
begin
Result := TThread.CreateAnonymousThread(Proc);
{$IFDEF MSWINDOWS}
{$IFDEF MSWINDOWS}
// Set priority lower than MainThread priority if created from main thread
if TThread.CurrentThread.ThreadID = MainThreadID then
begin
@@ -177,7 +182,7 @@ begin
Result.Priority := prio;
end;
{$WARN SYMBOL_PLATFORM ON}
{$ENDIF MSWINDOWS}
{$ENDIF MSWINDOWS}
if DbgName <> '' then
Result.NameThreadForDebugging(DbgName); // Set thread name for debugging
@@ -187,12 +192,12 @@ function TMycTaskFactory.CreateTask(const Gate: TState; const Proc: TProc): TSta
begin
if Gate.IsSet then
begin
EnqueueJob( Proc );
EnqueueJob(Proc);
end
else
begin
// The job will run when Gate notifies the subscriber returned by Run.
Result := Gate.Subscribe( Run( Proc ) );
Result := Gate.Subscribe(Run(Proc));
end;
end;
@@ -205,16 +210,18 @@ begin
res := TLatch.Construct(1); // Changed to use direct static call on TMycLatch
capturedProc := Proc; // Capture Proc for the anonymous method
CreateAnonymousThread('Thread',
procedure
begin
try
capturedProc(); // Execute the provided procedure
finally
capturedProc := nil; // Clear the captured proc
res.Notify; // Signal completion via the latch's Notify method
end;
end).Start;
CreateAnonymousThread(
'Thread',
procedure
begin
try
capturedProc(); // Execute the provided procedure
finally
capturedProc := nil; // Clear the captured proc
res.Notify; // Signal completion via the latch's Notify method
end;
end)
.Start;
// Return the state interface of the latch
exit(res.State);
@@ -286,12 +293,12 @@ class procedure TMycTaskFactory.AquireTaskManager;
begin
if not Assigned(TaskManager) then
TaskManager := TMycTaskFactory.Create;
inc( FTaskManagerLock );
inc(FTaskManagerLock);
end;
class procedure TMycTaskFactory.ReleaseTaskManager;
begin
dec( FTaskManagerLock );
dec(FTaskManagerLock);
if FTaskManagerLock = 0 then
TaskManager := nil;
end;
@@ -322,11 +329,7 @@ begin
for i := 0 to High(FWorkThreads) do
FWorkGate.Release;
TSpinWait.SpinUntil(
function: Boolean
begin
Result := FThreadsRunning = 0;
end);
TSpinWait.SpinUntil(function: Boolean begin Result := FThreadsRunning = 0; end);
Assert(FThreadsRunning = 0);
@@ -357,7 +360,8 @@ begin
if lock = nil then
lock := TSemaphore.Create(nil, 0, 1, '');
try
{var subscription :=} State.Subscribe(TMycTaskWait.Create(lock));
{var subscription :=}
State.Subscribe(TMycTaskWait.Create(lock));
lock.Acquire;
finally
FWaitSemaphores.Push(lock);
@@ -386,8 +390,7 @@ end;
{ TMycPendingJob }
constructor TMycPendingJob.Create(OwnerTaskFactory: TMycTaskFactory; const
JobProc: TProc);
constructor TMycPendingJob.Create(OwnerTaskFactory: TMycTaskFactory; const JobProc: TProc);
begin
inherited Create;
FOwner := OwnerTaskFactory;
@@ -398,13 +401,13 @@ function TMycPendingJob.Notify: Boolean;
var
P: TProc;
begin
PPointer(@P)^ := TInterlocked.Exchange( PPointer(@FJob)^, nil );
PPointer(@P)^ := TInterlocked.Exchange(PPointer(@FJob)^, nil);
Result := Assigned(P);
if Result then
begin
if Assigned(FOwner) then
FOwner.EnqueueJob(P);
P := nil;
P := nil;
end;
end;
Src/Myc.Futures.pas
+23 -26
View File
@@ -4,7 +4,8 @@ interface
uses
System.SysUtils,
Myc.Signals, Myc.TaskManager;
Myc.Signals,
Myc.TaskManager;
type
// Represents the eventual result of an asynchronous operation.
@@ -32,17 +33,17 @@ type
class destructor DestroyClass;
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: TFuture<T> ): IMycFuture<T>; overload;
class operator Implicit(const A: IMycFuture<T>): TFuture<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 Gate: IMycState; 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 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;
@@ -53,12 +54,13 @@ type
implementation
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
FFuture := AFuture;
if not Assigned( FFuture ) then
if not Assigned(FFuture) then
FFuture := FNull;
end;
@@ -73,26 +75,21 @@ begin
TMycTaskFactory.ReleaseTaskManager;
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
var
Cap := FFuture;
var Cap := FFuture;
Result := TFuture<S>.Construct( FFuture.Done,
function: S
begin
Result := Proc( Cap.Result );
end );
Result := TFuture<S>.Construct(FFuture.Done, function: S begin Result := Proc(Cap.Result); 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
Result := TMycGateFuncFuture<T>.Create( TaskManager, nil, Proc );
Result := TMycGateFuncFuture<T>.Create(TaskManager, nil, Proc);
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
Result := TMycGateFuncFuture<T>.Create( TaskManager, Gate, Proc );
Result := TMycGateFuncFuture<T>.Create(TaskManager, Gate, Proc);
end;
function TFuture<T>.GetDone: IMycState;
@@ -107,16 +104,16 @@ end;
function TFuture<T>.WaitFor: T;
begin
TaskManager.WaitFor( FFuture.Done );
TaskManager.WaitFor(FFuture.Done);
Result := FFuture.Result;
end;
class operator TFuture<T>.Implicit( const A: IMycFuture<T> ): TFuture<T>;
class operator TFuture<T>.Implicit(const A: IMycFuture<T>): TFuture<T>;
begin
Result.Create( A );
Result.Create(A);
end;
class operator TFuture<T>.Implicit( const A: TFuture<T> ): IMycFuture<T>;
class operator TFuture<T>.Implicit(const A: TFuture<T>): IMycFuture<T>;
begin
Result := A.FFuture;
end;
Src/Myc.Lazy.pas
+15 -15
View File
@@ -11,7 +11,7 @@ type
{$REGION 'property access'}
function GetChanged: IMycState;
{$ENDREGION}
function Pop( out Res: T ): Boolean;
function Pop(out Res: T): Boolean;
property Changed: IMycState read GetChanged;
end;
@@ -24,14 +24,14 @@ type
class constructor CreateClass;
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: TLazy<T> ): IMycLazy<T>; overload;
class operator Implicit(const A: IMycLazy<T>): TLazy<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;
end;
@@ -41,16 +41,16 @@ implementation
uses
Myc.Core.Lazy;
constructor TLazy<T>.Create( const ALazy: IMycLazy<T> );
constructor TLazy<T>.Create(const ALazy: IMycLazy<T>);
begin
FLazy := ALazy;
if not Assigned( FLazy ) then
if not Assigned(FLazy) then
FLazy := FNull;
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
Result := TMycFuncLazy<T>.Create( Changing, Proc );
Result := TMycFuncLazy<T>.Create(Changing, Proc);
end;
class constructor TLazy<T>.CreateClass;
@@ -63,17 +63,17 @@ begin
Result := FLazy.Changed;
end;
function TLazy<T>.Pop( out Res: T ): Boolean;
function TLazy<T>.Pop(out Res: T): Boolean;
begin
Result := FLazy.Pop( Res );
Result := FLazy.Pop(Res);
end;
class operator TLazy<T>.Implicit( const A: IMycLazy<T> ): TLazy<T>;
class operator TLazy<T>.Implicit(const A: IMycLazy<T>): TLazy<T>;
begin
Result.Create( A );
Result.Create(A);
end;
class operator TLazy<T>.Implicit( const A: TLazy<T> ): IMycLazy<T>;
class operator TLazy<T>.Implicit(const A: TLazy<T>): IMycLazy<T>;
begin
Result := A.FLazy;
end;
Src/Myc.Signals.pas
+55 -55
View File
@@ -18,24 +18,24 @@ type
function GetIsSet: Boolean;
{$ENDREGION}
// Subscribes a given subscriber to this TState.
function Subscribe( Subscriber: IMycSubscriber ): Pointer;
procedure Unsubscribe( Tag: Pointer );
function Subscribe(Subscriber: IMycSubscriber): Pointer;
procedure Unsubscribe(Tag: Pointer);
// IsSet is true if the TState has been reached or the condition is met.
property IsSet: Boolean read GetIsSet;
end;
TState = record // helper for IMycState
type
TSubscription = record
private
FState: IMycState;
FTag: Pointer; // Tag identifying this subscription within the notifier list.
constructor Create( const AState: IMycState; ATag: Pointer );
public
class operator Initialize( out Dest: TSubscription );
// Unsubscribes from the associated TState.
procedure Unsubscribe;
end;
type
TSubscription = record
private
FState: IMycState;
FTag: Pointer; // Tag identifying this subscription within the notifier list.
constructor Create(const AState: IMycState; ATag: Pointer);
public
class operator Initialize(out Dest: TSubscription);
// Unsubscribes from the associated TState.
procedure Unsubscribe;
end;
strict private
class var
@@ -45,25 +45,25 @@ type
FState: IMycState;
function GetIsSet: Boolean; inline;
public
constructor Create( const AState: IMycState );
constructor Create(const AState: IMycState);
class operator Implicit( const A: IMycState ): TState; overload;
class operator Implicit( const A: TState ): IMycState; overload;
class operator Implicit(const A: IMycState): TState; overload;
class operator Implicit(const A: TState): IMycState; overload;
class function All( const States: TArray<TState> ): TState; static;
class function Any( 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 property Null: IMycState read FNull;
function Subscribe( Subscriber: IMycSubscriber ): TSubscription; inline;
procedure Unsubscribe( Tag: Pointer ); inline;
function Subscribe(Subscriber: IMycSubscriber): TSubscription; inline;
procedure Unsubscribe(Tag: Pointer); inline;
property IsSet: Boolean read GetIsSet;
end;
// IMycLatch is a specific type of flag that, once set, remains set (non-resettable).
// 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.
function GetState: TState;
property State: TState read GetState;
@@ -86,7 +86,7 @@ type
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;
@@ -97,7 +97,7 @@ type
// 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.
IMycDirty = interface( IMycSubscriber )
IMycDirty = interface(IMycSubscriber)
// Provides access to the IMycState interface of the flag.
function GetState: TState;
// Resets the flag to its "clean" (not set / not dirty) State.
@@ -119,26 +119,26 @@ type
implementation
uses
Myc.Core.Notifier, Myc.Core.Signals;
Myc.Core.Notifier,
Myc.Core.Signals;
{ TState.TSubscription }
constructor TState.TSubscription.Create( const AState: IMycState; ATag:
TMycNotifyList<IMycSubscriber>.TTag );
constructor TState.TSubscription.Create(const AState: IMycState; ATag: TMycNotifyList<IMycSubscriber>.TTag);
begin
Assert( Assigned( AState ) );
Assert(Assigned(AState));
FState := AState;
FTag := ATag;
end;
procedure TState.TSubscription.Unsubscribe;
begin
FState.Unsubscribe( FTag );
FState.Unsubscribe(FTag);
FState := TState.Null;
FTag := nil;
end;
class operator TState.TSubscription.Initialize( out Dest: TSubscription );
class operator TState.TSubscription.Initialize(out Dest: TSubscription);
begin
Dest.FState := TState.Null;
Dest.FTag := nil;
@@ -146,42 +146,42 @@ end;
{ TState }
constructor TState.Create( const AState: IMycState );
constructor TState.Create(const AState: IMycState);
begin
FState := AState;
if not Assigned( FState ) then
if not Assigned(FState) then
FState := FNull;
end;
class constructor TState.ClassCreate;
begin
// 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;
class function TState.All( const States: TArray<TState> ): TState;
class function TState.All(const States: TArray<TState>): TState;
var
Latch: IMycLatch;
begin
Latch := TLatch.Construct( Length( States ) );
for var i := 0 to High( States ) do
States[i].Subscribe( Latch );
Latch := TLatch.Construct(Length(States));
for var i := 0 to High(States) do
States[i].Subscribe(Latch);
Result := Latch.State;
end;
class function TState.Any( const States: TArray<TState> ): TState;
class function TState.Any(const States: TArray<TState>): TState;
var
Latch: IMycLatch;
begin
if Length( States ) = 0 then
if Length(States) = 0 then
begin
Result := TState.Null;
end
else
begin
Latch := TLatch.Construct( 1 );
for var i := 0 to High( States ) do
States[i].Subscribe( Latch );
Latch := TLatch.Construct(1);
for var i := 0 to High(States) do
States[i].Subscribe(Latch);
Result := Latch.State;
end;
end;
@@ -191,24 +191,24 @@ begin
Result := FState.IsSet;
end;
function TState.Subscribe( Subscriber: IMycSubscriber ): TSubscription;
function TState.Subscribe(Subscriber: IMycSubscriber): TSubscription;
begin
Result := TSubscription.Create( FState, FState.Subscribe( Subscriber ) );
Result := TSubscription.Create(FState, FState.Subscribe(Subscriber));
end;
procedure TState.Unsubscribe( Tag: Pointer );
procedure TState.Unsubscribe(Tag: Pointer);
begin
FState.Unsubscribe( Tag );
FState.Unsubscribe(Tag);
end;
class operator TState.Implicit( const A: TState ): IMycState;
class operator TState.Implicit(const A: TState): IMycState;
begin
Result := A.FState;
end;
class operator TState.Implicit( const A: IMycState ): TState;
class operator TState.Implicit(const A: IMycState): TState;
begin
Result.Create( A );
Result.Create(A);
end;
{ TLatch }
@@ -224,24 +224,24 @@ end;
constructor TLatch.Create(const ALatch: IMycLatch);
begin
FLatch := ALatch;
if not Assigned( FLatch ) then
if not Assigned(FLatch) then
FLatch := FNull;
end;
class function TLatch.Construct(Count: Integer): TLatch;
begin
if Count > 0 then
Result := TMycLatch.Create( Count )
Result := TMycLatch.Create(Count)
else
Result := FNull;
end;
class function TLatch.Enqueue(var Gate: TLatch; Count: Integer=1): TState;
class function TLatch.Enqueue(var Gate: TLatch; Count: Integer = 1): TState;
begin
var gateState := Gate.State;
Gate := TMycLatch.Create( Count );
gateState.Subscribe( Gate );
exit( Gate.State );
Gate := TMycLatch.Create(Count);
gateState.Subscribe(Gate);
exit(Gate.State);
end;
function TLatch.GetState: TState;
@@ -256,7 +256,7 @@ end;
class operator TLatch.Implicit(const A: IMycLatch): TLatch;
begin
Result.Create( A );
Result.Create(A);
end;
class operator TLatch.Implicit(const A: TLatch): IMycLatch;
Src/Myc.TaskManager.pas
+3 -3
View File
@@ -9,7 +9,7 @@ uses
type
IMycTaskManager = interface
// TOD Dokumentation
function CreateTask( const Gate: TState; const Proc: TProc ): TState.TSubscription;
function CreateTask(const Gate: TState; const Proc: TProc): TState.TSubscription;
// Waits for the operation associated with State to complete.
// 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;
begin
Result := Gate.Subscribe( TMycExecMock.Create( Proc ) );
Result := Gate.Subscribe(TMycExecMock.Create(Proc));
end;
procedure TMycTaskManagerMock.WaitFor(State: IMycState);
begin
Assert( State.IsSet );
Assert(State.IsSet);
end;
procedure SetupTaskManagerMock;
Src/Myc.Test.Core.Atomic.pas
+12 -13
View File
@@ -18,7 +18,7 @@ type
PTestSListEntryData = ^TTestSListEntryData;
TTestSListEntryData = record
Entry: TSListEntry; // The SList entry structure
ID: Integer; // Sample data associated with the entry
ID: Integer; // Sample data associated with the entry
end;
[TestFixture]
@@ -109,7 +109,8 @@ type
implementation
uses System.TypInfo;
uses
System.TypInfo;
{ TTestSList }
@@ -147,14 +148,14 @@ begin
// Popping to empty the list if not already empty
end;
tempList := FList; // Store to call Free
FList := nil; // Prevent using FList after Free
tempList.Free; // Free the TSList structure itself
FList := nil; // Prevent using FList after Free
tempList.Free; // Free the TSList structure itself
end;
// Free all allocated PTestSListEntryData
for entryNode in FEntries do
begin
var P:= entryNode;
var P := entryNode;
FreeMemAligned(P);
end;
SetLength(FEntries, 0);
@@ -277,10 +278,11 @@ begin
// This test confirms that using an aligned entry from AllocEntryData works.
entryData := AllocEntryData(123);
// This should not raise an assertion error from TSList.Push.
Assert.WillNotRaise(procedure
begin
FList.Push(@entryData.Entry);
end, nil, 'Pushing an aligned entry should not raise an exception/assertion.');
Assert.WillNotRaise(
procedure begin FList.Push(@entryData.Entry); end,
nil,
'Pushing an aligned entry should not raise an exception/assertion.'
);
Assert.AreEqual(1, FList.QueryDepth, 'QueryDepth should be 1 after pushing an aligned entry.');
end;
@@ -391,10 +393,7 @@ end;
procedure TTestMycAtomicStack_Integer.TestClear_OnEmptyStack;
begin
// Clearing an already empty stack should not cause issues
Assert.WillNotRaise(procedure
begin
FStack.Clear;
end, nil, 'Clear on an empty stack should not raise an exception.');
Assert.WillNotRaise(procedure 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.');
end;
Src/Myc.Test.Core.Lazy.pas
+75 -50
View File
@@ -5,9 +5,9 @@ interface
uses
System.SysUtils,
DUnitX.TestFramework,
Myc.Signals, // For IMycState, TState, IMycDirty
Myc.Lazy, // For IMycLazy<T>
Myc.Core.Lazy; // Unit to be tested
Myc.Signals, // For IMycState, TState, IMycDirty
Myc.Lazy, // For IMycLazy<T>
Myc.Core.Lazy; // Unit to be tested
type
[TestFixture]
@@ -186,12 +186,15 @@ begin
sourceDirty.Reset;
procExecuted := False;
expectedValue := 50;
funcLazy := TMycFuncLazy<Integer>.Create(sourceDirty.State,
function: Integer
begin
procExecuted := True;
Result := expectedValue;
end);
funcLazy :=
TMycFuncLazy<Integer>.Create(
sourceDirty.State,
function: Integer
begin
procExecuted := True;
Result := expectedValue;
end
);
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');
value := 0;
@@ -219,7 +222,11 @@ begin
value := preCallValue;
result := funcLazy.Pop(value);
Assert.IsTrue(result, 'First Pop should return true by design, even if FProc is nil');
Assert.AreEqual(preCallValue, value, 'Value should be unchanged as FProc was nil and current Pop implementation does not assign Default(T)');
Assert.AreEqual(
preCallValue,
value,
'Value should be unchanged as FProc was nil and current Pop implementation does not assign Default(T)'
);
Assert.IsFalse(funcLazy.GetChanged.IsSet, 'Changed state should be false after Pop');
end;
@@ -252,12 +259,15 @@ begin
sourceDirty.Reset;
initialProcValue := 44;
procExecutedCount := 0;
funcLazy := TMycFuncLazy<Integer>.Create(sourceDirty.State,
function: Integer
begin
Inc(procExecutedCount);
Result := initialProcValue;
end);
funcLazy :=
TMycFuncLazy<Integer>.Create(
sourceDirty.State,
function: Integer
begin
Inc(procExecutedCount);
Result := initialProcValue;
end
);
Helper_ConsumeInitialPop(funcLazy, initialProcValue);
Assert.AreEqual(1, procExecutedCount, 'Proc should have executed once for initial pop');
result := funcLazy.Pop(value);
@@ -294,13 +304,18 @@ begin
sourceDirty := TDirty.Construct;
sourceDirty.Reset;
procCallCount := 0;
funcLazy := TMycFuncLazy<Integer>.Create(sourceDirty.State,
function: Integer
begin
Inc(procCallCount);
if procCallCount = 1 then Result := 30
else Result := 300 + procCallCount;
end);
funcLazy :=
TMycFuncLazy<Integer>.Create(
sourceDirty.State,
function: Integer
begin
Inc(procCallCount);
if procCallCount = 1 then
Result := 30
else
Result := 300 + procCallCount;
end
);
currentExpectedValue := 30;
Helper_ConsumeInitialPop(funcLazy, currentExpectedValue);
Assert.AreEqual(1, procCallCount, 'Proc executed for initial Pop');
@@ -326,12 +341,15 @@ begin
sourceDirty := TDirty.Construct;
sourceDirty.Reset;
procCallCount := 0;
funcLazy := TMycFuncLazy<Integer>.Create(sourceDirty.State,
function: Integer
begin
Inc(procCallCount);
Result := 40;
end);
funcLazy :=
TMycFuncLazy<Integer>.Create(
sourceDirty.State,
function: Integer
begin
Inc(procCallCount);
Result := 40;
end
);
resultPop1 := funcLazy.Pop(value);
Assert.IsTrue(resultPop1, 'First Pop should return true by design');
Assert.AreEqual(40, value, 'Value from first Pop');
@@ -359,14 +377,20 @@ begin
initialValue := 51;
firstSourceChangeValue := 52;
funcLazy := TMycFuncLazy<Integer>.Create(sourceDirty.State,
function: Integer
begin
Inc(procCallCount);
if procCallCount = 1 then 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);
funcLazy :=
TMycFuncLazy<Integer>.Create(
sourceDirty.State,
function: Integer
begin
Inc(procCallCount);
if procCallCount = 1 then
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)
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)
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.
// 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');
@@ -412,12 +436,10 @@ begin
Assert.IsTrue(funcLazyObj.Pop(tempVal), 'Initial Pop should succeed');
funcLazyObj.Destroy;
Assert.WillNotRaise(
procedure
begin
sourceDirty.Notify;
end,
nil,
'Destroy test assumes TMycSubscription.Unsubscribe works. Verified by no crash on source notify post-destroy.');
procedure begin sourceDirty.Notify; end,
nil,
'Destroy test assumes TMycSubscription.Unsubscribe works. Verified by no crash on source notify post-destroy.'
);
sourceDirty := nil;
end;
@@ -434,12 +456,15 @@ begin
Assert.IsTrue(sourceDirty.State.IsSet, 'SourceDirty should be initially set for this test scenario');
expectedValue := 70;
procExecuted := False;
funcLazy := TMycFuncLazy<Integer>.Create(sourceDirty.State,
function: Integer
begin
procExecuted := True;
Result := expectedValue;
end);
funcLazy :=
TMycFuncLazy<Integer>.Create(
sourceDirty.State,
function: Integer
begin
procExecuted := True;
Result := expectedValue;
end
);
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)');
value := 0;
Src/Myc.Test.Lazy.pas
+64 -46
View File
@@ -5,8 +5,8 @@ interface
uses
System.SysUtils,
DUnitX.TestFramework,
Myc.Signals, // For IMycState, TState, IMycDirty
Myc.Lazy; // The unit under test
Myc.Signals, // For IMycState, TState, IMycDirty
Myc.Lazy; // The unit under test
type
[TestFixture]
@@ -145,12 +145,15 @@ var
begin
procExecuted := False;
// FChangingSignal is reset in Setup
lazyIntf := TLazy<Integer>.Construct(FChangingSignal.State,
function: Integer
begin
procExecuted := True;
Result := 10;
end);
lazyIntf :=
TLazy<Integer>.Construct(
FChangingSignal.State,
function: Integer
begin
procExecuted := True;
Result := 10;
end
);
Assert.IsNotNull(lazyIntf, 'TLazy.Construct should return a valid interface');
lazyRec := lazyIntf; // Implicit conversion
@@ -167,12 +170,15 @@ var
begin
procExecuted := False;
expectedValue := 20;
lazyIntf := TLazy<Integer>.Construct(FChangingSignal.State,
function: Integer
begin
procExecuted := True;
Result := expectedValue;
end);
lazyIntf :=
TLazy<Integer>.Construct(
FChangingSignal.State,
function: Integer
begin
procExecuted := True;
Result := expectedValue;
end
);
lazyRec := lazyIntf;
ConsumeInitialPop(lazyRec, expectedValue, 'TestConstruct_FirstPop');
@@ -229,12 +235,15 @@ var
procCallCount: Integer;
begin
procCallCount := 0;
lazyIntf := TLazy<Integer>.Construct(FChangingSignal.State,
function: Integer
begin
Inc(procCallCount);
Result := 100 + procCallCount; // Value changes per call
end);
lazyIntf :=
TLazy<Integer>.Construct(
FChangingSignal.State,
function: Integer
begin
Inc(procCallCount);
Result := 100 + procCallCount; // Value changes per call
end
);
lazyRec := lazyIntf;
ConsumeInitialPop(lazyRec, 101, 'TestConstruct_StateInteraction_PopResetsChangedAfterSignal (Initial)'); // procCallCount = 1
@@ -257,12 +266,15 @@ var
procCallCount: Integer;
begin
procCallCount := 0;
lazyIntf := TLazy<Integer>.Construct(FChangingSignal.State,
function: Integer
begin
Inc(procCallCount);
Result := 200 + procCallCount;
end);
lazyIntf :=
TLazy<Integer>.Construct(
FChangingSignal.State,
function: Integer
begin
Inc(procCallCount);
Result := 200 + procCallCount;
end
);
lazyRec := lazyIntf;
// 1. Initial Pop
@@ -307,20 +319,20 @@ begin
ConsumeInitialPop(lazyRec, 1, 'TestConstruct_Destruction (Initial)');
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(
procedure
begin
localChangingSignal.Notify; // Notify the source AFTER the lazy object is supposed to be gone.
end,
nil, // Default: any exception is a failure
'Notifying source after lazy object is freed should not crash, indicating unsubscription.');
procedure
begin
localChangingSignal.Notify; // Notify the source AFTER the lazy object is supposed to be gone.
end,
nil, // Default: any exception is a failure
'Notifying source after lazy object is freed should not crash, indicating unsubscription.'
);
localChangingSignal := nil; // Clean up the local signal itself.
end;
// == Tests for TLazy<T>.Create with a pre-existing (non-nil) IMycLazy ==
procedure TTestMyLazy.TestCreateWithExistingLazy_DelegatesChangedCorrectly;
@@ -355,12 +367,15 @@ var
procCallCount: Integer;
begin
procCallCount := 0;
originalLazyIntf := TLazy<Integer>.Construct(FChangingSignal.State,
function: Integer
begin
Inc(procCallCount);
Result := 70 + procCallCount;
end);
originalLazyIntf :=
TLazy<Integer>.Construct(
FChangingSignal.State,
function: Integer
begin
Inc(procCallCount);
Result := 70 + procCallCount;
end
);
wrappedLazyRec := TLazy<Integer>.Create(originalLazyIntf);
// First Pop via wrapper (initial pop)
@@ -434,12 +449,15 @@ var
procExecuted: Boolean;
begin
procExecuted := False;
lazyIntf := TLazy<Integer>.Construct(FChangingSignal.State,
function: Integer
begin
procExecuted := True;
Result := 100;
end);
lazyIntf :=
TLazy<Integer>.Construct(
FChangingSignal.State,
function: Integer
begin
procExecuted := True;
Result := 100;
end
);
lazyRec := lazyIntf;
ConsumeInitialPop(lazyRec, 100, 'TestPop_AfterInitialAndNoSignal (Initial)');