added Futures

This commit is contained in:
Michael Schimmel
2025-06-02 00:45:30 +02:00
parent ca101a3452
commit 63484cd495
15 changed files with 1625 additions and 4126 deletions
+18 -32
View File
@@ -13,10 +13,10 @@ uses
type
[TestFixture]
[IgnoreMemoryLeaks(true)]
TMycTaskFactoryTests = class(TObject)
private
FFactory: IMycTaskFactory;
procedure TestProcExecute(var executed: Boolean; signal: IMycLatch); // Parameter type is IMycLatch
public
[Setup]
procedure Setup;
@@ -63,20 +63,9 @@ begin
end;
end;
procedure TMycTaskFactoryTests.TestProcExecute(var executed: Boolean; signal: IMycLatch);
begin
executed := True;
if Assigned(signal) then
signal.Notify;
end;
procedure TMycTaskFactoryTests.TestFactoryCreationAndTeardown;
var
threadCount: Integer;
begin
Assert.IsNotNull(FFactory, 'Factory should be created');
threadCount := FFactory.ThreadCount;
Assert.AreEqual(TThread.ProcessorCount, threadCount, 'Thread count should match processor count');
end;
procedure TMycTaskFactoryTests.TestCreateThreadExecutesAndSignals;
@@ -149,22 +138,22 @@ end;
procedure TMycTaskFactoryTests.TestRunDelayedJobDoesNotExecutePrematurely;
var
jobExecuted: Boolean;
jobCompletedLatch: IMycLatch;
jobCompleted: IMycLatch;
subscriber: IMycSubscriber;
startCount: Integer;
dummyWaitLatch: IMycLatch;
dummyWait: IMycLatch;
begin
jobExecuted := False;
startCount := 3;
jobCompletedLatch := TMycLatch.CreateLatch(1); // Changed from Signals.CreateLatch
dummyWaitLatch := TMycLatch.CreateLatch(1); // Changed from Signals.CreateLatch
jobCompleted := TMycLatch.CreateLatch(1); // Changed from Signals.CreateLatch
dummyWait := TMycLatch.CreateLatch(1); // Changed from Signals.CreateLatch
subscriber := FFactory.Run(startCount,
procedure
begin
jobExecuted := True;
jobCompletedLatch.Notify;
jobCompleted.Notify;
end);
Assert.IsNotNull(subscriber, 'Run should return a subscriber for delayed job_P2');
@@ -175,8 +164,8 @@ begin
subscriber.Notify;
Assert.IsFalse(jobExecuted, 'Job should not execute after two notifications_P2');
FFactory.Run(0, procedure begin dummyWaitLatch.Notify; end);
FFactory.WaitFor(dummyWaitLatch.State);
FFactory.Run(0, procedure begin dummyWait.Notify; end);
FFactory.WaitFor(dummyWait.State);
Assert.IsFalse(jobExecuted, 'Job should still not have executed before third notify_P2');
end;
@@ -229,28 +218,25 @@ procedure TMycTaskFactoryTests.TestExceptionPropagationFromJob;
var
jobDoneLatch: IMycLatch;
begin
jobDoneLatch := TMycLatch.CreateLatch(1); // Changed from Signals.CreateLatch
jobDoneLatch := TMycLatch.CreateLatch(1);
FFactory.Run(0,
procedure
var
dummy: Integer;
begin
dummy := 0;
raise TMycTaskFactory.ETaskException.Create('Test Exception From Job');
// jobDoneLatch.Notify; // This line will not be reached
try
raise TMycTaskFactory.ETaskException.Create('Test Exception From Job');
finally
jobDoneLatch.Notify;
end;
end);
FFactory.Run(0, procedure begin jobDoneLatch.Notify; end);
FFactory.WaitFor(jobDoneLatch.State);
Assert.WillRaise(
procedure
begin
(FFactory as TMycTaskFactory).HandleException;
FFactory.WaitFor(jobDoneLatch.State);
end,
TMycTaskFactory.ETaskException,
'HandleException should re-raise the exception from the job'
'WaitFor should re-raise the exception from the job'
);
var noExceptionRaised: Boolean := True;
@@ -283,8 +269,8 @@ var
dummyStateToWaitFor: IMycState;
begin
exceptionCaughtInJob := False;
jobDoneLatch := TMycLatch.CreateLatch(1); // Changed from Signals.CreateLatch
dummyStateToWaitFor := TMycLatch.CreateLatch(1).State; // Changed from Signals.CreateLatch
jobDoneLatch := TMycLatch.CreateLatch(1);
dummyStateToWaitFor := TMycLatch.CreateLatch(1).State;
FFactory.Run(0,
procedure