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
+2 -1
View File
@@ -33,7 +33,8 @@ type
end;
TMycAtomicStack<T> = record
private type
private
type
PItem = ^TItem;
TItem = packed record
Next: TSListEntry;
Src/Myc.Core.Futures.pas
+7 -3
View File
@@ -4,7 +4,9 @@ interface
uses
System.SysUtils,
Myc.Signals, Myc.TaskManager, Myc.Futures;
Myc.Signals,
Myc.TaskManager,
Myc.Futures;
type
TMycFuture<T> = class abstract(TInterfacedObject, IMycFuture<T>)
@@ -56,7 +58,8 @@ begin
// Subscribe the job execution to AGate.
// The job will run when AGate notifies the subscriber returned by Run.
FInit := ATaskManager.CreateTask(
FInit :=
ATaskManager.CreateTask(
AGate,
procedure
begin
@@ -70,7 +73,8 @@ begin
finally
Self.FDone.Notify; // Signal that this future is done (successfully or with error)
end;
end );
end
);
end;
destructor TMycGateFuncFuture<T>.Destroy;
Src/Myc.Core.Notifier.pas
+5 -2
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.
@@ -41,7 +42,9 @@ type
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
Src/Myc.Core.Signals.pas
+6 -12
View File
@@ -37,7 +37,8 @@ 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.
@@ -70,7 +71,8 @@ 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).
@@ -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
+16 -13
View File
@@ -3,8 +3,12 @@ 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)
@@ -47,7 +51,8 @@ type
TMycTaskFactory = class(TInterfacedObject, IMycTaskManager, IMycTaskFactory)
type
ETaskException = class(Exception) end;
ETaskException = class(Exception)
end;
private
[volatile]
FException: TObject; // Holds the first exception object from a worker thread
@@ -205,7 +210,8 @@ begin
res := TLatch.Construct(1); // Changed to use direct static call on TMycLatch
capturedProc := Proc; // Capture Proc for the anonymous method
CreateAnonymousThread('Thread',
CreateAnonymousThread(
'Thread',
procedure
begin
try
@@ -214,7 +220,8 @@ begin
capturedProc := nil; // Clear the captured proc
res.Notify; // Signal completion via the latch's Notify method
end;
end).Start;
end)
.Start;
// Return the state interface of the latch
exit(res.State);
@@ -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;
Src/Myc.Futures.pas
+6 -9
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.
@@ -53,7 +54,8 @@ type
implementation
uses
Myc.Core.Futures, Myc.Core.Tasks;
Myc.Core.Futures,
Myc.Core.Tasks;
constructor TFuture<T>.Create(const AFuture: IMycFuture<T>);
begin
@@ -75,14 +77,9 @@ end;
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>;
Src/Myc.Signals.pas
+3 -3
View File
@@ -119,12 +119,12 @@ 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));
FState := AState;
Src/Myc.Test.Core.Atomic.pas
+8 -9
View File
@@ -109,7 +109,8 @@ type
implementation
uses System.TypInfo;
uses
System.TypInfo;
{ TTestSList }
@@ -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
+48 -23
View File
@@ -186,12 +186,15 @@ begin
sourceDirty.Reset;
procExecuted := False;
expectedValue := 50;
funcLazy := TMycFuncLazy<Integer>.Create(sourceDirty.State,
funcLazy :=
TMycFuncLazy<Integer>.Create(
sourceDirty.State,
function: Integer
begin
procExecuted := True;
Result := expectedValue;
end);
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,
funcLazy :=
TMycFuncLazy<Integer>.Create(
sourceDirty.State,
function: Integer
begin
Inc(procExecutedCount);
Result := initialProcValue;
end);
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,
funcLazy :=
TMycFuncLazy<Integer>.Create(
sourceDirty.State,
function: Integer
begin
Inc(procCallCount);
if procCallCount = 1 then Result := 30
else Result := 300 + procCallCount;
end);
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,
funcLazy :=
TMycFuncLazy<Integer>.Create(
sourceDirty.State,
function: Integer
begin
Inc(procCallCount);
Result := 40;
end);
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,
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);
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)');
@@ -412,12 +436,10 @@ begin
Assert.IsTrue(funcLazyObj.Pop(tempVal), 'Initial Pop should succeed');
funcLazyObj.Destroy;
Assert.WillNotRaise(
procedure
begin
sourceDirty.Notify;
end,
procedure begin sourceDirty.Notify; end,
nil,
'Destroy test assumes TMycSubscription.Unsubscribe works. Verified by no crash on source notify post-destroy.');
'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,
funcLazy :=
TMycFuncLazy<Integer>.Create(
sourceDirty.State,
function: Integer
begin
procExecuted := True;
Result := expectedValue;
end);
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
+32 -14
View File
@@ -145,12 +145,15 @@ var
begin
procExecuted := False;
// FChangingSignal is reset in Setup
lazyIntf := TLazy<Integer>.Construct(FChangingSignal.State,
lazyIntf :=
TLazy<Integer>.Construct(
FChangingSignal.State,
function: Integer
begin
procExecuted := True;
Result := 10;
end);
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,
lazyIntf :=
TLazy<Integer>.Construct(
FChangingSignal.State,
function: Integer
begin
procExecuted := True;
Result := expectedValue;
end);
end
);
lazyRec := lazyIntf;
ConsumeInitialPop(lazyRec, expectedValue, 'TestConstruct_FirstPop');
@@ -229,12 +235,15 @@ var
procCallCount: Integer;
begin
procCallCount := 0;
lazyIntf := TLazy<Integer>.Construct(FChangingSignal.State,
lazyIntf :=
TLazy<Integer>.Construct(
FChangingSignal.State,
function: Integer
begin
Inc(procCallCount);
Result := 100 + procCallCount; // Value changes per call
end);
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,
lazyIntf :=
TLazy<Integer>.Construct(
FChangingSignal.State,
function: Integer
begin
Inc(procCallCount);
Result := 200 + procCallCount;
end);
end
);
lazyRec := lazyIntf;
// 1. Initial Pop
@@ -315,12 +327,12 @@ 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.');
'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,
originalLazyIntf :=
TLazy<Integer>.Construct(
FChangingSignal.State,
function: Integer
begin
Inc(procCallCount);
Result := 70 + procCallCount;
end);
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,
lazyIntf :=
TLazy<Integer>.Construct(
FChangingSignal.State,
function: Integer
begin
procExecuted := True;
Result := 100;
end);
end
);
lazyRec := lazyIntf;
ConsumeInitialPop(lazyRec, 100, 'TestPop_AfterInitialAndNoSignal (Initial)');
Test/TestCoreFutures.pas
+60 -31
View File
@@ -4,11 +4,13 @@ interface
uses
DUnitX.TestFramework,
System.SysUtils, System.Generics.Collections, // Added for TObjectList if needed, not strictly for this
System.SysUtils,
System.Generics.Collections, // Added for TObjectList if needed, not strictly for this
System.SyncObjs,
Myc.Signals, // For IMycLatch, TMycLatch, IMycState, IMycSubscriber [cite: 62, 68, 53, 45]
Myc.Core.Tasks, // For IMycTaskFactory, TMycTaskFactory [cite: 97, 113]
Myc.Futures, Myc.Core.Futures; // For IMycFuture, TMycInitStateFuncFuture
Myc.Futures,
Myc.Core.Futures; // For IMycFuture, TMycInitStateFuncFuture
type
// Helper class to notify a latch when its Notify method is called.
@@ -96,12 +98,16 @@ begin
// Use TMycLatch.Null for an already set init state [cite: 71, 81, 206, 216, 324, 334]
LInitStateAsState := TState.Null;
LFuture := TMycGateFuncFuture<Integer>.Create(FTaskFactory, LInitStateAsState,
LFuture :=
TMycGateFuncFuture<Integer>.Create(
FTaskFactory,
LInitStateAsState,
function: Integer
begin
Inc(Self.FProcExecutionCount);
Result := CExpectedResult;
end);
end
);
FTaskFactory.WaitFor(LFuture.Done); // Accesses IMycFuture.GetDone [cite: 110, 234, 352]
@@ -122,12 +128,16 @@ const
begin
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 :=
TMycGateFuncFuture<string>.Create(
FTaskFactory,
LInitLatch.State,
function: string
begin
Inc(Self.FProcExecutionCount);
Result := CExpectedResult;
end);
end
);
Assert.AreEqual(0, FProcExecutionCount, 'AProc should not have executed yet.');
Assert.IsFalse(LFuture.Done.IsSet, 'Future should not be done yet.');
@@ -157,12 +167,16 @@ begin
LLocalTaskFactory := TMycTaskFactory.Create;
LInitStateAsState := TState.Null; // Immediate execution
LFuture := TMycGateFuncFuture<Integer>.Create(LLocalTaskFactory, LInitStateAsState,
LFuture :=
TMycGateFuncFuture<Integer>.Create(
LLocalTaskFactory,
LInitStateAsState,
function: Integer
begin
Inc(Self.FProcExecutionCount);
raise Exception.Create(CExceptionMessage);
end);
end
);
try
LLocalTaskFactory.WaitFor(LFuture.Done);
@@ -210,30 +224,26 @@ var
begin
LInitLatch := TLatch.Construct(1);
LFuture := TMycGateFuncFuture<Integer>.Create(FTaskFactory, LInitLatch.State,
LFuture :=
TMycGateFuncFuture<Integer>.Create(
FTaskFactory,
LInitLatch.State,
function: Integer
begin
Inc(Self.FProcExecutionCount);
Result := 123;
end);
end
);
Assert.IsFalse(LFuture.Done.IsSet, 'Future should not be marked as done initially.');
Assert.WillRaise(
procedure
begin
LFuture.GetResult;
end );
Assert.WillRaise(procedure begin LFuture.GetResult; end);
LInitLatch.Notify;
FTaskFactory.WaitFor(LFuture.Done);
Assert.WillNotRaise(
procedure
begin
LFuture.GetResult;
end );
Assert.WillNotRaise(procedure begin LFuture.GetResult; end);
end;
procedure TTestMycGateFuncFuture.Test_FanIn_OneFutureWaitsForMultipleOthers;
@@ -253,33 +263,45 @@ begin
LGateLatch := TLatch.Construct(2); // [cite: 77, 212, 330]
// Create MainFuture, AInitState is the GateLatch's state.
LMainFuture := TMycGateFuncFuture<string>.Create(FTaskFactory, LGateLatch.State,
LMainFuture :=
TMycGateFuncFuture<string>.Create(
FTaskFactory,
LGateLatch.State,
function: string
begin
Inc(Self.FProcExecutionCount, 10); // Indicate MainFuture's proc ran
Result := CMainFutureResult;
end);
end
);
// Setup Prerequisite Futures
// PrerequisiteFuture1
LInitStateP1 := TLatch.Construct(1); // Controllable init state for PF1
LPrerequisiteFuture1 := TMycGateFuncFuture<Integer>.Create(FTaskFactory, LInitStateP1.State,
LPrerequisiteFuture1 :=
TMycGateFuncFuture<Integer>.Create(
FTaskFactory,
LInitStateP1.State,
function: Integer
begin
Inc(Self.FProcExecutionCount, 1); // PF1 ran
Result := 1;
end);
end
);
LSub1 := TLatchNotifierSubscriber.Create(LGateLatch);
Subscriptions[1] := LPrerequisiteFuture1.Done.Subscribe(LSub1); // Subscribe to PF1's completion [cite: 56, 188, 306]
// PrerequisiteFuture2
LInitStateP2 := TLatch.Construct(1); // Controllable init state for PF2
LPrerequisiteFuture2 := TMycGateFuncFuture<Integer>.Create(FTaskFactory, LInitStateP2.State,
LPrerequisiteFuture2 :=
TMycGateFuncFuture<Integer>.Create(
FTaskFactory,
LInitStateP2.State,
function: Integer
begin
Inc(Self.FProcExecutionCount, 1); // PF2 ran
Result := 2;
end);
end
);
LSub2 := TLatchNotifierSubscriber.Create(LGateLatch);
Subscriptions[2] := LPrerequisiteFuture2.Done.Subscribe(LSub2); // Subscribe to PF2's completion
@@ -294,7 +316,6 @@ begin
Assert.IsFalse(LMainFuture.Done.IsSet, 'MainFuture should still not be done.');
Assert.AreEqual(1, FProcExecutionCount mod 10, 'Only PF1 AProc should have run.');
// Trigger PrerequisiteFuture2
LInitStateP2.Notify; //
FTaskFactory.WaitFor(LPrerequisiteFuture2.Done); // Ensure PF2 completes and notifies GateLatch
@@ -325,22 +346,30 @@ begin
LTriggerLatch := TLatch.Construct(1); // Single trigger [cite: 77, 212, 330]
// Future A
LFutureA := TMycGateFuncFuture<Integer>.Create(FTaskFactory, LTriggerLatch.State,
LFutureA :=
TMycGateFuncFuture<Integer>.Create(
FTaskFactory,
LTriggerLatch.State,
function: Integer
begin
LFlagFutureARan := True;
System.SyncObjs.TInterlocked.Increment(Self.FSharedCounter); // Thread-safe increment
Result := 100;
end);
end
);
// Future B
LFutureB := TMycGateFuncFuture<Integer>.Create(FTaskFactory, LTriggerLatch.State,
LFutureB :=
TMycGateFuncFuture<Integer>.Create(
FTaskFactory,
LTriggerLatch.State,
function: Integer
begin
LFlagFutureBRan := True;
System.SyncObjs.TInterlocked.Increment(Self.FSharedCounter); // Thread-safe increment
Result := 200;
end);
end
);
Assert.IsFalse(LFutureA.Done.IsSet, 'FutureA should not be done yet.');
Assert.IsFalse(LFutureB.Done.IsSet, 'FutureB should not be done yet.');
Test/TestFutures.pas
+59 -37
View File
@@ -74,7 +74,8 @@ var
resultValue: Integer;
begin
// Test construction with a simple function that returns an Integer
fut := TFuture<Integer>.Construct( // [cite: 146]
fut :=
TFuture<Integer>.Construct( // [cite: 146]
function: Integer
begin
TThread.Sleep(20); // Simulate some background work
@@ -97,7 +98,9 @@ var
resultValue: Integer;
begin
// Test construction with a nil gate, which should execute the task immediately
fut := TFuture<Integer>.Construct( nil, // Explicitly providing a nil gate [cite: 147]
fut :=
TFuture<Integer>.Construct(
nil, // Explicitly providing a nil gate [cite: 147]
function: Integer
begin
TThread.Sleep(20); // Simulate work
@@ -124,7 +127,9 @@ begin
Assert.IsTrue(presetGate.IsSet, 'The preset gate (State.Null) should be initially set.'); // Static string [cite: 55]
// Construct a future with a gate that is already set
fut := TFuture<Integer>.Construct( presetGate, // [cite: 147]
fut :=
TFuture<Integer>.Construct(
presetGate, // [cite: 147]
function: Integer
begin
Result := 44; // This should execute quickly
@@ -151,11 +156,10 @@ begin
Assert.IsFalse(delayedGate.State.IsSet, 'The delayed gate should not be initially set.'); // Static string [cite: 59, 55]
// Construct a future with a gate that is not yet set
fut := TFuture<Integer>.Construct( delayedGate.State, // Get the IMycState interface from the latch [cite: 147, 59]
function: Integer
begin
Result := 45;
end
fut :=
TFuture<Integer>.Construct(
delayedGate.State, // Get the IMycState interface from the latch [cite: 147, 59]
function: Integer begin Result := 45; end
);
Assert.IsNotNull(fut.Done, 'Future.Done should not be nil for delayed gate construct.'); // Static string [cite: 148]
@@ -184,7 +188,8 @@ var
resultValue: string;
begin
// Create an initial future
fut1 := TFuture<Integer>.Construct( // [cite: 146]
fut1 :=
TFuture<Integer>.Construct( // [cite: 146]
function: Integer
begin
TThread.Sleep(20); // Simulate work
@@ -193,7 +198,8 @@ begin
);
// Chain a second future that depends on the result of the first
fut2 := fut1.Chain<string>( // [cite: 147]
fut2 :=
fut1.Chain<string>( // [cite: 147]
function(Input: Integer): string // This function receives the result of fut1
begin
TThread.Sleep(20); // Simulate further work
@@ -222,19 +228,16 @@ begin
// Static string [cite: 59, 55]
// First future depends on the delayedGate
fut1 := TFuture<Integer>.Construct( delayedGate.State, // [cite: 147, 59]
function: Integer
begin
Result := 200;
end
fut1 :=
TFuture<Integer>.Construct(
delayedGate.State, // [cite: 147, 59]
function: Integer begin Result := 200; end
);
// Second future is chained to the first
fut2 := fut1.Chain<string>( // [cite: 147]
function( Input: Integer ): string
begin
Result := 'ChainVal: ' + Input.ToString;
end
fut2 :=
fut1.Chain<string>( // [cite: 147]
function(Input: Integer): string begin Result := 'ChainVal: ' + Input.ToString; end
);
Assert.IsNotNull(fut2.Done, 'Chained (with gate) Future.Done should not be nil.'); // Static string [cite: 148]
@@ -264,7 +267,8 @@ var
finalResult: string;
begin
// Initial future A
futA := TFuture<Integer>.Construct( // [cite: 146]
futA :=
TFuture<Integer>.Construct( // [cite: 146]
function: Integer
begin
TThread.Sleep(10);
@@ -273,7 +277,8 @@ begin
);
// Future B, chained from A
futB := futA.Chain<Real>( // [cite: 147]
futB :=
futA.Chain<Real>( // [cite: 147]
function(InputA: Integer): Real
begin
TThread.Sleep(10);
@@ -282,7 +287,8 @@ begin
);
// Future C, chained from B
futC := futB.Chain<string>( // [cite: 147]
futC :=
futB.Chain<string>( // [cite: 147]
function(InputB: Real): string
begin
TThread.Sleep(10);
@@ -311,7 +317,8 @@ var
resultValue: string;
begin
// Parametric test for Future<string>
fut := TFuture<string>.Construct( // [cite: 146]
fut :=
TFuture<string>.Construct( // [cite: 146]
function: string
begin
TThread.Sleep(10);
@@ -346,11 +353,13 @@ begin
for i := 0 to High(Futures) do
begin
// 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
Result := function: Integer
Result :=
function: Integer
var
delay: Integer;
begin
@@ -358,7 +367,8 @@ begin
TThread.Sleep(delay);
Result := captureIndex; // Return the captured index
end;
end )( i )
end
)(i)
);
doneStates[i] := Futures[i].Done; // [cite: 148]
end;
@@ -367,7 +377,9 @@ begin
Assert.IsNotNull(combinedStateAll, 'State.All should return a valid IMycState.'); // Static string
// Create a master future that waits on the combined State.All state
masterFuture := TFuture<Boolean>.Construct( combinedStateAll, // [cite: 147]
masterFuture :=
TFuture<Boolean>.Construct(
combinedStateAll, // [cite: 147]
function: Boolean
begin
Result := True; // This function executes when combinedStateAll is set
@@ -411,11 +423,13 @@ begin
for i := 0 to High(Futures) do
begin
// Capture loop variable
Futures[i] := TFuture<Integer>.Construct( // [cite: 146]
Futures[i] :=
TFuture<Integer>.Construct( // [cite: 146]
(
function(captureIndex: Integer): TFunc<Integer>
begin
Result := function: Integer
Result :=
function: Integer
var
delay: Integer;
begin
@@ -426,7 +440,8 @@ begin
TThread.Sleep(delay);
Result := captureIndex;
end;
end )( i )
end
)(i)
);
doneStates[i] := Futures[i].Done; // [cite: 148]
end;
@@ -435,7 +450,9 @@ begin
Assert.IsNotNull(combinedStateAny, 'State.Any should return a valid IMycState.'); // Static string
// Create a master future that waits on the combined State.Any state
masterFuture := TFuture<Boolean>.Construct( combinedStateAny, // [cite: 147]
masterFuture :=
TFuture<Boolean>.Construct(
combinedStateAny, // [cite: 147]
function: Boolean
begin
Result := True; // This function executes when combinedStateAny is set
@@ -474,11 +491,13 @@ var
finalResult: Integer;
begin
// Create an outer future that, when resolved, produces another (inner) future.
outerFuture := TFuture < TFuture < Integer >>.Construct( // [cite: 146]
outerFuture :=
TFuture<TFuture<Integer>>.Construct( // [cite: 146]
function: TFuture<Integer> // This lambda returns a Future<Integer>
begin
TThread.Sleep(10); // Simulate work for the outer future to produce the inner one
Result := TFuture<Integer>.Construct( // [cite: 146]
Result :=
TFuture<Integer>.Construct( // [cite: 146]
function: Integer
begin
TThread.Sleep(10); // Simulate work for the inner future
@@ -511,7 +530,8 @@ var
finalResult: string;
begin
// Create an initial future
initialFuture := TFuture<Integer>.Construct( // [cite: 146]
initialFuture :=
TFuture<Integer>.Construct( // [cite: 146]
function: Integer
begin
TThread.Sleep(10);
@@ -520,12 +540,14 @@ begin
);
// Chain it with a function that itself returns a new Future<string>
outerChainedFuture := initialFuture.Chain < TFuture < string >> ( // [cite: 147]
outerChainedFuture :=
initialFuture.Chain<TFuture<string>>( // [cite: 147]
function(Input: Integer): TFuture<string> // This lambda returns a Future<string>
begin
TThread.Sleep(10); // Simulate work in the chain function
// Input is the result of initialFuture (77)
Result := TFuture<string>.Construct( // [cite: 146]
Result :=
TFuture<string>.Construct( // [cite: 146]
function: string
begin
TThread.Sleep(10); // Simulate work for the inner-most future
Test/TestNotifier.pas
+2 -1
View File
@@ -105,7 +105,8 @@ var
dummyPredicate: TPredicate<IMyTestInterface>;
begin
predicateCallCount := 0;
dummyPredicate := function( Item: IMyTestInterface ): Boolean
dummyPredicate :=
function(Item: IMyTestInterface): Boolean
begin
Inc(predicateCallCount);
Result := True;
Test/TestNotifier_ChaosStress.pas
+39 -18
View File
@@ -20,8 +20,7 @@ type
function GetInstanceID: Integer;
function GetExpectedToBeAdvised: Boolean;
procedure SetExpectedToBeAdvised(const Value: Boolean);
property ExpectedToBeAdvised: Boolean read GetExpectedToBeAdvised write
SetExpectedToBeAdvised;
property ExpectedToBeAdvised: Boolean read GetExpectedToBeAdvised write SetExpectedToBeAdvised;
end;
TMyStressReceiver = class(TInterfacedObject, IMyStressTestInterface)
@@ -39,8 +38,7 @@ type
function GetValue: Integer;
function GetNotificationCount: Integer;
function GetInstanceID: Integer;
property ExpectedToBeAdvised: Boolean read GetExpectedToBeAdvised write
SetExpectedToBeAdvised;
property ExpectedToBeAdvised: Boolean read GetExpectedToBeAdvised write SetExpectedToBeAdvised;
end;
// Record type to store an advised receiver and its tag
@@ -165,7 +163,8 @@ begin
try
for i := 1 to FIterations do
begin
if Terminated then Break; // Respond to termination request
if Terminated then
Break; // Respond to termination request
op := Random(100);
@@ -218,14 +217,16 @@ begin
begin
Item.Foo(FThreadID); // Pass ThreadID as notification type for context
Result := True; // Keep item
end);
end
);
end;
finally
FOwnerFixture.FNotifier.Release;
end;
end;
if (i mod 75 = 0) then Sleep(0); // Yield occasionally to encourage context switching
if (i mod 75 = 0) then
Sleep(0); // Yield occasionally to encourage context switching
end;
except
on E: Exception do
@@ -250,7 +251,6 @@ end;
// end;
// end;
{ TMycNotifierChaosStressTests }
procedure TMycNotifierChaosStressTests.Setup;
begin
@@ -337,8 +337,7 @@ begin
begin
// If an error occurred, Assert.IsNull would fail.
// The message can safely use LThreadError.Message here.
Assert.IsNull(LThreadError,
'Thread ' + threads[i].FThreadID.ToString + ' reported an error: ' + LThreadError.Message);
Assert.IsNull(LThreadError, 'Thread ' + threads[i].FThreadID.ToString + ' reported an error: ' + LThreadError.Message);
end
else
begin
@@ -364,7 +363,8 @@ begin
begin
actualLiveReceiversInNotifier.Add(Item);
Result := True;
end);
end
);
end;
finally
FNotifier.Release;
@@ -372,8 +372,14 @@ begin
actualLiveInNotifierAtEnd := actualLiveReceiversInNotifier.Count;
// 2. Compare overall counts
Assert.AreEqual(totalExpectedLiveByThreadsAtEnd, actualLiveInNotifierAtEnd,
Format('Mismatch in live item count at end. Threads expected %d, Notifier has %d.', [totalExpectedLiveByThreadsAtEnd, actualLiveInNotifierAtEnd]));
Assert.AreEqual(
totalExpectedLiveByThreadsAtEnd,
actualLiveInNotifierAtEnd,
Format(
'Mismatch in live item count at end. Threads expected %d, Notifier has %d.',
[totalExpectedLiveByThreadsAtEnd, actualLiveInNotifierAtEnd]
)
);
// 3. Detailed check: Iterate all receivers ever created.
// Their 'ExpectedToBeAdvised' flag (last known state from its managing thread)
@@ -393,14 +399,29 @@ begin
end;
end;
Assert.AreEqual(receiver.ExpectedToBeAdvised, found,
Format('Receiver ID %d: Thread expected it to be advised=%d, but its presence in Notifier is %d. NotificationCount=%d',
[receiver.GetInstanceID, Integer(receiver.ExpectedToBeAdvised), Integer(found), receiver.GetNotificationCount]));
Assert.AreEqual(
receiver.ExpectedToBeAdvised,
found,
Format(
'Receiver ID %d: Thread expected it to be advised=%d, but its presence in Notifier is %d. NotificationCount=%d',
[
receiver.GetInstanceID,
Integer(receiver.ExpectedToBeAdvised),
Integer(found),
receiver.GetNotificationCount
]
)
);
// Further checks on NotificationCount could be added if specific notification patterns were expected.
// For this chaos test, ensuring count is non-negative and consistent with advised state is a good start.
Assert.IsTrue(receiver.GetNotificationCount >= 0,
Format('Receiver ID %d has non-positive notification count: %d', [receiver.GetInstanceID, receiver.GetNotificationCount]));
Assert.IsTrue(
receiver.GetNotificationCount >= 0,
Format(
'Receiver ID %d has non-positive notification count: %d',
[receiver.GetInstanceID, receiver.GetNotificationCount]
)
);
if found and (receiver.GetNotificationCount = 0) then
begin
// This might be okay if Notify calls were very sparse or the item was just added and not yet notified.
Test/TestNotifier_Threading.pas
+16 -6
View File
@@ -127,7 +127,8 @@ begin
// Acquire lock before calling Advise
FOwnerFixture.FNotifier.Lock;
try
{var tag :=} FOwnerFixture.FNotifier.Advise(FReceiversToAdd[i]);
{var tag :=}
FOwnerFixture.FNotifier.Advise(FReceiversToAdd[i]);
// The 'tag' could be used here if necessary for other test scenarios
finally
// Definitely release lock in the finally block
@@ -264,9 +265,15 @@ begin
finally
FNotifier.Release;
end;
Assert.AreEqual(totalAdvisedExpected, currentNotifyCount,
'The number of items in the Notifier after all Advise operations (' + currentNotifyCount.ToString +
') does not match the expected number (' + totalAdvisedExpected.ToString + ').');
Assert.AreEqual(
totalAdvisedExpected,
currentNotifyCount,
'The number of items in the Notifier after all Advise operations ('
+ currentNotifyCount.ToString
+ ') does not match the expected number ('
+ totalAdvisedExpected.ToString
+ ').'
);
// 2. Execute UnadviseAll
FNotifier.Lock;
@@ -290,8 +297,11 @@ begin
finally
FNotifier.Release;
end;
Assert.AreEqual(0, currentNotifyCount,
'The Notifier should be empty after UnadviseAll, but still contains ' + currentNotifyCount.ToString + ' items.');
Assert.AreEqual(
0,
currentNotifyCount,
'The Notifier should be empty after UnadviseAll, but still contains ' + currentNotifyCount.ToString + ' items.'
);
end;
initialization
Test/TestSignals_Latch.pas
+20 -4
View File
@@ -128,7 +128,11 @@ begin
Assert.AreEqual(ExpectedIsSet, latch.State.IsSet, 'Latch initial IsSet state mismatch for count ' + IntToStr(InitialCount) + '.');
end;
procedure TTestMycLatch.TestNotify_ReturnValueAndState_AfterOneNotify(InitialCount: Integer; ExpectedReturn: Boolean; ExpectedIsSet: Boolean);
procedure TTestMycLatch.TestNotify_ReturnValueAndState_AfterOneNotify(
InitialCount: Integer;
ExpectedReturn: Boolean;
ExpectedIsSet: Boolean
);
var
latch: IMycLatch;
returnedValueFromNotify: Boolean;
@@ -136,8 +140,16 @@ begin
latch := TLatch.Construct(InitialCount);
returnedValueFromNotify := latch.Notify; // This is IMycLatch (as IMycSubscriber).Notify
Assert.AreEqual(ExpectedReturn, returnedValueFromNotify, 'Unexpected return value from Latch.Notify call for initial count ' + IntToStr(InitialCount) + '.');
Assert.AreEqual(ExpectedIsSet, latch.State.IsSet, 'Unexpected IsSet state after Latch.Notify call for initial count ' + IntToStr(InitialCount) + '.');
Assert.AreEqual(
ExpectedReturn,
returnedValueFromNotify,
'Unexpected return value from Latch.Notify call for initial count ' + IntToStr(InitialCount) + '.'
);
Assert.AreEqual(
ExpectedIsSet,
latch.State.IsSet,
'Unexpected IsSet state after Latch.Notify call for initial count ' + IntToStr(InitialCount) + '.'
);
end;
procedure TTestMycLatch.TestNotify_DecrementsCounter_StateChanges;
@@ -492,7 +504,11 @@ begin
Assert.AreEqual(1, mockSubInitial.NotifyCount, 'Initial subscriber (unadvised) not notified again.');
// mockSubNew should also not be notified again, as it was only notified immediately
// and not persistently added to FSubscribers for subsequent Latch.Notify calls.
Assert.AreEqual(1, mockSubNew.NotifyCount, 'New subscriber (notified once on subscribe) not notified by subsequent Latch.Notify calls.');
Assert.AreEqual(
1,
mockSubNew.NotifyCount,
'New subscriber (notified once on subscribe) not notified by subsequent Latch.Notify calls.'
);
end;
initialization
Test/TestTasks.pas
+19 -21
View File
@@ -8,7 +8,8 @@ uses
System.Classes,
System.SyncObjs,
Myc.Core.Tasks,
Myc.Signals, Myc.Core.Signals,
Myc.Signals,
Myc.Core.Signals,
Myc.Core.Atomic;
type
@@ -73,10 +74,7 @@ var
procWrapper: TProc;
begin
executed := False;
procWrapper := procedure
begin
executed := True;
end;
procWrapper := procedure begin executed := True; end;
threadState := FFactory.CreateThread(procWrapper); // CreateThread in TaskFactory now uses TMycLatch.CreateLatch
Assert.IsNotNull(threadState, 'CreateThread should return a valid state object');
@@ -93,12 +91,14 @@ begin
jobExecuted := False;
jobCompletedLatch := TLatch.Construct(1); // Changed from Signals.CreateLatch
FFactory.Run(
FFactory
.Run(
procedure
begin
jobExecuted := True;
jobCompletedLatch.Notify;
end).Notify;
end)
.Notify;
FFactory.WaitFor(jobCompletedLatch.State);
Assert.IsTrue(jobExecuted, 'Immediate job should have executed');
@@ -113,12 +113,14 @@ begin
jobExecuted := False;
jobCompletedLatch := TLatch.Construct(1); // Changed from Signals.CreateLatch
subscriber := FFactory.Run(
subscriber :=
FFactory.Run(
procedure
begin
jobExecuted := True;
jobCompletedLatch.Notify;
end);
end
);
Assert.IsNotNull(subscriber, 'Run should return a subscriber for delayed job');
// Use TMycLatch.Null for comparison
@@ -130,7 +132,6 @@ begin
Assert.IsTrue(jobExecuted, 'Delayed job should execute after all notifications');
end;
procedure TMycTaskFactoryTests.TestWaitForAlreadySetState;
var
alreadySetLatch: IMycLatch;
@@ -166,7 +167,8 @@ begin
inMainThreadInJob := FFactory.InMainThread;
inWorkerThreadInJob := FFactory.InWorkerThread;
jobDoneLatch.Notify;
end);
end
);
FFactory.WaitFor(jobDoneLatch.State);
@@ -188,13 +190,11 @@ begin
finally
jobDoneLatch.Notify;
end;
end);
end
);
Assert.WillRaise(
procedure
begin
FFactory.WaitFor(jobDoneLatch.State);
end,
procedure begin FFactory.WaitFor(jobDoneLatch.State); end,
TMycTaskFactory.ETaskException,
'WaitFor should re-raise the exception from the job'
);
@@ -213,10 +213,7 @@ begin
FFactory.Teardown;
Assert.WillRaise(
procedure
begin
FFactory.EnqueueJob(procedure begin end);
end,
procedure begin FFactory.EnqueueJob(procedure begin end); end,
TMycTaskFactory.ETaskException,
'Running a job on a torn-down factory should raise ETaskException'
);
@@ -244,7 +241,8 @@ begin
end;
end;
jobDoneLatch.Notify;
end);
end
);
FFactory.WaitFor(jobDoneLatch.State);
Assert.IsTrue(exceptionCaughtInJob, 'WaitFor called within a worker thread job should raise ETaskException');