Implemented TLazy + Tests

This commit is contained in:
Michael Schimmel
2025-06-03 17:10:55 +02:00
parent 38c9e2830d
commit 254eb7b114
18 changed files with 1329 additions and 149 deletions
+25 -10
View File
@@ -7,15 +7,19 @@ uses
Myc.Signals, Myc.TaskManager, Myc.Futures;
type
// Abstract base class for IMycFuture<T> implementations.
TMycFuture<T> = class abstract( TInterfacedObject, IMycFuture<T> )
protected
function GetResult: T; virtual; abstract;
function GetDone: IMycState; virtual; abstract;
end;
// Concrete future implementation triggered by an initial state, executing a TFunc<T>.
TMycInitStateFuncFuture<T> = class( TMycFuture<T> )
TMycNullFuture<T> = class( TMycFuture<T> )
protected
function GetResult: T; override;
function GetDone: IMycState; override;
end;
TMycGateFuncFuture<T> = class(TMycFuture<T>)
private
FInit: TMycSubscription;
FDone: IMycLatch;
@@ -24,20 +28,31 @@ type
function GetResult: T; override;
function GetDone: IMycState; override;
public
// Creates a future that executes AProc after AGate is set, using ATaskFactory.
constructor Create( const ATaskManager: IMycTaskManager; const AGate: IMycState; AProc: TFunc<T> );
destructor Destroy; override;
end;
implementation
{ TMycInitStateFuncFuture<T> }
{ TMycNullFuture<T> }
constructor TMycInitStateFuncFuture<T>.Create( const ATaskManager: IMycTaskManager; const AGate: IMycState; AProc: TFunc<T> );
function TMycNullFuture<T>.GetDone: IMycState;
begin
Result := TState.Null;
end;
function TMycNullFuture<T>.GetResult: T;
begin
Result := Default(T);
end;
{ TMycGateFuncFuture<T> }
constructor TMycGateFuncFuture<T>.Create(const ATaskManager: IMycTaskManager; const AGate: IMycState; AProc: TFunc<T>);
begin
inherited Create;
FDone := TState.CreateLatch( 1 );
FDone := TLatch.Construct( 1 );
// Subscribe the job execution to AGate.
// The job will run when AGate notifies the subscriber returned by Run.
@@ -58,7 +73,7 @@ begin
end );
end;
destructor TMycInitStateFuncFuture<T>.Destroy;
destructor TMycGateFuncFuture<T>.Destroy;
begin
Assert( FDone.State.IsSet );
@@ -66,12 +81,12 @@ begin
inherited Destroy;
end;
function TMycInitStateFuncFuture<T>.GetDone: IMycState;
function TMycGateFuncFuture<T>.GetDone: IMycState;
begin
Result := FDone.State;
end;
function TMycInitStateFuncFuture<T>.GetResult: T;
function TMycGateFuncFuture<T>.GetResult: T;
begin
Assert( FDone.State.IsSet, 'Result is not yet available.' );
Result := FResult;
+85
View File
@@ -0,0 +1,85 @@
unit Myc.Core.Lazy;
interface
uses
System.SysUtils,
Myc.Signals,
Myc.Lazy;
type
TMycLazy<T> = class abstract( TInterfacedObject, IMycLazy<T> )
protected
function GetChanged: IMycState; virtual; abstract;
public
function Pop( out Res: T ): Boolean; virtual; abstract;
end;
TMycNullLazy<T> = class( TMycLazy<T> )
protected
function GetChanged: IMycState; override;
public
function Pop( out Res: T ): Boolean; override;
end;
TMycFuncLazy<T> = class( TMycLazy<T> )
private
FChanged: IMycDirty;
FChangeState: TMycSubscription;
FProc: TFunc<T>;
protected
function GetChanged: IMycState; override;
public
constructor Create( const AChanged: IMycState; const AProc: TFunc<T> );
destructor Destroy; override;
function Pop( out Res: T ): Boolean; override;
end;
implementation
{ TMycNullLazy<T> }
function TMycNullLazy<T>.GetChanged: IMycState;
begin
Result := TState.Null;
end;
function TMycNullLazy<T>.Pop( out Res: T ): Boolean;
begin
Res := Default ( T );
Result := true;
end;
{ TMycFuncLazy<T> }
constructor TMycFuncLazy<T>.Create( const AChanged: IMycState; const AProc: TFunc<T> );
begin
inherited Create;
FChanged := TDirty.Construct;
FProc := AProc;
FChangeState := AChanged.Subscribe( FChanged );
end;
destructor TMycFuncLazy<T>.Destroy;
begin
FChangeState.Unsubscribe;
inherited;
end;
function TMycFuncLazy<T>.GetChanged: IMycState;
begin
Result := FChanged.State;
end;
function TMycFuncLazy<T>.Pop( out Res: T ): Boolean;
begin
Result := FChanged.State.IsSet;
if Result then
begin
if Assigned( FProc ) then
Res := FProc;
FChanged.Reset;
end;
end;
end.
+41 -36
View File
@@ -9,18 +9,12 @@ uses
type
TMycState = class abstract( TInterfacedObject, IMycState )
strict private
class var
FNull: IMycState;
class constructor ClassCreate;
protected
function GetIsSet: Boolean; virtual; abstract;
public
function Subscribe(Subscriber: IMycSubscriber): TMycSubscription; virtual; abstract;
procedure Unsubscribe(Tag: TMycNotifyList<IMycSubscriber>.TTag); virtual; abstract;
property IsSet: Boolean read GetIsSet;
// Provides access to the singleton null latch instance (always set).
class property Null: IMycState read FNull;
end;
// TMycNullState implements a "null object" pattern for IMycState.
@@ -42,9 +36,6 @@ type
TMycLatch = class(TMycState, IMycLatch)
strict private
FSubscribers: TMycNotifyList<IMycSubscriber>; // List of subscribers waiting for this latch to be set.
class var
FNull: IMycLatch; // Singleton instance of a latch that is always set.
class constructor ClassCreate; // Class constructor to initialize FNull.
private
[volatile] FCount: Integer; // The internal countdown value for the latch.
function GetState: IMycState; // Implementation for IMycLatch.GetState and IMycFlag.GetState.
@@ -56,9 +47,6 @@ type
constructor Create(ACount: Integer);
destructor Destroy; override;
// Factory method: creates a new countdown latch or returns the Null latch if Count <= 0.
class function CreateLatch(Count: Integer): IMycLatch; static;
// IMycSignal implementation
function Subscribe(Subscriber: IMycSubscriber): TMycSubscription; override;
procedure Unsubscribe(Tag: TMycNotifyList<IMycSubscriber>.TTag); override;
@@ -67,9 +55,12 @@ type
// Decrements the internal count. If the count reaches zero,
// registered subscribers are notified, and the latch becomes permanently set.
function Notify: Boolean;
end;
// Provides access to the singleton null latch instance (always set).
class property Null: IMycLatch read FNull;
TMycNullLatch = class( TInterfacedObject, IMycLatch )
private
function GetState: IMycState;
function Notify: Boolean;
end;
// TMycDirty implements a resettable "dirty flag".
@@ -91,7 +82,6 @@ type
// Factory method to create a new TMycDirty instance.
class function CreateDirty: IMycDirty; static;
// IMycSignal implementation
function Subscribe(Subscriber: IMycSubscriber): TMycSubscription; override;
procedure Unsubscribe(Tag: TMycNotifyList<IMycSubscriber>.TTag); override;
@@ -103,17 +93,18 @@ type
function Reset: Boolean;
end;
TMycNullDirty = class( TInterfacedObject, IMycDirty )
private
function GetState: IMycState;
function Notify: Boolean;
function Reset: Boolean;
end;
implementation
uses
System.SyncObjs; // For TInterlocked
class constructor TMycState.ClassCreate;
begin
// Create a singleton null latch instance that is initially (and always) set.
FNull := TMycNullState.Create(); // Calls the instance constructor
end;
{ TMycNullState }
constructor TMycNullState.Create;
@@ -142,6 +133,18 @@ begin
// Unsubscribing from a null state has no effect.
end;
{ TMycNullLatch }
function TMycNullLatch.GetState: IMycState;
begin
Result := TState.Null;
end;
function TMycNullLatch.Notify: Boolean;
begin
Result := false;
end;
{ TMycLatch }
constructor TMycLatch.Create(ACount: Integer);
@@ -152,27 +155,12 @@ begin
FSubscribers.Create;
end;
class constructor TMycLatch.ClassCreate;
begin
// Create a singleton null latch instance that is initially (and always) set.
FNull := TMycLatch.Create(0); // Calls the instance constructor
end;
destructor TMycLatch.Destroy;
begin
FSubscribers.Destroy;
inherited;
end;
class function TMycLatch.CreateLatch(Count: Integer): IMycLatch;
begin
// Factory method: returns a new latch or the shared Null latch if Count <= 0.
if Count > 0 then
Result := TMycLatch.Create(Count) // Instance constructor
else
Result := FNull;
end;
function TMycLatch.Notify: Boolean;
var
currentCountAfterDecrement: Integer;
@@ -259,6 +247,23 @@ begin
end;
end;
{ TMycNullDirty }
function TMycNullDirty.GetState: IMycState;
begin
Result := TState.Null;
end;
function TMycNullDirty.Notify: Boolean;
begin
Result := false;
end;
function TMycNullDirty.Reset: Boolean;
begin
Result := true;
end;
{ TMycDirty }
constructor TMycDirty.Create;
+3 -3
View File
@@ -150,7 +150,7 @@ begin
FWorkThreads[i].Free;
if Assigned(FException) then
FException.Free;
FException.Free;
FWorkGate.Free;
FWorkStack.Clear;
@@ -203,7 +203,7 @@ var
capturedProc: TProc;
begin
// Create a latch that will be signaled when the proc finishes
res := TMycLatch.CreateLatch(1); // Changed to use direct static call on TMycLatch
res := TLatch.Construct(1); // Changed to use direct static call on TMycLatch
capturedProc := Proc; // Capture Proc for the anonymous method
CreateAnonymousThread('Thread',
@@ -303,7 +303,7 @@ begin
raise ETaskException.Create('Task factory terminated');
if not Assigned(Job) then
exit(TMycLatch.Null); // Already correct, uses direct static property on TMycLatch
exit(TLatch.Null); // Already correct, uses direct static property on TMycLatch
// Create a pending job
Result := TMycPendingJob.Create(Self, Job);
+10 -3
View File
@@ -20,16 +20,20 @@ type
end;
TFuture<T> = record
strict private
private
FFuture: IMycFuture<T>;
function GetDone: IMycState; inline;
function GetResult: T; inline;
class var
FNull: IMycFuture<T>;
class constructor CreateClass;
class destructor DestroyClass;
public
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;
@@ -52,11 +56,14 @@ uses
constructor TFuture<T>.Create(const AFuture: IMycFuture<T>);
begin
FFuture := AFuture;
if not Assigned(FFuture) then
FFuture := FNull;
end;
class constructor TFuture<T>.CreateClass;
begin
TMycTaskFactory.AquireTaskManager;
FNull := TMycNullFuture<T>.Create;
end;
class destructor TFuture<T>.DestroyClass;
@@ -77,12 +84,12 @@ end;
class function TFuture<T>.Construct(const Proc: TFunc<T>): IMycFuture<T>;
begin
Result := TMycInitStateFuncFuture<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>): IMycFuture<T>;
begin
Result := TMycInitStateFuncFuture<T>.Create( TaskManager, Gate, Proc );
Result := TMycGateFuncFuture<T>.Create( TaskManager, Gate, Proc );
end;
function TFuture<T>.GetDone: IMycState;
+81
View File
@@ -0,0 +1,81 @@
unit Myc.Lazy;
interface
uses
System.SysUtils,
Myc.Signals;
type
IMycLazy<T> = interface
{$REGION 'property access'}
function GetChanged: IMycState;
{$ENDREGION}
function Pop( out Res: T ): Boolean;
property Changed: IMycState read GetChanged;
end;
TLazy<T> = record
private
FLazy: IMycLazy<T>;
function GetChanged: IMycState; inline;
class var
FNull: IMycLazy<T>;
class constructor CreateClass;
public
constructor Create(const ALazy: IMycLazy<T>);
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;
function Pop(out Res: T): Boolean; inline;
property Changed: IMycState read GetChanged;
end;
implementation
uses
Myc.Core.Lazy;
constructor TLazy<T>.Create(const ALazy: IMycLazy<T>);
begin
FLazy := ALazy;
if not Assigned(FLazy) then
FLazy := FNull;
end;
class function TLazy<T>.Construct(const Changing: IMycState; const Proc: TFunc<T>): IMycLazy<T>;
begin
Result := TMycFuncLazy<T>.Create( Changing, Proc );
end;
class constructor TLazy<T>.CreateClass;
begin
FNull := TMycNullLazy<T>.Create;
end;
function TLazy<T>.GetChanged: IMycState;
begin
Result := FLazy.Changed;
end;
function TLazy<T>.Pop(out Res: T): Boolean;
begin
Result := FLazy.Pop( Res );
end;
class operator TLazy<T>.Implicit(const A: IMycLazy<T>): TLazy<T>;
begin
Result.Create( A );
end;
class operator TLazy<T>.Implicit(const A: TLazy<T>): IMycLazy<T>;
begin
Result := A.FLazy;
end;
end.
+87 -24
View File
@@ -24,7 +24,7 @@ type
// Unsubscribes from the associated TState.
procedure Unsubscribe;
class operator Initialize( out Dest: TMycSubscription );
property TState: IMycState read GetState;
property State: IMycState read GetState;
end;
IMycState = interface
@@ -39,6 +39,30 @@ type
property IsSet: Boolean read GetIsSet;
end;
TState = record // helper for IMycState
strict private
class var
FNull: IMycState;
class constructor ClassCreate;
private
FState: IMycState;
function GetIsSet: Boolean; inline;
public
constructor Create(const AState: IMycState);
class operator Implicit(const A: IMycState): TState; overload;
class operator Implicit(const A: TState): IMycState; overload;
class function All( const States: TArray<IMycState> ): IMycState; static;
class function Any( const States: TArray<IMycState> ): IMycState; static;
class property Null: IMycState read FNull;
function Subscribe(Subscriber: IMycSubscriber): TMycSubscription; 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 )
@@ -48,6 +72,16 @@ type
// Inherits IMycSubscriber and State property from IMycFlag. No new members.
end;
TLatch = record
strict private
class var
FNull: IMycLatch;
class constructor ClassCreate;
public
class function Construct(Count: Integer): IMycLatch; static;
class property Null: IMycLatch read FNull;
end;
// 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 )
@@ -59,19 +93,14 @@ type
property State: IMycState read GetState;
end;
TState = record
private
FState: IMycState;
class function GetNull: IMycState; static;
TDirty = record
strict private
class var
FNull: IMycDirty;
class constructor ClassCreate;
public
constructor Create(const AState: IMycState);
class function CreateLatch( Count: Integer ): IMycLatch; static;
class function CreateDirty: IMycDirty; static;
class function All( const States: TArray<IMycState> ): IMycState; static;
class function Any( const States: TArray<IMycState> ): IMycState; static;
class operator Implicit(const A: IMycState): TState; overload;
class operator Implicit(const A: TState): IMycState; overload;
class property Null: IMycState read GetNull;
class function Construct: IMycDirty; static;
class property Null: IMycDirty read FNull;
end;
implementation
@@ -92,7 +121,7 @@ end;
procedure TMycSubscription.Unsubscribe;
begin
FState.Unsubscribe( FTag );
FState := TMycState.Null;
FState := TState.Null;
FTag := nil;
end;
@@ -103,7 +132,7 @@ end;
class operator TMycSubscription.Initialize( out Dest: TMycSubscription );
begin
Dest.FState := TMycState.Null;
Dest.FState := TState.Null;
Dest.FTag := nil;
end;
@@ -113,19 +142,20 @@ constructor TState.Create(const AState: IMycState);
begin
FState := AState;
if not Assigned(FState) then
FState := TMycState.Null;
FState := FNull;
end;
class function TState.CreateLatch( Count: Integer ): IMycLatch;
class constructor TState.ClassCreate;
begin
Result := TMycLatch.CreateLatch( Count );
// Create a singleton null latch instance that is initially (and always) set.
FNull := TMycNullState.Create(); // Calls the instance constructor
end;
class function TState.All( const States: TArray<IMycState> ): IMycState;
var
Latch: IMycLatch;
begin
Latch := CreateLatch( Length( States ) );
Latch := TLatch.Construct( Length( States ) );
for var i := 0 to High( States ) do
States[i].Subscribe( Latch );
Result := Latch.State;
@@ -141,21 +171,26 @@ begin
end
else
begin
Latch := CreateLatch( 1 );
Latch := TLatch.Construct( 1 );
for var i := 0 to High( States ) do
States[i].Subscribe( Latch );
Result := Latch.State;
end;
end;
class function TState.CreateDirty: IMycDirty;
function TState.GetIsSet: Boolean;
begin
Result := TMycDirty.CreateDirty;
Result := FState.IsSet;
end;
class function TState.GetNull: IMycState;
function TState.Subscribe(Subscriber: IMycSubscriber): TMycSubscription;
begin
Result := TMycState.Null;
Result := FState.Subscribe(Subscriber);
end;
procedure TState.Unsubscribe(Tag: Pointer);
begin
FState.Unsubscribe(Tag);
end;
class operator TState.Implicit(const A: TState): IMycState;
@@ -168,4 +203,32 @@ begin
Result.Create( A );
end;
{ TLatch }
class constructor TLatch.ClassCreate;
begin
// Create a singleton null latch instance that is initially (and always) set.
FNull := TMycNullLatch.Create; // Calls the instance constructor
end;
class function TLatch.Construct(Count: Integer): IMycLatch;
begin
if Count > 0 then
Result := TMycLatch.Create( Count )
else
Result := FNull;
end;
{ TDirty }
class constructor TDirty.ClassCreate;
begin
FNull := TMycNullDirty.Create;
end;
class function TDirty.Construct: IMycDirty;
begin
Result := TMycDirty.Create;
end;
end.
+456
View File
@@ -0,0 +1,456 @@
unit Myc.Test.Core.Lazy;
interface
uses
System.SysUtils,
DUnitX.TestFramework,
Myc.Signals, // For IMycState, TState, IMycDirty
Myc.Lazy, // For IMycLazy<T>
Myc.Core.Lazy; // Unit to be tested
type
[TestFixture]
TTestMycCoreLazy = class(TObject)
private
procedure Helper_ConsumeInitialPop(const ALazy: IMycLazy<Integer>; InitialExpectedValue: Integer); overload;
procedure Helper_ConsumeInitialPop(const ALazy: IMycLazy<string>; const InitialExpectedValue: string); overload;
public
[Setup]
procedure Setup;
[TearDown]
procedure TearDown;
// Tests for TMycNullLazy<T>
[Test]
procedure TestNullLazy_GetChanged_IsAlwaysNullState;
[Test]
procedure TestNullLazy_Pop_ReturnsDefaultIntegerAndTrue;
[Test]
procedure TestNullLazy_Pop_ReturnsDefaultStringAndTrue;
[Test]
procedure TestNullLazy_Pop_ReturnsDefaultInterfaceAndTrue;
// Tests for TMycFuncLazy<T> reflecting "IsSet is true by design after creation"
[Test]
procedure TestFuncLazy_GetChanged_IsAlwaysTrueAfterCreation;
[Test]
procedure TestFuncLazy_FirstPop_AlwaysEvaluatesAndResetsChanged;
[Test]
procedure TestFuncLazy_Pop_WhenProcIsNull_FirstPopReturnsTrueAndValueUnchanged_ResetsChanged;
// Tests for behavior after the initial "changed" state is consumed
[Test]
procedure TestFuncLazy_AfterFirstPop_IfNoSourceChange_GetChangedIsFalse;
[Test]
procedure TestFuncLazy_AfterFirstPop_IfNoSourceChange_PopReturnsFalse_ValueUndefined;
[Test]
procedure TestFuncLazy_AfterSourceChange_GetChanged_IsSet;
[Test]
procedure TestFuncLazy_AfterSourceChange_Pop_ReturnsTrueAndProcResult_ResetsChanged;
[Test]
procedure TestFuncLazy_Pop_Twice_SourceUnchanged_SecondPopReturnsFalse_ValueUndefined;
// This test is now significantly changed to reflect TMycDirty's notification behavior
[Test]
procedure TestFuncLazy_SourceInteraction_NotifyOnSetSourceDoesNotRetriggerLazy;
[Test]
procedure TestFuncLazy_Destroy_UnsubscribesFromSource;
[Test]
procedure TestFuncLazy_SourceIsInitiallySet_PopBehavesCorrectly;
end;
implementation
uses
System.Rtti,
Myc.Core.Signals;
{ TTestMycCoreLazy Helper Methods }
procedure TTestMycCoreLazy.Helper_ConsumeInitialPop(const ALazy: IMycLazy<Integer>; InitialExpectedValue: Integer);
var
tempValue: Integer;
popResult: Boolean;
begin
Assert.IsTrue(ALazy.GetChanged.IsSet, 'Changed.IsSet should be true before consuming initial pop');
popResult := ALazy.Pop(tempValue);
Assert.IsTrue(popResult, 'Consuming initial Pop should return true');
Assert.AreEqual(InitialExpectedValue, tempValue, 'Value from initial Pop is unexpected');
Assert.IsFalse(ALazy.GetChanged.IsSet, 'Changed.IsSet should be false after consuming initial pop');
end;
procedure TTestMycCoreLazy.Helper_ConsumeInitialPop(const ALazy: IMycLazy<string>; const InitialExpectedValue: string);
var
tempValue: string;
popResult: Boolean;
begin
Assert.IsTrue(ALazy.GetChanged.IsSet, 'Changed.IsSet should be true before consuming initial pop');
popResult := ALazy.Pop(tempValue);
Assert.IsTrue(popResult, 'Consuming initial Pop should return true');
Assert.AreEqual(InitialExpectedValue, tempValue, 'Value from initial Pop is unexpected');
Assert.IsFalse(ALazy.GetChanged.IsSet, 'Changed.IsSet should be false after consuming initial pop');
end;
{ TTestMycCoreLazy Test Methods }
procedure TTestMycCoreLazy.Setup;
begin
end;
procedure TTestMycCoreLazy.TearDown;
begin
end;
// == Tests for TMycNullLazy<T> ==
procedure TTestMycCoreLazy.TestNullLazy_GetChanged_IsAlwaysNullState;
var
nullLazy: IMycLazy<Integer>;
changedState: IMycState;
begin
nullLazy := TMycNullLazy<Integer>.Create as IMycLazy<Integer>;
Assert.IsNotNull(nullLazy, 'TMycNullLazy<Integer> instance should not be nil');
changedState := nullLazy.GetChanged;
Assert.AreSame(TState.Null, changedState, 'TMycNullLazy.GetChanged should return TState.Null');
Assert.IsTrue(changedState.IsSet, 'TState.Null should always be set');
end;
procedure TTestMycCoreLazy.TestNullLazy_Pop_ReturnsDefaultIntegerAndTrue;
var
nullLazy: IMycLazy<Integer>;
value: Integer;
result: Boolean;
begin
nullLazy := TMycNullLazy<Integer>.Create as IMycLazy<Integer>;
Assert.IsNotNull(nullLazy, 'TMycNullLazy<Integer> instance should not be nil');
value := 123;
result := nullLazy.Pop(value);
Assert.IsTrue(result, 'TMycNullLazy.Pop should return true');
Assert.AreEqual(Default(Integer), value, 'Value should be Default(Integer) after Pop');
end;
procedure TTestMycCoreLazy.TestNullLazy_Pop_ReturnsDefaultStringAndTrue;
var
nullLazy: IMycLazy<string>;
value: string;
result: Boolean;
begin
nullLazy := TMycNullLazy<string>.Create as IMycLazy<string>;
Assert.IsNotNull(nullLazy, 'TMycNullLazy<string> instance should not be nil');
value := 'test';
result := nullLazy.Pop(value);
Assert.IsTrue(result, 'TMycNullLazy.Pop should return true');
Assert.AreEqual(Default(string), value, 'Value should be Default(string) after Pop');
end;
procedure TTestMycCoreLazy.TestNullLazy_Pop_ReturnsDefaultInterfaceAndTrue;
var
nullLazy: IMycLazy<IMycState>;
value: IMycState;
result: Boolean;
begin
nullLazy := TMycNullLazy<IMycState>.Create as IMycLazy<IMycState>;
Assert.IsNotNull(nullLazy, 'TMycNullLazy<IMycState> instance should not be nil');
value := TState.Null;
result := nullLazy.Pop(value);
Assert.IsTrue(result, 'TMycNullLazy.Pop should return true');
Assert.IsNull(value, 'Value should be nil for an interface type after Pop from NullLazy');
end;
// == Tests for TMycFuncLazy<T> - Initial State by Design ==
procedure TTestMycCoreLazy.TestFuncLazy_GetChanged_IsAlwaysTrueAfterCreation;
var
funcLazy: IMycLazy<Integer>;
changedState: IMycState;
sourceDirty: IMycDirty;
begin
sourceDirty := TDirty.Construct;
sourceDirty.Reset;
funcLazy := TMycFuncLazy<Integer>.Create(sourceDirty.State, function: Integer begin Result := 10; end);
Assert.IsNotNull(funcLazy, 'TMycFuncLazy<Integer> instance should not be nil');
changedState := funcLazy.GetChanged;
Assert.IsNotNull(changedState, 'funcLazy.GetChanged should return a valid IMycState');
Assert.IsTrue(changedState.IsSet, 'By design, funcLazy.GetChanged.IsSet should be true immediately after creation');
end;
procedure TTestMycCoreLazy.TestFuncLazy_FirstPop_AlwaysEvaluatesAndResetsChanged;
var
funcLazy: IMycLazy<Integer>;
value: Integer;
result: Boolean;
sourceDirty: IMycDirty;
procExecuted: Boolean;
expectedValue: Integer;
begin
sourceDirty := TDirty.Construct;
sourceDirty.Reset;
procExecuted := False;
expectedValue := 50;
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;
result := funcLazy.Pop(value);
Assert.IsTrue(result, 'The first Pop should return true by design, indicating evaluation');
Assert.IsTrue(procExecuted, 'FProc should have been executed on the first Pop');
Assert.AreEqual(expectedValue, value, 'Value should be the result from FProc after the first Pop');
Assert.IsFalse(funcLazy.GetChanged.IsSet, 'Changed.IsSet should be false after the first Pop, as Pop resets it');
end;
procedure TTestMycCoreLazy.TestFuncLazy_Pop_WhenProcIsNull_FirstPopReturnsTrueAndValueUnchanged_ResetsChanged;
var
funcLazy: IMycLazy<Integer>;
value: Integer;
preCallValue: Integer;
result: Boolean;
sourceDirty: IMycDirty;
begin
sourceDirty := TDirty.Construct;
sourceDirty.Reset;
funcLazy := TMycFuncLazy<Integer>.Create(sourceDirty.State, nil);
Assert.IsNotNull(funcLazy, 'TMycFuncLazy<Integer> instance should not be nil');
Assert.IsTrue(funcLazy.GetChanged.IsSet, 'Changed state should be true before Pop by design');
preCallValue := 123;
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.IsFalse(funcLazy.GetChanged.IsSet, 'Changed state should be false after Pop');
end;
// == Tests for TMycFuncLazy<T> - Behavior After Initial Pop ==
procedure TTestMycCoreLazy.TestFuncLazy_AfterFirstPop_IfNoSourceChange_GetChangedIsFalse;
var
funcLazy: IMycLazy<Integer>;
sourceDirty: IMycDirty;
initialProcValue: Integer;
begin
sourceDirty := TDirty.Construct;
sourceDirty.Reset;
initialProcValue := 33;
funcLazy := TMycFuncLazy<Integer>.Create(sourceDirty.State, function: Integer begin Result := initialProcValue; end);
Helper_ConsumeInitialPop(funcLazy, initialProcValue);
Assert.IsFalse(funcLazy.GetChanged.IsSet, 'After initial Pop and no source change, GetChanged.IsSet should be false');
end;
procedure TTestMycCoreLazy.TestFuncLazy_AfterFirstPop_IfNoSourceChange_PopReturnsFalse_ValueUndefined;
var
funcLazy: IMycLazy<Integer>;
value: Integer;
result: Boolean;
sourceDirty: IMycDirty;
initialProcValue: Integer;
procExecutedCount: Integer;
begin
sourceDirty := TDirty.Construct;
sourceDirty.Reset;
initialProcValue := 44;
procExecutedCount := 0;
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);
Assert.IsFalse(result, 'Second Pop (after initial, no source change) should return false');
Assert.AreEqual(1, procExecutedCount, 'Proc should not have executed again');
end;
procedure TTestMycCoreLazy.TestFuncLazy_AfterSourceChange_GetChanged_IsSet;
var
funcLazy: IMycLazy<Integer>;
changedState: IMycState;
sourceDirty: IMycDirty;
initialProcValue: Integer;
begin
sourceDirty := TDirty.Construct;
sourceDirty.Reset;
initialProcValue := 20;
funcLazy := TMycFuncLazy<Integer>.Create(sourceDirty.State, function: Integer begin Result := initialProcValue; end);
Helper_ConsumeInitialPop(funcLazy, initialProcValue);
sourceDirty.Notify;
changedState := funcLazy.GetChanged;
Assert.IsTrue(changedState.IsSet, 'After source change (post-initial pop), funcLazy.GetChanged.IsSet should be true');
end;
procedure TTestMycCoreLazy.TestFuncLazy_AfterSourceChange_Pop_ReturnsTrueAndProcResult_ResetsChanged;
var
funcLazy: IMycLazy<Integer>;
value: Integer;
result: Boolean;
sourceDirty: IMycDirty;
procCallCount: Integer;
currentExpectedValue: Integer;
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);
currentExpectedValue := 30;
Helper_ConsumeInitialPop(funcLazy, currentExpectedValue);
Assert.AreEqual(1, procCallCount, 'Proc executed for initial Pop');
sourceDirty.Notify;
Assert.IsTrue(funcLazy.GetChanged.IsSet, 'Changed state should be true after source notification');
value := 0;
result := funcLazy.Pop(value);
currentExpectedValue := 300 + 2;
Assert.IsTrue(result, 'Pop should return true after source changed');
Assert.AreEqual(2, procCallCount, 'Proc should have been executed again');
Assert.AreEqual(currentExpectedValue, value, 'Value should be the new result of FProc');
Assert.IsFalse(funcLazy.GetChanged.IsSet, 'Changed state should be false after Pop');
end;
procedure TTestMycCoreLazy.TestFuncLazy_Pop_Twice_SourceUnchanged_SecondPopReturnsFalse_ValueUndefined;
var
funcLazy: IMycLazy<Integer>;
value: Integer;
resultPop1, resultPop2: Boolean;
sourceDirty: IMycDirty;
procCallCount: Integer;
begin
sourceDirty := TDirty.Construct;
sourceDirty.Reset;
procCallCount := 0;
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');
Assert.AreEqual(1, procCallCount, 'Proc called for first Pop');
Assert.IsFalse(funcLazy.GetChanged.IsSet, 'Changed state should be false after first Pop');
resultPop2 := funcLazy.Pop(value);
Assert.IsFalse(resultPop2, 'Second Pop should return false as state was reset and not changed again by source');
Assert.AreEqual(1, procCallCount, 'Proc should not be called for second Pop if no source change');
end;
// TestFuncLazy_SourceChanges_Pop_SourceChangesAgain_PopAgain has been RENAMED and RESTRUCTURED
// to TestFuncLazy_SourceInteraction_NotifyOnSetSourceDoesNotRetriggerLazy
procedure TTestMycCoreLazy.TestFuncLazy_SourceInteraction_NotifyOnSetSourceDoesNotRetriggerLazy;
var
funcLazy: IMycLazy<Integer>;
value: Integer;
result: Boolean;
sourceDirty: IMycDirty;
procCallCount: Integer;
initialValue, firstSourceChangeValue: Integer;
begin
sourceDirty := TDirty.Construct;
sourceDirty.Reset; // sourceDirty.IsSet is FALSE
procCallCount := 0;
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);
// 1. Initial Pop (consumes "by design" changed state)
Assert.IsTrue(funcLazy.GetChanged.IsSet, 'Changed state should be true before first Pop (by design)');
result := funcLazy.Pop(value); // procCallCount becomes 1
Assert.IsTrue(result, 'First Pop should return true');
Assert.AreEqual(initialValue, value, 'Value from first Pop');
Assert.AreEqual(1, procCallCount, 'Proc called for initial Pop');
Assert.IsFalse(funcLazy.GetChanged.IsSet, 'Changed state should be false after first Pop');
// 2. First effective source change (sourceDirty: false -> true)
sourceDirty.Notify; // sourceDirty.IsSet becomes TRUE, notifies funcLazy.FChanged, funcLazy.GetChanged.IsSet becomes TRUE
Assert.IsTrue(sourceDirty.State.IsSet, 'sourceDirty should be set after first Notify');
Assert.IsTrue(funcLazy.GetChanged.IsSet, 'Changed state should be true after first effective source notification');
result := funcLazy.Pop(value); // procCallCount becomes 2
Assert.IsTrue(result, 'Pop after first effective source change should return true');
Assert.AreEqual(firstSourceChangeValue, value, 'Value from Pop after first effective source change');
Assert.AreEqual(2, procCallCount, 'Proc called again');
Assert.IsFalse(funcLazy.GetChanged.IsSet, 'Changed state should be false after second Pop');
// 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.
Assert.IsFalse(funcLazy.GetChanged.IsSet, 'Changed state should REMAIN false after Notify on an already-set source');
// 4. Attempt to Pop again
result := funcLazy.Pop(value); // procCallCount should remain 2
Assert.IsFalse(result, 'Pop after Notify on an already-set source should return false');
Assert.AreEqual(2, procCallCount, 'Proc should NOT have been called again');
// Value of 'value' is undefined here and not checked.
end;
procedure TTestMycCoreLazy.TestFuncLazy_Destroy_UnsubscribesFromSource;
var
funcLazyObj: TMycFuncLazy<Integer>;
sourceDirty: IMycDirty;
tempVal: Integer;
begin
sourceDirty := TDirty.Construct;
sourceDirty.Reset;
funcLazyObj := TMycFuncLazy<Integer>.Create(sourceDirty.State, function: Integer begin Result := 1; end);
Assert.IsTrue(funcLazyObj.Pop(tempVal), 'Initial Pop should succeed');
funcLazyObj.Destroy;
funcLazyObj := nil;
Assert.WillNotRaise(
procedure
begin
sourceDirty.Notify;
end,
nil,
'Destroy test assumes TMycSubscription.Unsubscribe works. Verified by no crash on source notify post-destroy.');
sourceDirty := nil;
end;
procedure TTestMycCoreLazy.TestFuncLazy_SourceIsInitiallySet_PopBehavesCorrectly;
var
funcLazy: IMycLazy<Integer>;
value: Integer;
result: Boolean;
sourceDirty: IMycDirty;
expectedValue: Integer;
procExecuted: Boolean;
begin
sourceDirty := TDirty.Construct;
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);
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;
result := funcLazy.Pop(value);
Assert.IsTrue(result, 'First Pop should return true');
Assert.IsTrue(procExecuted, 'FProc should have been executed on first Pop');
Assert.AreEqual(expectedValue, value, 'Value should be the result of FProc');
Assert.IsFalse(funcLazy.GetChanged.IsSet, 'Changed state should be false after the first Pop');
end;
initialization
TDUnitX.RegisterTestFixture(TTestMycCoreLazy);
end.
+460
View File
@@ -0,0 +1,460 @@
unit Myc.Test.Lazy;
interface
uses
System.SysUtils,
DUnitX.TestFramework,
Myc.Signals, // For IMycState, TState, IMycDirty
Myc.Lazy; // The unit under test
type
[TestFixture]
TTestMyLazy = class(TObject)
private
FChangingSignal: IMycDirty; // Used as the 'Changing' state for functional lazy objects
// Helper to consume the initial pop, which is always expected to succeed
// for a TLazy wrapping a functional lazy object due to "Changed.IsSet initially true" design.
procedure ConsumeInitialPop(var ALazyRec: TLazy<Integer>; ExpectedInitialValue: Integer; const MsgPrefix: string);
public
[Setup]
procedure Setup;
[TearDown]
procedure TearDown;
// Tests for TLazy<T>.Create(nil) - Null Object Pattern
[Test]
procedure TestCreateWithNil_Changed_IsAlwaysTrue;
[Test]
procedure TestCreateWithNil_Pop_ReturnsTrueAndDefaultInteger;
[Test]
procedure TestCreateWithNil_Pop_ReturnsTrueAndDefaultString;
// Tests for TLazy<T>.Construct (creates a functional lazy object)
[Test]
procedure TestConstruct_InitialChanged_IsAlwaysTrue;
[Test]
procedure TestConstruct_FirstPop_SucceedsAndResetsChanged;
[Test]
procedure TestConstruct_WithNilProc_FirstPopReturnsTrueAndValueUnchanged;
[Test]
procedure TestConstruct_StateInteraction_SignalTriggersChanged;
[Test]
procedure TestConstruct_StateInteraction_PopResetsChangedAfterSignal;
[Test]
procedure TestConstruct_StateInteraction_NotifyOnAlreadySetSource_DoesNotRetrigger;
[Test]
procedure TestConstruct_Destruction_UnsubscribesAndNoCrashOnSourceNotify;
// Tests for TLazy<T>.Create with a pre-existing (non-nil) IMycLazy
[Test]
procedure TestCreateWithExistingLazy_DelegatesChangedCorrectly;
[Test]
procedure TestCreateWithExistingLazy_DelegatesPopCorrectly;
// Tests for TLazy<T> implicit operators
[Test]
procedure TestImplicitOperator_FromInterfaceToRecord;
[Test]
procedure TestImplicitOperator_FromRecordToInterface;
// Tests for TLazy<T>.Pop specific behaviors (Res undefined)
[Test]
procedure TestPop_AfterInitialAndNoSignal_ReturnsFalseAndResUndefined;
end;
implementation
// No direct uses of Myc.Core.* units here
{ TTestMyLazy }
procedure TTestMyLazy.Setup;
begin
// Create a common signal source for tests that need it.
// TState.CreateDirty is from Myc.Signals.pas (interface part)
// Its implementation might rely on Myc.Core.Signals, but that's an indirect usage.
FChangingSignal := TDirty.Construct;
FChangingSignal.Reset; // Start with a clean (not set) signal for predictable test starts
end;
procedure TTestMyLazy.TearDown;
begin
FChangingSignal := nil; // Release the common signal source
end;
procedure TTestMyLazy.ConsumeInitialPop(var ALazyRec: TLazy<Integer>; ExpectedInitialValue: Integer; const MsgPrefix: string);
var
val: Integer;
popResult: Boolean;
begin
Assert.IsTrue(ALazyRec.Changed.IsSet, MsgPrefix + ': Changed.IsSet should be true before initial Pop');
popResult := ALazyRec.Pop(val);
Assert.IsTrue(popResult, MsgPrefix + ': Initial Pop should return true');
Assert.AreEqual(ExpectedInitialValue, val, MsgPrefix + ': Value from initial Pop mismatch');
Assert.IsFalse(ALazyRec.Changed.IsSet, MsgPrefix + ': Changed.IsSet should be false after initial Pop');
end;
// == Tests for TLazy<T>.Create(nil) - Null Object Pattern ==
procedure TTestMyLazy.TestCreateWithNil_Changed_IsAlwaysTrue;
var
lazyRec: TLazy<Integer>;
begin
lazyRec := TLazy<Integer>.Create(nil); // This uses the internal FNull (TMycNullLazy)
Assert.IsTrue(lazyRec.Changed.IsSet, 'For TLazy created with nil, Changed.IsSet should be true (TMycNullLazy behavior)');
// Second check to ensure it's consistently true
Assert.IsTrue(lazyRec.Changed.IsSet, 'For TLazy created with nil, Changed.IsSet should remain true');
end;
procedure TTestMyLazy.TestCreateWithNil_Pop_ReturnsTrueAndDefaultInteger;
var
lazyRec: TLazy<Integer>;
val: Integer;
popResult: Boolean;
begin
lazyRec := TLazy<Integer>.Create(nil);
val := 12345; // Pre-assign to check if Pop overwrites it with Default
popResult := lazyRec.Pop(val);
Assert.IsTrue(popResult, 'Pop on TLazy created with nil should return true');
Assert.AreEqual(Default(Integer), val, 'Pop on TLazy created with nil should set Res to Default(Integer)');
end;
procedure TTestMyLazy.TestCreateWithNil_Pop_ReturnsTrueAndDefaultString;
var
lazyRec: TLazy<string>;
val: string;
popResult: Boolean;
begin
lazyRec := TLazy<string>.Create(nil);
val := 'test'; // Pre-assign
popResult := lazyRec.Pop(val);
Assert.IsTrue(popResult, 'Pop on TLazy created with nil (string) should return true');
Assert.AreEqual(Default(string), val, 'Pop on TLazy created with nil (string) should set Res to Default(string)');
end;
// == Tests for TLazy<T>.Construct static method ==
procedure TTestMyLazy.TestConstruct_InitialChanged_IsAlwaysTrue;
var
lazyIntf: IMycLazy<Integer>;
lazyRec: TLazy<Integer>;
procExecuted: Boolean;
begin
procExecuted := False;
// FChangingSignal is reset in Setup
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
Assert.IsTrue(lazyRec.Changed.IsSet, 'Constructed lazy object: Initial Changed.IsSet should be true by design');
Assert.IsFalse(procExecuted, 'Proc should not have been executed by Construct or by checking Changed state');
end;
procedure TTestMyLazy.TestConstruct_FirstPop_SucceedsAndResetsChanged;
var
lazyIntf: IMycLazy<Integer>;
lazyRec: TLazy<Integer>;
procExecuted: Boolean;
expectedValue: Integer;
begin
procExecuted := False;
expectedValue := 20;
lazyIntf := TLazy<Integer>.Construct(FChangingSignal.State,
function: Integer
begin
procExecuted := True;
Result := expectedValue;
end);
lazyRec := lazyIntf;
ConsumeInitialPop(lazyRec, expectedValue, 'TestConstruct_FirstPop');
Assert.IsTrue(procExecuted, 'Proc should have been executed by the initial Pop');
end;
procedure TTestMyLazy.TestConstruct_WithNilProc_FirstPopReturnsTrueAndValueUnchanged;
var
lazyIntf: IMycLazy<Integer>;
lazyRec: TLazy<Integer>;
val: Integer;
preVal: Integer;
popResult: Boolean;
begin
lazyIntf := TLazy<Integer>.Construct(FChangingSignal.State, nil); // Proc is nil
lazyRec := lazyIntf;
Assert.IsTrue(lazyRec.Changed.IsSet, 'Constructed lazy (nil Proc): Initial Changed.IsSet should be true');
preVal := 77;
val := preVal;
popResult := lazyRec.Pop(val);
Assert.IsTrue(popResult, 'Constructed lazy (nil Proc): First Pop should return true');
// As per TMycFuncLazy behavior, if FProc is nil, Pop does not assign Default(T) to Res,
// Res remains unchanged.
Assert.AreEqual(preVal, val, 'Constructed lazy (nil Proc): Res should be unchanged by Pop as Proc was nil');
Assert.IsFalse(lazyRec.Changed.IsSet, 'Constructed lazy (nil Proc): Changed.IsSet should be false after Pop');
end;
procedure TTestMyLazy.TestConstruct_StateInteraction_SignalTriggersChanged;
var
lazyIntf: IMycLazy<Integer>;
lazyRec: TLazy<Integer>;
expectedValue: Integer;
begin
expectedValue := 30;
lazyIntf := TLazy<Integer>.Construct(FChangingSignal.State, function: Integer begin Result := expectedValue; end);
lazyRec := lazyIntf;
ConsumeInitialPop(lazyRec, expectedValue, 'TestConstruct_StateInteraction_SignalTriggersChanged (Initial)');
Assert.IsFalse(lazyRec.Changed.IsSet, 'After initial Pop, Changed.IsSet should be false');
FChangingSignal.Notify; // Trigger the source signal
Assert.IsTrue(lazyRec.Changed.IsSet, 'After source signal Notify, Changed.IsSet should become true');
end;
procedure TTestMyLazy.TestConstruct_StateInteraction_PopResetsChangedAfterSignal;
var
lazyIntf: IMycLazy<Integer>;
lazyRec: TLazy<Integer>;
val: Integer;
popResult: Boolean;
procCallCount: Integer;
begin
procCallCount := 0;
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
FChangingSignal.Notify;
Assert.IsTrue(lazyRec.Changed.IsSet, 'Changed.IsSet should be true after signal');
popResult := lazyRec.Pop(val); // procCallCount = 2
Assert.IsTrue(popResult, 'Pop after signal should return true');
Assert.AreEqual(102, val, 'Value from Pop after signal mismatch');
Assert.AreEqual(2, procCallCount, 'Proc call count after second pop mismatch');
Assert.IsFalse(lazyRec.Changed.IsSet, 'Changed.IsSet should be false after Pop following signal');
end;
procedure TTestMyLazy.TestConstruct_StateInteraction_NotifyOnAlreadySetSource_DoesNotRetrigger;
var
lazyIntf: IMycLazy<Integer>;
lazyRec: TLazy<Integer>;
val: Integer;
popResult: Boolean;
procCallCount: Integer;
begin
procCallCount := 0;
lazyIntf := TLazy<Integer>.Construct(FChangingSignal.State,
function: Integer
begin
Inc(procCallCount);
Result := 200 + procCallCount;
end);
lazyRec := lazyIntf;
// 1. Initial Pop
ConsumeInitialPop(lazyRec, 201, 'TestConstruct_NotifyOnAlreadySetSource (Initial)'); // procCallCount = 1
Assert.IsFalse(FChangingSignal.State.IsSet, 'Source signal FChangingSignal should still be false (was reset in Setup)');
// 2. Trigger source, make it set, Pop
FChangingSignal.Notify; // FChangingSignal.IsSet becomes TRUE
Assert.IsTrue(lazyRec.Changed.IsSet, 'Lazy state should be true after FChangingSignal.Notify');
popResult := lazyRec.Pop(val); // procCallCount = 2
Assert.IsTrue(popResult);
Assert.AreEqual(202, val);
Assert.IsFalse(lazyRec.Changed.IsSet, 'Lazy state should be false after second Pop');
// 3. Notify FChangingSignal again. It's already set.
// This should NOT re-notify subscribers (like the lazy object's internal trigger)
// because TMycDirty only notifies on a false -> true transition.
Assert.IsTrue(FChangingSignal.State.IsSet, 'FChangingSignal should still be true before redundant Notify');
FChangingSignal.Notify;
Assert.IsFalse(lazyRec.Changed.IsSet, 'Lazy state should REMAIN false after Notify on an already-set source');
// 4. Attempt to Pop again
popResult := lazyRec.Pop(val); // procCallCount should remain 2
Assert.IsFalse(popResult, 'Pop after Notify on an already-set source should return false');
Assert.AreEqual(2, procCallCount, 'Proc should not have been called for this Pop');
end;
procedure TTestMyLazy.TestConstruct_Destruction_UnsubscribesAndNoCrashOnSourceNotify;
var
lazyIntf: IMycLazy<Integer>;
localChangingSignal: IMycDirty; // Use a local signal for this test to control its lifetime
begin
localChangingSignal := TDirty.Construct;
localChangingSignal.Reset;
lazyIntf := TLazy<Integer>.Construct(localChangingSignal.State, function: Integer begin Result := 1; end);
Assert.IsNotNull(lazyIntf, 'Constructed lazy interface should not be nil');
// Simulate usage and release of the lazy object
var lazyRec: TLazy<Integer> := lazyIntf; // Wrap for initial pop
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.
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.');
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;
var
originalLazyIntf: IMycLazy<Integer>;
wrappedLazyRec: TLazy<Integer>;
expectedValue: Integer;
begin
expectedValue := 60;
originalLazyIntf := TLazy<Integer>.Construct(FChangingSignal.State, function: Integer begin Result := expectedValue; end);
// originalLazyIntf.Changed.IsSet is true by design
wrappedLazyRec := TLazy<Integer>.Create(originalLazyIntf);
Assert.IsTrue(wrappedLazyRec.Changed.IsSet, 'Wrapped lazy: Changed.IsSet should reflect original (initially true)');
ConsumeInitialPop(wrappedLazyRec, expectedValue, 'TestCreateWithExistingLazy_DelegatesChangedCorrectly (Initial)');
// Now wrappedLazyRec.Changed.IsSet is false, and so should originalLazyIntf.Changed.IsSet
Assert.IsFalse(originalLazyIntf.Changed.IsSet, 'Original lazy: Changed.IsSet should also be false after wrapped Pop');
FChangingSignal.Notify;
Assert.IsTrue(wrappedLazyRec.Changed.IsSet, 'Wrapped lazy: Changed.IsSet should be true after source signal');
Assert.IsTrue(originalLazyIntf.Changed.IsSet, 'Original lazy: Changed.IsSet should also be true after source signal');
end;
procedure TTestMyLazy.TestCreateWithExistingLazy_DelegatesPopCorrectly;
var
originalLazyIntf: IMycLazy<Integer>;
wrappedLazyRec: TLazy<Integer>;
val: Integer;
popResult: Boolean;
procCallCount: Integer;
begin
procCallCount := 0;
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)
ConsumeInitialPop(wrappedLazyRec, 71, 'TestCreateWithExistingLazy_DelegatesPopCorrectly (Initial)'); // procCallCount = 1
Assert.AreEqual(1, procCallCount, 'Proc call count after wrapped initial Pop');
// Second Pop via wrapper (no source change yet)
popResult := wrappedLazyRec.Pop(val);
Assert.IsFalse(popResult, 'Second Pop via wrapper (no source change) should return false');
Assert.AreEqual(1, procCallCount, 'Proc call count should not change');
// Trigger source, Pop via wrapper
FChangingSignal.Notify;
Assert.IsTrue(wrappedLazyRec.Changed.IsSet, 'Wrapped lazy: Changed.IsSet true after source signal');
popResult := wrappedLazyRec.Pop(val); // procCallCount = 2
Assert.IsTrue(popResult, 'Pop via wrapper after source signal should return true');
Assert.AreEqual(72, val, 'Value from Pop via wrapper after signal');
Assert.AreEqual(2, procCallCount, 'Proc call count after signal and Pop');
Assert.IsFalse(wrappedLazyRec.Changed.IsSet, 'Wrapped lazy: Changed.IsSet false after Pop');
end;
// == Tests for TLazy<T> implicit operators ==
procedure TTestMyLazy.TestImplicitOperator_FromInterfaceToRecord;
var
lazyIntf: IMycLazy<Integer>;
lazyRec: TLazy<Integer>;
expectedValue: Integer;
begin
expectedValue := 80;
lazyIntf := TLazy<Integer>.Construct(FChangingSignal.State, function: Integer begin Result := expectedValue; end);
Assert.IsNotNull(lazyIntf, 'Interface should be assigned');
lazyRec := lazyIntf; // Implicit conversion: IMycLazy<T> to TLazy<T>
// Verify by using the record
Assert.IsTrue(lazyRec.Changed.IsSet, 'Record (from intf): Initial Changed.IsSet should be true');
ConsumeInitialPop(lazyRec, expectedValue, 'TestImplicitOperator_FromInterfaceToRecord');
end;
procedure TTestMyLazy.TestImplicitOperator_FromRecordToInterface;
var
lazyIntfFromConstruct: IMycLazy<Integer>;
lazyRec: TLazy<Integer>;
lazyIntfFromRecord: IMycLazy<Integer>;
val: Integer;
expectedValue: Integer;
begin
expectedValue := 90;
lazyIntfFromConstruct := TLazy<Integer>.Construct(FChangingSignal.State, function: Integer begin Result := expectedValue; end);
lazyRec.Create(lazyIntfFromConstruct); // Explicitly create record
lazyIntfFromRecord := lazyRec; // Implicit conversion: TLazy<T> to IMycLazy<T>
// Verify by using the converted interface
Assert.AreSame(lazyIntfFromConstruct, lazyIntfFromRecord, 'Converted interface should be the same as the original wrapped one');
Assert.IsTrue(lazyIntfFromRecord.Changed.IsSet, 'Interface (from rec): Initial Changed.IsSet should be true');
var popResult := lazyIntfFromRecord.Pop(val); // This also tests if the interface is functional
Assert.IsTrue(popResult);
Assert.AreEqual(expectedValue, val);
Assert.IsFalse(lazyIntfFromRecord.Changed.IsSet);
end;
// == Tests for TLazy<T>.Pop specific behaviors (Res undefined) ==
procedure TTestMyLazy.TestPop_AfterInitialAndNoSignal_ReturnsFalseAndResUndefined;
var
lazyIntf: IMycLazy<Integer>;
lazyRec: TLazy<Integer>;
val: Integer; // Value will not be checked as Pop returns false
popResult: Boolean;
procExecuted: Boolean;
begin
procExecuted := False;
lazyIntf := TLazy<Integer>.Construct(FChangingSignal.State,
function: Integer
begin
procExecuted := True;
Result := 100;
end);
lazyRec := lazyIntf;
ConsumeInitialPop(lazyRec, 100, 'TestPop_AfterInitialAndNoSignal (Initial)');
Assert.IsTrue(procExecuted, 'Proc should have run for initial pop');
procExecuted := False; // Reset for next check
// FChangingSignal has not been notified again
Assert.IsFalse(lazyRec.Changed.IsSet, 'Changed.IsSet must be false before this Pop attempt');
popResult := lazyRec.Pop(val);
Assert.IsFalse(popResult, 'Pop when Changed.IsSet is false should return false');
Assert.IsFalse(procExecuted, 'Proc should NOT have run as Pop returned false');
// Do NOT check 'val' as its content is undefined when Pop returns false.
end;
initialization
TDUnitX.RegisterTestFixture(TTestMyLazy);
end.
+5 -1
View File
@@ -28,7 +28,11 @@ uses
Myc.TaskManager in '..\Src\Myc.TaskManager.pas',
Myc.Core.Futures in '..\Src\Myc.Core.Futures.pas',
Myc.Core.Signals in '..\Src\Myc.Core.Signals.pas',
TestFutures in 'TestFutures.pas';
TestFutures in 'TestFutures.pas',
Myc.Lazy in '..\Src\Myc.Lazy.pas',
Myc.Core.Lazy in '..\Src\Myc.Core.Lazy.pas',
Myc.Test.Core.Lazy in '..\Src\Myc.Test.Core.Lazy.pas',
Myc.Test.Lazy in '..\Src\Myc.Test.Lazy.pas';
{ keep comment here to protect the following conditional from being removed by the IDE when adding a unit }
{$IFNDEF TESTINSIGHT}
+14 -10
View File
@@ -64,9 +64,9 @@
<VerInfo_Keys>CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=</VerInfo_Keys>
<Debugger_RunParams>--exitbehavior:Pause</Debugger_RunParams>
<DCC_Define>TESTINSIGHT;$(DCC_Define)</DCC_Define>
<PostBuildEvent><![CDATA[T:\DelphiIntfExtract\Win64\Debug\ExtractPascalInterfaces.exe -o T:\Myc\intf.txt T:\Myc\src
$(PostBuildEvent)]]></PostBuildEvent>
<PostBuildEventExecuteWhen>TargetOutOfDate</PostBuildEventExecuteWhen>
<PreBuildEvent><![CDATA[T:\DelphiIntfExtract\Win64\Debug\ExtractPascalInterfaces.exe -o T:\Myc\intf.txt T:\Myc\src
$(PreBuildEvent)]]></PreBuildEvent>
</PropertyGroup>
<PropertyGroup Condition="'$(Base_Win32)'!=''">
<DCC_UsePackage>vclwinx;fmx;vclie;DbxCommonDriver;bindengine;IndyIPCommon;VCLRESTComponents;FireDACCommonODBC;FireDACCommonDriver;IndyProtocols;vclx;Skia.Package.RTL;IndyIPClient;dbxcds;vcledge;bindcompvclwinx;FmxTeeUI;bindcompfmx;inetdb;FireDACSqliteDriver;DbxClientDriver;Tee;soapmidas;vclactnband;TeeUI;fmxFireDAC;dbexpress;DBXMySQLDriver;VclSmp;inet;vcltouch;fmxase;dbrtl;Skia.Package.FMX;fmxdae;TeeDB;FireDACMSAccDriver;CustomIPTransport;vcldsnap;DBXInterBaseDriver;IndySystem;Skia.Package.VCL;vcldb;vclFireDAC;bindcomp;FireDACCommon;inetstn;IndyCore;RESTBackendComponents;bindcompdbx;rtl;FireDACMySQLDriver;FireDACADSDriver;RESTComponents;DBXSqliteDriver;vcl;IndyIPServer;dsnapxml;dsnapcon;adortl;vclimg;FireDACPgDriver;FireDAC;inetdbxpress;xmlrtl;tethering;bindcompvcl;dsnap;CloudService;fmxobj;bindcompvclsmp;FMXTee;soaprtl;soapserver;FireDACIBDriver;$(DCC_UsePackage)</DCC_UsePackage>
@@ -128,6 +128,10 @@ $(PostBuildEvent)]]></PostBuildEvent>
<DCCReference Include="..\Src\Myc.Core.Futures.pas"/>
<DCCReference Include="..\Src\Myc.Core.Signals.pas"/>
<DCCReference Include="TestFutures.pas"/>
<DCCReference Include="..\Src\Myc.Lazy.pas"/>
<DCCReference Include="..\Src\Myc.Core.Lazy.pas"/>
<DCCReference Include="..\Src\Myc.Test.Core.Lazy.pas"/>
<DCCReference Include="..\Src\Myc.Test.Lazy.pas"/>
<BuildConfiguration Include="Base">
<Key>Base</Key>
</BuildConfiguration>
@@ -1149,35 +1153,35 @@ $(PostBuildEvent)]]></PostBuildEvent>
<Import Project="$(APPDATA)\Embarcadero\$(BDSAPPDATABASEDIR)\$(PRODUCTVERSION)\UserTools.proj" Condition="Exists('$(APPDATA)\Embarcadero\$(BDSAPPDATABASEDIR)\$(PRODUCTVERSION)\UserTools.proj')"/>
<Import Project="$(MSBuildProjectName).deployproj" Condition="Exists('$(MSBuildProjectName).deployproj')"/>
<PropertyGroup Condition="'$(Config)'=='Debug' And '$(Platform)'=='Win32'">
<PreBuildEvent/>
<PreBuildEvent>T:\DelphiIntfExtract\Win64\Debug\ExtractPascalInterfaces.exe -o T:\Myc\intf.txt T:\Myc\src</PreBuildEvent>
<PreBuildEventIgnoreExitCode>False</PreBuildEventIgnoreExitCode>
<PreLinkEvent/>
<PreLinkEventIgnoreExitCode>False</PreLinkEventIgnoreExitCode>
<PostBuildEvent>T:\DelphiIntfExtract\Win64\Debug\ExtractPascalInterfaces.exe -o T:\Myc\intf.txt T:\Myc\src</PostBuildEvent>
<PostBuildEvent/>
<PostBuildEventIgnoreExitCode>False</PostBuildEventIgnoreExitCode>
</PropertyGroup>
<PropertyGroup Condition="'$(Config)'=='Debug' And '$(Platform)'=='Win64'">
<PreBuildEvent/>
<PreBuildEvent>T:\DelphiIntfExtract\Win64\Debug\ExtractPascalInterfaces.exe -o T:\Myc\intf.txt T:\Myc\src</PreBuildEvent>
<PreBuildEventIgnoreExitCode>False</PreBuildEventIgnoreExitCode>
<PreLinkEvent/>
<PreLinkEventIgnoreExitCode>False</PreLinkEventIgnoreExitCode>
<PostBuildEvent>T:\DelphiIntfExtract\Win64\Debug\ExtractPascalInterfaces.exe -o T:\Myc\intf.txt T:\Myc\src</PostBuildEvent>
<PostBuildEvent/>
<PostBuildEventIgnoreExitCode>False</PostBuildEventIgnoreExitCode>
</PropertyGroup>
<PropertyGroup Condition="'$(Config)'=='Release' And '$(Platform)'=='Win32'">
<PreBuildEvent/>
<PreBuildEvent>T:\DelphiIntfExtract\Win64\Debug\ExtractPascalInterfaces.exe -o T:\Myc\intf.txt T:\Myc\src</PreBuildEvent>
<PreBuildEventIgnoreExitCode>False</PreBuildEventIgnoreExitCode>
<PreLinkEvent/>
<PreLinkEventIgnoreExitCode>False</PreLinkEventIgnoreExitCode>
<PostBuildEvent>T:\DelphiIntfExtract\Win64\Debug\ExtractPascalInterfaces.exe -o T:\Myc\intf.txt T:\Myc\src</PostBuildEvent>
<PostBuildEvent/>
<PostBuildEventIgnoreExitCode>False</PostBuildEventIgnoreExitCode>
</PropertyGroup>
<PropertyGroup Condition="'$(Config)'=='Release' And '$(Platform)'=='Win64'">
<PreBuildEvent/>
<PreBuildEvent>T:\DelphiIntfExtract\Win64\Debug\ExtractPascalInterfaces.exe -o T:\Myc\intf.txt T:\Myc\src</PreBuildEvent>
<PreBuildEventIgnoreExitCode>False</PreBuildEventIgnoreExitCode>
<PreLinkEvent/>
<PreLinkEventIgnoreExitCode>False</PreLinkEventIgnoreExitCode>
<PostBuildEvent>T:\DelphiIntfExtract\Win64\Debug\ExtractPascalInterfaces.exe -o T:\Myc\intf.txt T:\Myc\src</PostBuildEvent>
<PostBuildEvent/>
<PostBuildEventIgnoreExitCode>False</PostBuildEventIgnoreExitCode>
</PropertyGroup>
</Project>
+26 -26
View File
@@ -23,7 +23,7 @@ type
[TestFixture]
[IgnoreMemoryLeaks(true)]
TTestMycInitStateFuncFuture = class(TObject)
TTestMycGateFuncFuture = class(TObject)
private
FTaskFactory: IMycTaskFactory;
FProcExecutionCount: Integer; // Counter for side effects of AProc
@@ -67,16 +67,16 @@ begin
Result := False; // This subscriber is typically one-shot for this purpose.
end;
{ TTestMycInitStateFuncFuture }
{ TTestMycGateFuncFuture }
procedure TTestMycInitStateFuncFuture.Setup;
procedure TTestMycGateFuncFuture.Setup;
begin
FTaskFactory := TMycTaskFactory.Create; // Create a new task factory instance for each test [cite: 113, 235, 353]
FProcExecutionCount := 0;
FSharedCounter := 0;
end;
procedure TTestMycInitStateFuncFuture.TearDown;
procedure TTestMycGateFuncFuture.TearDown;
begin
if Assigned(FTaskFactory) then
begin
@@ -85,7 +85,7 @@ begin
end;
end;
procedure TTestMycInitStateFuncFuture.Test_BasicSuccess_WithImmediateInitState;
procedure TTestMycGateFuncFuture.Test_BasicSuccess_WithImmediateInitState;
var
LFuture: IMycFuture<Integer>;
LInitStateAsState: IMycState; // Parameter for Create
@@ -96,7 +96,7 @@ begin
// Use TMycLatch.Null for an already set init state [cite: 71, 81, 206, 216, 324, 334]
LInitStateAsState := TState.Null;
LFuture := TMycInitStateFuncFuture<Integer>.Create(FTaskFactory, LInitStateAsState,
LFuture := TMycGateFuncFuture<Integer>.Create(FTaskFactory, LInitStateAsState,
function: Integer
begin
Inc(Self.FProcExecutionCount);
@@ -112,7 +112,7 @@ begin
Assert.AreEqual(CExpectedResult, LResultValue, 'GetResult returned an unexpected value.');
end;
procedure TTestMycInitStateFuncFuture.Test_ChainedExecution_WithDelayedInitState;
procedure TTestMycGateFuncFuture.Test_ChainedExecution_WithDelayedInitState;
var
LFuture: IMycFuture<string>;
LInitLatch: IMycLatch;
@@ -120,9 +120,9 @@ var
const
CExpectedResult = 'ChainCompleted';
begin
LInitLatch := TState.CreateLatch(1); // Create an init state that is not yet set [cite: 77, 212, 330]
LInitLatch := TLatch.Construct(1); // Create an init state that is not yet set [cite: 77, 212, 330]
LFuture := TMycInitStateFuncFuture<string>.Create(FTaskFactory, LInitLatch.State,
LFuture := TMycGateFuncFuture<string>.Create(FTaskFactory, LInitLatch.State,
function: string
begin
Inc(Self.FProcExecutionCount);
@@ -143,7 +143,7 @@ begin
Assert.AreEqual(CExpectedResult, LResultValue, 'GetResult returned an unexpected value after delayed init.');
end;
procedure TTestMycInitStateFuncFuture.Test_ExceptionInProc_HandledAsPlanned;
procedure TTestMycGateFuncFuture.Test_ExceptionInProc_HandledAsPlanned;
var
LFuture: IMycFuture<Integer>;
LLocalTaskFactory: IMycTaskFactory;
@@ -157,7 +157,7 @@ begin
LLocalTaskFactory := TMycTaskFactory.Create;
LInitStateAsState := TState.Null; // Immediate execution
LFuture := TMycInitStateFuncFuture<Integer>.Create(LLocalTaskFactory, LInitStateAsState,
LFuture := TMycGateFuncFuture<Integer>.Create(LLocalTaskFactory, LInitStateAsState,
function: Integer
begin
Inc(Self.FProcExecutionCount);
@@ -203,14 +203,14 @@ begin
end;
end;
procedure TTestMycInitStateFuncFuture.Test_GetResult_BeforeDone_RaisesException;
procedure TTestMycGateFuncFuture.Test_GetResult_BeforeDone_RaisesException;
var
LFuture: IMycFuture<Integer>;
LInitLatch: IMycLatch;
begin
LInitLatch := TState.CreateLatch(1);
LInitLatch := TLatch.Construct(1);
LFuture := TMycInitStateFuncFuture<Integer>.Create(FTaskFactory, LInitLatch.State,
LFuture := TMycGateFuncFuture<Integer>.Create(FTaskFactory, LInitLatch.State,
function: Integer
begin
Inc(Self.FProcExecutionCount);
@@ -236,7 +236,7 @@ begin
end );
end;
procedure TTestMycInitStateFuncFuture.Test_FanIn_OneFutureWaitsForMultipleOthers;
procedure TTestMycGateFuncFuture.Test_FanIn_OneFutureWaitsForMultipleOthers;
var
LPrerequisiteFuture1, LPrerequisiteFuture2: IMycFuture<Integer>;
LMainFuture: IMycFuture<string>;
@@ -250,10 +250,10 @@ begin
FProcExecutionCount := 0; // Reset for this test
// Gate Latch: MainFuture waits for this latch, which needs 2 notifications.
LGateLatch := TState.CreateLatch(2); // [cite: 77, 212, 330]
LGateLatch := TLatch.Construct(2); // [cite: 77, 212, 330]
// Create MainFuture, AInitState is the GateLatch's state.
LMainFuture := TMycInitStateFuncFuture<string>.Create(FTaskFactory, LGateLatch.State,
LMainFuture := TMycGateFuncFuture<string>.Create(FTaskFactory, LGateLatch.State,
function: string
begin
Inc(Self.FProcExecutionCount, 10); // Indicate MainFuture's proc ran
@@ -262,8 +262,8 @@ begin
// Setup Prerequisite Futures
// PrerequisiteFuture1
LInitStateP1 := TState.CreateLatch(1); // Controllable init state for PF1
LPrerequisiteFuture1 := TMycInitStateFuncFuture<Integer>.Create(FTaskFactory, LInitStateP1.State,
LInitStateP1 := TLatch.Construct(1); // Controllable init state for PF1
LPrerequisiteFuture1 := TMycGateFuncFuture<Integer>.Create(FTaskFactory, LInitStateP1.State,
function: Integer
begin
Inc(Self.FProcExecutionCount, 1); // PF1 ran
@@ -273,8 +273,8 @@ begin
Subscriptions[1] := LPrerequisiteFuture1.Done.Subscribe(LSub1); // Subscribe to PF1's completion [cite: 56, 188, 306]
// PrerequisiteFuture2
LInitStateP2 := TState.CreateLatch(1); // Controllable init state for PF2
LPrerequisiteFuture2 := TMycInitStateFuncFuture<Integer>.Create(FTaskFactory, LInitStateP2.State,
LInitStateP2 := TLatch.Construct(1); // Controllable init state for PF2
LPrerequisiteFuture2 := TMycGateFuncFuture<Integer>.Create(FTaskFactory, LInitStateP2.State,
function: Integer
begin
Inc(Self.FProcExecutionCount, 1); // PF2 ran
@@ -312,7 +312,7 @@ begin
Subscriptions[2].Unsubscribe; //
end;
procedure TTestMycInitStateFuncFuture.Test_FanOut_MultipleFuturesWaitForOneTrigger;
procedure TTestMycGateFuncFuture.Test_FanOut_MultipleFuturesWaitForOneTrigger;
var
LTriggerLatch: IMycLatch;
LFutureA, LFutureB: IMycFuture<Integer>;
@@ -322,10 +322,10 @@ begin
LFlagFutureBRan := False;
Self.FSharedCounter := 0; // Reset shared counter for this test
LTriggerLatch := TState.CreateLatch(1); // Single trigger [cite: 77, 212, 330]
LTriggerLatch := TLatch.Construct(1); // Single trigger [cite: 77, 212, 330]
// Future A
LFutureA := TMycInitStateFuncFuture<Integer>.Create(FTaskFactory, LTriggerLatch.State,
LFutureA := TMycGateFuncFuture<Integer>.Create(FTaskFactory, LTriggerLatch.State,
function: Integer
begin
LFlagFutureARan := True;
@@ -334,7 +334,7 @@ begin
end);
// Future B
LFutureB := TMycInitStateFuncFuture<Integer>.Create(FTaskFactory, LTriggerLatch.State,
LFutureB := TMycGateFuncFuture<Integer>.Create(FTaskFactory, LTriggerLatch.State,
function: Integer
begin
LFlagFutureBRan := True;
@@ -364,5 +364,5 @@ end;
initialization
// For DUnitX, attributes typically handle registration.
// If needed for older DUnit: RegisterTest(TTestMycInitStateFuncFuture.Suite);
// If needed for older DUnit: RegisterTest(TTestMycGateFuncFuture.Suite);
end.
+2 -2
View File
@@ -146,7 +146,7 @@ var
delayedGate: IMycLatch; // IMycLatch implements IMycState [cite: 58]
resultValue: Integer;
begin
delayedGate := TState.CreateLatch( 1 ); // Create a latch that requires one notification to be set [cite: 66]
delayedGate := TLatch.Construct( 1 ); // Create a latch that requires one notification to be set [cite: 66]
Assert.IsNotNull( delayedGate, 'The delayed gate (IMycLatch) should not be nil.' ); // Static string
Assert.IsFalse( delayedGate.State.IsSet, 'The delayed gate should not be initially set.' ); // Static string [cite: 59, 55]
@@ -217,7 +217,7 @@ var
delayedGate: IMycLatch;
resultValue: string;
begin
delayedGate := TState.CreateLatch( 1 ); // [cite: 66]
delayedGate := TLatch.Construct( 1 ); // [cite: 66]
Assert.IsFalse( delayedGate.State.IsSet, 'The delayed gate for chain test should not be initially set.' );
// Static string [cite: 59, 55]
+1 -1
View File
@@ -308,7 +308,7 @@ end;
procedure TMycNotifierChaosStressTests.Test_MixedOperations_Stress;
const
NumThreads = 24; // Number of concurrent worker threads
IterationsPerThread = 5000; // Number of random operations per thread
IterationsPerThread = 2000; // Number of random operations per thread
var
threads: array of TStressWorkerThread;
i: Integer;
+1 -1
View File
@@ -198,7 +198,7 @@ end;
procedure TMycNotifierThreadingTests.Test_ConcurrentAdvise_Then_UnadviseAll_Consistency;
const
NumThreads = 24; // Number of threads
ItemsPerThread = 2500; // Number of Advise operations per thread
ItemsPerThread = 250; // Number of Advise operations per thread
var
threads: array of TAdviseWorkerThread;
i: Integer;
+2 -2
View File
@@ -105,7 +105,7 @@ end;
function TTestMycDirtyFlag.CreateAndPrepareDirtyFlag(StartDirty: Boolean = True): IMycDirty;
begin
Result := TState.CreateDirty; // Initially dirty
Result := TDirty.Construct; // Initially dirty
if not StartDirty then
Result.Reset; // Reset to make it clean
Assert.AreEqual(StartDirty, Result.State.IsSet, 'CreateAndPrepareDirtyFlag initial state incorrect.');
@@ -127,7 +127,7 @@ procedure TTestMycDirtyFlag.TestCreate_InitialStateIsDirty;
var
dirtyFlag: IMycDirty;
begin
dirtyFlag := TState.CreateDirty;
dirtyFlag := TDirty.Construct;
Assert.IsTrue(dirtyFlag.State.IsSet, 'Newly created dirty flag should be IsSet (dirty).');
end;
+22 -22
View File
@@ -124,7 +124,7 @@ var
latch: IMycLatch;
begin
// TMycLatch.CreateLatch returns TMycLatch.Null if InitialCount <= 0
latch := TState.CreateLatch(InitialCount);
latch := TLatch.Construct(InitialCount);
Assert.AreEqual(ExpectedIsSet, latch.State.IsSet, 'Latch initial IsSet state mismatch for count ' + IntToStr(InitialCount) + '.');
end;
@@ -133,7 +133,7 @@ var
latch: IMycLatch;
returnedValueFromNotify: Boolean;
begin
latch := TState.CreateLatch(InitialCount);
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) + '.');
@@ -144,7 +144,7 @@ procedure TTestMycLatch.TestNotify_DecrementsCounter_StateChanges;
var
latch: IMycLatch;
begin
latch := TState.CreateLatch(1);
latch := TLatch.Construct(1);
Assert.IsFalse(latch.State.IsSet, 'Latch should initially not be set (Count=1).');
latch.Notify; // Count becomes 0
Assert.IsTrue(latch.State.IsSet, 'Latch should be set after Notify (Count became 0).');
@@ -154,7 +154,7 @@ procedure TTestMycLatch.TestNotify_MultipleNotifies_CounterBecomesNegativeAndSta
var
latch: IMycLatch;
begin
latch := TState.CreateLatch(1);
latch := TLatch.Construct(1);
latch.Notify; // Count becomes 0, IsSet = True
Assert.IsTrue(latch.State.IsSet, 'Latch should be set after first Notify.');
latch.Notify; // Count becomes -1, IsSet should remain True
@@ -169,7 +169,7 @@ var
mockSub: TMockSubscriber;
subscription: TMycSubscription;
begin
latch := TState.CreateLatch(1);
latch := TLatch.Construct(1);
mockSub := TMockSubscriber.Create;
subscription := latch.State.Subscribe(mockSub); // Subscribing to the Latch's state
@@ -188,7 +188,7 @@ var
mockSub1, mockSub2, mockSub3: TMockSubscriber;
sub1, sub2, sub3: TMycSubscription; // Keep subscriptions in scope
begin
latch := TState.CreateLatch(1);
latch := TLatch.Construct(1);
mockSub1 := TMockSubscriber.Create;
mockSub2 := TMockSubscriber.Create;
mockSub3 := TMockSubscriber.Create;
@@ -210,7 +210,7 @@ var
mockSub: TMockSubscriber;
subscription: TMycSubscription;
begin
latch := TState.CreateLatch(2); // Count = 2
latch := TLatch.Construct(2); // Count = 2
mockSub := TMockSubscriber.Create;
subscription := latch.State.Subscribe(mockSub);
@@ -225,7 +225,7 @@ var
mockSub: TMockSubscriber;
subscription: TMycSubscription;
begin
latch := TState.CreateLatch(1);
latch := TLatch.Construct(1);
mockSub := TMockSubscriber.Create;
subscription := latch.State.Subscribe(mockSub);
@@ -242,7 +242,7 @@ var
mockSub1, mockSub2: TMockSubscriber;
subscription1, subscription2: TMycSubscription;
begin
latch := TState.CreateLatch(1); // Create with count 1
latch := TLatch.Construct(1); // Create with count 1
mockSub1 := TMockSubscriber.Create;
subscription1 := latch.State.Subscribe(mockSub1); // Subscribe before set
@@ -270,8 +270,8 @@ var
mockSubForB: TMockSubscriber;
subHandle_B_listens_A, subHandle_Mock_listens_B: TMycSubscription;
begin
latchA := TState.CreateLatch(1);
latchB := TState.CreateLatch(1); // latchB is an IMycSubscriber
latchA := TLatch.Construct(1);
latchB := TLatch.Construct(1); // latchB is an IMycSubscriber
mockSubForB := TMockSubscriber.Create;
subHandle_Mock_listens_B := latchB.State.Subscribe(mockSubForB);
@@ -295,9 +295,9 @@ var
mockSubForC: TMockSubscriber;
sub_Mock_C, sub_C_B, sub_B_A: TMycSubscription;
begin
latchA := TState.CreateLatch(1);
latchB := TState.CreateLatch(1);
latchC := TState.CreateLatch(1);
latchA := TLatch.Construct(1);
latchB := TLatch.Construct(1);
latchC := TLatch.Construct(1);
mockSubForC := TMockSubscriber.Create;
sub_Mock_C := latchC.State.Subscribe(mockSubForC);
@@ -320,8 +320,8 @@ var
begin
// LatchA needs 2 notifies to become set. LatchB needs 1 notify to become set.
// LatchB subscribes to LatchA. So LatchB will be notified once LatchA becomes set.
latchA := TState.CreateLatch(2);
latchB := TState.CreateLatch(1);
latchA := TLatch.Construct(2);
latchB := TLatch.Construct(1);
mockSubForB := TMockSubscriber.Create;
sub_Mock_B := latchB.State.Subscribe(mockSubForB);
@@ -347,7 +347,7 @@ var
mockSub: TMockSubscriber;
subscription: TMycSubscription;
begin
latch := TState.CreateLatch(0); // Returns TMycLatch.Null which is set.
latch := TLatch.Construct(0); // Returns TMycLatch.Null which is set.
mockSub := TMockSubscriber.Create;
subscription := latch.State.Subscribe(mockSub); // TMycLatch.Subscribe notifies immediately if already set.
@@ -362,7 +362,7 @@ var
mockSub: TMockSubscriber;
subscription: TMycSubscription;
begin
latch := TState.CreateLatch(1);
latch := TLatch.Construct(1);
mockSub := TMockSubscriber.Create;
subscription := latch.State.Subscribe(mockSub);
@@ -381,7 +381,7 @@ var
mockSub: TMockSubscriber;
subscription: TMycSubscription;
begin
latch := TState.CreateLatch(3);
latch := TLatch.Construct(3);
latch.Notify; // Count -> 2
latch.Notify; // Count -> 1
@@ -404,7 +404,7 @@ var
mockSub1, mockSub2: TMockSubscriber;
subscription1, subscription2: TMycSubscription;
begin
latch := TState.CreateLatch(1);
latch := TLatch.Construct(1);
mockSub1 := TMockSubscriber.Create;
mockSub2 := TMockSubscriber.Create;
@@ -432,7 +432,7 @@ var
mockSub: TMockSubscriber;
// 'subscription' will be declared in an inner scope to control its finalization
begin
latch := TState.CreateLatch(1);
latch := TLatch.Construct(1);
mockSub := TMockSubscriber.Create;
var noException: Boolean := True;
@@ -468,7 +468,7 @@ var
mockSubInitial, mockSubNew: TMockSubscriber;
subscriptionInitial, subscriptionNew: TMycSubscription;
begin
latch := TState.CreateLatch(1);
latch := TLatch.Construct(1);
mockSubInitial := TMockSubscriber.Create;
subscriptionInitial := latch.State.Subscribe(mockSubInitial);
+8 -8
View File
@@ -91,7 +91,7 @@ var
jobCompletedLatch: IMycLatch;
begin
jobExecuted := False;
jobCompletedLatch := TMycLatch.CreateLatch(1); // Changed from Signals.CreateLatch
jobCompletedLatch := TLatch.Construct(1); // Changed from Signals.CreateLatch
FFactory.Run(
procedure
@@ -111,7 +111,7 @@ var
subscriber: IMycSubscriber;
begin
jobExecuted := False;
jobCompletedLatch := TMycLatch.CreateLatch(1); // Changed from Signals.CreateLatch
jobCompletedLatch := TLatch.Construct(1); // Changed from Signals.CreateLatch
subscriber := FFactory.Run(
procedure
@@ -122,7 +122,7 @@ begin
Assert.IsNotNull(subscriber, 'Run should return a subscriber for delayed job');
// Use TMycLatch.Null for comparison
Assert.AreNotEqual<IMycSubscriber>(TMycLatch.Null, subscriber, 'Subscriber should not be TMycLatch.Null for StartCount > 0');
Assert.AreNotEqual<IMycSubscriber>(TLatch.Null, subscriber, 'Subscriber should not be TMycLatch.Null for StartCount > 0');
subscriber.Notify;
@@ -137,7 +137,7 @@ var
startTime, endTime: Cardinal;
begin
// TMycLatch.CreateLatch(0) will return TMycLatch.Null
alreadySetLatch := TMycLatch.CreateLatch(0); // Changed from Signals.CreateLatch
alreadySetLatch := TLatch.Construct(0); // Changed from Signals.CreateLatch
Assert.IsTrue(alreadySetLatch.State.IsSet, 'Latch should be initially set');
startTime := TThread.GetTickCount;
@@ -155,7 +155,7 @@ var
begin
inMainThreadInJob := True;
inWorkerThreadInJob := False;
jobDoneLatch := TMycLatch.CreateLatch(1); // Changed from Signals.CreateLatch
jobDoneLatch := TLatch.Construct(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');
@@ -178,7 +178,7 @@ procedure TMycTaskFactoryTests.TestExceptionPropagationFromJob;
var
jobDoneLatch: IMycLatch;
begin
jobDoneLatch := TMycLatch.CreateLatch(1);
jobDoneLatch := TLatch.Construct(1);
FFactory.EnqueueJob(
procedure
@@ -229,8 +229,8 @@ var
dummyStateToWaitFor: IMycState;
begin
exceptionCaughtInJob := False;
jobDoneLatch := TMycLatch.CreateLatch(1);
dummyStateToWaitFor := TMycLatch.CreateLatch(1).State;
jobDoneLatch := TLatch.Construct(1);
dummyStateToWaitFor := TLatch.Construct(1).State;
FFactory.EnqueueJob(
procedure