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

renamed Semaphore to Latch

Browse Source
This commit is contained in:
Michael Schimmel
2025-05-27 11:51:06 +02:00
parent 95fddb0181
commit ca101a3452
7 changed files with 640 additions and 593 deletions
Download Patch File Download Diff File Expand all files Collapse all files
Test/TestTasks.pas
+60 -74
View File
@@ -8,15 +8,15 @@ uses
System.Classes,
System.SyncObjs,
Myc.Core.Tasks,
Myc.Signals, // For IMycSemaphore, Signals global
Myc.Core.Atomic; // If any atomic primitives are directly needed for test setup/assertion
Myc.Signals, // Uses TMycLatch.CreateLatch and TMycLatch.Null
Myc.Core.Atomic;
type
[TestFixture]
TMycTaskFactoryTests = class(TObject)
private
FFactory: IMycTaskFactory;
procedure TestProcExecute(var executed: Boolean; signal: IMycSemaphore);
procedure TestProcExecute(var executed: Boolean; signal: IMycLatch); // Parameter type is IMycLatch
public
[Setup]
procedure Setup;
@@ -51,19 +51,19 @@ implementation
procedure TMycTaskFactoryTests.Setup;
begin
FFactory := TMycTaskFactory.Create; // Creates the factory instance
FFactory := TMycTaskFactory.Create;
end;
procedure TMycTaskFactoryTests.TearDown;
begin
if Assigned(FFactory) then
begin
FFactory.Teardown; // Explicitly teardown
FFactory.Teardown;
FFactory := nil;
end;
end;
procedure TMycTaskFactoryTests.TestProcExecute(var executed: Boolean; signal: IMycSemaphore);
procedure TMycTaskFactoryTests.TestProcExecute(var executed: Boolean; signal: IMycLatch);
begin
executed := True;
if Assigned(signal) then
@@ -77,7 +77,6 @@ begin
Assert.IsNotNull(FFactory, 'Factory should be created');
threadCount := FFactory.ThreadCount;
Assert.AreEqual(TThread.ProcessorCount, threadCount, 'Thread count should match processor count');
// Teardown is implicitly tested by the [TearDown] method
end;
procedure TMycTaskFactoryTests.TestCreateThreadExecutesAndSignals;
@@ -87,102 +86,97 @@ var
procWrapper: TProc;
begin
executed := False;
// Wrap the procedure to match TProc signature if TestProcExecute is used,
// or define an anonymous procedure directly.
procWrapper := procedure
begin
executed := True;
end;
threadState := FFactory.CreateThread(procWrapper);
threadState := FFactory.CreateThread(procWrapper); // CreateThread in TaskFactory now uses TMycLatch.CreateLatch
Assert.IsNotNull(threadState, 'CreateThread should return a valid state object');
FFactory.WaitFor(threadState); // Wait for the thread to complete
FFactory.WaitFor(threadState);
Assert.IsTrue(executed, 'Procedure in created thread should have executed');
end;
procedure TMycTaskFactoryTests.TestRunImmediateJob;
var
jobExecuted: Boolean;
jobCompletedSignal: IMycSemaphore;
jobCompletedLatch: IMycLatch;
begin
jobExecuted := False;
jobCompletedSignal := Signals.CreateSemaphore(1); // Semaphore to signal job completion
jobCompletedLatch := TMycLatch.CreateLatch(1); // Changed from Signals.CreateLatch
FFactory.Run(0, // StartCount = 0 for immediate execution
FFactory.Run(0,
procedure
begin
jobExecuted := True;
jobCompletedSignal.Notify; // Signal completion
jobCompletedLatch.Notify;
end);
FFactory.WaitFor(jobCompletedSignal.State); // Wait for the job to complete
FFactory.WaitFor(jobCompletedLatch.State);
Assert.IsTrue(jobExecuted, 'Immediate job should have executed');
end;
procedure TMycTaskFactoryTests.TestRunDelayedJobExecutesAfterAllNotifies;
var
jobExecuted: Boolean;
jobCompletedSignal: IMycSemaphore;
jobCompletedLatch: IMycLatch;
subscriber: IMycSubscriber;
startCount: Integer;
begin
jobExecuted := False;
startCount := 2;
jobCompletedSignal := Signals.CreateSemaphore(1);
jobCompletedLatch := TMycLatch.CreateLatch(1); // Changed from Signals.CreateLatch
subscriber := FFactory.Run(startCount,
procedure
begin
jobExecuted := True;
jobCompletedSignal.Notify;
jobCompletedLatch.Notify;
end);
Assert.IsNotNull(subscriber, 'Run should return a subscriber for delayed job');
// Corrected line:
Assert.AreNotEqual<IMycSubscriber>(Signals.Null, subscriber, 'Subscriber should not be Signals.Null for StartCount > 0');
// Use TMycLatch.Null for comparison
Assert.AreNotEqual<IMycSubscriber>(TMycLatch.Null, subscriber, 'Subscriber should not be TMycLatch.Null for StartCount > 0');
subscriber.Notify; // First notification
subscriber.Notify; // Second notification, job should now be enqueued
subscriber.Notify;
subscriber.Notify;
FFactory.WaitFor(jobCompletedSignal.State); // Wait for job completion
FFactory.WaitFor(jobCompletedLatch.State);
Assert.IsTrue(jobExecuted, 'Delayed job should execute after all notifications');
end;
procedure TMycTaskFactoryTests.TestRunDelayedJobDoesNotExecutePrematurely;
var
jobExecuted: Boolean;
jobCompletedSignal: IMycSemaphore; // Not strictly needed here as job shouldn't run
jobCompletedLatch: IMycLatch;
subscriber: IMycSubscriber;
startCount: Integer;
dummyWaitSignal: IMycSemaphore;
dummyWaitLatch: IMycLatch;
begin
jobExecuted := False;
startCount := 3;
jobCompletedSignal := Signals.CreateSemaphore(1); // For the job, if it were to run
dummyWaitSignal := Signals.CreateSemaphore(1);
jobCompletedLatch := TMycLatch.CreateLatch(1); // Changed from Signals.CreateLatch
dummyWaitLatch := TMycLatch.CreateLatch(1); // Changed from Signals.CreateLatch
subscriber := FFactory.Run(startCount,
procedure
begin
jobExecuted := True;
jobCompletedSignal.Notify;
jobCompletedLatch.Notify;
end);
Assert.IsNotNull(subscriber, 'Run should return a subscriber for delayed job_P2');
subscriber.Notify; // First notification
subscriber.Notify;
Assert.IsFalse(jobExecuted, 'Job should not execute after one notification_P2');
subscriber.Notify; // Second notification
subscriber.Notify;
Assert.IsFalse(jobExecuted, 'Job should not execute after two notifications_P2');
// To give a very brief moment for any potential async execution attempt.
// This is not foolproof for catching race conditions but can help.
// A more robust way is harder without specific test hooks in the factory.
FFactory.Run(0, procedure begin dummyWaitSignal.Notify; end);
FFactory.WaitFor(dummyWaitSignal.State); // Ensures task queue is processed slightly
FFactory.Run(0, procedure begin dummyWaitLatch.Notify; end);
FFactory.WaitFor(dummyWaitLatch.State);
Assert.IsFalse(jobExecuted, 'Job should still not have executed before third notify_P2');
end;
@@ -190,18 +184,17 @@ end;
procedure TMycTaskFactoryTests.TestWaitForAlreadySetState;
var
alreadySetSignal: IMycSemaphore;
alreadySetLatch: IMycLatch;
startTime, endTime: Cardinal;
begin
alreadySetSignal := Signals.CreateSemaphore(0); // Count = 0 means it's already set
Assert.IsTrue(alreadySetSignal.State.IsSet, 'Signal should be initially set');
// TMycLatch.CreateLatch(0) will return TMycLatch.Null
alreadySetLatch := TMycLatch.CreateLatch(0); // Changed from Signals.CreateLatch
Assert.IsTrue(alreadySetLatch.State.IsSet, 'Latch should be initially set');
startTime := TThread.GetTickCount;
FFactory.WaitFor(alreadySetSignal.State); // Should return immediately
FFactory.WaitFor(alreadySetLatch.State);
endTime := TThread.GetTickCount;
// Check that WaitFor didn't block for a significant time
// Allow a small delta for processing, e.g., less than 50ms
Assert.IsTrue((endTime - startTime) < 50, 'WaitFor on an already set state should not block significantly');
end;
@@ -209,11 +202,11 @@ procedure TMycTaskFactoryTests.TestThreadInfoMethods;
var
inMainThreadInJob: Boolean;
inWorkerThreadInJob: Boolean;
jobDoneSignal: IMycSemaphore;
jobDoneLatch: IMycLatch;
begin
inMainThreadInJob := True; // Default to a state that would fail the assert
inWorkerThreadInJob := False; // Default to a state that would fail the assert
jobDoneSignal := Signals.CreateSemaphore(1);
inMainThreadInJob := True;
inWorkerThreadInJob := False;
jobDoneLatch := TMycLatch.CreateLatch(1); // Changed from Signals.CreateLatch
Assert.IsTrue(FFactory.InMainThread, 'Test method itself should be in main thread');
Assert.IsFalse(FFactory.InWorkerThread, 'Test method itself should not be in a factory worker thread');
@@ -223,10 +216,10 @@ begin
begin
inMainThreadInJob := FFactory.InMainThread;
inWorkerThreadInJob := FFactory.InWorkerThread;
jobDoneSignal.Notify;
jobDoneLatch.Notify;
end);
FFactory.WaitFor(jobDoneSignal.State); // Wait for the job to complete and set flags
FFactory.WaitFor(jobDoneLatch.State);
Assert.IsFalse(inMainThreadInJob, 'Job executed by factory should not be in main thread');
Assert.IsTrue(inWorkerThreadInJob, 'Job executed by factory should be in a worker thread');
@@ -234,39 +227,35 @@ end;
procedure TMycTaskFactoryTests.TestExceptionPropagationFromJob;
var
jobDoneSignal: IMycSemaphore; // To ensure job has a chance to run
jobDoneLatch: IMycLatch;
begin
jobDoneSignal := Signals.CreateSemaphore(1);
jobDoneLatch := TMycLatch.CreateLatch(1); // Changed from Signals.CreateLatch
FFactory.Run(0,
procedure
var
dummy: Integer; // To avoid hint W1035 if no other code is in the proc
dummy: Integer;
begin
dummy := 0; // Assign to avoid compiler warning if variable is unused
// Raise the specific nested exception type
dummy := 0;
raise TMycTaskFactory.ETaskException.Create('Test Exception From Job');
// jobDoneSignal.Notify; // This line will not be reached
// jobDoneLatch.Notify; // This line will not be reached
end);
// Give a brief moment for the job to be scheduled and potentially raise the exception.
// Run another dummy job to help process the queue and ensure the exception is set.
FFactory.Run(0, procedure begin jobDoneSignal.Notify; end);
FFactory.WaitFor(jobDoneSignal.State);
FFactory.Run(0, procedure begin jobDoneLatch.Notify; end);
FFactory.WaitFor(jobDoneLatch.State);
Assert.WillRaise(
procedure
begin
(FFactory as TMycTaskFactory).HandleException; // This should re-raise the exception
(FFactory as TMycTaskFactory).HandleException;
end,
TMycTaskFactory.ETaskException, // Correctly qualified exception type
TMycTaskFactory.ETaskException,
'HandleException should re-raise the exception from the job'
);
// Verify FException is cleared after being handled
var noExceptionRaised: Boolean := True;
try
(FFactory as TMycTaskFactory).HandleException; // Should not raise anything now
(FFactory as TMycTaskFactory).HandleException;
except
noExceptionRaised := False;
end;
@@ -275,14 +264,14 @@ end;
procedure TMycTaskFactoryTests.TestRunJobAfterFactoryTeardown;
begin
FFactory.Teardown; // Explicitly teardown the factory
FFactory.Teardown;
Assert.WillRaise(
procedure
begin
FFactory.Run(0, procedure begin end); // Attempt to run a job
FFactory.Run(0, procedure begin end);
end,
TMycTaskFactory.ETaskException, // Expecting the factory's specific exception type
TMycTaskFactory.ETaskException,
'Running a job on a torn-down factory should raise ETaskException'
);
end;
@@ -290,34 +279,31 @@ end;
procedure TMycTaskFactoryTests.TestWaitForInWorkerThreadRaisesException;
var
exceptionCaughtInJob: Boolean;
jobDoneSignal: IMycSemaphore;
jobDoneLatch: IMycLatch;
dummyStateToWaitFor: IMycState;
begin
exceptionCaughtInJob := False;
jobDoneSignal := Signals.CreateSemaphore(1);
dummyStateToWaitFor := Signals.CreateSemaphore(1).State; // A state that will never be set by this test logic
jobDoneLatch := TMycLatch.CreateLatch(1); // Changed from Signals.CreateLatch
dummyStateToWaitFor := TMycLatch.CreateLatch(1).State; // Changed from Signals.CreateLatch
FFactory.Run(0,
procedure
begin
try
FFactory.WaitFor(dummyStateToWaitFor); // This should raise ETaskException
FFactory.WaitFor(dummyStateToWaitFor);
except
on E: TMycTaskFactory.ETaskException do
begin
// Check message if needed: Assert.AreEqual('Waiting not allowed within tasks', E.Message);
exceptionCaughtInJob := True;
end;
// Else: Unexpected exception, test will fail by jobDoneSignal not being set or flag remaining false
end;
jobDoneSignal.Notify; // Signal completion of the job's execution path
jobDoneLatch.Notify;
end);
FFactory.WaitFor(jobDoneSignal.State); // Wait for the job to finish
FFactory.WaitFor(jobDoneLatch.State);
Assert.IsTrue(exceptionCaughtInJob, 'WaitFor called within a worker thread job should raise ETaskException');
end;
initialization
// Register TestFixtures
TDUnitX.RegisterTestFixture(TMycTaskFactoryTests);
end.