From 63484cd495af67348c2791411137df00a0f56f53 Mon Sep 17 00:00:00 2001 From: Michael Schimmel Date: Mon, 2 Jun 2025 00:45:30 +0200 Subject: [PATCH] added Futures --- Src/Myc.Core.Atomic.pas | 8 +- Src/Myc.Core.Tasks.pas | 104 +- Src/Myc.Futures.pas | 108 + Src/Myc.Signals.pas | 409 ++- Src/Myc.pas | 3848 ----------------------------- Test/MycTests.dpr | 6 +- Test/MycTests.dproj | 39 + Test/TestFutures.pas | 370 +++ Test/TestNotifier_ChaosStress.pas | 1 - Test/TestNotifier_Threading.pas | 3 +- Test/TestSList.pas | 1 - Test/TestSignals_Dirty.pas | 529 ++++ Test/TestSignals_Latch.pas | 274 +- Test/TestStack.pas | 1 - Test/TestTasks.pas | 50 +- 15 files changed, 1625 insertions(+), 4126 deletions(-) create mode 100644 Src/Myc.Futures.pas delete mode 100644 Src/Myc.pas create mode 100644 Test/TestFutures.pas create mode 100644 Test/TestSignals_Dirty.pas diff --git a/Src/Myc.Core.Atomic.pas b/Src/Myc.Core.Atomic.pas index 390af62..348572c 100644 --- a/Src/Myc.Core.Atomic.pas +++ b/Src/Myc.Core.Atomic.pas @@ -187,6 +187,10 @@ end; class operator TMycAtomicStack.Finalize(var Dest: TMycAtomicStack); begin Dest.Clear; + if Dest.FSList <> nil then // Check if FSList was initialized + begin + Dest.FSList.Free; // Call instance method Free on FSList via Dest + end; end; function TMycAtomicStack.Alloc: PItem; @@ -210,10 +214,6 @@ begin FreeMemAligned(item); // Global procedure item := PopPtr; // Call instance method PopPtr via Dest end; - if FSList <> nil then // Check if FSList was initialized - begin - FSList.Free; // Call instance method Free on FSList via Dest - end; end; function TMycAtomicStack.Pop: T; diff --git a/Src/Myc.Core.Tasks.pas b/Src/Myc.Core.Tasks.pas index 771d221..f50e7b1 100644 --- a/Src/Myc.Core.Tasks.pas +++ b/Src/Myc.Core.Tasks.pas @@ -8,17 +8,47 @@ uses type IMycTaskFactory = interface - {$region 'property access'} - function GetThreadCount: Integer; - {$endregion} - function CreateThread(const Proc: TProc): IMycState; - function InMainThread: Boolean; - function InWorkerThread: Boolean; - function Run(StartCount: Integer; Job: TProc): IMycSubscriber; - procedure Teardown; - procedure WaitFor(State: IMycState); - property ThreadCount: Integer read GetThreadCount; - end; + {$region 'property access'} + // Retrieves the number of worker threads. + function GetThreadCount: Integer; + {$endregion} + + // Creates and starts a new, independent thread executing Proc. + // Returns IMycState to await thread completion. + // Exceptions within Proc are caught; the first one is stored + // and can be re-raised in the main thread via WaitFor or Teardown. + function CreateThread(const Proc: TProc): IMycState; + + // Returns True if called from the main application thread. + function InMainThread: Boolean; + + // Returns True if called from one of the factory's worker threads. + function InWorkerThread: Boolean; + + // Schedules Job for execution by a worker thread. + // If StartCount > 0, Job is deferred until Notify is called StartCount times on the returned IMycSubscriber. + // If StartCount <= 0, Job is enqueued immediately. + // Returns IMycSubscriber for deferred jobs, or TMycLatch.Null for immediate jobs or if Job is nil. + // Exceptions during Job execution are caught; the first one is stored + // and can be re-raised in the main thread via WaitFor or Teardown. + // Raises ETaskException if the factory is already terminated. + function Run(StartCount: Integer; Job: TProc): IMycSubscriber; + + // Shuts down the task factory: terminates worker threads and cleans up resources. + // Before shutdown, any first stored exception from a worker thread (from Run or CreateThread tasks managed by this factory) + // will be re-raised in the calling (main) thread. + procedure Teardown; + + // Waits for the operation associated with State to complete. + // Must not be called from a worker thread of this factory. + // After waiting, or if the state is already set, any first stored exception + // from any worker thread of this factory will be re-raised in the calling (main) thread. + // Raises ETaskException if called from within a worker thread. + procedure WaitFor(State: IMycState); + + // Gets the number of worker threads. + property ThreadCount: Integer read GetThreadCount; + end; TMycTaskFactory = class(TInterfacedObject, IMycTaskFactory) type @@ -58,7 +88,7 @@ type implementation type - TMyc2PendingJob = class(TInterfacedObject, IMycSubscriber) + TMycPendingJob = class(TInterfacedObject, IMycSubscriber) private [volatile] FCount: Integer; // Countdown counter @@ -73,7 +103,7 @@ type property Owner: TMycTaskFactory read FOwner; end; - TMyc2TaskWait = class sealed(TInterfacedObject, IMycSubscriber) + TMycTaskWait = class sealed(TInterfacedObject, IMycSubscriber) private [volatile] FSemaphore: TSemaphore; // System.SyncObjs.TSemaphore to be released on notification @@ -88,8 +118,6 @@ type { TMycTaskFactory } constructor TMycTaskFactory.Create; -var - i: Integer; begin inherited Create; @@ -98,24 +126,31 @@ begin FWorkGate := TSemaphore.Create(nil, 0, MaxInt, ''); // Initial count is 0, workers will wait SetLength(FWorkThreads, TThread.ProcessorCount); // Create one thread per processor core - for i := 0 to High(FWorkThreads) do + for var i := 0 to High(FWorkThreads) do begin FWorkThreads[i] := CreateAnonymousThread('Thread pool [' + IntToStr(i) + ']', WorkerThread); TInterlocked.Increment(FThreadsRunning); // Increment active thread counter - FWorkThreads[i].Start; + FWorkThreads[i].FreeOnTerminate := false; end; + for var i := 0 to High(FWorkThreads) do + FWorkThreads[i].Start; end; destructor TMycTaskFactory.Destroy; begin Teardown; // Perform cleanup and stop threads + for var i := High(FWorkThreads) downto 0 do + FWorkThreads[i].Free; + FWorkGate.Free; + FWorkStack.Clear; inherited Destroy; end; class function TMycTaskFactory.CreateAnonymousThread(const DbgName: String; const Proc: TProc): TThread; {$IFDEF MSWINDOWS} +{$WARN SYMBOL_PLATFORM OFF} var prio: TThreadPriority; {$ENDIF MSWINDOWS} @@ -123,7 +158,6 @@ begin Result := TThread.CreateAnonymousThread(Proc); {$IFDEF MSWINDOWS} - {$WARN SYMBOL_PLATFORM OFF} // Set priority lower than MainThread priority if created from main thread if TThread.CurrentThread.ThreadID = MainThreadID then begin @@ -199,7 +233,7 @@ begin begin ex := AtomicExchange(Pointer(FException), nil); // Atomically retrieve and clear the stored exception if ex <> nil then - raise ex; // Re-raise the exception in the main thread + raise Exception(ex); end; end; @@ -238,7 +272,7 @@ begin end else // Create a pending job that waits for StartCount notifications - Result := TMyc2PendingJob.Create(StartCount, Self, Job); + Result := TMycPendingJob.Create(StartCount, Self, Job); end; procedure TMycTaskFactory.Teardown; @@ -285,17 +319,19 @@ begin if InWorkerThread then raise ETaskException.Create('Waiting not allowed within tasks'); - lock := FWaitSemaphores.Pop(); - if lock = nil then - lock := TSemaphore.Create(nil, 0, 1, ''); try - var subscription := State.Subscribe(TMyc2TaskWait.Create(lock)); - lock.Acquire; + lock := FWaitSemaphores.Pop(); + if lock = nil then + lock := TSemaphore.Create(nil, 0, 1, ''); + try + var subscription := State.Subscribe(TMycTaskWait.Create(lock)); + lock.Acquire; + finally + FWaitSemaphores.Push(lock); + end; finally - FWaitSemaphores.Push(lock); + HandleException; end; - - HandleException; end; procedure TMycTaskFactory.ExecuteJob; @@ -315,9 +351,9 @@ begin end; end; -{ TMyc2PendingJob } +{ TMycPendingJob } -constructor TMyc2PendingJob.Create(StartCountValue: Integer; OwnerTaskFactory: TMycTaskFactory; const JobProc: TProc); +constructor TMycPendingJob.Create(StartCountValue: Integer; OwnerTaskFactory: TMycTaskFactory; const JobProc: TProc); begin inherited Create; Assert(StartCountValue > 0); @@ -326,7 +362,7 @@ begin FJob := JobProc; end; -function TMyc2PendingJob.Notify: Boolean; +function TMycPendingJob.Notify: Boolean; var newCount: Integer; begin @@ -345,15 +381,15 @@ begin Result := newCount > 0; end; -{ TMyc2TaskWait } +{ TMycTaskWait } -constructor TMyc2TaskWait.Create(SemaphoreToSignal: TSemaphore); // Parameter is System.SyncObjs.TSemaphore +constructor TMycTaskWait.Create(SemaphoreToSignal: TSemaphore); // Parameter is System.SyncObjs.TSemaphore begin inherited Create; FSemaphore := SemaphoreToSignal; // Field is System.SyncObjs.TSemaphore end; -function TMyc2TaskWait.Notify: Boolean; +function TMycTaskWait.Notify: Boolean; var s: TSemaphore; // Local var is System.SyncObjs.TSemaphore begin diff --git a/Src/Myc.Futures.pas b/Src/Myc.Futures.pas new file mode 100644 index 0000000..6df8f55 --- /dev/null +++ b/Src/Myc.Futures.pas @@ -0,0 +1,108 @@ +unit Myc.Futures; + +interface + +uses + System.SysUtils, + Myc.Signals, Myc.Core.Tasks; + +type + // Represents the eventual result of an asynchronous operation. + IMycFuture = interface + {$REGION 'property access'} + function GetResult: T; + function GetDone: IMycState; + {$ENDREGION} + // Provides access to the computed result. + property Result: T read GetResult; + // Provides access to the completion state. + property Done: IMycState read GetDone; + end; + + // Abstract base class for IMycFuture implementations. + TMycFuture = class abstract(TInterfacedObject, IMycFuture) + protected + function GetResult: T; virtual; abstract; + function GetDone: IMycState; virtual; abstract; + end; + + // Concrete future implementation triggered by an initial state, executing a TFunc. + TMycInitStateFuncFuture = class(TMycFuture) + private + FInit: TMycSubscription; + FDone: IMycLatch; + FResult: T; + protected + function GetResult: T; override; + function GetDone: IMycState; override; + public + // Creates a future that executes AProc after AInitState is set, using ATaskFactory. + constructor Create(const ATaskFactory: IMycTaskFactory; const AInitState: + IMycState; AProc: TFunc); + // Cleans up resources, primarily by unsubscribing from the initial state. + destructor Destroy; override; + end; + +implementation + +{ TMycInitStateFuncFuture } + +constructor TMycInitStateFuncFuture.Create(const ATaskFactory: + IMycTaskFactory; const AInitState: IMycState; AProc: TFunc); +begin + inherited Create; + Assert(Assigned(AInitState), 'AInitState must be assigned.'); + + FDone := TMycLatch.CreateLatch(1); + + // Subscribe the job execution to AInitState. + // The job will run when AInitState notifies the subscriber returned by Run. + // AStartCount for Run is 1, meaning it waits for one Notify from AInitState's subscription. + FInit := AInitState.Subscribe( + ATaskFactory.Run(1, + + procedure + begin + try + try + Self.FResult := AProc(); + except + Self.FResult := Default(T); // Set result to Default(T) on error + raise; // Re-raise for TaskFactory to handle + end; + finally + Self.FDone.Notify; // Signal that this future is done (successfully or with error) + end; + end + ) + ); +end; + +destructor TMycInitStateFuncFuture.Destroy; +begin + Assert( FInit.State.IsSet ); + + // Explicitly unsubscribe from the initial state to ensure cleanup. + FInit.Unsubscribe; + inherited Destroy; +end; + +function TMycInitStateFuncFuture.GetDone: IMycState; +begin + Result := FDone.State; +end; + +function TMycInitStateFuncFuture.GetResult: T; +begin + if not FDone.State.IsSet then + begin + // Design decision: Caller must ensure future is done. + raise Exception.Create('Result is not yet available for the future.'); + end; + + // Returns FResult. If AProc failed, FResult is Default(T) and the exception + // was raised to be handled by the TaskFactory. + Result := FResult; +end; + +end. diff --git a/Src/Myc.Signals.pas b/Src/Myc.Signals.pas index 8319b08..ba0271c 100644 --- a/Src/Myc.Signals.pas +++ b/Src/Myc.Signals.pas @@ -3,153 +3,220 @@ unit Myc.Signals; interface uses - System.SysUtils, Myc.Core.Notifier; // Assuming Myc.Core.Notifier is available + System.SysUtils, Myc.Core.Notifier; type - IMycLatch = interface; // Forward declaration for the latch interface - - TMycSignal = class; // Base or related signal type + IMycState = interface; IMycSubscriber = interface // Interface for an entity that can be notified by a signal or latch. - // Returns true if further notifications are expected, false otherwise. + // Returns true if this subscriber expects further notifications from the source, false otherwise. function Notify: Boolean; end; + TMycState = class; + TMycSubscription = record private - FSignal: TMycSignal; // Could also be a more general IMycSignalProvider if TMycLatch isn't a TMycSignal - FTag: TMycNotifyList.TTag; + FState: IMycState; + FTag: TMycNotifyList.TTag; // Tag identifying this subscription within the notifier list. + function GetState: IMycState; + constructor Create(const AState: IMycState; ATag: TMycNotifyList.TTag); public - class operator Initialize(out Dest: TMycSubscription); - class operator Finalize(var Dest: TMycSubscription); - class operator Assign(var Dest: TMycSubscription; const [ref] Src: TMycSubscription); - - // Setup associates the subscription with a signal and a specific tag from TMycNotifyList. - procedure Setup(ASignal: TMycSignal; ATag: TMycNotifyList.TTag); inline; - // Unsubscribe removes this subscription from the signal it's associated with. + // Unsubscribes from the associated signal. procedure Unsubscribe; + property State: IMycState read GetState; end; - IMycSignal = interface - // Allows a subscriber to register for notifications. - // Returns a subscription record that manages the lifetime of the subscription. - function Subscribe(const Subscriber: IMycSubscriber): TMycSubscription; - end; - - TMycSignal = class abstract(TInterfacedObject, IMycSignal) - public - // Abstract method for subscribing to this signal. - function Subscribe(const Subscriber: IMycSubscriber): TMycSubscription; virtual; abstract; - // Abstract method for unsubscribing using a tag. - procedure Unsubscribe(Tag: TMycNotifyList.TTag); virtual; abstract; - end; - - IMycState = interface(IMycSignal) - // Represents a state that can be queried (IsSet) and subscribed to for changes. + IMycState = interface + // Represents a subscribable state that can be queried. {$region 'property access'} function GetIsSet: Boolean; {$endregion} - // IsSet is true if the state has been reached or the condition met. + // Subscribes a given subscriber to this signal. + function Subscribe(const Subscriber: IMycSubscriber): TMycSubscription; + procedure Unsubscribe(Tag: TMycNotifyList.TTag); + // IsSet is true if the state has been reached or the condition is met. property IsSet: Boolean read GetIsSet; end; - // IMycLatch represents a synchronization primitive that acts like a gate. - // Once its internal condition is met (e.g., a count reaches zero), it becomes "set" - // (its IMycState.IsSet becomes true) and remains set. - // It can be notified (as an IMycSubscriber) to progress towards its "set" state. - IMycLatch = interface(IMycSubscriber) + TMycState = class abstract( TInterfacedObject, IMycState ) + strict private + class var + FNull: IMycState; + class constructor ClassCreate; + protected + function GetIsSet: Boolean; virtual; abstract; + public + function Subscribe(const Subscriber: IMycSubscriber): TMycSubscription; virtual; abstract; + procedure Unsubscribe(Tag: TMycNotifyList.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; + + // IMycFlag represents a base for signal-like objects that have a binary state (set/not set), + // can be notified (as an IMycSubscriber) to potentially change state, + // and whose state (IMycState) can be queried and subscribed to. + IMycFlag = interface(IMycSubscriber) {$region 'property access'} - // Provides access to the IMycState interface of the latch, - // which indicates if the latch is set and allows subscriptions to this state change. + // Provides access to the IMycState interface of the flag. function GetState: IMycState; {$endregion} property State: IMycState read GetState; 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(IMycFlag) + // Inherits IMycSubscriber and State property from IMycFlag. No new members. + end; + // TMycLatch implements a countdown latch. // It is initialized with a count. Calls to its Notify method (as an IMycSubscriber) // decrement this count. When the count reaches zero, the latch transitions to the "set" // state (IsSet becomes true), notifies its current subscribers once, and then remains set. - TMycLatch = class(TMycSignal, IMycLatch, IMycState) + TMycLatch = class(TMycState, IMycLatch, IMycFlag) strict private FSubscribers: TMycNotifyList; // List of subscribers waiting for this latch to be set. class var - FNull: IMycLatch; - class constructor ClassCreate; + 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. - function GetState: IMycState; - function GetIsSet: Boolean; + [volatile] FCount: Integer; // The internal countdown value for the latch. + function GetState: IMycState; // Implementation for IMycLatch.GetState and IMycFlag.GetState. + protected + function GetIsSet: Boolean; override; final; // Implementation for IMycState.GetIsSet. public // Creates the latch with an initial count. - // If ACount is 0 or less, the latch is initially set. + // If ACount is 0 or less, the latch is effectively pre-set (delegates to FNull via CreateLatch factory). constructor Create(ACount: Integer); destructor Destroy; override; - // Creates a new countdown latch initialized with the given count. + // Factory method: creates a new countdown latch or returns the Null latch if Count <= 0. class function CreateLatch(Count: Integer): IMycLatch; static; - // IMycSignal implementation (from TMycSignal) + // IMycSignal implementation function Subscribe(const Subscriber: IMycSubscriber): TMycSubscription; override; procedure Unsubscribe(Tag: TMycNotifyList.TTag); override; // IMycSubscriber implementation for TMycLatch itself. // Decrements the internal count. If the count reaches zero, - // registered subscribers are notified and the latch becomes permanently set. + // registered subscribers are notified, and the latch becomes permanently set. function Notify: Boolean; + // Provides access to the singleton null latch instance (always set). 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(IMycFlag) + // Resets the flag to its "clean" (not set / not dirty) state. + // Returns true if the flag was actually dirty before this reset, false otherwise. + function Reset: Boolean; + end; + + // TMycDirty implements a resettable "dirty flag". + // It can be explicitly set to dirty (via Notify) or reset to clean (via Reset). + // Subscribers are notified of relevant state changes. + TMycDirty = class(TMycState, IMycFlag, IMycDirty) + strict private + FSubscribers: TMycNotifyList; // 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. + function GetState: IMycState; // Implementation for IMycFlag.GetState. + protected + function GetIsSet: Boolean; override; final; // Implementation for IMycState.GetIsSet (true if dirty). + public + // Creates a new dirty flag, initially set to dirty (true). + constructor Create; + destructor Destroy; override; + + // Factory method to create a new TMycDirty instance. + class function CreateDirty: IMycDirty; static; + + // IMycSignal implementation + function Subscribe(const Subscriber: IMycSubscriber): TMycSubscription; override; + procedure Unsubscribe(Tag: TMycNotifyList.TTag); override; + + // IMycSubscriber implementation for TMycDirty. + // Sets this flag to dirty (true). Notifies subscribers if it transitioned from clean to dirty. + function Notify: Boolean; + + // IMycDirty implementation. Resets the flag to clean (false). + function Reset: Boolean; + end; + implementation uses - System.SyncObjs; // For TInterlocked if used, though it wasn't in the original TMycSemaphore.Notify directly visible + System.SyncObjs; // For TInterlocked + +type + // TMycNullState implements a "null object" pattern for IMycState. + // This state is always considered "set". + TMycNullState = class(TInterfacedObject, IMycState) + protected + // IMycState + function GetIsSet: Boolean; + function Subscribe(const Subscriber: IMycSubscriber): TMycSubscription; + procedure Unsubscribe(Tag: TMycNotifyList.TTag); + public + constructor Create; + end; + +{ TMycNullState } + +constructor TMycNullState.Create; +begin + inherited Create; +end; + +function TMycNullState.GetIsSet: Boolean; +begin + Result := true; // Null state is always set. +end; + +function TMycNullState.Subscribe(const Subscriber: IMycSubscriber): TMycSubscription; +begin + // Since the state is always set, notify the subscriber immediately. + if Assigned(Subscriber) then + begin + Subscriber.Notify; + end; + // No ongoing subscription is necessary or meaningful for a null state. + Result.Create(Self, nil); // Return an empty subscription. +end; + +procedure TMycNullState.Unsubscribe(Tag: TMycNotifyList.TTag); +begin + // Unsubscribing from a null state has no effect. +end; { TMycSubscription } -procedure TMycSubscription.Setup(ASignal: TMycSignal; ATag: TMycNotifyList.TTag); +constructor TMycSubscription.Create(const AState: IMycState; ATag: + TMycNotifyList.TTag); begin - Unsubscribe; // Ensure any previous subscription is cleared. - FSignal := ASignal; + Assert( Assigned(AState) ); + FState := AState; FTag := ATag; end; procedure TMycSubscription.Unsubscribe; begin - if FTag <> nil then // Check if currently subscribed + if Assigned(FState) then begin - Assert(Assigned(FSignal), 'FSignal is not assigned during Unsubscribe'); - FSignal.Unsubscribe(FTag); - FTag := nil; // Mark as unsubscribed + FState.Unsubscribe(FTag); + FTag := nil; + FState := nil; end; end; -class operator TMycSubscription.Assign(var Dest: TMycSubscription; const [ref] Src: TMycSubscription); +function TMycSubscription.GetState: IMycState; begin - // This default assignment might not be what's intended if Src is a temporary. - // Proper management would involve Dest taking ownership or Src being managed. - // However, if it's just copying the record fields: - Dest.Setup(Src.FSignal, Src.FTag); - // To prevent Src from unsubscribing if it's a temporary and Dest now "owns" the subscription, - // one might consider nil'ing out Src.FTag, but that depends on usage patterns. - // Given the `const [ref] Src`, this assignment implies Dest should reflect Src. - // If Src is finalized later, it will call Unsubscribe. This might be problematic if Dest also expects to manage it. - // A robust solution for record assignment with resource management often requires more careful design - // or using interfaces/objects for the subscription itself. - // For now, keeping it simple as per original structure. -end; - -class operator TMycSubscription.Initialize(out Dest: TMycSubscription); -begin - Dest.FSignal := nil; // Ensure FSignal is initialized - Dest.FTag := nil; // Initialize tag to nil, indicating no active subscription. -end; - -class operator TMycSubscription.Finalize(var Dest: TMycSubscription); -begin - Dest.Unsubscribe; // Automatically unsubscribe when the record goes out of scope. + Result := FState; end; { TMycLatch } @@ -157,29 +224,28 @@ end; constructor TMycLatch.Create(ACount: Integer); begin inherited Create; - FCount := ACount; // Set the initial countdown value. - FSubscribers.Create; // Initialize the list of subscribers. + Assert( ACount >= 0 ); + FCount := ACount; + FSubscribers.Create; end; -{ TMycLatch } - class constructor TMycLatch.ClassCreate; begin - // Create1 a null latch instance that is initially (and always) set. - FNull := TMycLatch.Create(0); + // 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; // Clean up the subscriber list. + FSubscribers.Destroy; inherited; end; class function TMycLatch.CreateLatch(Count: Integer): IMycLatch; begin - // Factory method to create a new TMycLatch instance. + // Factory method: returns a new latch or the shared Null latch if Count <= 0. if Count > 0 then - Result := TMycLatch.Create(Count) + Result := TMycLatch.Create(Count) // Instance constructor else Result := FNull; end; @@ -189,37 +255,29 @@ var currentCountAfterDecrement: Integer; shouldNotifySubscribers: Boolean; begin - FSubscribers.Lock; // Lock to protect FCount and FSubscribers modifications/iterations + FSubscribers.Lock; try currentCountAfterDecrement := TInterlocked.Decrement(FCount); - // Defend against extreme underflow if Notify could be called excessively. - // This helps maintain a semblance of sanity for FCount, though ideally - // it shouldn't be needed if used as a typical countdown latch. if currentCountAfterDecrement < -MaxInt div 2 then - TInterlocked.Increment(FCount); // Try to pull it back from extreme negative. + TInterlocked.Increment(FCount); // Defend against extreme underflow. - // Notify subscribers only when the count transitions to zero. - shouldNotifySubscribers := (currentCountAfterDecrement = 0); + shouldNotifySubscribers := (currentCountAfterDecrement = 0); // Notify only on transition to zero. if shouldNotifySubscribers then begin FSubscribers.Notify( function(Subscriber: IMycSubscriber): Boolean begin - // Notify each subscriber. The result of Subscriber.Notify indicates - // if that subscriber expects further notifications (which, for a latch, is typically false after the first one). Result := Subscriber.Notify; end); end; - // A latch, once set (count <= 0), remains set. - // This Notify method itself returns true if the count is still > 0, - // indicating the latch has not yet been "set" by this Notify call. + // Returns true if the latch has not yet been set by this Notify call (count > 0). Result := currentCountAfterDecrement > 0; - // If the latch has become set (or was already set and Notify is called again making count more negative), - // unadvise all subscribers. This makes it a one-shot notification for this set of subscribers. + // If the latch is now set (or was already set), unadvise all subscribers. + // This ensures one-shot notification for the current set of subscribers. if currentCountAfterDecrement <= 0 then FSubscribers.UnadviseAll; finally @@ -229,7 +287,7 @@ end; function TMycLatch.GetIsSet: Boolean; begin - // The latch is considered "set" if its count has reached zero or less. + // The latch is set if its count has reached zero or less. Result := FCount <= 0; end; @@ -243,58 +301,157 @@ function TMycLatch.Subscribe(const Subscriber: IMycSubscriber): TMycSubscription var alreadySet: Boolean; begin + Result.Create(TMycState.Null, nil); // Default to an empty subscription. if not Assigned(Subscriber) then - begin - Result.Setup(nil, nil); // Return an empty/invalid subscription exit; - end; - // It's good practice to manage ref counts for interfaces passed around, - // especially if their lifetime is tied to the subscription. - // TMycNotifyList should handle AddRef/Release for stored subscribers if it holds interfaces. - // If direct Advise/Unadvise handles it, this explicit AddRef/Release pair might be for safety - // during the decision-making part of this method. - - Subscriber._AddRef; // Manually increment ref count for safety during this method's logic + Subscriber._AddRef; // Manage ref count during this method's logic. try FSubscribers.Lock; try - // Check if the latch is already set. - // This uses FCount directly rather than GetIsSet to avoid re-entrancy issues if GetIsSet had complex logic. - alreadySet := (FCount <= 0); + alreadySet := (FCount <= 0); // Check if latch is already set. if alreadySet then begin - // If already set, notify the new subscriber immediately and do not add to list. - // The subscription will be effectively null/empty as it's a one-shot notification. - Result.Setup(nil, nil); // No persistent subscription needed. - Subscriber.Notify; // Notify immediately. + // If already set, notify immediately; no persistent subscription needed. + Subscriber.Notify; end else begin - // If not yet set, advise the subscriber to the list. - // The TMycSubscription record will hold the tag for later unsubscription. - Result.Setup(Self, FSubscribers.Advise(Subscriber)); + // If not yet set, advise the subscriber. + Result.Create(Self, FSubscribers.Advise(Subscriber)); end; finally FSubscribers.Release; end; finally - Subscriber._Release; // Release the ref count taken at the beginning of the method. + Subscriber._Release; end; end; procedure TMycLatch.Unsubscribe(Tag: TMycNotifyList.TTag); begin - if Tag = nil then // No valid tag to unadvise. + if Tag = nil then exit; FSubscribers.Lock; try - FSubscribers.Unadvise(Tag); // Remove the subscriber associated with this tag. + FSubscribers.Unadvise(Tag); finally FSubscribers.Release; end; end; +{ TMycDirty } + +constructor TMycDirty.Create; +begin + inherited Create; + FFlag := true; // A new dirty flag is initially considered dirty. + FSubscribers.Create; +end; + +class function TMycDirty.CreateDirty: IMycDirty; +begin + // Factory method to create a new TMycDirty instance. + Result := TMycDirty.Create; +end; + +destructor TMycDirty.Destroy; +begin + FSubscribers.Destroy; // Clean up the subscriber list. + inherited; +end; + +function TMycDirty.Reset: Boolean; +begin + // Sets the flag to false (clean) and returns true if it was previously true (dirty). + Result := TInterlocked.Exchange(FFlag, false); +end; + +function TMycDirty.GetIsSet: Boolean; +begin + // IsSet is true if the flag is dirty (FFlag = true). + Result := FFlag; +end; + +function TMycDirty.GetState: IMycState; +begin + // TMycDirty itself implements IMycState. + exit(Self); +end; + +function TMycDirty.Notify: Boolean; +var + wasPreviouslyClean: Boolean; +begin + FSubscribers.Lock; + try + // Set the flag to true (dirty) and check if it was previously false (clean). + wasPreviouslyClean := not TInterlocked.Exchange(FFlag, true); + + 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); + 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. + // Here, it reflects whether a state change to dirty occurred due to this call. + Result := wasPreviouslyClean; + finally + FSubscribers.Release; + end; +end; + +function TMycDirty.Subscribe(const Subscriber: IMycSubscriber): TMycSubscription; +begin + Result.Create(TMycState.Null, nil); // Default to an empty subscription + if not Assigned(Subscriber) then + exit; + + // For TMycDirty, we always add the subscriber and then check if we need to notify immediately. + // Ref counting for the subscriber interface is assumed to be handled by TMycNotifyList.Advise/Unadvise. + // Or, if explicit management is needed like in TMycLatch, it should be added. + // For consistency with TMycLatch, let's add AddRef/Release here too. + Subscriber._AddRef; + try + FSubscribers.Lock; + try + // Add subscriber regardless of current state. + Result.Create(Self, FSubscribers.Advise(Subscriber)); + if FFlag then // If currently dirty, notify the new subscriber immediately. + begin + Subscriber.Notify; + end; + finally + FSubscribers.Release; + end; + finally + Subscriber._Release; + end; +end; + +procedure TMycDirty.Unsubscribe(Tag: TMycNotifyList.TTag); +begin + if Tag = nil then + exit; + + FSubscribers.Lock; + try + FSubscribers.Unadvise(Tag); + finally + FSubscribers.Release; + end; +end; + +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; + end. diff --git a/Src/Myc.pas b/Src/Myc.pas deleted file mode 100644 index 12dd378..0000000 --- a/Src/Myc.pas +++ /dev/null @@ -1,3848 +0,0 @@ -////////////////////////////////////////////////////////////////////////////// -////////////////////////////////////////////////////////////////////////////// -/// -/// Mycelium Scenes Library -/// ----------------------- -/// -/// (c)2007-2020 Michael Schimmel -/// Ehrenhainstr 40 -/// 42329 Wuppertal / Germany -/// info@mycelium.net -/// -/// All rights reserved. -/// -////////////////////////////////////////////////////////////////////////////// -////////////////////////////////////////////////////////////////////////////// - -unit Myc; - -interface - -uses - {$ifdef FullDebugMode}FastMM5, {$endif} - System.SysUtils, System.TypInfo, System.Generics.Collections, - System.Generics.Defaults; - -{$minenumsize 4} - - -type - {$message hint 'Debug-Code! Const Params?'} - TMyc3Combiner = reference to function( const Values: TArray ): T; - - TMyc3Interpolator = reference to function( Delta: Double; const StartValue: T; out Value: T ): Boolean; - TMyc3TargetInterpolator = reference to function( Delta: Double; const StartValue, TargetValue: T; out Value: T ): Boolean; - - EMycInvalidParameter = class( Exception ) - end; - - EMycInvalidOperation = class( Exception ) - end; - - TConstFunc = reference to function( const aa: A ): T; - TConstFunc = reference to function( const aa: A; const bb: B ): T; - TConstFunc = reference to function( const aa: A; const bb: B; const cc: C ): T; - TConstFunc = reference to function( const aa: A; const bb: B; const cc: C ; const dd: D ): T; - TConstFunc = reference to function( const aa: A; const bb: B; const cc: C ; const dd: D; const ee: E ): T; - TConstProc = reference to procedure( const aa: A ); - TConstProc = reference to procedure( const aa: A; const bb: B ); - TConstProc = reference to procedure( const aa: A; const bb: B; const cc: C ); - - TCompareValues = reference to function( const A, B: T ): Boolean; - - ///////////////////////////////////////////////////////////////////////////// - - IMycEnumerator = interface - function GetCurrent: T; - function MoveNext: Boolean; - procedure Reset; - property Current: T read GetCurrent; - end; - - IMyc2Enumerable = interface - function GetEnumerator: IMycEnumerator; - end; - - IMycCountable = interface - {$region 'property access'} - function GetCount: Integer; - function GetItems( Idx: Integer ): T; - {$endregion} - property Count: Integer read GetCount; - property Items[Idx: Integer]: T read GetItems; default; - end; - - ///////////////////////////////////////////////////////////////////////////// - - IAtomicStack = interface - function Pop: T; - function TryPop( out Item: T ): Boolean; - procedure Push( const Data: T ); - end; - - TAtomicStack = record - class function Create: IAtomicStack; static; - end; - - TProtected = record - private - [volatile] - FItem: T; - - public - constructor Create( const AItem: T ); - function Exchange( const Value: T ): T; - class operator Implicit( const Value: T ): TProtected; - end; - - ///////////////////////////////////////////////////////////////////////////// - - IMyc2Sink = interface - function Notify: Boolean; - end; - - IMyc2Flag = interface( IMyc2Sink ) - function Reset: Boolean; - end; - - {$message hint 'Replace TSignalTag by IMycDeletable? '} - TSignalTag = NativeInt; - - IMyc2Signal = interface - function Advise( const Sink: IMyc2Sink ): TSignalTag; - procedure Unadvise( Tag: TSignalTag ); - end; - - IMyc2Notifier = interface( IMyc2Sink ) - {$region 'property access'} - function GetSignal: IMyc2Signal; - {$endregion} - property Signal: IMyc2Signal read GetSignal; - end; - - IMyc2State = interface( IMyc2Signal ) - {$region 'property access'} - function GetIsSet: Boolean; - {$endregion} - property IsSet: Boolean read GetIsSet; - end; - - IMyc2Condition = interface( IMyc2Sink ) - {$region 'property access'} - function GetState: IMyc2State; - {$endregion} - property State: IMyc2State read GetState; - end; - - IMyc2Event = interface( IMyc2Condition ) - function Reset: Boolean; - end; - - IMycObserver = interface - function GetItem: T; - property Item: T read GetItem; - end; - - IMycNotifyObserver = IMycObserver; - IMycEventObserver = IMycObserver; - - TMycStateQueue = record - private - FStack: IAtomicStack; - - public - constructor Create(const AStack: IAtomicStack); overload; - - class function Create: TMycStateQueue; overload; static; - - procedure Add( const S: IMyc2State ); - procedure WaitFor; - - end; - - Signals = record - private - class function GetNull: IMyc2Condition; static; - - public - class function CreateCounter( Count: Integer ): IMyc2Condition; static; - class function CreateEvent( Init: Boolean = false ): IMyc2Event; overload; static; - class function CreateNotifier: IMyc2Notifier; overload; static; - class function CreateSink(Once: Boolean; const Proc: TProc): IMyc2Sink; overload; static; deprecated; - class function CreateSink(const Proc: TProc): IMyc2Sink; overload; static; - class function CreateFlag(Init: Boolean): IMyc2Flag; static; - - class function CreateObserver( const Signals: array of IMyc2Signal; const Sink: T ): IMycObserver; static; - class function CreateNotifyObserver( const Signals: array of IMyc2Signal ): IMycNotifyObserver; overload; static; - class function CreateEventObserver( const Signals: array of IMyc2Signal ): IMycEventObserver; overload; static; - - class function CreateNotifyObserver( const Signals: IMycCountable ): IMycNotifyObserver; overload; static; - class function CreateEventObserver( const Signals: IMycCountable ): IMycEventObserver; overload; static; - - class function Concat( const States: array of IMyc2State ): IMyc2State; static; - class function Union( const Sigs: array of IMyc2Signal ): IMyc2Signal; static; - - class function IsStatic( const Signal: IMyc2Signal ): Boolean; static; inline; - class function MakeValid( const Signal: IMyc2Signal ): IMyc2Signal; overload; static; inline; - class function MakeValid( const Signals: array of IMyc2Signal ): TArray; overload; static; - - class property Null: IMyc2Condition read GetNull; - end; - - ///////////////////////////////////////////////////////////////////////////// - - IMyc3Value = interface - {$region 'property access'} - function GetValue: T; - {$endregion} - property Value: T read GetValue; - end; - - TImmutable = record - private - FThis: IMyc3Value; - function GetValue: T; inline; - function GetHasValue: Boolean; inline; - class function GetNull: TImmutable; static; inline; - public - constructor Create(const AValue: T); overload; - class operator NotEqual(ALeft, ARight: TImmutable): Boolean; - class operator Equal(ALeft, ARight: TImmutable): Boolean; - property Value: T read GetValue; - property HasValue: Boolean read GetHasValue; - class property Null: TImmutable read GetNull; - end; - - // IDEA: - // Mutable objects represent exactly *one* property of a dynamic system. - // As such, they provide a change signal and an immutable value - // that is *replaced*, when they change. - // Q: How do you maintain thread safety with such an object? - // A: Reading a mutable object needs locking. There's no way around it. - // But picking up a reference to an immutable can be done with almost no - // overhead using atomic operations. - // Given the nature of mutable objects, they should only be used within - // the scope of a single thread (which does not have to be the main thread!) - // Q: Is it getting any better this way? - // A: mmmh... at least it offloads the application from doing this kinda stuff. - // And it ensures separating data from logic. - // Q: Shouldn't IMutable then be derived from IValue or from ISignal? - // A: To be considered. Given that IMutable is *not* the value itself, because - // IValue is immutable by definition, it seems to make more sense to derive - // it from ISignal. OTOH, it isn't a signal either. Maybe it should really - // stand for it's own. - - // Mutable objects may change over time. - IMyc3Mutable = interface - {$region 'property access'} - function GetChanged: IMyc2Signal; - {$endregion} - property Changed: IMyc2Signal read GetChanged; - end; - - // The Values of typed mutable objects are typed immutables. (And thus should - // be IValue instead of T, see idea above). - IMyc3Mutable = interface( IMyc3Mutable ) - {$region 'property access'} - function GetValue: T; - {$endregion} - property Value: T read GetValue; - end; - - IMyc3ObjectLink = interface - {$region 'property access'} - function GetMutable: IMyc3Mutable; - {$endregion} - procedure Destroyed; - property Mutable: IMyc3Mutable read GetMutable; - end; - - IMyc3Validatable = interface - {$region 'property access'} - function GetInvalidate: IMyc2Signal; - {$endregion} - - function Validate: Boolean; - property Invalidate: IMyc2Signal read GetInvalidate; - end; - - IMyc3Validatable = interface( IMyc3Validatable ) - {$region 'property access'} - function GetValue: T; - {$endregion} - property Value: T read GetValue; - end; - - TValidatable = record - class function FromSignal(const Signal: IMyc2Signal): IMyc3Validatable; static; - end; - - // This is the generic base interface for futures. Futures are used to initialize - // and hold immutable data. - // - // After the initialization is finished, the future and its value are considered - // to be immutable, which means statically constant and accessing them is always - // thread-safe and non-blocking. - // - // Reading the data before initialization is finished is not allowed! Other - // threads have to wait for the initialization signal before accessing the value. - // This can be done explicitly by waiting or by pipelining other futures. - IMyc3Future = interface - - {$region 'property access'} - function GetInitialized: IMyc2State; - function GetValue: T; - {$endregion} - // Wait until initialization is finished. Being a blocking operation, this is only - // allowed from the main thread. - {$message hint 'Sollte nichts zurückgeben, damit es nicht in Conditionals verwendet wird!'} - function WaitFor: T; - - // Initialization state. This state is set exactly once in the lifetime of the - // future. It can be used to pipeline other futures. - // - property Initialized: IMyc2State read GetInitialized; - - // Reading the value is NOT ALLOWED until the initialization is finished, - // otherwise an exception is raised. - // - // Use [WaitFor] to block execution until the value is ready. - property Value: T read GetValue; - end; - - IMyc3Changeable = interface - {$region 'property access'} - function GetMutable: IMyc3Mutable; - {$endregion} - procedure SetChanged; - property Mutable: IMyc3Mutable read GetMutable; - end; - - IMyc3Generic = interface( IMyc3Changeable ) - {$region 'property access'} - function GetFunc: TFunc; - procedure SetFunc(const Value: TFunc); - {$endregion} - property Func: TFunc read GetFunc write SetFunc; - end; - - IMyc3Writeable = interface( IMyc3Changeable ) - function SetValue(const Value: T): Boolean; - end; - - IMyc3ValidateMutable = interface( IMyc3Mutable ) - procedure Validate; - end; - - IMyc3Property = interface( IMyc3Mutable ) - procedure Delete; overload; - procedure Delete( const DefaultValue: T ); overload; - end; - - IMyc3MutableProperty = interface( IMyc3Mutable ) - - {$region 'property access'} - procedure SetMutable( const Value: IMyc3Mutable ); - {$endregion} - property Mutable: IMyc3Mutable write SetMutable; - end; - - IMyc3MutablePropertyEx = interface( IMyc3Mutable ) - procedure Invalidate; - end; - - IMyc3Animator = interface - procedure Tick( const Ticks: Int64 ); - end; - - IMyc3Animator = interface( IMyc3Animator ) - function GetCurrent: IMyc3Mutable; - property Current: IMyc3Mutable read GetCurrent; - end; - - IMycDeletable = interface - procedure Delete; - end; - - IMycArray = interface( IMyc2Enumerable ) - {$region 'property access'} - function GetCount: Integer; - function GetItems( Idx: Integer ): T; - {$endregion} - function ToArray: TArray; - function Sort( const Comparer: IComparer = nil; First: Integer = 0; Count: Integer = -1 ): TArray; - function Divide( const Comparer: IComparer ): TArray>; - function Divide1( const Comparer: IComparer ): TArray>; - function Range( First: Integer; Count: Integer ): IMycArray; - function Rearrange( const Indices: TArray ): IMycArray; - property Count: Integer read GetCount; - property Items[Idx: Integer]: T read GetItems; default; - end; - - IMycChain = interface( IMyc2Enumerable ) - {$region 'property access'} - function GetChanged: IMyc2Signal; - {$endregion} - function AddFirst( const Item: T ): IMycDeletable; - function AddLast( const Item: T ): IMycDeletable; - function ToArray: TArray; - property Changed: IMyc2Signal read GetChanged; - end; - - TChain = record - public - class function Create: IMycChain; static; - end; - - TMycArray = class {helper for TArray} - public - class function Create( const Arr: array of T ): IMycArray; overload; static; - class function Create( Count: Integer; const Getter: TFunc ): IMycArray; overload; static; - - class function Create(const Src: IMyc2Enumerable): IMycArray; overload; static; - - class function Create( const Src: IMycArray; const Converter: TConstFunc ): IMycArray; overload; static; - - class procedure Divide1( const Src: IMycArray>; out Keys: TArray; out Values: - TArray>; const Comparer: IComparer ); overload; static; - - class function Divide( const Src: IMycArray>; const Comparer: IComparer ): TArray>>; overload; static; - - class function Divide( const Src: TArray; const Comparer: IComparer ): TArray>; overload; static; - class function Divide( const Src: TArray>; const Comparer: IComparer ): TArray>>; overload; static; - - class function GetKeys( const Arr: TArray> ): TArray; static; - - class function CreateConvert( const Enum: IMyc2Enumerable; const Conv: TConstFunc ): IMyc2Enumerable; - end; - - IMyc3Set = interface( IMyc3Mutable ) - function Add( const Item: S ): Integer; - procedure Remove( const Item: S ); - procedure Delete( Idx: Integer ); - procedure Clear; - end; - - IMycEnumerable = interface( IMyc3Mutable> ) - {$region 'property access'} - function GetCount: Integer; - {$endregion} - function GetEnumerator: IMycEnumerator; - property Count: Integer read GetCount; - end; - - IMycSetItem = interface( IMycDeletable ) - {$region 'property access'} - function GetValue: T; - {$endregion} - property Value: T read GetValue; - end; - - IMycSet = interface( IMycEnumerable ) - function Add( const Value: T ): IMycSetItem; - function Pop: T; - procedure Clear; - end; - - IMycEnumArray = interface( IMycEnumerable ) - {$region 'property access'} - function GetItems( Idx: Integer ): T; - {$endregion} - function Sort( const Comparer: IComparer = nil; First: Integer = 0; Count: Integer = -1 ): IMycArray; - property Items[Idx: Integer]: T read GetItems; default; - end; - - TSet = record - public - class function Create: IMycSet; overload; static; - class function Create( const Arr: IMyc3Mutable> ): IMycEnumArray; overload; static; - class function CreateEx( const Arr: TArray ): IMycEnumArray; overload; static; - end; - - IMycAssembly = interface( IMycSet>> ) - {$region 'property access'} - function GetItems: IMyc3Mutable>; - {$endregion} - function Add( const Value: T ): IMycDeletable; overload; - function Add( const Values: array of T ): IMycDeletable; overload; - property Items: IMyc3Mutable> read GetItems; - end deprecated; - - TAssembly = record - class function Create: IMycAssembly; static; - end deprecated; - - IMycStack = interface - {$region 'property access'} - function GetCount: Integer; - {$endregion} - procedure Push( const Value: T ); - function Pop: T; - procedure Clear; - function ToArray: TArray; - property Count: Integer read GetCount; - end; - - Stack = record - class function Create: IMycStack; static; - end; - - TFunc = reference to function( P1: U; P2: V; P3: W; P4: X; P5: Y ): T; - TFunc = reference to function( P1: U; P2: V; P3: W; P4: X; P5: Y; P6: Z ): T; - - ///////////////////////////////////////////////////////////////////////////// - // TValue - // - TValue = class - type - TCalculator = reference to procedure( var Value: T ); - - class var - FDefaultMutable: IMyc3Mutable; - FDefaultMutableFuture: IMyc3Mutable>; - - class constructor CreateClass; - class function GetDefaultFuture: IMyc3Future; static; - - public - class function AsImmutable( const Value: T ): IMyc3Value; overload; static; - - class function CreateLazy(const Func: TFunc): IMyc3Value; static; - - // Create a constant future. - class function AsFuture( const Value: T ): IMyc3Future; static; - - // Create a generic future. Its fully up to the calculator to handle - // synchronization. - class function CreateFuture( const StartSignal: IMyc2Signal; const Calculator: TFunc ): IMyc3Future; - overload; static; - class function CreateFuture( const StartSignal: IMyc2Signal; const Calculator: TFunc < IMyc3Future < T >> ) - : IMyc3Future; overload; static; - - class function CreateFutureArray( Count: Integer; const Calculator: TFunc ): IMyc3Future>; overload; static; - class function CreateFutureArray( const StartSignal: IMyc2Signal; Count: Integer; const Calculator: TFunc ): - IMyc3Future>; overload; static; - - class function CreateFutures( Count: Integer; const Src: IMyc3Future < TArray < T >> ): TArray>; overload; static; - - // Create a generic immutable - class function CreateFuture( const Calculator: TFunc ): IMyc3Future; overload; static; - - class function Convert( P: IMyc3Future; const Converter: TFunc ): IMyc3Future; static; - - // Create an immutable from one other immutables. - class function CreateFuture( P: IMyc3Future; Calculator: TFunc ): IMyc3Future; overload; static; - class function CreateFuture( P: IMyc3Future; Calculator: TFunc < U, IMyc3Future < T >> ): IMyc3Future; - overload; static; - class function CreateFuture( P1: IMyc3Future; P2: IMyc3Future; Calculator: TFunc ): IMyc3Future; - overload; static; - class function CreateFuture( P1: IMyc3Future; P2: IMyc3Future; Calculator: TFunc < U, V, IMyc3Future < T >> ) - : IMyc3Future; overload; static; - class function CreateFuture( P1: IMyc3Future; P2: IMyc3Future; P3: IMyc3Future; - Calculator: TFunc ): IMyc3Future; overload; static; - - // Create an immutable array from an array of immutables. - class function CreateFuture( const Values: TArray < IMyc3Future < T >> ): IMyc3Future>; overload; static; - class function CreateFuture( const Values: TArray>; const Calculator: TFunc ): IMyc3Future>; - overload; static; - - // Calculate an immutable from a set of other immutables. This is a convenient - // function that passes the parameter Values as typed array to the calculator. - class function CreateFuture( const Params: TArray>; Calculator: TFunc, T> ): IMyc3Future; - overload; static; - - // Create a future from the value of another future. - class function CreateFuture( Future: IMyc3Future; Creator: TFunc> ): IMyc3Future; - overload; static; - - // Execute on future init. - class function Execute( Future: IMyc3Future; Proc: TConstFunc ): IMyc2State; - - // Get value, if future is initialized. - class function TryGetValue( const Future: IMyc3Future; out Value: T ): Boolean; static; - - // Create a mutable from a constant value. The resulting mutable never changes. - class function AsConst( const Value: T ): IMyc3Mutable; overload; static; deprecated 'use TMutable()'; - class function CreateMutable( const Value: T ): IMyc3Mutable; overload; static; deprecated 'use TMutable()'; - - class function CreateMutable( Calculator: TFunc ): IMyc3Mutable; overload; static; - experimental; - - class function CreateMutable( const Changed: array of IMyc2Signal; const Calculator: TFunc ): IMyc3Mutable; overload; static; deprecated 'use TMutable.FromSignals()'; - class function CreateMutable(const Changed: array of IMyc2Signal; const Calculator: TFunc>): IMyc3Mutable; overload; static; deprecated 'use TMutable.FromSignals()'; - // Extend a mutable by a set of signals. - class function CreateMutable( const Changed: array of IMyc2Signal; const Mutable: IMyc3Mutable ): IMyc3Mutable; overload; static; - class function CreateMutable( const Event: IMycEventObserver; const Calculator: TFunc ): IMyc3Mutable; overload; static; - // Futures as mutables - class function AsMutable( const Value: IMyc3Mutable> ): IMyc3Mutable; overload; static; - class function AsMutable( const Value: IMyc3Mutable> ): IMyc3Mutable; overload; static; - - class function AsMutable(const Value: IMyc3Future): IMyc3Mutable; overload; static; - class function AsMutable(const Value: IMyc3Mutable>): IMyc3Mutable; overload; static; - - // Operators - class function CreateMutable( P: IMyc3Mutable; Calculator: TFunc ): IMyc3Mutable; overload; static; - class function CreateMutable( P1: IMyc3Mutable; P2: IMyc3Mutable; Calculator: TFunc ) - : IMyc3Mutable; overload; static; - class function CreateMutable( P1: IMyc3Mutable; P2: IMyc3Mutable; P3: IMyc3Mutable; - Calculator: TFunc ): IMyc3Mutable; overload; static; - class function CreateMutable( P1: IMyc3Mutable; P2: IMyc3Mutable; P3: IMyc3Mutable; - P4: IMyc3Mutable; Calculator: TFunc ): IMyc3Mutable; overload; static; - class function CreateMutable( P1: IMyc3Mutable; P2: IMyc3Mutable; P3: IMyc3Mutable; P4: IMyc3Mutable; P5: - IMyc3Mutable; Calculator: TFunc ): IMyc3Mutable; overload; static; - class function CreateMutable( P1: IMyc3Mutable; P2: IMyc3Mutable; P3: IMyc3Mutable; P4: IMyc3Mutable; P5: - IMyc3Mutable; P6: IMyc3Mutable; Calculator: TFunc ): IMyc3Mutable; overload; static; - - // Mutable arrays - class function CreateMutable( const Arr: TArray < IMyc3Mutable < T >> ): IMyc3Mutable>; overload; static; deprecated 'Mutable.CreateArray'; - class function CreateMutable( const Arr: TArray>; Calculator: TFunc ): - IMyc3Mutable>; overload; static; - class function CreateMutableEx( Params: TArray>; Calculator: TFunc, T> ): IMyc3Mutable; overload; static; - experimental; - - {$message hint 'Debug-Code! Eigentlich ist das hier das wahre Lazy-Mutable'} - class function CreateGeneric(const Calculator: TFunc = nil): IMyc3Generic; - - // Create a mutable, that supports direct changes to it's value. - class function CreateWriteable: IMyc3Writeable; overload; static; - class function CreateWriteable( const InitValue: T ): IMyc3Writeable; overload; static; - class function CreateWriteable( const InitValue: T; const EqualityComparison: TEqualityComparison ): IMyc3Writeable; - overload; static; - - class function CreateValidate( const Calculator: TFunc ): IMyc3ValidateMutable; static; - - class function CreateMutableProperty(const InitValue: IMyc3Mutable = nil): IMyc3MutableProperty; overload; static; experimental; - - class function CreateProperty( const Creator: TFunc < IMyc3Mutable < T >> ): IMyc3MutablePropertyEx; overload; static; - experimental; - - class function CreatePropertyEx( const Decorated: IMyc3Mutable ): IMyc3Property; overload; static; - - // Combining values - class function Combine( Values: TArray; Combiner: TMyc3Combiner ): IMyc3Future; overload; static; - class function Combine(const Values: TArray>; Combiner: TMyc3Combiner): IMyc3Mutable; overload; static; - class function Combine( const Values: TArray>; Combiner: TMyc3Combiner ): IMyc3Future; - overload; static; - class function CreateSet: IMycSet; overload; static; - - class function WaitFor( Future: IMyc3Future ): T; overload; static; - class procedure WaitFor( const Futures: TArray>; Exec: TProc ); overload; static; - - class function Capture( const Src: TArray ): TArray; - experimental; - - class function CreateAnimator( const Target: IMyc3Mutable; const Interpolator: TMyc3TargetInterpolator ) - : IMyc3Animator; overload; static; - class function CreateAnimator( const Init: T; const ChangeSignal: IMyc2Signal; const Interpolator: TMyc3Interpolator ) - : IMyc3Animator; overload; static; - - class function MakeValid( const Value: IMyc3Future ): IMyc3Future; overload; static; inline; - class function MakeValid( const Value: IMyc3Mutable ): IMyc3Mutable; overload; static; inline; - - class property DefaultFuture: IMyc3Future read GetDefaultFuture; - class property DefaultMutable: IMyc3Mutable read FDefaultMutable; - class property DefaultMutableFuture: IMyc3Mutable> read FDefaultMutableFuture; - end; - - TMutableFuture = record - private - class var - FNull: IMyc3Mutable>; - class function GetNull: IMyc3Mutable>; static; - class constructor CreateClass; - - public - class function Create( const P: IMyc3Mutable>; Calc: TFunc ): IMyc3Mutable>; static; - - class property Null: IMyc3Mutable> read GetNull; - end; - - IMyc3MutableCache = interface( IMyc3Mutable ) - {$region 'property access'} - function GetCount: Integer; - {$endregion} - function Add( const Value: IMyc3Mutable ): IMyc3Mutable; - procedure Clear; - procedure Validate; - function GetEnumerator: IMycEnumerator>; - property Count: Integer read GetCount; - end; - - IMyc3MutableTable = interface - procedure Clear; - end; - - IMyc3MutableTable = interface( IMyc3MutableTable ) - function Add( const Value: T ): IMyc3Mutable; - end; - - TMutableCache = record - private - FThis: IMyc3MutableTable; - - function GetItem(const Value: T): IMyc3Mutable; - - public - constructor Create( const AThis: IMyc3MutableTable ); - procedure Clear; - property Item[const Value: T]: IMyc3Mutable read GetItem; default; - end; - - TMutable = record - private - FThis: IMyc3Mutable; - - public - class function FromSignals(const Changed: array of IMyc2Signal; const Calculator: TFunc): IMyc3Mutable; overload; static; - class function FromSignals(const Changed: array of IMyc2Signal; const Calculator: TFunc>): IMyc3Mutable; overload; static; - - class function From(const Value: IMyc3Mutable; const Conv: TFunc>): TMutable; overload; static; - - class operator Explicit(const Value: T): TMutable; - class operator Implicit(const Item: IMyc3Mutable): TMutable; - class operator Implicit(const Item: TMutable): IMyc3Mutable; - end; - - TMutableFuture = record - - // Arrays - class function FromArray(const Value: TArray>>): IMyc3Mutable>>; overload; static; - end; - - TFuture = record - class function From(const Value: IMyc3Future; const Conv: TFunc): IMyc3Future; overload; static; - class function From(const Value: IMyc3Future; const Conv: TFunc>): IMyc3Future; overload; static; - - class function FromArray(const Value: TArray>): IMyc3Future>; overload; static; - - class function Combine( const Value: TArray>; const Calculator: TFunc, T> ): IMyc3Future; overload; static; - - class function Merge(const Parts: TArray>): TArray; overload; static; - class function Merge(const Parts: TArray>>): IMyc3Future>; overload; static; - end; - - Mutable = record - // convert - class function Convert(const Value: IMyc3Mutable; const Conv: TFunc): IMyc3Mutable; overload; static; - class function Convert(const Value: IMyc3Mutable>; const Conv: TFunc): IMyc3Mutable>; overload; static; - class function Convert(const Value: IMyc3Mutable>; const Conv: TFunc>): IMyc3Mutable>; overload; static; - - // enclose - class function From(const Value: T): IMyc3Mutable; overload; static; - class function From(const Value: IMyc3Mutable; const Conv: TFunc>): IMyc3Mutable; overload; static; - class function From(const ValueR: IMyc3Mutable; const ValueS: IMyc3Mutable; const Conv: TFunc>): IMyc3Mutable; overload; static; - - // Arrays - class function FromArray(const Value: TArray>): IMyc3Mutable>; overload; static; - class function FromArray(const Value: IMyc3Mutable>; const Conv: TFunc): IMyc3Mutable>; overload; static; - class function FromArray(const Value: IMyc3Mutable>; const Conv: TFunc>): IMyc3Mutable>; overload; static; - - class function FilterArray(const Values: IMyc3Mutable>; const FilterFunc: TConstFunc>): IMyc3Mutable>; static; - class function SortArray(const Values: IMyc3Mutable>; const Comparer: IComparer): IMyc3Mutable>; static; - class function TrimArray(const Values: IMyc3Mutable>): IMyc3Mutable>; static; - - // bool - class function Create( Value: Boolean ): IMyc3Mutable; overload; static; - - class function True: IMyc3Mutable; overload; static; deprecated 'use TMutableBool'; - class function False: IMyc3Mutable; overload; static; deprecated 'use TMutableBool'; - - class function OpOR(const Arr: TArray>): IMyc3Mutable; static; deprecated 'use TMutableBool'; - class function OpAND(const Arr: TArray>): IMyc3Mutable; static; deprecated 'use TMutableBool'; - class function OpNOR(const Arr: TArray>): IMyc3Mutable; static; deprecated 'use TMutableBool'; - class function OpNAND(const Arr: TArray>): IMyc3Mutable; static; deprecated 'use TMutableBool'; - class function OpNOT(const A: IMyc3Mutable): IMyc3Mutable; static; deprecated 'use TMutableBool'; - - class function IfThen(const Condition: IMyc3Mutable; const TrueValue: IMyc3Mutable): IMyc3Mutable; overload; static; - class function IfThen(const Condition: IMyc3Mutable; const TrueValue: IMyc3Mutable>): IMyc3Mutable>; overload; static; - class function IfNotThen(const Condition: IMyc3Mutable; const FalseValue: IMyc3Mutable): IMyc3Mutable; static; - class function IfThenElse(const Condition: IMyc3Mutable; const TrueValue, FalseValue: IMyc3Mutable): IMyc3Mutable; static; - - class function CreateOverride(const Value, Ovrride: IMyc3Mutable>): IMyc3Mutable>; overload; static; - - class function FromSignal(const Signal: IMyc2Signal): IMyc3Mutable; static; - class function FromState(const State: IMyc2State): IMyc3Mutable; static; - - class function CreateValidator( const Comparer: IComparer = nil ): IMyc3MutableCache; static; - class function CreateCache( const Comparer: IComparer = nil ): TMutableCache; static; - - class function CreateEventObserver(const Mutables: TArray>): IMycEventObserver; static; - class function CreateNotifyObserver(const Mutables: TArray>): IMycNotifyObserver; static; - - class function ExtractSignals(const Mutables: TArray>): IMyc2Signal; static; - - class function CreateAssembly(const Arr: IMyc3Mutable>>): IMyc3Mutable>; overload; static; - class function CreateAssembly(const Arr: IMyc3Mutable>>>): IMyc3Mutable>>; overload; static; - - class function CreateAssembly(const Arr: IMyc3Mutable>>; const Creator: TFunc, T>): IMyc3Mutable; overload; static; - - class function CreateAssembly(const Arr: IMyc3Mutable>>>; const Creator: TFunc, T>): - IMyc3Mutable>; overload; static; - - class function CreateAssembly(const Arr: IMyc3Mutable>>; const Creator: TFunc, S>): IMyc3Mutable; - overload; static; - - class function CreateAssembly(const Arr: IMyc3Mutable>>>; const Creator: TFunc, S>): - IMyc3Mutable>; overload; static; - - class function ConvertSet(const Arr: IMyc3Mutable>>; const Converter: TFunc): IMyc3Mutable>>; overload; static; - - class function ConvertSet(const Arr: IMyc3Mutable>>>; const Converter: TFunc): IMyc3Mutable< - TArray< IMyc3Mutable>>>; overload; static; - - class function Merge(const Parts: IMyc3Mutable>>): IMyc3Mutable>; overload; static; - class function Merge(const Parts: IMyc3Mutable>>>): IMyc3Mutable>>; overload; static; - - class function CreateObjectLink(Obj: T): IMyc3ObjectLink; static; - - class function CreateNullable: IMyc3Writeable>; static; - end; - - TMutableBool = record - private - FThis: IMyc3Mutable; - class function GetDefaults(Value: Boolean): IMyc3Mutable; static; inline; - - public - constructor Create(const AThis: IMyc3Mutable); - - class operator LogicalNot(const Value: TMutableBool): TMutableBool; - class operator LogicalAnd(const A, B: TMutableBool): TMutableBool; - class operator LogicalOr(const A, B: TMutableBool): TMutableBool; - - class operator Equal(const A, B: TMutableBool): TMutableBool; - class operator NotEqual(const A, B: TMutableBool): TMutableBool; - - class operator Implicit(const Value: IMyc3Mutable): TMutableBool; inline; - class operator Implicit(const Value: TMutableBool): IMyc3Mutable; inline; - - class property Defaults[Value: Boolean]: IMyc3Mutable read GetDefaults; - - class function True: IMyc3Mutable; static; inline; - class function False: IMyc3Mutable; static; inline; - - property This: IMyc3Mutable read FThis; - end; - - Mutable = class - private - class function GetComparer: IComparer>; static; inline; - - public - class function Default: IMyc3Mutable; static; inline; - - class function IfThen( const Condition: IMyc3Mutable; const TrueValue: IMyc3Mutable ): IMyc3Mutable; static; deprecated; - class function IfNotThen( const Condition: IMyc3Mutable; const FalseValue: IMyc3Mutable ): IMyc3Mutable; static; deprecated; - class function IfThenElse( const Condition: IMyc3Mutable; const TrueValue, FalseValue: IMyc3Mutable ): IMyc3Mutable; static; deprecated; - - class function CreateArray( const Arr: TArray> ): IMyc3Mutable>; overload; static; - class function CreateArray( const Arr: IMyc3Mutable>; Calculator: TFunc ): IMyc3Mutable>; overload; static; - - class property Comparer: IComparer> read GetComparer; - end; - - TMyc2ComputeProperty = record - private - FDone: IMyc2State; - FValue: T; - - public - constructor Create( const StartSignal: IMyc2Signal; const Creator: TFunc ); - function Value: T; inline; - procedure Terminate; inline; - property Done: IMyc2State read FDone; - end; - - ///////////////////////////////////////////////////////////////////////////// - // IMyc2TaskFactory - // - IMyc2TaskFactory = interface - {$region 'property access'} - function GetThreadCount: Integer; - {$endregion} - function CreateThread( const Proc: TProc ): IMyc2State; - function InMainThread: Boolean; - function InWorkerThread: Boolean; - function Run( StartCount: Integer; Proc: TProc ): IMyc2Sink; - procedure Teardown; - procedure WaitFor( State: IMyc2State ); - property ThreadCount: Integer read GetThreadCount; - end; - - TMyc3Tasks = class( TObject ) - private - FApi: IMyc2TaskFactory; - FEnabled: Boolean; - function GetInMainThread: Boolean; - function GetThreadCount: Integer; - procedure SetEnabled( const Value: Boolean ); - - procedure Run( const StartSignal: IMyc2Signal; const Proc: TProc ); overload; - procedure Run( const Proc: TProc ); overload; - public - constructor Create( const AApi: IMyc2TaskFactory ); - destructor Destroy; override; - function CreateThread( const Proc: TProc ): IMyc2State; - procedure ExpectSignaled( State: IMyc2State; const Msg: String = 'Expected state to be already set' ); - - function LoopUntil( const DoneSignal: IMyc2Signal; const Proc: TFunc ): IMyc2State; - - function ParallelFor(const StartSignal: IMyc2Signal; LowVal, HighVal, Slice: Integer; const Proc: TProc): IMyc2State; overload; - procedure ParallelFor(LowVal, HighVal, Slice: Integer; const Proc: TProc); overload; - - function Start( const StartSignal: IMyc2Signal; const Proc: TFunc ): IMyc2State; overload; - function Start( const StartSignal: IMyc2Signal; Proc: TProc ): IMyc2State; overload; - function Start( const StartSignal: IMyc2Signal; P1: T1; Proc: TProc ): IMyc2State; overload; - function Start( const StartSignal: IMyc2Signal; P1: T1; P2: T2; Proc: TProc ): IMyc2State; overload; - function Start( const Proc: TFunc ): IMyc2State; overload; - function Start( const Proc: TProc ): IMyc2State; overload; - - function Enqueue( var Queue: IMyc2State; const Proc: TFunc ): IMyc2State; overload; - function Enqueue( var Queue: IMyc2State; const Proc: TProc ): IMyc2State; overload; - - function Capture( P: T; Proc: TProc ): TProc; overload; - function Capture( P1: T; P2: R; Proc: TProc ): TProc; overload; - function Capture( P1: T; P2: R; P3: U; Proc: TProc ): TProc; overload; - - function Capture( P: T; Proc: TFunc ): TFunc; overload; - function Capture( P: T; Proc: TFunc ): TFunc; overload; - function Capture( P: T; Proc: TFunc ): TFunc; overload; - - procedure WaitFor( const State: IMyc2State ); - - property InMainThread: Boolean read GetInMainThread; - property ThreadCount: Integer read GetThreadCount; - - property Enabled: Boolean write SetEnabled; - end; - - TTag = record - strict private - FManaged: IInterface; - FOrdinal: Int64; - {$ifdef DEBUG} - FTypeInfo: PTypeInfo; - {$endif} - - public - class function From(const Data: T): TTag; static; - function AsType: T; - end; - - // Parameters - - TParameterValue = record - strict private - FMutable: IMyc3Mutable; - {$ifdef DEBUG} - FTypeInfo: PTypeInfo; - procedure CheckType(TI: PTypeInfo); - {$endif} - - public - constructor Create( ATypeInfo: PTypeInfo; const AMutable: IMyc3Mutable ); overload; - function Get: T; - class function Create( const Intf: T ): TParameterValue; overload; static; - class function Create( const Intf: IMyc3Mutable ): TParameterValue; overload; static; - class function Compare( const A, B: TParameterValue ): Integer; static; - class function FromArray( const Values: TArray ): TArray>; overload; static; - class function FromVarRec( const VarRec: TVarRec ): TParameterValue; static; - constructor Assign( const Src: TParameterValue ); - function AsType: IMyc3Mutable; - property Mutable: IMyc3Mutable read FMutable; - end; - - TFieldID = Integer; - - TParameterField = record - private - FID: TFieldID; - FValue: TParameterValue; - - public - constructor Create( AID: TFieldID; const AValue: TParameterValue ); overload; - - class function Create( ID: TFieldID; const Intf: T ): TParameterField; overload; static; - class function Create( ID: TFieldID; const Intf: IMyc3Mutable ): TParameterField; overload; static; - - property ID: TFieldID read FID; - property Value: TParameterValue read FValue write FValue; - end; - - IMycParameterRecordDefinition = interface - {$region 'property access'} - function GetByName(const Caption: String): Integer; - function GetCount: Integer; - function GetFields( Idx: Integer ): TFieldID; - function GetIdx: Integer; - {$endregion} - function IndexOf( Field: TFieldID ): Integer; - property ByName[const Caption: String]: Integer read GetByName; - property Count: Integer read GetCount; - property Fields[Idx: Integer]: TFieldID read GetFields; - property Idx: Integer read GetIdx; - end; - - IMyc3ParameterRecord = interface - {$region 'property access'} - function GetByName(const Caption: String): TParameterValue; - function GetDef: IMycParameterRecordDefinition; - function GetValues(ID: TFieldID): TParameterValue; - {$endregion} - function GetEnumerator: TEnumerator; - property ByName[const Caption: String]: TParameterValue read GetByName; - property Def: IMycParameterRecordDefinition read GetDef; - property Values[ID: TFieldID]: TParameterValue read GetValues; default; - end; - - TParameterRecord = record - private - FThis: IMyc3ParameterRecord; - - function GetValues(ID: TFieldID): TParameterValue; inline; - function GetByName( const Caption: String ): TParameterValue; inline; - function GetDef: IMycParameterRecordDefinition; inline; - - public - constructor Create( const AThis: IMyc3ParameterRecord ); - - function AsType( ID: TFieldID ): IMyc3Mutable; inline; - function Get(ID: TFieldID): T; inline; - - class operator Implicit(const Item: IMyc3ParameterRecord): TParameterRecord; - class operator Implicit(const Item: TParameterRecord): IMyc3ParameterRecord; - - property Def: IMycParameterRecordDefinition read GetDef; - - property Values[ID: TFieldID]: TParameterValue read GetValues; default; - property ByName[const Caption: String]: TParameterValue read GetByName; - end; - - IMycParameterSpace = interface - {$region 'property access'} - function GetFieldCount: Integer; - function GetDefaultValues( FieldID: TFieldID ): TParameterValue; - function GetCaptions( FieldID: TFieldID ): String; - function GetComparer( FieldID: TFieldID ): IComparer; - function GetByName(const Caption: String): TFieldID; - {$endregion} - function AddField( TypInfo: PTypeInfo; const Caption: String; const DefaultValue: IMyc3Mutable; const Comparer: IComparer ): TFieldID; - function CompareValues( FieldID: TFieldID; const A, B: TParameterValue ): Integer; - function CreateRecord(const Fields: TArray): IMyc3ParameterRecord; - function CreateDef(const Fields: TArray): IMycParameterRecordDefinition; - property DefaultValues[FieldID: TFieldID]: TParameterValue read GetDefaultValues; - property Captions[FieldID: TFieldID]: String read GetCaptions; - property Comparer[FieldID: TFieldID]: IComparer read GetComparer; - property ByName[const Caption: String]: TFieldID read GetByName; - property FieldCount: Integer read GetFieldCount; - end; - - TParameterSpace = record - private - FThis: IMycParameterSpace; - - function GetFieldCount: Integer; inline; - function GetDefaultValues( FieldID: TFieldID ): TParameterValue; inline; - function GetCaptions( FieldID: TFieldID ): String; inline; - function GetComparer( FieldID: TFieldID ): IComparer; inline; - - public - constructor Create( const AThis: IMycParameterSpace ); overload; - - class function Create: TParameterSpace; overload; static; - - { TODO : ->Factory (mit D11 managed records) } - function AddField(const Caption: String; const DefaultValue: T; const Comparer: IComparer = nil): TFieldID; - - function CompareValues( FieldID: TFieldID; const A, B: TParameterValue ): Integer; - function CreateRecord( const Fields: TArray ): TParameterRecord; - function CreateDef(const Fields: TArray): IMycParameterRecordDefinition; - - class operator Implicit( const Item: TParameterSpace ): IMycParameterSpace; - class operator Implicit( const Item: IMycParameterSpace ): TParameterSpace; - - property FieldCount: Integer read GetFieldCount; - property DefaultValues[FieldID: TFieldID]: TParameterValue read GetDefaultValues; - property Captions[FieldID: TFieldID]: String read GetCaptions; - property Comparer[FieldID: TFieldID]: IComparer read GetComparer; - end; - -type - TStackTrace = record - const - Len = 64; - var - Msg: String; - StackTrace: array [0..Len-1] of NativeUInt; - constructor Create(ASkipFrames: Cardinal; const AMsg: String = ''); - function ToText: String; - end; - -var - Tasks: TMyc3Tasks; - -procedure RaiseInvalidParameter( const Msg: String = '' ); -procedure RaiseNullPointer; -procedure RaiseInvalidOperation( const Msg: String = '' ); overload; -procedure RaiseInvalidOperation( const Msg: String; const Args: array of const ); overload; - -procedure ForEach( Count: Integer; Exec: TProc ); overload; -procedure ForEach( Count1, Count2: Integer; Exec: TProc ); overload; -procedure ForEach( Count1, Count2, Count3: Integer; Exec: TProc ); overload; -procedure ForEach( LowIdx, HighIdx: Integer; Exec: TProc ); overload; - -implementation - -uses - System.Classes, System.SyncObjs, System.SysConst, System.Math, - Myc.Signals, Myc.Tasks, Myc.Values, Myc.Values.Sets, Myc.Values.Validate, - Myc.Values.Properties, Myc.Values.Bool, Myc.Atomic, Myc.Future.Arrays, - Myc.Values.Parameter; - -procedure RaiseInvalidParameter( const Msg: String = '' ); -var - Str: String; -begin - Str := 'Invalid parameter'; - if Msg <> '' then - Str := Str + ' (' + Msg + ')'; - - raise EMycInvalidParameter.Create( Str ); -end; - -procedure RaiseNullPointer; -begin - RaiseInvalidParameter( 'null pointer' ); -end; - -procedure RaiseInvalidOperation( const Msg: String ); overload; -begin - RaiseInvalidOperation( Msg, [] ); -end; - -procedure RaiseInvalidOperation( const Msg: String; const Args: array of const ); overload; -begin - if Msg = '' then - raise EMycInvalidOperation.Create( 'Invalid operation' ) - else - raise EMycInvalidOperation.CreateFmt( 'Invalid operation: ' + Msg, Args ) -end; - -procedure ForEach( Count: Integer; Exec: TProc ); -var - i: Integer; -begin - for i := 0 to Count - 1 do - Exec( i ); -end; - -procedure ForEach( Count1, Count2: Integer; Exec: TProc ); -var - i, j: Integer; -begin - for i := 0 to Count1 - 1 do - for j := 0 to Count2 - 1 do - Exec( i, j ); -end; - -procedure ForEach( Count1, Count2, Count3: Integer; Exec: TProc ); -var - i, j, k: Integer; -begin - for i := 0 to Count1 - 1 do - for j := 0 to Count2 - 1 do - for k := 0 to Count3 - 1 do - Exec( i, j, k ); -end; - -procedure ForEach( LowIdx, HighIdx: Integer; Exec: TProc ); overload; -var - i: Integer; -begin - for i := LowIdx to HighIdx do - Exec( i ); -end; - -{ TMyc3Tasks } - -constructor TMyc3Tasks.Create( const AApi: IMyc2TaskFactory ); -begin - inherited Create; - FApi := AApi; - FEnabled := True; -end; - -destructor TMyc3Tasks.Destroy; -begin - FApi.Teardown; - inherited; -end; - -function TMyc3Tasks.Capture( P1: T; P2: R; P3: U; Proc: TProc ): TProc; -begin - Result := - procedure - begin - Proc( P1, P2, P3 ); - end; -end; - -function TMyc3Tasks.Capture( P: T; Proc: TFunc ): TFunc; -begin - Result := - function: R - begin - Result := Proc( P ); - end; -end; - -function TMyc3Tasks.Capture( P1: T; P2: R; Proc: TProc ): TProc; -begin - Result := - procedure - begin - Proc( P1, P2 ); - end; -end; - -function TMyc3Tasks.Capture( P: T; Proc: TFunc ): TFunc; -begin - Result := - function( Q: U ): R - begin - Result := Proc( P, Q ); - end; -end; - -function TMyc3Tasks.Capture( P: T; Proc: TFunc ): TFunc; -begin - Result := - function( Q: U; R: V ): R - begin - Result := Proc( P, Q, R ); - end; -end; - -function TMyc3Tasks.Capture( P: T; Proc: TProc ): TProc; -begin - Result := - procedure - begin - Proc( P ); - end; -end; - -function TMyc3Tasks.CreateThread( const Proc: TProc ): IMyc2State; -begin - Result := FApi.CreateThread( Proc ); -end; - -{ TSet } - -class function TSet.Create: IMycSet; -begin - Result := TMycSet.Create; -end; - -class function TSet.CreateEx( const Arr: TArray ): IMycEnumArray; -begin - Result := TMycEnumArray.CreateStatic( Arr ); -end; - -class function TSet.Create( const Arr: IMyc3Mutable> ): IMycEnumArray; -begin - Result := TMycEnumArray.CreateMutable( Arr ); -end; - -{ TFuture } - -class function TFuture.From(const Value: IMyc3Future; const Conv: TFunc): IMyc3Future; -begin - Result := TMyc3Future.CreateFuture( Value.Initialized, - function: T - begin - Result := Conv( Value.Value ); - end ); -end; - -class function TFuture.Combine(const Value: TArray>; - const Calculator: TFunc, T>): IMyc3Future; -begin - Result := TValue.CreateFuture( Value, Calculator ); -end; - -class function TFuture.From(const Value: IMyc3Future; const Conv: TFunc>): IMyc3Future; -begin - Result := TMyc3Future.CreateFuture( Value.Initialized, - function: IMyc3Future - begin - Result := Conv( Value.Value ); - end ); -end; - -class function TFuture.FromArray(const Value: TArray>): IMyc3Future>; -begin - Result := TMyc3FutureArrayEx.Create( Value ); -end; - -class function TFuture.Merge(const Parts: TArray>): TArray; -var - i, j, n: Integer; -begin - n := 0; - for i := 0 to High(Parts) do - inc( n, Length(Parts[i]) ); - - SetLength( Result, n ); - n := 0; - for i := 0 to High(Parts) do - begin - for j := 0 to High(Parts[i]) do - begin - Result[n] := Parts[i,j]; - inc(n); - end; - end; -end; - -class function TFuture.Merge(const Parts: TArray>>): IMyc3Future>; -begin - if Length(Parts) = 0 then - Result := TValue>.DefaultFuture - else if Length(Parts) = 1 then - Result := Parts[0] - else - Result := TValue>.CreateFuture>>( - TValue>.CreateFuture( Parts ), - function( Parts: TArray> ): TArray - begin - Result := Merge( Parts ); - end ); -end; - -{ TMutableFuture } - -class constructor TMutableFuture.CreateClass; -begin - FNull := TValue>.CreateMutable( TValue.DefaultFuture ); -end; - -class function TMutableFuture.Create( const P: IMyc3Mutable>; Calc: TFunc ): IMyc3Mutable>; -begin - Result := TValue>.CreateMutable>( - P, - function( P: IMyc3Future ): IMyc3Future - begin - Result := TValue.CreateFuture( - P, - function( P: T ): S - begin - Result := Calc( P ); - end ); - end ); -end; - -class function TMutableFuture.GetNull: IMyc3Mutable>; -begin - Result := FNull; -end; - -{ TImmutable } - -constructor TImmutable.Create(const AValue: T); -begin - FThis := TMyc3Value.Create( AValue ); -end; - -function TImmutable.GetValue: T; -begin - if FThis<>nil then - Result := FThis.Value - else - Result := Default(T); -end; - -function TImmutable.GetHasValue: Boolean; -begin - Result := FThis<>nil; -end; - -class function TImmutable.GetNull: TImmutable; -begin - Result := Default(TImmutable); -end; - -class operator TImmutable.Equal(ALeft, ARight: TImmutable): Boolean; -begin - if ALeft.HasValue and ARight.HasValue then - Result := TEqualityComparer.Default.Equals(ALeft.Value, ARight.Value) - else - Result := ALeft.HasValue = ARight.HasValue; -end; - -class operator TImmutable.NotEqual(ALeft, ARight: TImmutable): Boolean; -begin - if ALeft.HasValue and ARight.HasValue then - Result := not TEqualityComparer.Default.Equals(ALeft.Value, ARight.Value) - else - Result := ALeft.HasValue <> ARight.HasValue; -end; - -{ TMyc3Tasks } - -function TMyc3Tasks.Enqueue( var Queue: IMyc2State; const Proc: TFunc ): IMyc2State; -var - Exec: IMyc2Condition; - [unsafe] - Q: IMyc2State; -begin - Exec := Signals.CreateCounter( 1 ); - - Result := Exec.State; - - Result._AddRef; - Pointer( Q ) := TInterlocked.Exchange( Pointer( Queue ), Pointer( Result ) ); - try - Start( Q, Proc ).Advise( Exec ); - finally - Q._Release; - end; -end; - -function TMyc3Tasks.Enqueue( var Queue: IMyc2State; const Proc: TProc ): IMyc2State; -var - Exec: IMyc2Condition; - [unsafe] - Q: IMyc2State; -begin - Exec := Signals.CreateCounter( 1 ); - - Result := Exec.State; - - Result._AddRef; - Pointer( Q ) := TInterlocked.Exchange( Pointer( Queue ), Pointer( Result ) ); - try - Start( Q, Proc ).Advise( Exec ); - finally - Q._Release; - end; -end; - -procedure TMyc3Tasks.ExpectSignaled( State: IMyc2State; const Msg: String = 'Expected state to be already set' ); -begin - System.Assert( Signals.IsStatic( State ) or State.IsSet, Msg ); -end; - -function TMyc3Tasks.GetInMainThread: Boolean; -begin - Result := FApi.InMainThread; -end; - -function TMyc3Tasks.GetThreadCount: Integer; -begin - Result := FApi.ThreadCount; -end; - -function TMyc3Tasks.LoopUntil( const DoneSignal: IMyc2Signal; const Proc: TFunc ): IMyc2State; -var - Done: IMyc2Event; - CapturedProc: TFunc; -begin - if Signals.IsStatic( DoneSignal ) then - exit( Signals.Null.State ); - - DoneSignal._AddRef; - try - Done := Signals.CreateEvent( false ); - DoneSignal.Advise( Done ); - - CapturedProc := Proc; - - Result := FApi.CreateThread( - procedure - begin - try - while not Done.State.IsSet do - WaitFor( CapturedProc ); - finally - CapturedProc := nil; - end; - end ); - finally - DoneSignal._Release; - end; -end; - -function TMyc3Tasks.ParallelFor(const StartSignal: IMyc2Signal; LowVal, HighVal, Slice: Integer; const Proc: TProc): - IMyc2State; - - function CallFunc( f, l: Integer; Proc: TProc ): IMyc2State; - begin - Result := Start( - StartSignal, - procedure - begin - Proc( f, l ); - end ); - end; - -var - l, f, n: Integer; - Counter: IMyc2Condition; -begin - if not Assigned( Proc ) or ( LowVal > HighVal ) then - exit; - - if Slice <= 0 then - Slice := max( 1, (HighVal-LowVal+1) div ThreadCount ); - - n := 0; - f := LowVal; - while f <= HighVal do - begin - inc( f, Slice ); - inc( n ); - end; - - if n=0 then - exit; - - Counter := Signals.CreateCounter( n ); - - f := LowVal; - while f <= HighVal do - begin - l := f + Slice - 1; - if l > HighVal then - l := HighVal; - - CallFunc( f, l, Proc ).Advise( Counter ); - - f := l + 1; - end; - - Result := Counter.State; -end; - -procedure TMyc3Tasks.ParallelFor(LowVal, HighVal, Slice: Integer; const Proc: TProc); -begin - if Slice <= 0 then - Slice := max( 1, (HighVal-LowVal+1) div ThreadCount ); - - if HighVal - LowVal >= Slice then - WaitFor( ParallelFor( nil, LowVal, HighVal, Slice, Proc ) ) - else - Proc( LowVal, HighVal ); -end; - -procedure TMyc3Tasks.Run( const StartSignal: IMyc2Signal; const Proc: TProc ); -begin - if not Signals.IsStatic( StartSignal ) then - begin - if FEnabled then - StartSignal.Advise( FApi.Run( 1, Proc ) ) - else - StartSignal.Advise( Signals.CreateSink( True, Proc ) ); - end - else - Run( Proc ); -end; - -procedure TMyc3Tasks.Run( const Proc: TProc ); -begin - if FEnabled then - FApi.Run( 0, Proc ) - else - Proc( ); -end; - -procedure TMyc3Tasks.SetEnabled( const Value: Boolean ); -begin - {$ifndef DisableThreading} - FEnabled := Value; - {$endif} -end; - -function TMyc3Tasks.Start( const StartSignal: IMyc2Signal; const Proc: TFunc ): IMyc2State; -var - Done: IMyc2Condition; - CapturedProc: TFunc; -begin - if not Assigned( Proc ) then - exit( Signals.Null.State ); - - Done := Signals.CreateCounter( 1 ); - - CapturedProc := Proc; - - Run( StartSignal, - procedure - var - Sig: IMyc2Signal; - begin - try - Sig := CapturedProc( ); - finally - CapturedProc := nil; - - if not Signals.IsStatic( Sig ) then - Sig.Advise( Done ) - else - Done.Notify; - end; - end ); - - exit( Done.State ); -end; - -function TMyc3Tasks.Start( const StartSignal: IMyc2Signal; Proc: TProc ): IMyc2State; -var - Done: IMyc2Condition; -begin - Assert( Assigned( Proc ) ); - Done := Signals.CreateCounter( 1 ); - - Run( StartSignal, - procedure - begin - try - Proc; - finally - Done.Notify; - end; - end ); - - exit( Done.State ); -end; - -function TMyc3Tasks.Start( const Proc: TFunc ): IMyc2State; -begin - Result := Start( nil, Proc ); -end; - -function TMyc3Tasks.Start( const Proc: TProc ): IMyc2State; -begin - Result := Start( nil, Proc ); -end; - -function TMyc3Tasks.Start( const StartSignal: IMyc2Signal; P1: T1; P2: T2; Proc: TProc ): IMyc2State; -begin - Result := Start( StartSignal, - procedure - begin - Proc( P1, P2 ); - end ); -end; - -function TMyc3Tasks.Start( const StartSignal: IMyc2Signal; P1: T1; Proc: TProc ): IMyc2State; -begin - Result := Start( StartSignal, - procedure - begin - Proc( P1 ); - end ); -end; - -procedure TMyc3Tasks.WaitFor( const State: IMyc2State ); -begin - FApi.WaitFor( State ); -end; - -{ TValue } - -class constructor TValue.CreateClass; -begin - FDefaultMutable := TMyc3ConstantMutable.Create( Default(T) ); - FDefaultMutableFuture := TMyc3ConstantMutable>.Create( TMyc3ConstantFuture.Create( Default(T) ) ); -end; - -class function TValue.Capture( const Src: TArray ): TArray; -var - i: Integer; -begin - SetLength( Result, Length( Src ) ); - for i := 0 to High( Src ) do - Result[i] := Src[i]; -end; - -class function TValue.CreateFuture( Future: IMyc3Future; Creator: TFunc < T, IMyc3Future < T >> ): IMyc3Future; -begin - Result := TMyc3Future.CreateFuture( Future.Initialized, - function: IMyc3Future - begin - Result := Creator( Future.Value ); - end ); -end; - -class function TValue.CreateFuture( const StartSignal: IMyc2Signal; const Calculator: TFunc < IMyc3Future < T >> ) -: IMyc3Future; -begin - Result := TMyc3Future.CreateFuture( StartSignal, - function: IMyc3Future - begin - Result := Calculator( ); - end ); -end; - -class function TValue.Combine( const Values: TArray>; Combiner: TMyc3Combiner ): IMyc3Future; -begin - if Values=nil then - exit( DefaultFuture ); - - Result := CreateFuture( Values, - function( Arr: TArray ): T - begin - Result := Combiner( Arr ); - end ); -end; - -class function TValue.Combine( Values: TArray; Combiner: TMyc3Combiner ): IMyc3Future; -begin - if Values=nil then - exit( DefaultFuture ); - - Result := TValue.CreateFuture( - function: T - begin - Result := Combiner( Values ); - end ); -end; - -class function TValue.Combine(const Values: TArray>; Combiner: TMyc3Combiner): IMyc3Mutable; -var - Chg: TArray; - i: Integer; -begin - Result := Mutable.Convert, T>( - TValue.CreateMutable(Values), - function( Values: TArray ): T - begin - if not Assigned( Combiner ) then - exit( Default( T ) ); - Result := Combiner( Values ); - end ); -end; - -class function TValue.CreateAnimator( const Target: IMyc3Mutable; const Interpolator: TMyc3TargetInterpolator ) -: IMyc3Animator; -begin - Result := CreateAnimator( Target.Value, Target.Changed, - function( Delta: Double; const StartValue: T; out Value: T ): Boolean - begin - Result := Interpolator( Delta, StartValue, Target.Value, Value ); - if not Result then - Value := Target.Value; - end ); -end; - -class function TValue.CreateAnimator( const Init: T; const ChangeSignal: IMyc2Signal; -const Interpolator: TMyc3Interpolator ): IMyc3Animator; -begin - Result := TMyc3Animator.Create( Init, ChangeSignal, Interpolator ); -end; - -class function TValue.AsFuture( const Value: T ): IMyc3Future; -begin - Result := TMyc3ConstantFuture.Create( Value ); -end; - -class function TValue.CreateFuture( const StartSignal: IMyc2Signal; const Calculator: TFunc ): IMyc3Future; -begin - Result := TMyc3Future.CreateFuture( StartSignal, Calculator ); -end; - -class function TValue.CreateFuture( const Calculator: TFunc ): IMyc3Future; -begin - Result := TMyc3Future.CreateFuture( Calculator ); -end; - -class function TValue.CreateFuture( const Params: TArray>; Calculator: TFunc, T> ): IMyc3Future; -var - Counter: IMyc2Condition; - i: Integer; - Arr: TArray>; -begin - Counter := Signals.CreateCounter( Length( Params ) ); - SetLength( Arr, Length( Params ) ); - - for i := 0 to High( Params ) do - begin - if Params[i]<>nil then - begin - Arr[i] := Params[i]; - Arr[i].Initialized.Advise( Counter ); - end - else - Counter.Notify; - end; - - Result := TMyc3Future.CreateFuture( Counter.State, - function: T - var - Values: TArray; - i: Integer; - begin - SetLength( Values, Length( Arr ) ); - for i := 0 to High( Values ) do - if Arr[i]<>nil then - Values[i] := Arr[i].Value; - - Result := Calculator( Values ); - end ); -end; - -class function TValue.CreateFuture( P1: IMyc3Future; P2: IMyc3Future; Calculator: TFunc ): IMyc3Future; -var - Counter: IMyc2Condition; -begin - Assert( Assigned( P1 ) and Assigned( P2 ) ); - Counter := Signals.CreateCounter( 2 ); - - P1.Initialized.Advise( Counter ); - P2.Initialized.Advise( Counter ); - - Result := CreateFuture( Counter.State, - function: T - begin - Result := Calculator( P1.Value, P2.Value ); - end ); -end; - -class function TValue.CreateFuture( P1: IMyc3Future; P2: IMyc3Future; Calculator: TFunc < U, V, IMyc3Future < T >> - ): IMyc3Future; -var - Counter: IMyc2Condition; -begin - Assert( Assigned( P1 ) and Assigned( P2 ) ); - Counter := Signals.CreateCounter( 2 ); - - P1.Initialized.Advise( Counter ); - P2.Initialized.Advise( Counter ); - - Result := CreateFuture( Counter.State, - function: IMyc3Future - begin - Result := Calculator( P1.Value, P2.Value ); - end ); -end; - -class function TValue.CreateFuture( P: IMyc3Future; Calculator: TFunc ): IMyc3Future; -begin - Assert( Assigned( P ) ); - Result := CreateFuture( P.Initialized, - function: T - begin - Result := Calculator( P.Value ); - end ); -end; - -class function TValue.CreateFuture( P: IMyc3Future; Calculator: TFunc < U, IMyc3Future < T >> ): IMyc3Future; -begin - Assert( Assigned( P ) ); - Result := CreateFuture( P.Initialized, - function: IMyc3Future - begin - Result := Calculator( P.Value ); - end ); -end; - -class function TValue.AsImmutable( const Value: T ): IMyc3Value; -begin - Result := TMyc3Value.Create( Value ); -end; - -class function TValue.CreateLazy(const Func: TFunc): IMyc3Value; -begin - Result := TMyc3Lazy.Create( Func ); -end; - -class function TValue.CreateFuture( const Values: TArray < IMyc3Future < T >> ): IMyc3Future>; -begin - Result := TMyc3FutureArrayEx.Create( Values ); -end; - -class function TValue.CreateFuture( const Values: TArray>; const Calculator: TFunc ): - IMyc3Future>; -begin - Result := TMyc3FutureArrayConvert.Create( Values, Calculator ); -end; - -class function TValue.CreateFuture( P1: IMyc3Future; P2: IMyc3Future; P3: IMyc3Future; -Calculator: TFunc ): IMyc3Future; -var - Counter: IMyc2Condition; -begin - Assert( Assigned( P1 ) and Assigned( P2 ) and Assigned( P3 ) ); - Counter := Signals.CreateCounter( 3 ); - - P1.Initialized.Advise( Counter ); - P2.Initialized.Advise( Counter ); - P3.Initialized.Advise( Counter ); - - Result := CreateFuture( Counter.State, - function: T - begin - Result := Calculator( P1.Value, P2.Value, P3.Value ); - end ); -end; - -class function TValue.CreateFutures( Count: Integer; const Src: IMyc3Future < TArray < T >> ): TArray>; -begin - Result := TMyc3FutureArray.CreateFutures( Count, Src ); -end; - -class function TValue.CreateMutable( const Value: T ): IMyc3Mutable; -begin - Result := AsConst( Value ); -end; - -class function TValue.CreateMutable( const Changed: array of IMyc2Signal; const Calculator: TFunc ): IMyc3Mutable; -begin - Result := TMyc3Mutable.CreateMutable( Changed, Calculator ); -end; - -class function TValue.AsMutable( const Value: IMyc3Mutable> ): IMyc3Mutable; -begin - Result := TMyc3EnclosedMutable.Create( Value ); -end; - -class function TValue.AsMutable( const Value: IMyc3Mutable> ): IMyc3Mutable; -begin - Result := TValue.CreateMutable>( - Value, - function( Immutable: IMyc3Value ): T - begin - if Immutable<>nil then - Result := Immutable.Value - else - Result := default ( T ); - end ); -end; - -class function TValue.AsConst( const Value: T ): IMyc3Mutable; -begin - Result := TMyc3ConstantMutable.Create( Value ); -end; - -class function TValue.AsMutable(const Value: IMyc3Future): IMyc3Mutable; -begin - Result := TMyc3FutureAsMutable.CreateFutureAsMutable( Value ) -end; - -class function TValue.AsMutable(const Value: IMyc3Mutable>): IMyc3Mutable; -begin - Result := TMyc3EnclosedMutable.Create( - TMyc3Mutable>.CreateMutable( - Value.Changed, - function: IMyc3Mutable - begin - Result := AsMutable( Value.Value ); - end ) ); -end; - -class function TValue.Convert( P: IMyc3Future; const Converter: TFunc ): IMyc3Future; -begin - if P.Initialized.IsSet then - Result := AsFuture( Converter( P.Value ) ) - else - Result := CreateFuture( P, Converter ); -end; - -class function TValue.CreateGeneric(const Calculator: TFunc): IMyc3Generic; -begin - Result := TMyc3Changeable.CreateGeneric( Calculator ); -end; - -class function TValue.CreateFutureArray( const StartSignal: IMyc2Signal; Count: Integer; const Calculator: TFunc ): - IMyc3Future>; -var - Init: IMyc2State; - Arr: TArray; - Calc: TFunc; -begin - SetLength( Arr, Count ); - - Calc := Calculator; - Init := Tasks.ParallelFor( - StartSignal, - 0, Count-1, 1, - procedure( A, B: Integer ) - var - i: Integer; - begin - for i := A to B do - Calc( i ) - end ); - - Result := TMyc3Future>.CreateFuture( Init, Arr ); -end; - -class function TValue.CreateFutureArray( Count: Integer; const Calculator: TFunc ): IMyc3Future>; -begin - Result := CreateFutureArray( Signals.Null.State, Count, Calculator ); -end; - -class function TValue.CreateValidate( const Calculator: TFunc ): IMyc3ValidateMutable; -begin - Result := TMyc3ValidateMutable.Create( Calculator ); -end; - -class function TValue.CreateMutable( const Arr: TArray < IMyc3Mutable < T >> ): IMyc3Mutable>; -begin - Result := TMyc3Mutable.CreateArray( Arr ); -end; - -class function TValue.CreateMutable( Calculator: TFunc ): IMyc3Mutable; -begin - Result := CreateMutable( [], Calculator ); -end; - -class function TValue.CreateMutable( const Event: IMycEventObserver; const Calculator: TFunc ): IMyc3Mutable; -begin - Result := TMyc3Mutable.CreateMutable( Event, Calculator ); -end; - -class function TValue.CreateMutable( const Changed: array of IMyc2Signal; const Mutable: IMyc3Mutable ): IMyc3Mutable; -var - Notifier: IMyc2Notifier; - i: Integer; -begin - Notifier := Signals.CreateNotifier; - Mutable.Changed.Advise( Notifier ); - for i := 0 to High( Changed ) do - Changed[i].Advise( Notifier ); - - Result := TMyc3Mutable.CreateMutable( - Notifier.Signal, - function: T - begin - Result := Mutable.Value; - end ); -end; - -class function TValue.CreateMutable(const Changed: array of IMyc2Signal; const Calculator: TFunc>): IMyc3Mutable; -begin - Result := TMyc3EnclosedMutable.Create( TMyc3Mutable>.CreateMutable( Changed, Calculator ) ); -end; - -class function TValue.CreateMutable( P1: IMyc3Mutable; P2: IMyc3Mutable; P3: IMyc3Mutable; -Calculator: TFunc ): IMyc3Mutable; -begin - Assert( Assigned( P1 ) and Assigned( P2 ) and Assigned( P3 ) ); - - if not Signals.IsStatic(P1.Changed) or not Signals.IsStatic(P2.Changed) or not Signals.IsStatic(P3.Changed) then - begin - Result := TMyc3Mutable.CreateMutable( - [P1.Changed, P2.Changed, P3.Changed], - function: T - begin - Result := Calculator( P1.Value, P2.Value, P3.Value ); - end ); - end - else - Result := TMyc3ConstantMutable.Create( Calculator( P1.Value, P2.Value, P3.Value ) ); -end; - -class function TValue.CreateMutable( P1: IMyc3Mutable; P2: IMyc3Mutable; P3: IMyc3Mutable; -P4: IMyc3Mutable; Calculator: TFunc ): IMyc3Mutable; -begin - Assert( Assigned( P1 ) and Assigned( P2 ) and Assigned( P3 ) and Assigned( P4 ) ); - - if not Signals.IsStatic(P1.Changed) or not Signals.IsStatic(P2.Changed) or not Signals.IsStatic(P3.Changed) or not Signals.IsStatic(P4.Changed) then - begin - Result := TMyc3Mutable.CreateMutable( - [P1.Changed, P2.Changed, P3.Changed, P4.Changed], - function: T - begin - Result := Calculator( P1.Value, P2.Value, P3.Value, P4.Value ); - end ); - end - else - Result := TMyc3ConstantMutable.Create( Calculator( P1.Value, P2.Value, P3.Value, P4.Value ) ); -end; - -class function TValue.CreateMutableEx( Params: TArray>; Calculator: TFunc, T> ): IMyc3Mutable; -var - i: Integer; - Sigs: TArray; -begin - case Length( Params ) of - 0: - Result := CreateMutable( - function: T - begin - Result := Calculator( [] ); - end ); - 1: - Result := CreateMutable( Params[0], - function( P: S ): T - begin - Result := Calculator( [P] ); - end ); - 2: - Result := CreateMutable( Params[0], Params[1], - function( P1, P2: S ): T - begin - Result := Calculator( [P1, P2] ); - end ); - 3: - Result := CreateMutable( Params[0], Params[1], Params[2], - function( P1, P2, P3: S ): T - begin - Result := Calculator( [P1, P2, P3] ); - end ); - 4: - Result := CreateMutable( Params[0], Params[1], Params[2], Params[3], - function( P1, P2, P3, P4: S ): T - begin - Result := Calculator( [P1, P2, P3, P4] ); - end ); - else - begin - SetLength( Sigs, Length( Params ) ); - - for i := 0 to High( Sigs ) do - begin - Assert( Assigned( Params[i] ) ); - Sigs[i] := Params[i].Changed; - end; - - Result := TMyc3Mutable.CreateMutable( - Sigs, - function: T - var - Values: TArray; - Init: IMyc2Signal; - i: Integer; - begin - SetLength( Values, Length( Params ) ); - for i := 0 to High( Values ) do - Values[i] := Params[i].Value; - - Result := Calculator( Values ); - end ); - end; - end; -end; - -class function TValue.CreateMutable( const Arr: TArray>; Calculator: TFunc ): - IMyc3Mutable>; -begin - Result := TMyc3MutableArray.Create( Arr, Calculator ); -end; - -class function TValue.CreateMutable( P1: IMyc3Mutable; P2: IMyc3Mutable; P3: IMyc3Mutable; P4: - IMyc3Mutable; P5: IMyc3Mutable; P6: IMyc3Mutable; Calculator: TFunc ): IMyc3Mutable; -begin - Assert( Assigned( P1 ) and Assigned( P2 ) and Assigned( P3 ) and Assigned( P4 ) and Assigned( P5 ) and Assigned( P6 ) ); - - if not Signals.IsStatic(P1.Changed) or not Signals.IsStatic(P2.Changed) or not Signals.IsStatic(P3.Changed) - or not Signals.IsStatic(P4.Changed) or not Signals.IsStatic(P5.Changed) or not Signals.IsStatic(P6.Changed) then - begin - Result := TMyc3Mutable.CreateMutable( - [P1.Changed, P2.Changed, P3.Changed, P4.Changed, P5.Changed, P6.Changed], - function: T - begin - Result := Calculator( P1.Value, P2.Value, P3.Value, P4.Value, P5.Value, P6.Value ); - end ); - end - else - Result := TMyc3ConstantMutable.Create( Calculator( P1.Value, P2.Value, P3.Value, P4.Value, P5.Value, P6.Value ) ); -end; - -class function TValue.CreateMutable( P1: IMyc3Mutable; P2: IMyc3Mutable; P3: IMyc3Mutable; P4: IMyc3Mutable; -P5: IMyc3Mutable; Calculator: TFunc ): IMyc3Mutable; -begin - Assert( Assigned( P1 ) and Assigned( P2 ) and Assigned( P3 ) and Assigned( P4 ) and Assigned( P5 ) ); - - if not Signals.IsStatic(P1.Changed) or not Signals.IsStatic(P2.Changed) or not Signals.IsStatic(P3.Changed) - or not Signals.IsStatic(P4.Changed) or not Signals.IsStatic(P5.Changed) then - begin - Result := TMyc3Mutable.CreateMutable( - [P1.Changed, P2.Changed, P3.Changed, P4.Changed, P5.Changed], - function: T - begin - Result := Calculator( P1.Value, P2.Value, P3.Value, P4.Value, P5.Value ); - end ); - end - else - Result := TMyc3ConstantMutable.Create( Calculator( P1.Value, P2.Value, P3.Value, P4.Value, P5.Value ) ); -end; - -class function TValue.CreateMutable( P1: IMyc3Mutable; P2: IMyc3Mutable; Calculator: TFunc ) -: IMyc3Mutable; -begin - Assert( Assigned( P1 ) and Assigned( P1 ) ); - - if not Signals.IsStatic(P1.Changed) or not Signals.IsStatic(P2.Changed) then - begin - Result := TMyc3Mutable.CreateMutable( - [P1.Changed, P2.Changed], - function: T - begin - Result := Calculator( P1.Value, P2.Value ); - end ); - end - else - Result := TMyc3ConstantMutable.Create( Calculator( P1.Value, P2.Value ) ); -end; - -class function TValue.CreateMutable( P: IMyc3Mutable; Calculator: TFunc ): IMyc3Mutable; -begin - Assert( Assigned( P ) ); - - if not Signals.IsStatic(P.Changed) then - begin - Result := TMyc3Mutable.CreateMutable( - P.Changed, - function: T - begin - Result := Calculator( P.Value ); - end ); - end - else - Result := TMyc3ConstantMutable.Create( Calculator( P.Value ) ); -end; - -class function TValue.CreateWriteable( const InitValue: T ): IMyc3Writeable; -begin - Result := TMyc3Writeable.CreateWriteable( InitValue ); -end; - -class function TValue.CreatePropertyEx( const Decorated: IMyc3Mutable ): IMyc3Property; -begin - Result := TMycProperty.CreateProperty( Decorated ); -end; - -class function TValue.CreateProperty( const Creator: TFunc < IMyc3Mutable < T >> ): IMyc3MutablePropertyEx; -begin - Result := TMyc3MutablePropertyEx.Create( Creator ); -end; - -class function TValue.CreateMutableProperty(const InitValue: IMyc3Mutable): IMyc3MutableProperty; -begin - Result := TMyc3MutableProperty.Create( InitValue ); -end; - -class function TValue.CreateSet: IMycSet; -begin - Result := TMycSet.Create; -end; - -class function TValue.CreateWriteable( const InitValue: T; const EqualityComparison: TEqualityComparison ) -: IMyc3Writeable; -begin - Result := TMyc3Writeable.CreateWriteable( InitValue, EqualityComparison ); -end; - -class function TValue.CreateWriteable: IMyc3Writeable; -begin - Result := CreateWriteable( Default(T) ); -end; - -class function TValue.Execute( Future: IMyc3Future; Proc: TConstFunc ): IMyc2State; -begin - Result := Tasks.Start( Future.Initialized, - function: IMyc2Signal - begin - Result := Proc( Future.Value ); - end ); -end; - -class function TValue.GetDefaultFuture: IMyc3Future; -begin - Result := TMyc3Future.DefaultFuture; -end; - -class function TValue.MakeValid( const Value: IMyc3Future ): IMyc3Future; -begin - Result := Value; - if Result = nil then - Result := DefaultFuture; -end; - -class function TValue.MakeValid( const Value: IMyc3Mutable ): IMyc3Mutable; -begin - Result := Value; - if Result = nil then - Result := DefaultMutable; -end; - -class function TValue.TryGetValue( const Future: IMyc3Future; out Value: T ): Boolean; -begin - Result := Future <> nil; - if Result then - begin - Result := Future.Initialized = Signals.Null.State; - if Result then - begin - Result := Future.Initialized.IsSet; - if Result then - Value := Future.Value; - end; - end; -end; - -class function TValue.WaitFor( Future: IMyc3Future ): T; -begin - Tasks.WaitFor( Future.Initialized ); - exit( Future.Value ); -end; - -class procedure TValue.WaitFor( const Futures: TArray>; Exec: TProc ); -var - i: Integer; - Arr: TArray>; -begin - SetLength( Arr, Length( Futures ) ); - for i := 0 to High( Futures ) do - if Futures[i].Initialized.IsSet then - Exec( i, Futures[i].Value ) - else - Arr[i] := Futures[i]; - - for i := 0 to High( Arr ) do - if Arr[i] <> nil then - Exec( i, WaitFor( Futures[i] ) ); -end; - -{ TMyc2ComputeProperty } - -constructor TMyc2ComputeProperty.Create( const StartSignal: IMyc2Signal; const Creator: TFunc ); -var - P: ^T; -begin - FValue := default ( T ); - P := @FValue; - FDone := Tasks.Start( StartSignal, - procedure - begin - P^ := Creator( ); - end ); -end; - -procedure TMyc2ComputeProperty.Terminate; -begin - if FDone <> Signals.Null.State then - begin - Tasks.WaitFor( FDone ); - FDone := Signals.Null.State; - end; -end; - -function TMyc2ComputeProperty.Value: T; -begin - Terminate; - Result := FValue; -end; - -{ Signals } - -class function Signals.CreateCounter( Count: Integer ): IMyc2Condition; -begin - Result := TMyc2Signal.CreateCounter( Count ) -end; - -class function Signals.CreateEvent( Init: Boolean = false ): IMyc2Event; -begin - Result := TMyc2Signal.CreateEvent( Init ); -end; - -class function Signals.CreateNotifier: IMyc2Notifier; -begin - Result := TMyc2Signal.CreateNotifier; -end; - -class function Signals.CreateSink(Once: Boolean; const Proc: TProc): IMyc2Sink; -begin - Result := TMyc2SinkProc.CreateSink( Once, Proc ); -end; - -class function Signals.Concat( const States: array of IMyc2State ): IMyc2State; -begin - Result := TMyc2Signal.CreateConcat( States ); -end; - -class function Signals.CreateObserver( const Signals: array of IMyc2Signal; const Sink: T ): IMycObserver; -begin - Result := TMycObserver.CreateObserver( Signals, Sink ); -end; - -class function Signals.CreateEventObserver( const Signals: array of IMyc2Signal ): IMycEventObserver; -begin - Result := CreateObserver( Signals, CreateEvent( True ) ); -end; - -class function Signals.CreateNotifyObserver( const Signals: array of IMyc2Signal ): IMycNotifyObserver; -begin - Result := CreateObserver( Signals, CreateNotifier ); -end; - -class function Signals.CreateNotifyObserver( const Signals: IMycCountable ): IMycNotifyObserver; -var - Arr: TArray; - i: Integer; -begin - SetLength( Arr, Signals.Count ); - for i := 0 to High( Arr ) do - Arr[i] := Signals[i]; - - Result := CreateNotifyObserver( Arr ); -end; - -class function Signals.CreateEventObserver( const Signals: IMycCountable ): IMycEventObserver; -var - Arr: TArray; - i: Integer; -begin - SetLength( Arr, Signals.Count ); - for i := 0 to High( Arr ) do - Arr[i] := Signals[i]; - - Result := CreateEventObserver( Arr ); -end; - -class function Signals.CreateFlag(Init: Boolean): IMyc2Flag; -begin - Result := TMyc2Flag.Create( Init ); -end; - -class function Signals.CreateSink(const Proc: TProc): IMyc2Sink; -begin - Result := TMyc2SinkProc.CreateSink( false, Proc ); -end; - -class function Signals.GetNull: IMyc2Condition; -begin - exit( TMyc2Signal.Null ); -end; - -class function Signals.IsStatic( const Signal: IMyc2Signal ): Boolean; -begin - Result := ( Signal = nil ) or ( Signal = Null.State ); -end; - -class function Signals.MakeValid( const Signal: IMyc2Signal ): IMyc2Signal; -begin - if IsStatic( Signal ) then - exit( Null.State ) - else - exit( Signal ); -end; - -class function Signals.MakeValid( const Signals: array of IMyc2Signal ): TArray; -begin - Result := TMyc2Signal.MakeValid( Signals ); -end; - -class function Signals.Union( const Sigs: array of IMyc2Signal ): IMyc2Signal; -begin - Result := TMyc2Signal.CreateUnion( Sigs ); -end; - -{ TState } - -class function TAtomicStack.Create: IAtomicStack; -begin - Result := TMycAtomicStack.Create; -end; - -{ TProtected } - -constructor TProtected.Create( const AItem: T ); -begin - FItem := AItem; -end; - -function TProtected.Exchange( const Value: T ): T; -begin - if Value <> nil then - Value._AddRef; - - PPointer( @Result )^ := TInterlocked.Exchange( PPointer( @FItem )^, PPointer( @Value )^ ); -end; - -class operator TProtected.Implicit( const Value: T ): TProtected; -begin - Result.Create( Value ); -end; - -{ Mutable } - -class function Mutable.ConvertSet(const Arr: IMyc3Mutable>>; const Converter: TFunc): IMyc3Mutable< - TArray< IMyc3Mutable>>; -begin - Result := TValue>>.CreateMutable>>( - Arr, - function( Arr: TArray> ): TArray> - var - i: Integer; - begin - SetLength( Result, Length(Arr) ); - for i := 0 to High(Result) do - begin - Assert( Arr[i] <> nil ); - Result[i] := TValue.CreateMutable( Arr[i], Converter ); - end; - end ); -end; - -class function Mutable.ConvertSet(const Arr: IMyc3Mutable>>>; const Converter: TFunc): - IMyc3Mutable>>>; -begin - Result := ConvertSet, IMyc3Future>( - Arr, - function( Item: IMyc3Future ): IMyc3Future - begin - Assert( Item <> nil ); - Result := TValue.CreateFuture( Item, Converter ); - end ); -end; - -class function Mutable.Create( Value: Boolean ): IMyc3Mutable; -begin - Result := TMycMutableBoolean.CreateBoolean( Value ); -end; - -class function Mutable.CreateAssembly(const Arr: IMyc3Mutable>>): IMyc3Mutable>; -begin - Result := - Mutable.From>, TArray>( - Arr, - function( Arr: TArray> ): IMyc3Mutable> - begin - Result := TValue.CreateMutable( Arr ); - end ); -end; - -class function Mutable.CreateAssembly(const Arr: IMyc3Mutable>>>): IMyc3Mutable>>; -begin - Result := - Mutable.From>>, IMyc3Future>>( - Arr, - function( Arr: TArray>> ): IMyc3Mutable>> - begin - Result := TMutableFuture.FromArray( Arr ); - end ); -end; - -class function Mutable.CreateAssembly(const Arr: IMyc3Mutable>>; const Creator: TFunc, T>): IMyc3Mutable; -begin - Result := TValue.AsMutable( - TValue>.CreateMutable>>( - Arr, - function( Arr: TArray> ): IMyc3Mutable - begin - Result := TValue.CreateMutable>( TValue.CreateMutable( Arr ), Creator ) ; - end ) ); -end; - -class function Mutable.CreateAssembly( - const Arr: IMyc3Mutable>>>; - const Creator: TFunc, S>): IMyc3Mutable>; -begin - Result := CreateAssembly, IMyc3Future>( Arr, - function( Arr: TArray> ): IMyc3Future - begin - Result := TValue.CreateFuture>( TValue.CreateFuture( Arr ), Creator ); - end ); -end; - -class function Mutable.CreateAssembly(const Arr: IMyc3Mutable>>; const Creator: TFunc, S>): - IMyc3Mutable; -begin - Result := TValue.AsMutable( - TValue>.CreateMutable>>( - Arr, - function( Arr: TArray> ): IMyc3Mutable - begin - Result := TValue.CreateMutable>( TValue.CreateMutable( Arr ), Creator ) ; - end ) ); -end; - -class function Mutable.CreateAssembly(const Arr: IMyc3Mutable>>>; const Creator: TFunc, T>) - : IMyc3Mutable>; -begin - Result := CreateAssembly>( Arr, - function( Arr: TArray> ): IMyc3Future - begin - Result := TValue.CreateFuture>( TValue.CreateFuture( Arr ), Creator ); - end ); -end; - -class function Mutable.FromSignal(const Signal: IMyc2Signal): IMyc3Mutable; -begin - Result := TMycMutableSignal.Create( Signal ); -end; - -class function Mutable.CreateOverride(const Value, Ovrride: IMyc3Mutable>): IMyc3Mutable>; -begin - Result := TValue>.CreateMutable, TImmutable>( - Value, Ovrride, - function( Value, Ovrride: TImmutable ): TImmutable - begin - if not Ovrride.HasValue then - Result := Value - else - Result := Ovrride; - end ); -end; - -class function Mutable.CreateCache( const Comparer: IComparer = nil ): TMutableCache; -begin - Result.Create( TMycMutableTable.Create( Comparer ) ); -end; - -class function Mutable.CreateNotifyObserver(const Mutables: TArray>): IMycNotifyObserver; -var - Sigs: TArray; - i: Integer; -begin - SetLength( Sigs, Length(Mutables) ); - for i := 0 to High(Sigs) do - Sigs[i] := Mutables[i].Changed; - Result := Signals.CreateNotifyObserver(Sigs); -end; - -class function Mutable.CreateEventObserver(const Mutables: TArray>): IMycEventObserver; -var - Sigs: TArray; - i: Integer; -begin - SetLength( Sigs, Length(Mutables) ); - for i := 0 to High(Sigs) do - Sigs[i] := Mutables[i].Changed; - Result := Signals.CreateEventObserver(Sigs); -end; - -class function Mutable.CreateValidator( const Comparer: IComparer = nil ): IMyc3MutableCache; -begin - Result := TMycMutableCache.CreateCache( Comparer ); -end; - -class function Mutable.ExtractSignals(const Mutables: TArray>): IMyc2Signal; -var - i: Integer; - Arr: TArray; -begin - SetLength( Arr, Length(Mutables) ); - for i := 0 to High(Arr) do - Arr[i] := Mutables[i].Changed; - Result := Signals.Union( Arr ); -end; - -class function Mutable.False: IMyc3Mutable; -begin - Result := TMycMutableBoolean.CreateBoolean( System.False ); -end; - -class function Mutable.From(const Value: IMyc3Mutable; const Conv: TFunc>): IMyc3Mutable; -begin - Result := TMyc3EnclosedMutable.Create( - TValue>.CreateMutable( Value, Conv ) ); -end; - -class function Mutable.Convert(const Value: IMyc3Mutable; const Conv: TFunc): IMyc3Mutable; -begin - Result := TValue.CreateMutable( Value, Conv ); -end; - -class function Mutable.Convert(const Value: IMyc3Mutable>; const Conv: TFunc): IMyc3Mutable>; -begin - Result := Convert, IMyc3Future>( - Value, - function( Value: IMyc3Future ): IMyc3Future - begin - Result := TFuture.From( Value, Conv ) - end ); -end; - -class function Mutable.Convert(const Value: IMyc3Mutable>; const Conv: TFunc>): IMyc3Mutable>; -begin - Result := Convert, IMyc3Future>( - Value, - function( Value: IMyc3Future ): IMyc3Future - begin - Result := TFuture.From( Value, Conv ) - end ); -end; - -class function Mutable.CreateNullable: IMyc3Writeable>; -begin - Result := TValue>.CreateWriteable( TImmutable.Null ); -end; - -class function Mutable.CreateObjectLink(Obj: T): IMyc3ObjectLink; -begin - Result := TMyc3ObjectLink.Create( Obj ); -end; - -class function Mutable.TrimArray(const Values: IMyc3Mutable>): IMyc3Mutable>; -begin - Result := TValue>.CreateMutable>( - Values, - function( Values: TArray ): TArray - var - i, n: Integer; - begin - n := 0; - for i := 0 to High(Values) do - if Assigned(Values[i]) then - inc(n); - - SetLength( Result, n ); - n := 0; - for i := 0 to High(Values) do - begin - Result[n] := Values[i]; - inc(n); - end; - end ); -end; - -class function Mutable.FilterArray(const Values: IMyc3Mutable>; const FilterFunc: TConstFunc>): IMyc3Mutable>; -var - Sieve: IMyc3Mutable>>; -begin - Sieve := TValue>>.CreateMutable>( - Values, - function( Values: TArray ): TArray> - var - i: Integer; - begin - SetLength( Result, Length( Values ) ); - for i := 0 to High(Values) do - Result[i] := FilterFunc( Values[i] ); - end ); - - Result := TValue>.CreateMutable, TArray>( - Mutable.CreateAssembly( Sieve ), - Values, - function( Sieve: TArray; GeoArr: TArray ): TArray - var - i, n: Integer; - begin - n := 0; - for i := 0 to High(GeoArr) do - if Sieve[i] then - inc( n ); - SetLength( Result, n ); - n := 0; - for i := 0 to High(GeoArr) do - if Sieve[i] then - begin - Result[n] := GeoArr[i]; - inc(n); - end; - end ); -end; - -class function Mutable.From(const ValueR: IMyc3Mutable; const ValueS: IMyc3Mutable; const Conv: TFunc>): IMyc3Mutable; -begin - Result := TMyc3EnclosedMutable.Create( - TValue>.CreateMutable( ValueR, ValueS, Conv ) ); -end; - -class function Mutable.From(const Value: T): IMyc3Mutable; -begin - Result := TMyc3ConstantMutable.Create( Value ); -end; - -class function Mutable.FromArray(const Value: IMyc3Mutable>; const Conv: TFunc): IMyc3Mutable>; -begin - Result := - Convert, TArray>( Value, - function( Arr: TArray ): TArray - var - i: Integer; - begin - SetLength( Result, Length(Arr) ); - for i := 0 to High(Arr) do - Result[i] := Conv( Arr[i] ); - end ); -end; - -class function Mutable.FromArray(const Value: IMyc3Mutable>; const Conv: TFunc>): IMyc3Mutable>; -begin - Result := CreateAssembly( FromArray>( Value, Conv ) ); -end; - -class function Mutable.FromArray(const Value: TArray>): IMyc3Mutable>; -begin - Result := TMyc3MutableArray.Create( - Value, - function( Idx: Integer; Val: T ): T - begin - Result := Val; - end ); -end; - -class function Mutable.FromState(const State: IMyc2State): IMyc3Mutable; -begin - Result := TMycMutableState.Create( State ); -end; - -class function Mutable.IfNotThen(const Condition: IMyc3Mutable; const FalseValue: IMyc3Mutable): IMyc3Mutable; -begin - Assert( Assigned( Condition ) and Assigned( FalseValue ) ); - - if Signals.IsStatic(Condition.Changed) then - begin - if Condition.Value then - exit( TValue.DefaultMutable ) - else - exit( FalseValue ); - end; - - Result := TMyc3Mutable.CreateMutable( - [Condition.Changed, FalseValue.Changed], - function: T - begin - if Condition.Value then - Result := System.Default( T ) - else - Result := FalseValue.Value; - end ); -end; - -class function Mutable.IfThen(const Condition: IMyc3Mutable; const TrueValue: IMyc3Mutable): IMyc3Mutable; -begin - Assert( Assigned( Condition ) and Assigned( TrueValue ) ); - - if Signals.IsStatic(Condition.Changed) then - begin - if Condition.Value then - exit( TrueValue ) - else - exit( TValue.DefaultMutable ); - end; - - Result := TMyc3Mutable.CreateMutable( - [Condition.Changed, TrueValue.Changed], - function: T - begin - if Condition.Value then - Result := TrueValue.Value - else - Result := System.Default( T ); - end ); -end; - -class function Mutable.IfThen(const Condition: IMyc3Mutable; const TrueValue: IMyc3Mutable>): IMyc3Mutable< - IMyc3Future>; -begin - Result := IfThenElse>( Condition, TrueValue, TValue.DefaultMutableFuture ); -end; - -class function Mutable.IfThenElse(const Condition: IMyc3Mutable; const TrueValue, FalseValue: IMyc3Mutable): IMyc3Mutable; -begin - Assert( Assigned( Condition ) and Assigned( TrueValue ) and Assigned( FalseValue ) ); - - Result := TMyc3Mutable.CreateMutable( - [Condition.Changed, TrueValue.Changed, FalseValue.Changed], - function: T - begin - if Condition.Value then - Result := TrueValue.Value - else - Result := FalseValue.Value; - end ); -end; - -class function Mutable.Merge(const Parts: IMyc3Mutable>>): IMyc3Mutable>; -begin - Result := TValue>.CreateMutable>>( - Parts, - function( Parts: TArray> ): TArray - begin - Result := TFuture.Merge( Parts ); - end ); -end; - -class function Mutable.Merge(const Parts: IMyc3Mutable>>>): IMyc3Mutable>>; -begin - Result := TValue>>.CreateMutable>>>( - Parts, - function( Parts: TArray>> ): IMyc3Future> - begin - Result := TFuture.Merge( Parts ); - end ); -end; - -class function Mutable.OpAND(const Arr: TArray>): IMyc3Mutable; -begin - if Length(Arr)=2 then - Result := TValue.CreateMutable( - Arr[0], Arr[1], - function( A, B: Boolean ): Boolean - begin - Result := A and B; - end ) - else if Length(Arr)=1 then - Result := Arr[0] - else - Result := TValue.CreateMutable>( - TValue.CreateMutable(Arr), - function( Arr: TArray ): Boolean - var - i: Integer; - begin - for i := 0 to High(Arr) do - if not Arr[i] then - exit( System.False ); - exit( System.true ); - end ); -end; - -class function Mutable.OpNOT(const A: IMyc3Mutable): IMyc3Mutable; -begin - Result := TValue.CreateMutable( - A, - function( A: Boolean ): Boolean - begin - Result := not A; - end ); -end; - -class function Mutable.OpNOR(const Arr: TArray>): IMyc3Mutable; -begin - if Length(Arr)=2 then - Result := TValue.CreateMutable( - Arr[0], Arr[1], - function( A, B: Boolean ): Boolean - begin - Result := not (A or B); - end ) - else if Length(Arr)=1 then - Result := OpNOT( Arr[0] ) - else - Result := TValue.CreateMutable>( - TValue.CreateMutable(Arr), - function( Arr: TArray ): Boolean - var - i: Integer; - begin - for i := 0 to High(Arr) do - if not Arr[i] then - exit( System.true ); - exit( System.False ); - end ); -end; - -class function Mutable.OpNAND(const Arr: TArray>): IMyc3Mutable; -begin - if Length(Arr)=2 then - Result := TValue.CreateMutable( - Arr[0], Arr[1], - function( A, B: Boolean ): Boolean - begin - Result := not (A and B); - end ) - else if Length(Arr)=1 then - Result := OpNOT( Arr[0] ) - else - Result := TValue.CreateMutable>( - TValue.CreateMutable(Arr), - function( Arr: TArray ): Boolean - var - i: Integer; - begin - for i := 0 to High(Arr) do - if not Arr[i] then - exit( System.true ); - exit( System.False ); - end ); -end; - -class function Mutable.OpOR(const Arr: TArray>): IMyc3Mutable; -begin - if Length(Arr)=2 then - Result := TValue.CreateMutable( - Arr[0], Arr[1], - function( A, B: Boolean ): Boolean - begin - Result := A or B; - end ) - else if Length(Arr)=1 then - Result := Arr[0] - else - Result := TValue.CreateMutable>( - TValue.CreateMutable(Arr), - function( Arr: TArray ): Boolean - var - i: Integer; - begin - for i := 0 to High(Arr) do - if Arr[i] then - exit( System.true ); - exit( System.False ); - end ); -end; - -class function Mutable.SortArray(const Values: IMyc3Mutable>; const Comparer: IComparer): IMyc3Mutable>; -var - Cmp: IComparer; -begin - Cmp := Comparer; - if not Assigned(Cmp) then - Cmp := TComparer.Default; - - Result := TValue>.CreateMutable>( - Values, - function( Values: TArray ): TArray - begin - SetLength( Result, Length(Values) ); - TArray.Copy( Values, Result, Length(Values) ); - TArray.Sort( Result, Cmp ); - end ); -end; - -class function Mutable.True: IMyc3Mutable; -begin - Result := TMycMutableBoolean.CreateBoolean( System.True ); -end; - -class function Mutable.GetComparer: IComparer>; -begin - Result := TMyc3Mutable.Comparer; -end; - -class function Mutable.CreateArray( const Arr: TArray> ): IMyc3Mutable>; -begin - Result := TMyc3Mutable.CreateArray( Arr ); -end; - -class function Mutable.CreateArray( const Arr: IMyc3Mutable>; Calculator: TFunc ): IMyc3Mutable>; -begin - Result := TMyc3Mutable>.CreateMutable( - [Arr.Changed], - function: TArray - var - i: Integer; - begin - SetLength( Result, Length( Arr.Value ) ); - for i := 0 to High( Arr.Value ) do - Result[i] := Calculator( Arr.Value[i] ); - end ); -end; - -class function Mutable.Default: IMyc3Mutable; -begin - Result := TValue.DefaultMutable; -end; - -class function Mutable.IfThen( const Condition: IMyc3Mutable; const TrueValue: IMyc3Mutable ): IMyc3Mutable; -begin - Assert( Assigned( Condition ) and Assigned( TrueValue ) ); - - if Condition = Mutable.True then - exit( TrueValue ) - else if Condition = Mutable.False then - exit( default ); - - Result := TMyc3Mutable.CreateMutable( - [Condition.Changed, TrueValue.Changed], - function: T - begin - if Condition.Value then - Result := TrueValue.Value - else - Result := System.Default( T ); - end ); -end; - -class function Mutable.IfNotThen( const Condition: IMyc3Mutable; const FalseValue: IMyc3Mutable ): IMyc3Mutable; -begin - Assert( Assigned( Condition ) and Assigned( FalseValue ) ); - - if Condition = Mutable.True then - exit( default ) - else if Condition = Mutable.False then - exit( FalseValue ); - - Result := TMyc3Mutable.CreateMutable( - [Condition.Changed, FalseValue.Changed], - function: T - begin - if Condition.Value then - Result := System.Default( T ) - else - Result := FalseValue.Value; - end ); -end; - -class function Mutable.IfThenElse( const Condition: IMyc3Mutable; const TrueValue, FalseValue: IMyc3Mutable ): IMyc3Mutable; -begin - Assert( Assigned( Condition ) and Assigned( TrueValue ) and Assigned( FalseValue ) ); - - if Condition = Mutable.True then - exit( TrueValue ); - if Condition = Mutable.False then - exit( FalseValue ); - if TrueValue = default then - exit( IfNotThen( Condition, FalseValue ) ); - if FalseValue = default then - exit( IfThen( Condition, TrueValue ) ); - - Result := TMyc3Mutable.CreateMutable( - [Condition.Changed, TrueValue.Changed, FalseValue.Changed], - function: T - begin - if Condition.Value then - Result := TrueValue.Value - else - Result := FalseValue.Value; - end ); -end; - -{ TMutableBool } - -constructor TMutableBool.Create(const AThis: IMyc3Mutable); -begin - FThis := AThis; -end; - -class function TMutableBool.GetDefaults(Value: Boolean): IMyc3Mutable; -begin - Result := TMycMutableBoolean.CreateBoolean( Value ); -end; - -class function TMutableBool.True: IMyc3Mutable; -begin - Result := TMycMutableBoolean.CreateBoolean( System.true ); -end; - -class function TMutableBool.False: IMyc3Mutable; -begin - Result := TMycMutableBoolean.CreateBoolean( System.false ); -end; - -class operator TMutableBool.Equal(const A, B: TMutableBool): TMutableBool; -begin - Result := TValue.CreateMutable( - A, B, - function( A, B: Boolean ): Boolean - begin - Result := A = B; - end ); -end; - -class operator TMutableBool.Implicit(const Value: IMyc3Mutable): TMutableBool; -begin - Result.Create( Value ); -end; - -class operator TMutableBool.Implicit(const Value: TMutableBool): IMyc3Mutable; -begin - Result := Value.This; -end; - -class operator TMutableBool.LogicalAnd(const A, B: TMutableBool): TMutableBool; -begin - Result := TValue.CreateMutable( - A, B, - function( A, B: Boolean ): Boolean - begin - Result := A and B; - end ); -end; - -class operator TMutableBool.LogicalNot(const Value: TMutableBool): TMutableBool; -begin - Result := TValue.CreateMutable( - Value, - function( Value: Boolean ): Boolean - begin - Result := not Value; - end ); -end; - -class operator TMutableBool.LogicalOr(const A, B: TMutableBool): TMutableBool; -begin - Result := TValue.CreateMutable( - A, B, - function( A, B: Boolean ): Boolean - begin - Result := A or B; - end ); -end; - -class operator TMutableBool.NotEqual(const A, B: TMutableBool): TMutableBool; -begin - Result := TValue.CreateMutable( - A, B, - function( A, B: Boolean ): Boolean - begin - Result := A <> B; - end ); -end; - -{ TAssembly } - -class function TAssembly.Create: IMycAssembly; -begin - Result := TMycAssembly.Create; -end; - -{ TMycArray } - -class function TMycArray.Create( const Arr: array of T ): IMycArray; -begin - Result := TMycCustomArray.CreateArray( Arr ); -end; - -class function TMycArray.Create( Count: Integer; const Getter: TFunc ): IMycArray; -begin - Result := TMycGenericArray.Create( Count, Getter ); -end; - -class function TMycArray.Create( const Src: IMycArray; const Converter: TConstFunc ): IMycArray; -begin - Result := TMycCustomArray.CreateConvert( Src, Converter ); -end; - -class function TMycArray.Create(const Src: IMyc2Enumerable): IMycArray; -var - n: Integer; - E: IMycEnumerator; - Vals: TArray; -begin - E := Src.GetEnumerator; - - n := 0; - while E.MoveNext do - inc( n ); - - SetLength( Vals, n ); - - E.Reset; - n := 0; - while E.MoveNext do - begin - Vals[n] := E.Current; - inc(n); - end; - - Result := TMycCustomArray.CreateArray( Vals ); -end; - -class function TMycArray.CreateConvert( const Enum: IMyc2Enumerable; const Conv: TConstFunc ): IMyc2Enumerable; -begin - Result := TMyc2ConvertEnumerable.Create( Enum, Conv ); -end; - -class function TMycArray.Divide( const Src: TArray; const Comparer: IComparer ): TArray>; -var - i: Integer; - Arr: TArray>; -begin - Arr := Create( Src ).Divide( Comparer ); - - SetLength( Result, Length( Arr ) ); - for i := 0 to High( Result ) do - Result[i] := Arr[i].ToArray; -end; - -class procedure TMycArray.Divide1( const Src: IMycArray>; out Keys: TArray; out Values: - TArray>; const Comparer: IComparer ); -var - Arr: TArray>>; - i: Integer; -begin - Arr := Src.Divide( - TComparer>.Construct( - function( const A, B: TPair ): Integer - begin - Result := Comparer.Compare( A.Key, B.Key ); - end ) ); - - SetLength( Keys, Length( Arr ) ); - SetLength( Values, Length( Arr ) ); - for i := 0 to High( Arr ) do - begin - Keys[i] := Arr[i][0].Key; - - Values[i] := TMycCustomArray.CreateConvert>( - Arr[i], - function( const P: TPair ): TValue - begin - Result := P.Value; - end ); - end; -end; - -class function TMycArray.Divide( const Src: TArray>; const Comparer: IComparer ): TArray>>; -var - i, j: Integer; - Arr: TArray>>; -begin - Arr := Create>( Src ).Divide( - TComparer>.Construct( - function( const A, B: TPair ): Integer - begin - Result := Comparer.Compare( A.Key, B.Key ); - end ) ); - - SetLength( Result, Length( Arr ) ); - for i := 0 to High( Result ) do - begin - Result[i].Key := Arr[i][0].Key; - SetLength( Result[i].Value, Arr[i].Count ); - for j := 0 to High( Result[i].Value ) do - Result[i].Value[j] := Arr[i][j].Value; - end; -end; - -class function TMycArray.Divide( const Src: IMycArray>; const Comparer: IComparer ): - TArray>>; -var - Arr: TArray>>; - i: Integer; -begin - Arr := Src.Divide( - TComparer>.Construct( - function( const A, B: TPair ): Integer - begin - Result := Comparer.Compare( A.Key, B.Key ); - end ) ); - - SetLength( Result, Length( Arr ) ); - for i := 0 to High( Result ) do - begin - Result[i] := TPair>.Create( - Arr[i][0].Key, - TMycCustomArray.CreateConvert>( - Arr[i], - function( const P: TPair ): TValue - begin - Result := P.Value; - end ) ); - end; -end; - -class function TMycArray.GetKeys( const Arr: TArray> ): TArray; -var - i: Integer; -begin - SetLength( Result, Length( Arr ) ); - for i := 0 to High( Arr ) do - Result[i] := Arr[i].Key; -end; - -class function TChain.Create: IMycChain; -begin - Result := TMycChain.Create; -end; - -{ TMutableCache } - -constructor TMutableCache.Create( const AThis: IMyc3MutableTable ); -begin - FThis := AThis; -end; - -function TMutableCache.GetItem(const Value: T): IMyc3Mutable; -begin - Result := FThis.Add( Value ); -end; - -procedure TMutableCache.Clear; -begin - FThis.Clear; -end; - -class function Stack.Create: IMycStack; -begin - Result := TMycStack.Create; -end; - -{ TTag } - -class function TTag.From(const Data: T): TTag; -begin - {$ifdef DEBUG} - Result.FTypeInfo := TypeInfo(T); - Assert( (Result.FTypeInfo<>nil) and (Result.FTypeInfo.Name <> 'TTag'), 'Recursive tag declaration' ); - {$endif} - - case PTypeInfo(TypeInfo(T)).Kind of - tkInteger: - begin - case PTypeInfo(TypeInfo(T)).TypeData.OrdType of - otSByte: PShortInt(@Result.FOrdinal)^ := PShortInt(@Data)^; - otUByte: PByte(@Result.FOrdinal)^ := PByte(@Data)^; - otSWord: PSmallInt(@Result.FOrdinal)^ := PSmallInt(@Data)^; - otUWord: PWord(@Result.FOrdinal)^ := PWord(@Data)^; - otSLong: PInteger(@Result.FOrdinal)^ := PInteger(@Data)^; - otULong: PLongword(@Result.FOrdinal)^ := PLongword(@Data)^; - end; - end; - - tkInt64: - begin - Result.FOrdinal := PInt64(@Data)^; - end; - - tkFloat: - begin - case PTypeInfo(TypeInfo(T)).TypeData.FloatType of - ftSingle: PSingle(@Result.FOrdinal)^ := PSingle(@Data)^; - ftDouble: PDouble(@Result.FOrdinal)^ := PDouble(@Data)^; - else - begin - Result.FOrdinal := 0; - Result.FManaged := TMyc3Value.Create(Data); - end; - end; - end; - - {$IFNDEF AUTOREFCOUNT} - tkClass, - {$ENDIF} - tkPointer: - begin - PPointer(@Result.FOrdinal)^ := PPointer(@Data)^; - end; - - tkInterface: - begin - Result.FOrdinal := 0; - Result.FManaged := IInterface(PPointer(@Data)^); - end; - - else - begin - Result.FOrdinal := 0; - Result.FManaged := TMyc3Value.Create(Data); - end; - end; -end; - -function TTag.AsType: T; -begin - {$ifdef DEBUG} - if FTypeInfo=nil then - RaiseInvalidOperation( 'TTag not initialized, value of type %s expected', [PTypeInfo(TypeInfo(T)).Name] ); - - if FTypeInfo <> TypeInfo(T) then - RaiseInvalidOperation( 'TTag<%s> can''t cast to %s', [FTypeInfo.Name, PTypeInfo(TypeInfo(T)).Name] ); - {$endif} - - case PTypeInfo(TypeInfo(T)).Kind of - tkInteger: - begin - case PTypeInfo(TypeInfo(T)).TypeData.OrdType of - otSByte: PShortInt(@Result)^ := PShortInt(@FOrdinal)^; - otUByte: PByte(@Result)^ := PByte(@FOrdinal)^; - otSWord: PSmallInt(@Result)^ := PSmallInt(@FOrdinal)^; - otUWord: PWord(@Result)^ := PWord(@FOrdinal)^; - otSLong: PInteger(@Result)^ := PInteger(@FOrdinal)^; - otULong: PLongword(@Result)^ := PLongword(@FOrdinal)^; - end; - end; - - tkInt64: - begin - PInt64(@Result)^ := FOrdinal; - end; - - tkFloat: - begin - case PTypeInfo(TypeInfo(T)).TypeData.FloatType of - ftSingle: PSingle(@Result)^ := PSingle(@FOrdinal)^; - ftDouble: PDouble(@Result)^ := PDouble(@FOrdinal)^; - else - Result := IMyc3Value( FManaged ).Value; - end; - end; - - {$IFNDEF AUTOREFCOUNT} - tkClass, - {$ENDIF} - tkPointer: - begin - PPointer(@Result)^ := PPointer(@FOrdinal)^; - end; - - tkInterface: - begin - IInterface(PPointer(@Result)^) := FManaged; - end; - - else - begin - Result := IMyc3Value( FManaged ).Value; - end; - end; -end; - -{ TMycStateQueue } - -constructor TMycStateQueue.Create(const AStack: IAtomicStack); -begin - FStack := AStack; -end; - -procedure TMycStateQueue.Add(const S: IMyc2State); -begin - FStack.Push( S ); -end; - -class function TMycStateQueue.Create: TMycStateQueue; -begin - Result.Create( TAtomicStack.Create ); -end; - -procedure TMycStateQueue.WaitFor; -var - S: IMyc2State; -begin - S := FStack.Pop; - while S<>nil do - begin - Tasks.WaitFor( S ); - S := FStack.Pop; - end; -end; - -{ TMutable } - -class function TMutable.FromSignals(const Changed: array of IMyc2Signal; const Calculator: TFunc): IMyc3Mutable; -begin - Result := TMyc3Mutable.CreateMutable( Changed, Calculator ); -end; - -class function TMutable.FromSignals(const Changed: array of IMyc2Signal; const Calculator: TFunc>): IMyc3Mutable; -begin - Result := TMyc3EnclosedMutable.Create( TMyc3Mutable>.CreateMutable( Changed, Calculator ) ); -end; - -class function TMutable.From(const Value: IMyc3Mutable; const Conv: TFunc>): TMutable; -begin - Result := TMyc3EnclosedMutable.Create( TValue>.CreateMutable( Value, Conv ) ); -end; - -class operator TMutable.Explicit(const Value: T): TMutable; -begin - Result.FThis := TMyc3ConstantMutable.Create( Value ); -end; - -class operator TMutable.Implicit( - const Item: TMutable): IMyc3Mutable; -begin - Result := Item.FThis; -end; - -class operator TMutable.Implicit( - const Item: IMyc3Mutable): TMutable; -begin - Result.FThis := Item; -end; - -{ TParameterValue } - -constructor TParameterValue.Create( ATypeInfo: PTypeInfo; const AMutable: IMyc3Mutable ); -begin - FMutable := AMutable; - {$ifdef DEBUG} - FTypeInfo := ATypeInfo; - {$endif} -end; - -function TParameterValue.Get: T; -begin - Assert( FMutable<>nil, 'Value is NULL' ); - Result := AsType.Value; -end; - -function TParameterValue.AsType: IMyc3Mutable; -begin - {$ifdef DEBUG} - CheckType( TypeInfo( T ) ); - {$endif} - Result := IMyc3Mutable( FMutable ); -end; - -class function TParameterValue.Compare( const A, B: TParameterValue ): Integer; -begin - Result := CompareValue( NativeInt( A.Mutable ), NativeInt( B.Mutable ) ); -end; - -class function TParameterValue.FromArray( const Values: TArray ): TArray>; -var - i: Integer; -begin - SetLength( Result, Length( Values ) ); - for i := 0 to High( Result ) do - Result[i] := Values[i].AsType; -end; - -class function TParameterValue.Create( const Intf: T ): TParameterValue; -begin - Result.Create( TypeInfo( T ), TValue.CreateMutable( Intf ) ); -end; - -class function TParameterValue.Create( const Intf: IMyc3Mutable ): TParameterValue; -begin - Result.Create( TypeInfo( T ), Intf ); -end; - -constructor TParameterValue.Assign( const Src: TParameterValue ); -begin - {$ifdef DEBUG} - CheckType( Src.FTypeInfo ); - {$endif} - FMutable := Src.FMutable; -end; - -{$ifdef DEBUG} -procedure TParameterValue.CheckType(TI: PTypeInfo); -begin - Assert( FTypeInfo = TI, Format( 'Type mismatch (casting param %s to %s)', [FTypeInfo.Name, TI.Name] ) ); -end; -{$endif} - -class function TParameterValue.FromVarRec( const VarRec: TVarRec ): TParameterValue; -begin - case VarRec.VType of - vtInteger: - Result := TParameterValue.Create( VarRec.VInteger ); - vtBoolean: - Result := TParameterValue.Create( VarRec.VBoolean ); - vtWideChar: - Result := TParameterValue.Create( VarRec.VWideChar ); - vtInt64: - Result := TParameterValue.Create( VarRec.VInt64^ ); - vtChar: - Result := TParameterValue.Create( String( VarRec.VChar ) ); - vtPChar: - Result := TParameterValue.Create( String( VarRec.VPChar ) ); - vtPWideChar: - Result := TParameterValue.Create( String( VarRec.VPWideChar ) ); - vtString: - Result := TParameterValue.Create( String( VarRec.VString^ ) ); - vtWideString: - Result := TParameterValue.Create( String( VarRec.VWideString ) ); - vtAnsiString: - Result := TParameterValue.Create( String( VarRec.VAnsiString ) ); - vtUnicodeString: - Result := TParameterValue.Create( String( VarRec.VUnicodeString ) ); - vtObject: - Result := TParameterValue.Create( TObject( VarRec.VObject ) ); - vtClass: - Result := TParameterValue.Create( VarRec.VClass ); - vtVariant: - Result := TParameterValue.Create( VarRec.VVariant^ ); - vtPointer: - Result := TParameterValue.Create( VarRec.VPointer ); - vtExtended: - Result := TParameterValue.Create( VarRec.VExtended^ ); - vtCurrency: - Result := TParameterValue.Create( VarRec.VCurrency^ ); - vtInterface: - Result := TParameterValue.Create( IInterface( VarRec.VInterface ) ); - end; -end; - -{ TParameterField } - -constructor TParameterField.Create( AID: TFieldID; const AValue: TParameterValue ); -begin - FID := AID; - FValue := AValue; -end; - -class function TParameterField.Create( ID: TFieldID; const Intf: IMyc3Mutable ): TParameterField; -begin - Result := TParameterField.Create( ID, TParameterValue.Create( Intf ) ); -end; - -class function TParameterField.Create( ID: TFieldID; const Intf: T ): TParameterField; -begin - Result := TParameterField.Create( ID, TParameterValue.Create( Intf ) ); -end; - -{ TParameterRecord } - -constructor TParameterRecord.Create( const AThis: IMyc3ParameterRecord ); -begin - FThis := AThis; -end; - -function TParameterRecord.AsType( ID: TFieldID ): IMyc3Mutable; -begin - Result := GetValues( ID ).AsType; -end; - -function TParameterRecord.Get(ID: TFieldID): T; -begin - Result := GetValues( ID ).Get; -end; - -function TParameterRecord.GetByName( const Caption: String ): TParameterValue; -begin - Result := FThis.ByName[Caption]; -end; - -function TParameterRecord.GetDef: IMycParameterRecordDefinition; -begin - Result := FThis.Def; -end; - -function TParameterRecord.GetValues(ID: TFieldID): TParameterValue; -begin - Result := FThis.Values[ID]; -end; - -class operator TParameterRecord.Implicit(const Item: IMyc3ParameterRecord): TParameterRecord; -begin - Result.Create( Item ); -end; - -class operator TParameterRecord.Implicit(const Item: TParameterRecord): IMyc3ParameterRecord; -begin - Result := Item.FThis; -end; - -{ TParameterSpace } - -constructor TParameterSpace.Create( const AThis: IMycParameterSpace ); -begin - FThis := AThis; -end; - -function TParameterSpace.CompareValues( FieldID: TFieldID; const A, B: TParameterValue ): Integer; -begin - Result := FThis.CompareValues( FieldID, A, B ); -end; - -class function TParameterSpace.Create: TParameterSpace; -begin - Result.Create( TMycParameterSpace.Create ); -end; - -function TParameterSpace.CreateRecord( const Fields: TArray ): TParameterRecord; -begin - Result.Create( FThis.CreateRecord( Fields ) ); -end; - -function TParameterSpace.GetCaptions( FieldID: TFieldID ): String; -begin - Result := FThis.Captions[FieldID]; -end; - -function TParameterSpace.GetComparer( FieldID: TFieldID ): IComparer; -begin - Result := FThis.Comparer[FieldID]; -end; - -function TParameterSpace.GetDefaultValues( FieldID: TFieldID ): TParameterValue; -begin - Result := FThis.DefaultValues[FieldID]; -end; - -function TParameterSpace.GetFieldCount: Integer; -begin - Result := FThis.FieldCount; -end; - -function TParameterSpace.AddField(const Caption: String; const DefaultValue: T; const Comparer: IComparer = nil): TFieldID; -var - ValueComparer: IComparer; - Comp: IComparer; -begin - ValueComparer := Comparer; - if ValueComparer=nil then - ValueComparer := TComparer.Default; - - Comp := TComparer.Construct( - function( const A, B: TParameterValue ): Integer - begin - if ( A.Mutable <> nil ) and ( B.Mutable<>nil ) then - Result := ValueComparer.Compare( A.AsType.Value, B.AsType.Value ) - else if A.Mutable <> nil then - Result := 1 - else if B.Mutable <> nil then - Result := -1 - else - Result := 0; - end ); - - Result := FThis.AddField( TypeInfo( T ), Caption, TValue.CreateMutable( DefaultValue ), Comp ); -end; - -function TParameterSpace.CreateDef(const Fields: TArray): IMycParameterRecordDefinition; -begin - Result := FThis.CreateDef( Fields ); -end; - -class operator TParameterSpace.Implicit( const Item: TParameterSpace ): IMycParameterSpace; -begin - Result := Item.FThis; -end; - -class operator TParameterSpace.Implicit( const Item: IMycParameterSpace ): TParameterSpace; -begin - Result.Create( Item ); -end; - -{ TMutableFuture } - -class function TMutableFuture.FromArray(const Value: TArray>>): IMyc3Mutable>>; -begin - Result := Mutable.Convert>, IMyc3Future>>( - Mutable.FromArray>( Value ), - function( Value: TArray> ): IMyc3Future> - begin - Result := TFuture.FromArray( Value ); - end ); -end; - -constructor TStackTrace.Create(ASkipFrames: Cardinal; const AMsg: String = ''); -begin - Msg := AMsg; - {$ifdef FullDebugMode} - FastMM_EnterDebugMode; - FastMM_GetStackTrace(@StackTrace, Length(StackTrace), 0); - {$endif} -end; - -function TStackTrace.ToText: String; -{$ifdef FullDebugMode} -var - LStackTraceBuffer: array[0..Len * 160] of WideChar; -{$endif} -begin - Result := Msg; - if Result<>'' then - Result := Result + #13#10; - - {$ifdef FullDebugMode} - FastMM_ConvertStackTraceToText( - @StackTrace, Length(StackTrace), @LStackTraceBuffer, - @LStackTraceBuffer[High(LStackTraceBuffer)]); - - Result := Result + LStackTraceBuffer; - {$else} - Result := Result + 'StackTrace: FullDebugMode not enabled'; - {$endif} -end; - -class function TValidatable.FromSignal(const Signal: IMyc2Signal): IMyc3Validatable; -begin - Result := TMyc3ValidatableSignal.Create(Signal); -end; - -initialization - -Tasks := TMyc3Tasks.Create( TMyc2TaskFactory.Create ); - -finalization - -FreeAndNil( Tasks ); - -end. diff --git a/Test/MycTests.dpr b/Test/MycTests.dpr index c175f0a..6e03a57 100644 --- a/Test/MycTests.dpr +++ b/Test/MycTests.dpr @@ -12,7 +12,6 @@ uses TestInsight.DUnitX, {$ELSE} DUnitX.Loggers.Console, - DUnitX.Loggers.Xml.NUnit, {$ENDIF } DUnitX.TestFramework, TestNotifier in 'TestNotifier.pas', @@ -22,7 +21,10 @@ uses TestNotifier_ChaosStress in 'TestNotifier_ChaosStress.pas', TestSignals_Latch in 'TestSignals_Latch.pas', Myc.Core.Tasks in '..\Src\Myc.Core.Tasks.pas', - TestTasks in 'TestTasks.pas'; + TestTasks in 'TestTasks.pas', + TestSignals_Dirty in 'TestSignals_Dirty.pas', + Myc.Futures in '..\Src\Myc.Futures.pas', + TestFutures in 'TestFutures.pas'; { keep comment here to protect the following conditional from being removed by the IDE when adding a unit } {$IFNDEF TESTINSIGHT} diff --git a/Test/MycTests.dproj b/Test/MycTests.dproj index 663a4aa..6f57883 100644 --- a/Test/MycTests.dproj +++ b/Test/MycTests.dproj @@ -63,6 +63,10 @@ 1031 CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments= --exitbehavior:Pause + TESTINSIGHT;$(DCC_Define) + + TargetOutOfDate 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) @@ -117,6 +121,9 @@ + + + Base @@ -1128,4 +1135,36 @@ + + + False + + False + T:\DelphiIntfExtract\Win64\Debug\ExtractPascalInterfaces.exe -o T:\Myc\intf.txt T:\Myc\src + False + + + + False + + False + T:\DelphiIntfExtract\Win64\Debug\ExtractPascalInterfaces.exe -o T:\Myc\intf.txt T:\Myc\src + False + + + + False + + False + T:\DelphiIntfExtract\Win64\Debug\ExtractPascalInterfaces.exe -o T:\Myc\intf.txt T:\Myc\src + False + + + + False + + False + T:\DelphiIntfExtract\Win64\Debug\ExtractPascalInterfaces.exe -o T:\Myc\intf.txt T:\Myc\src + False + diff --git a/Test/TestFutures.pas b/Test/TestFutures.pas new file mode 100644 index 0000000..ff2315e --- /dev/null +++ b/Test/TestFutures.pas @@ -0,0 +1,370 @@ +unit TestFutures; + +interface + +uses + DUnitX.TestFramework, + 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; // For IMycFuture, TMycInitStateFuncFuture + +type + // Helper class to notify a latch when its Notify method is called. + TLatchNotifierSubscriber = class(TInterfacedObject, IMycSubscriber) + private + FGateLatch: IMycLatch; + public + constructor Create(AGateLatch: IMycLatch); + // IMycSubscriber + function Notify: Boolean; // Implements IMycSubscriber.Notify [cite: 46, 181, 299] + end; + + [TestFixture] + [IgnoreMemoryLeaks(true)] + TTestMycInitStateFuncFuture = class(TObject) + private + FTaskFactory: IMycTaskFactory; + FProcExecutionCount: Integer; // Counter for side effects of AProc + FSharedCounter: Integer; // For Fan-Out test side effects + public + [Setup] + procedure Setup; + [TearDown] + procedure TearDown; + + [Test] + procedure Test_BasicSuccess_WithImmediateInitState; + [Test] + procedure Test_ChainedExecution_WithDelayedInitState; + [Test] + procedure Test_ExceptionInProc_HandledAsPlanned; + [Test] + procedure Test_GetResult_BeforeDone_RaisesException; + [Test] + procedure Test_FanIn_OneFutureWaitsForMultipleOthers; + [Test] + procedure Test_FanOut_MultipleFuturesWaitForOneTrigger; + end; + +implementation + +{ TLatchNotifierSubscriber } + +constructor TLatchNotifierSubscriber.Create(AGateLatch: IMycLatch); +begin + inherited Create; + FGateLatch := AGateLatch; +end; + +function TLatchNotifierSubscriber.Notify: Boolean; +begin + if Assigned(FGateLatch) then + begin + FGateLatch.Notify; // Notify the provided gate latch [cite: 80, 215, 333] + end; + Result := False; // This subscriber is typically one-shot for this purpose. +end; + +{ TTestMycInitStateFuncFuture } + +procedure TTestMycInitStateFuncFuture.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; +begin + if Assigned(FTaskFactory) then + begin + FTaskFactory.Teardown; // Teardown the factory, this may re-raise exceptions [cite: 107, 234, 352] + FTaskFactory := nil; + end; +end; + +procedure TTestMycInitStateFuncFuture.Test_BasicSuccess_WithImmediateInitState; +var + LFuture: IMycFuture; + LInitStateAsState: IMycState; // Parameter for Create + LResultValue: Integer; +const + CExpectedResult = 42; +begin + // Use TMycLatch.Null for an already set init state [cite: 71, 81, 206, 216, 324, 334] + LInitStateAsState := TMycLatch.Null.State; // Get IMycState from IMycLatch [cite: 61, 196, 314] + + LFuture := TMycInitStateFuncFuture.Create(FTaskFactory, LInitStateAsState, + function: Integer + begin + Inc(Self.FProcExecutionCount); + Result := CExpectedResult; + end); + + FTaskFactory.WaitFor(LFuture.Done); // Accesses IMycFuture.GetDone [cite: 110, 234, 352] + + Assert.IsTrue(LFuture.Done.IsSet, 'Future should be marked as done.'); // Accesses IMycState.IsSet [cite: 57, 194, 312] + Assert.AreEqual(1, FProcExecutionCount, 'AProc should have been executed once.'); + + LResultValue := LFuture.GetResult; // Accesses IMycFuture.GetResult + Assert.AreEqual(CExpectedResult, LResultValue, 'GetResult returned an unexpected value.'); +end; + +procedure TTestMycInitStateFuncFuture.Test_ChainedExecution_WithDelayedInitState; +var + LFuture: IMycFuture; + LInitLatch: IMycLatch; + LResultValue: string; +const + CExpectedResult = 'ChainCompleted'; +begin + LInitLatch := TMycLatch.CreateLatch(1); // Create an init state that is not yet set [cite: 77, 212, 330] + + LFuture := TMycInitStateFuncFuture.Create(FTaskFactory, LInitLatch.State, + function: string + begin + Inc(Self.FProcExecutionCount); + Result := CExpectedResult; + end); + + Assert.AreEqual(0, FProcExecutionCount, 'AProc should not have executed yet.'); + Assert.IsFalse(LFuture.Done.IsSet, 'Future should not be done yet.'); + + LInitLatch.Notify; // Trigger the initial state [cite: 80, 215, 333] + + FTaskFactory.WaitFor(LFuture.Done); + + Assert.IsTrue(LFuture.Done.IsSet, 'Future should be marked as done after init state trigger.'); + Assert.AreEqual(1, FProcExecutionCount, 'AProc should have been executed once after init state.'); + + LResultValue := LFuture.GetResult; + Assert.AreEqual(CExpectedResult, LResultValue, 'GetResult returned an unexpected value after delayed init.'); +end; + +procedure TTestMycInitStateFuncFuture.Test_ExceptionInProc_HandledAsPlanned; +var + LFuture: IMycFuture; + LLocalTaskFactory: IMycTaskFactory; + LInitStateAsState: IMycState; + LResultValue: Integer; + LExpectedExceptionRaisedByFactory: Boolean; +const + CExceptionMessage = 'Test exception from AProc'; +begin + LExpectedExceptionRaisedByFactory := False; + LLocalTaskFactory := TMycTaskFactory.Create; + LInitStateAsState := TMycLatch.Null.State; // Immediate execution + + LFuture := TMycInitStateFuncFuture.Create(LLocalTaskFactory, LInitStateAsState, + function: Integer + begin + Inc(Self.FProcExecutionCount); + raise Exception.Create(CExceptionMessage); + end); + + try + LLocalTaskFactory.WaitFor(LFuture.Done); + except + on E: Exception do + begin + if E.Message = CExceptionMessage then + LExpectedExceptionRaisedByFactory := True; + end; + end; + + Assert.IsTrue(LFuture.Done.IsSet, 'Future should be done even if AProc raised an exception.'); + Assert.AreEqual(1, FProcExecutionCount, 'AProc (which raised) should have been executed once.'); + + LResultValue := LFuture.GetResult; + Assert.AreEqual(Default(Integer), LResultValue, 'GetResult should return Default(T) when AProc raises an exception.'); + + if not LExpectedExceptionRaisedByFactory then + begin + try + LLocalTaskFactory.Teardown; // This should re-raise the exception [cite: 108, 234, 352] + except + on E: Exception do + begin + Assert.AreEqual(CExceptionMessage, E.Message, 'TaskFactory did not re-raise the correct exception message on Teardown.'); + LExpectedExceptionRaisedByFactory := True; + end; + end; + Assert.IsTrue(LExpectedExceptionRaisedByFactory, 'TaskFactory Teardown did not raise any exception as expected.'); + end; + + if LExpectedExceptionRaisedByFactory then // Factory was torn down (implicitly or explicitly) and did its job + LLocalTaskFactory := nil + else if Assigned(LLocalTaskFactory) then // Teardown didn't raise as expected, or wasn't called due to earlier exception path + begin + LLocalTaskFactory.Teardown; // Ensure it's torn down if test logic failed to confirm exception + LLocalTaskFactory := nil; + end; +end; + +procedure TTestMycInitStateFuncFuture.Test_GetResult_BeforeDone_RaisesException; +var + LFuture: IMycFuture; + LInitLatch: IMycLatch; + LExpectedExceptionRaised: Boolean; +const + CExpectedExceptionMessage = 'Result is not yet available for the future.'; +begin + LExpectedExceptionRaised := False; + LInitLatch := TMycLatch.CreateLatch(1); // Create a latch that is not yet set [cite: 77, 212, 330] + + LFuture := TMycInitStateFuncFuture.Create(FTaskFactory, LInitLatch.State, + function: Integer + begin + Inc(Self.FProcExecutionCount); + Result := 123; + end); + + Assert.IsFalse(LFuture.Done.IsSet, 'Future should not be marked as done initially.'); + + try + LFuture.GetResult; + except + on E: Exception do + begin + Assert.AreEqual(CExpectedExceptionMessage, E.Message, 'Exception message mismatch.'); + LExpectedExceptionRaised := True; + end; + end; + Assert.IsTrue(LExpectedExceptionRaised, 'Calling GetResult before done should raise an exception.'); + + LInitLatch.Notify; // [cite: 80, 215, 333] + FTaskFactory.WaitFor(LFuture.Done); // +end; + +procedure TTestMycInitStateFuncFuture.Test_FanIn_OneFutureWaitsForMultipleOthers; +var + LPrerequisiteFuture1, LPrerequisiteFuture2: IMycFuture; + LMainFuture: IMycFuture; + LGateLatch: IMycLatch; + LSub1, LSub2: IMycSubscriber; // To hold the TLatchNotifierSubscriber instances + LInitStateP1, LInitStateP2: IMycLatch; + Subscriptions: array[1..2] of TMycSubscription; // To manage subscriptions +const + CMainFutureResult = 'AllPrerequisitesCompleted'; +begin + FProcExecutionCount := 0; // Reset for this test + + // Gate Latch: MainFuture waits for this latch, which needs 2 notifications. + LGateLatch := TMycLatch.CreateLatch(2); // [cite: 77, 212, 330] + + // Create MainFuture, AInitState is the GateLatch's state. + LMainFuture := TMycInitStateFuncFuture.Create(FTaskFactory, LGateLatch.State, + function: string + begin + Inc(Self.FProcExecutionCount, 10); // Indicate MainFuture's proc ran + Result := CMainFutureResult; + end); + + // Setup Prerequisite Futures + // PrerequisiteFuture1 + LInitStateP1 := TMycLatch.CreateLatch(1); // Controllable init state for PF1 + LPrerequisiteFuture1 := TMycInitStateFuncFuture.Create(FTaskFactory, LInitStateP1.State, + function: Integer + begin + Inc(Self.FProcExecutionCount, 1); // PF1 ran + Result := 1; + end); + LSub1 := TLatchNotifierSubscriber.Create(LGateLatch); + Subscriptions[1] := LPrerequisiteFuture1.Done.Subscribe(LSub1); // Subscribe to PF1's completion [cite: 56, 188, 306] + + // PrerequisiteFuture2 + LInitStateP2 := TMycLatch.CreateLatch(1); // Controllable init state for PF2 + LPrerequisiteFuture2 := TMycInitStateFuncFuture.Create(FTaskFactory, LInitStateP2.State, + function: Integer + begin + Inc(Self.FProcExecutionCount, 1); // PF2 ran + Result := 2; + end); + LSub2 := TLatchNotifierSubscriber.Create(LGateLatch); + Subscriptions[2] := LPrerequisiteFuture2.Done.Subscribe(LSub2); // Subscribe to PF2's completion + + // --- Execution & Verification --- + Assert.IsFalse(LMainFuture.Done.IsSet, 'MainFuture should not be done yet.'); + Assert.AreEqual(0, FProcExecutionCount, 'No AProc should have executed yet.'); + + // Trigger PrerequisiteFuture1 + LInitStateP1.Notify; // + FTaskFactory.WaitFor(LPrerequisiteFuture1.Done); // Ensure PF1 completes and notifies GateLatch + Assert.IsFalse(LGateLatch.State.IsSet, 'GateLatch should not be set after only one prerequisite.'); + 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 + + // Now GateLatch should be set, and MainFuture should execute + FTaskFactory.WaitFor(LMainFuture.Done); + + Assert.IsTrue(LGateLatch.State.IsSet, 'GateLatch should be set after both prerequisites.'); + Assert.IsTrue(LMainFuture.Done.IsSet, 'MainFuture should be done now.'); + Assert.AreEqual(12, FProcExecutionCount, 'All AProcs (PF1, PF2, Main) should have run.'); // 1+1+10 + Assert.AreEqual(CMainFutureResult, LMainFuture.GetResult, 'MainFuture returned an unexpected result.'); + + // Clean up subscriptions explicitly, though ARC + managed records handle much + Subscriptions[1].Unsubscribe; // [cite: 52, 186, 304] + Subscriptions[2].Unsubscribe; // +end; + +procedure TTestMycInitStateFuncFuture.Test_FanOut_MultipleFuturesWaitForOneTrigger; +var + LTriggerLatch: IMycLatch; + LFutureA, LFutureB: IMycFuture; + LFlagFutureARan, LFlagFutureBRan: Boolean; +begin + LFlagFutureARan := False; + LFlagFutureBRan := False; + Self.FSharedCounter := 0; // Reset shared counter for this test + + LTriggerLatch := TMycLatch.CreateLatch(1); // Single trigger [cite: 77, 212, 330] + + // Future A + LFutureA := TMycInitStateFuncFuture.Create(FTaskFactory, LTriggerLatch.State, + function: Integer + begin + LFlagFutureARan := True; + System.SyncObjs.TInterlocked.Increment(Self.FSharedCounter); // Thread-safe increment + Result := 100; + end); + + // Future B + LFutureB := TMycInitStateFuncFuture.Create(FTaskFactory, LTriggerLatch.State, + function: Integer + begin + LFlagFutureBRan := True; + System.SyncObjs.TInterlocked.Increment(Self.FSharedCounter); // Thread-safe increment + Result := 200; + end); + + Assert.IsFalse(LFutureA.Done.IsSet, 'FutureA should not be done yet.'); + Assert.IsFalse(LFutureB.Done.IsSet, 'FutureB should not be done yet.'); + Assert.AreEqual(0, Self.FSharedCounter, 'No future AProcs should have executed yet.'); + + // Trigger the common latch + LTriggerLatch.Notify; // [cite: 80, 215, 333] + + // Wait for both futures to complete + FTaskFactory.WaitFor(LFutureA.Done); + FTaskFactory.WaitFor(LFutureB.Done); + + Assert.IsTrue(LFutureA.Done.IsSet, 'FutureA should be done.'); + Assert.IsTrue(LFutureB.Done.IsSet, 'FutureB should be done.'); + Assert.IsTrue(LFlagFutureARan, 'FutureA AProc should have run.'); + Assert.IsTrue(LFlagFutureBRan, 'FutureB AProc should have run.'); + Assert.AreEqual(2, Self.FSharedCounter, 'Both future AProcs should have incremented the counter.'); + Assert.AreEqual(100, LFutureA.GetResult, 'FutureA GetResult value mismatch.'); + Assert.AreEqual(200, LFutureB.GetResult, 'FutureB GetResult value mismatch.'); +end; + +initialization + // For DUnitX, attributes typically handle registration. + // If needed for older DUnit: RegisterTest(TTestMycInitStateFuncFuture.Suite); +end. diff --git a/Test/TestNotifier_ChaosStress.pas b/Test/TestNotifier_ChaosStress.pas index fb3d86f..c974228 100644 --- a/Test/TestNotifier_ChaosStress.pas +++ b/Test/TestNotifier_ChaosStress.pas @@ -313,7 +313,6 @@ var threads: array of TStressWorkerThread; i: Integer; LThreadError: Exception; - LMessage: string; totalExpectedLiveByThreadsAtEnd, actualLiveInNotifierAtEnd: Integer; actualLiveReceiversInNotifier: TList; // Store interface type from Notify receiver: IMyStressTestInterface; diff --git a/Test/TestNotifier_Threading.pas b/Test/TestNotifier_Threading.pas index c275fee..8103a64 100644 --- a/Test/TestNotifier_Threading.pas +++ b/Test/TestNotifier_Threading.pas @@ -116,7 +116,6 @@ end; procedure TAdviseWorkerThread.Execute; var i: Integer; - tag: TMycNotifyList.TTag; // Tag is not used further in this test design begin inherited; // Important for TThread try @@ -128,7 +127,7 @@ begin // Acquire lock before calling Advise FOwnerFixture.FNotifier.Lock; try - 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 diff --git a/Test/TestSList.pas b/Test/TestSList.pas index f1e2ecc..0403179 100644 --- a/Test/TestSList.pas +++ b/Test/TestSList.pas @@ -51,7 +51,6 @@ type // --- TSList Parallel Access Test --- [Test] - [Timeout(30000)] // Timeout in milliseconds procedure TestTSList_ParallelPushPop; end; diff --git a/Test/TestSignals_Dirty.pas b/Test/TestSignals_Dirty.pas new file mode 100644 index 0000000..2424acb --- /dev/null +++ b/Test/TestSignals_Dirty.pas @@ -0,0 +1,529 @@ +unit TestSignals_Dirty; + +interface + +uses + DUnitX.TestFramework, + System.SysUtils, + Myc.Signals; // Unit under test + +type + // Helper class to mock a subscriber (reuse or redefine if not in common unit) + TMockSubscriber = class(TInterfacedObject, IMycSubscriber) + public + NotifyCount: Integer; + NotifyShouldReturn: Boolean; + WasCalled: Boolean; + LastReturnedValueFromSource: Boolean; // To store what the source's Notify returned + + constructor Create(AShouldReturn: Boolean = True); + function Notify: Boolean; // IMycSubscriber implementation. + end; + + [TestFixture] + TTestMycDirtyFlag = class(TObject) + private + // Helper to create a dirty flag and optionally reset it for a clean initial state + function CreateAndPrepareDirtyFlag(StartDirty: Boolean = True): IMycDirty; + public + [Setup] + procedure Setup; + [TearDown] + procedure TearDown; + + // Category 1: Basic State, Notify (as Subscriber method), and Reset + [Test] + procedure TestCreate_InitialStateIsDirty; + [Test] + procedure TestReset_FromDirtyState_BecomesCleanAndReturnsTrue; + [Test] + procedure TestReset_FromCleanState_StaysCleanAndReturnsFalse; + [Test] + procedure TestNotify_OnCleanFlag_SetsDirtyAndReturnsTrue; + [Test] + procedure TestNotify_OnDirtyFlag_StaysDirtyAndReturnsFalse; + + // Category 2: Subscriber Notifications + [Test] + procedure TestSubscribe_ToAlreadyDirtyFlag_NotifiesSubscriberImmediately; + [Test] + procedure TestSubscribe_ToCleanFlag_DoesNotNotifySubscriberImmediately; + [Test] + procedure TestSubscriber_Notified_WhenFlagTransitionsToDirty; + [Test] + procedure TestSubscriber_NotNotified_WhenSettingAlreadyDirtyFlagViaNotify; + [Test] + procedure TestSubscriber_NotNotified_ByResetAction; + [Test] + procedure TestMultipleSubscribers_Notified_WhenFlagTransitionsToDirty; + [Test] + procedure TestUnsubscribe_SubscriberNotNotified; + + // Category 3: Chaining Dirty Flags + [Test] + procedure TestChain_A_Notifies_B_SimplePropagation; + [Test] + procedure TestChain_A_Notifies_B_Notifies_C_SimplePropagation; + + // Category 4: Chaining with Resets and Re-triggering (Consistency) + [Test] + procedure TestChain_A_B_ResetB_RetriggerA_BStaysCleanIfANotChanged; + [Test] + procedure TestChain_A_B_ResetA_ThenTriggerA_FullPropagationToB; + [Test] + procedure TestChain_A_B_C_IntermediateBReset_RetriggerA_PropagatesToC; + [Test] + procedure TestChain_A_B_C_AllReset_RetriggerA_FullPropagation; + [Test] + procedure TestChain_A_B_C_TriggerA_ResetA_TriggerA_EnsureCNotifiedCorrectly; + + end; + +implementation + +{ TMockSubscriber } + +constructor TMockSubscriber.Create(AShouldReturn: Boolean = True); +begin + inherited Create; + NotifyCount := 0; + NotifyShouldReturn := AShouldReturn; + WasCalled := False; + LastReturnedValueFromSource := False; // Default +end; + +function TMockSubscriber.Notify: Boolean; +begin + Inc(NotifyCount); + WasCalled := True; + // This return value is what this subscriber tells the source signal. + // For testing, we usually want it to return false to signify it doesn't need more from this one event. + Result := NotifyShouldReturn; +end; + +{ TTestMycDirtyFlag } + +function TTestMycDirtyFlag.CreateAndPrepareDirtyFlag(StartDirty: Boolean = True): IMycDirty; +begin + Result := TMycDirty.CreateDirty; // Initially dirty + if not StartDirty then + Result.Reset; // Reset to make it clean + Assert.AreEqual(StartDirty, Result.State.IsSet, 'CreateAndPrepareDirtyFlag initial state incorrect.'); +end; + +procedure TTestMycDirtyFlag.Setup; +begin + // Per-test setup +end; + +procedure TTestMycDirtyFlag.TearDown; +begin + // Per-test teardown +end; + +// Category 1: Basic State, Notify (as Subscriber method), and Reset + +procedure TTestMycDirtyFlag.TestCreate_InitialStateIsDirty; +var + dirtyFlag: IMycDirty; +begin + dirtyFlag := TMycDirty.CreateDirty; + Assert.IsTrue(dirtyFlag.State.IsSet, 'Newly created dirty flag should be IsSet (dirty).'); +end; + +procedure TTestMycDirtyFlag.TestReset_FromDirtyState_BecomesCleanAndReturnsTrue; +var + dirtyFlag: IMycDirty; + resetResult: Boolean; +begin + dirtyFlag := CreateAndPrepareDirtyFlag(True); // Start dirty + + resetResult := dirtyFlag.Reset; + + Assert.IsFalse(dirtyFlag.State.IsSet, 'Flag should be clean (not IsSet) after Reset.'); + Assert.IsTrue(resetResult, 'Reset() should return True when resetting a dirty flag.'); +end; + +procedure TTestMycDirtyFlag.TestReset_FromCleanState_StaysCleanAndReturnsFalse; +var + dirtyFlag: IMycDirty; + resetResult: Boolean; +begin + dirtyFlag := CreateAndPrepareDirtyFlag(False); // Start clean + + resetResult := dirtyFlag.Reset; + + Assert.IsFalse(dirtyFlag.State.IsSet, 'Flag should remain clean (not IsSet) after Reset on clean flag.'); + Assert.IsFalse(resetResult, 'Reset() should return False when resetting an already clean flag.'); +end; + +procedure TTestMycDirtyFlag.TestNotify_OnCleanFlag_SetsDirtyAndReturnsTrue; +var + dirtyFlag: IMycDirty; + notifyResult: Boolean; +begin + dirtyFlag := CreateAndPrepareDirtyFlag(False); // Start clean + + notifyResult := dirtyFlag.Notify; // Call IMycSubscriber.Notify to make it dirty + + Assert.IsTrue(dirtyFlag.State.IsSet, 'Flag should be dirty (IsSet) after Notify on clean flag.'); + Assert.IsTrue(notifyResult, 'Notify() should return True indicating a state change from clean to dirty.'); +end; + +procedure TTestMycDirtyFlag.TestNotify_OnDirtyFlag_StaysDirtyAndReturnsFalse; +var + dirtyFlag: IMycDirty; + notifyResult: Boolean; +begin + dirtyFlag := CreateAndPrepareDirtyFlag(True); // Start dirty + + notifyResult := dirtyFlag.Notify; // Call IMycSubscriber.Notify again + + Assert.IsTrue(dirtyFlag.State.IsSet, 'Flag should remain dirty (IsSet).'); + Assert.IsFalse(notifyResult, 'Notify() should return False as flag was already dirty (no state change to dirty).'); +end; + +// Category 2: Subscriber Notifications + +procedure TTestMycDirtyFlag.TestSubscribe_ToAlreadyDirtyFlag_NotifiesSubscriberImmediately; +var + dirtyFlag: IMycDirty; + subscriber: TMockSubscriber; + subscription: TMycSubscription; +begin + dirtyFlag := CreateAndPrepareDirtyFlag(True); // Start dirty + subscriber := TMockSubscriber.Create; + + subscription := dirtyFlag.State.Subscribe(subscriber); + + Assert.AreEqual(1, subscriber.NotifyCount, 'Subscriber should be notified immediately when subscribing to an already dirty flag.'); + Assert.IsTrue(subscriber.WasCalled, 'Subscriber WasCalled should be true.'); +end; + +procedure TTestMycDirtyFlag.TestSubscribe_ToCleanFlag_DoesNotNotifySubscriberImmediately; +var + dirtyFlag: IMycDirty; + subscriber: TMockSubscriber; + subscription: TMycSubscription; +begin + dirtyFlag := CreateAndPrepareDirtyFlag(False); // Start clean + subscriber := TMockSubscriber.Create; + + subscription := dirtyFlag.State.Subscribe(subscriber); + + Assert.AreEqual(0, subscriber.NotifyCount, 'Subscriber should NOT be notified immediately when subscribing to a clean flag.'); + Assert.IsFalse(subscriber.WasCalled, 'Subscriber WasCalled should be false.'); +end; + +procedure TTestMycDirtyFlag.TestSubscriber_Notified_WhenFlagTransitionsToDirty; +var + dirtyFlag: IMycDirty; + subscriber: TMockSubscriber; + subscription: TMycSubscription; +begin + dirtyFlag := CreateAndPrepareDirtyFlag(False); // Start clean + subscriber := TMockSubscriber.Create; + subscription := dirtyFlag.State.Subscribe(subscriber); + + Assert.AreEqual(0, subscriber.NotifyCount, 'Subscriber initially not notified.'); + + dirtyFlag.Notify; // Make the flag dirty + + Assert.AreEqual(1, subscriber.NotifyCount, 'Subscriber should be notified once flag transitions to dirty.'); +end; + +procedure TTestMycDirtyFlag.TestSubscriber_NotNotified_WhenSettingAlreadyDirtyFlagViaNotify; +var + dirtyFlag: IMycDirty; + subscriber: TMockSubscriber; + subscription: TMycSubscription; +begin + dirtyFlag := CreateAndPrepareDirtyFlag(True); // Start dirty + subscriber := TMockSubscriber.Create; + subscription := dirtyFlag.State.Subscribe(subscriber); // Gets initial notification + + Assert.AreEqual(1, subscriber.NotifyCount, 'Subscriber notified on subscribe to dirty flag.'); + + dirtyFlag.Notify; // Notify again, flag was already dirty + + Assert.AreEqual(1, subscriber.NotifyCount, 'Subscriber should NOT be notified again if flag was already dirty.'); +end; + +procedure TTestMycDirtyFlag.TestSubscriber_NotNotified_ByResetAction; +var + dirtyFlag: IMycDirty; + subscriber: TMockSubscriber; + subscription: TMycSubscription; +begin + dirtyFlag := CreateAndPrepareDirtyFlag(True); // Start dirty + subscriber := TMockSubscriber.Create; + subscription := dirtyFlag.State.Subscribe(subscriber); // Gets initial notification + + Assert.AreEqual(1, subscriber.NotifyCount, 'Subscriber notified on subscribe.'); + dirtyFlag.Reset; // Reset the flag + Assert.IsFalse(dirtyFlag.State.IsSet, 'Flag is now clean.'); + + // Current TMycDirty.Reset does not notify subscribers. + Assert.AreEqual(1, subscriber.NotifyCount, 'Subscriber should NOT be notified by Reset action.'); +end; + +procedure TTestMycDirtyFlag.TestMultipleSubscribers_Notified_WhenFlagTransitionsToDirty; +var + dirtyFlag: IMycDirty; + sub1, sub2: TMockSubscriber; + subscription1, subscription2: TMycSubscription; +begin + dirtyFlag := CreateAndPrepareDirtyFlag(False); // Start clean + sub1 := TMockSubscriber.Create; + sub2 := TMockSubscriber.Create; + subscription1 := dirtyFlag.State.Subscribe(sub1); + subscription2 := dirtyFlag.State.Subscribe(sub2); + + dirtyFlag.Notify; // Make flag dirty + + Assert.AreEqual(1, sub1.NotifyCount, 'Subscriber 1 should be notified.'); + Assert.AreEqual(1, sub2.NotifyCount, 'Subscriber 2 should be notified.'); +end; + +procedure TTestMycDirtyFlag.TestUnsubscribe_SubscriberNotNotified; +var + dirtyFlag: IMycDirty; + subscriber: TMockSubscriber; + subscription: TMycSubscription; +begin + dirtyFlag := CreateAndPrepareDirtyFlag(False); // Start clean + subscriber := TMockSubscriber.Create; + subscription := dirtyFlag.State.Subscribe(subscriber); + + subscription.Unsubscribe; // Explicitly unsubscribe + + dirtyFlag.Notify; // Make flag dirty + + Assert.AreEqual(0, subscriber.NotifyCount, 'Unsubscribed subscriber should not be notified.'); +end; + +// Category 3: Chaining Dirty Flags +// In these tests, FlagX.Notify means calling the IMycSubscriber.Notify method on FlagX. +// This makes FlagX dirty and potentially notifies its subscribers (like FlagY). + +procedure TTestMycDirtyFlag.TestChain_A_Notifies_B_SimplePropagation; +var + flagA, flagB: IMycDirty; + subToB: TMockSubscriber; + subscriptionA_B, subscriptionMock_B: TMycSubscription; +begin + flagA := CreateAndPrepareDirtyFlag(False); // A starts clean + flagB := CreateAndPrepareDirtyFlag(False); // B starts clean + subToB := TMockSubscriber.Create; + + subscriptionMock_B := flagB.State.Subscribe(subToB); + subscriptionA_B := flagA.State.Subscribe(flagB); // B subscribes to A's state changes (B's Notify will be called) + + flagA.Notify; // Make A dirty. This should trigger B.Notify + + Assert.IsTrue(flagA.State.IsSet, 'Flag A should be dirty.'); + Assert.IsTrue(flagB.State.IsSet, 'Flag B should become dirty due to A.'); + Assert.AreEqual(1, subToB.NotifyCount, 'Subscriber to B should be notified once.'); +end; + +procedure TTestMycDirtyFlag.TestChain_A_Notifies_B_Notifies_C_SimplePropagation; +var + flagA, flagB, flagC: IMycDirty; + subToC: TMockSubscriber; + subscriptionB_A, subscriptionC_B, subscriptionMock_C: TMycSubscription; +begin + flagA := CreateAndPrepareDirtyFlag(False); + flagB := CreateAndPrepareDirtyFlag(False); + flagC := CreateAndPrepareDirtyFlag(False); + subToC := TMockSubscriber.Create; + + subscriptionMock_C := flagC.State.Subscribe(subToC); + subscriptionC_B := flagB.State.Subscribe(flagC); // C subscribes to B + subscriptionB_A := flagA.State.Subscribe(flagB); // B subscribes to A + + flagA.Notify; // Make A dirty + + Assert.IsTrue(flagA.State.IsSet, 'Flag A should be dirty in cascade.'); + Assert.IsTrue(flagB.State.IsSet, 'Flag B should be dirty in cascade.'); + Assert.IsTrue(flagC.State.IsSet, 'Flag C should be dirty in cascade.'); + Assert.AreEqual(1, subToC.NotifyCount, 'Subscriber to C should be notified once in cascade.'); +end; + +// Category 4: Chaining with Resets and Re-triggering (Consistency) + +procedure TTestMycDirtyFlag.TestChain_A_B_ResetB_RetriggerA_BStaysCleanIfANotChanged; +var + flagA, flagB: IMycDirty; + subToB: TMockSubscriber; + subscriptionA_B, subscriptionMock_B: TMycSubscription; +begin + flagA := CreateAndPrepareDirtyFlag(False); + flagB := CreateAndPrepareDirtyFlag(False); + subToB := TMockSubscriber.Create; + subscriptionMock_B := flagB.State.Subscribe(subToB); + subscriptionA_B := flagA.State.Subscribe(flagB); + + flagA.Notify; // A dirty -> B dirty. subToB notified. + Assert.IsTrue(flagB.State.IsSet, 'Flag B should be dirty initially.'); + Assert.AreEqual(1, subToB.NotifyCount, 'Subscriber to B initially notified.'); + + flagB.Reset; // B becomes clean. A is still dirty. + Assert.IsFalse(flagB.State.IsSet, 'Flag B should be clean after reset.'); + Assert.AreEqual(1, subToB.NotifyCount, 'Subscriber to B not notified by B.Reset.'); + + // Notify A again. A was already dirty. So A.Notify() returns false, A does not call ProtectedNotifyOwnSubscribers. + // Thus, B.Notify() is NOT called. B should remain clean. + flagA.Notify; + + Assert.IsTrue(flagA.State.IsSet, 'Flag A remains dirty.'); + Assert.IsFalse(flagB.State.IsSet, 'Flag B should remain clean if A did not transition to dirty.'); + Assert.AreEqual(1, subToB.NotifyCount, 'Subscriber to B should not be notified again.'); +end; + +procedure TTestMycDirtyFlag.TestChain_A_B_ResetA_ThenTriggerA_FullPropagationToB; +var + flagA, flagB: IMycDirty; + subToB: TMockSubscriber; + subscriptionA_B, subscriptionMock_B: TMycSubscription; +begin + flagA := CreateAndPrepareDirtyFlag(False); + flagB := CreateAndPrepareDirtyFlag(False); + subToB := TMockSubscriber.Create; + subscriptionMock_B := flagB.State.Subscribe(subToB); + subscriptionA_B := flagA.State.Subscribe(flagB); + + flagA.Notify; // A dirty -> B dirty. subToB notified. + Assert.IsTrue(flagB.State.IsSet, 'Flag B should be dirty after A triggers.'); + Assert.AreEqual(1, subToB.NotifyCount, 'subToB notified once.'); + + flagA.Reset; // A becomes clean. B is still dirty (state change of A to clean doesn't propagate as a "dirty" signal to B). + Assert.IsFalse(flagA.State.IsSet, 'Flag A is clean after reset.'); + Assert.IsTrue(flagB.State.IsSet, 'Flag B remains dirty.'); // B's state doesn't change because A becoming clean doesn't call B.Notify + + flagA.Notify; // A (was clean) becomes dirty again. A.Notify() returns true. A notifies B. + // B.Notify() is called. B was dirty. B.Notify() sets FFlag to true (no change), returns false. + // So B does NOT notify subToB again. + + Assert.IsTrue(flagA.State.IsSet, 'Flag A is dirty again.'); + Assert.IsTrue(flagB.State.IsSet, 'Flag B is dirty (was already, and A.Notify called B.Notify which set it dirty again).'); + Assert.AreEqual(1, subToB.NotifyCount, 'subToB should NOT be notified again as B did not transition from clean to dirty.'); +end; + +procedure TTestMycDirtyFlag.TestChain_A_B_C_IntermediateBReset_RetriggerA_PropagatesToC; +var + flagA, flagB, flagC: IMycDirty; + subToC: TMockSubscriber; + subscriptionB_A, subscriptionC_B, subscriptionMock_C: TMycSubscription; +begin + flagA := CreateAndPrepareDirtyFlag(False); + flagB := CreateAndPrepareDirtyFlag(False); + flagC := CreateAndPrepareDirtyFlag(False); + subToC := TMockSubscriber.Create; + + subscriptionMock_C := flagC.State.Subscribe(subToC); + subscriptionC_B := flagB.State.Subscribe(flagC); + subscriptionB_A := flagA.State.Subscribe(flagB); + + // Initial full propagation + flagA.Notify; // A dirty -> B dirty -> C dirty. subToC notified. + Assert.IsTrue(flagC.State.IsSet, 'Flag C should be dirty initially.'); + Assert.AreEqual(1, subToC.NotifyCount, 'subToC initial count.'); + + // Intermediate reset + flagB.Reset; // B becomes clean. A is dirty, C is dirty. + Assert.IsFalse(flagB.State.IsSet, 'Flag B is clean.'); + + // Reset and re-trigger A + flagA.Reset; // A becomes clean. + Assert.IsFalse(flagA.State.IsSet, 'Flag A is clean.'); + + flagA.Notify; // A (was clean) -> A dirty. A notifies B. + // B.Notify() called. B was clean -> B dirty. B notifies C. + // C.Notify() called. C was dirty -> C set dirty (no change), C.Notify() returns false. + // So subToC is NOT notified again. + + Assert.IsTrue(flagA.State.IsSet, 'Flag A is dirty again.'); + Assert.IsTrue(flagB.State.IsSet, 'Flag B becomes dirty again.'); + Assert.IsTrue(flagC.State.IsSet, 'Flag C is dirty (was already).'); + Assert.AreEqual(1, subToC.NotifyCount, 'subToC should NOT be notified again.'); +end; + +procedure TTestMycDirtyFlag.TestChain_A_B_C_AllReset_RetriggerA_FullPropagation; +var + flagA, flagB, flagC: IMycDirty; + subToC: TMockSubscriber; + subscriptionB_A, subscriptionC_B, subscriptionMock_C: TMycSubscription; +begin + flagA := CreateAndPrepareDirtyFlag(False); + flagB := CreateAndPrepareDirtyFlag(False); + flagC := CreateAndPrepareDirtyFlag(False); + subToC := TMockSubscriber.Create; + + subscriptionMock_C := flagC.State.Subscribe(subToC); + subscriptionC_B := flagB.State.Subscribe(flagC); + subscriptionB_A := flagA.State.Subscribe(flagB); + + // All are clean. Trigger A. + flagA.Notify; // A dirty -> B dirty -> C dirty. subToC notified. + Assert.IsTrue(flagC.State.IsSet, 'Flag C dirty after first full propagation.'); + Assert.AreEqual(1, subToC.NotifyCount, 'subToC notified once.'); + + // Reset all + flagA.Reset; + flagB.Reset; + flagC.Reset; + Assert.IsFalse(flagA.State.IsSet, 'Flag A clean.'); + Assert.IsFalse(flagB.State.IsSet, 'Flag B clean.'); + Assert.IsFalse(flagC.State.IsSet, 'Flag C clean.'); + // subToC count is still 1, it's not notified by resets. + + // Re-trigger A + flagA.Notify; // A (was clean) -> A dirty. A notifies B. + // B.Notify() called. B was clean -> B dirty. B notifies C. + // C.Notify() called. C was clean -> C dirty. C notifies subToC. + + Assert.IsTrue(flagA.State.IsSet, 'Flag A dirty on re-trigger.'); + Assert.IsTrue(flagB.State.IsSet, 'Flag B dirty on re-trigger.'); + Assert.IsTrue(flagC.State.IsSet, 'Flag C dirty on re-trigger.'); + Assert.AreEqual(2, subToC.NotifyCount, 'subToC should be notified a second time.'); +end; + +procedure TTestMycDirtyFlag.TestChain_A_B_C_TriggerA_ResetA_TriggerA_EnsureCNotifiedCorrectly; +var + flagA, flagB, flagC: IMycDirty; + subToC: TMockSubscriber; + subscriptionB_A, subscriptionC_B, subscriptionMock_C: TMycSubscription; +begin + flagA := CreateAndPrepareDirtyFlag(False); + flagB := CreateAndPrepareDirtyFlag(False); + flagC := CreateAndPrepareDirtyFlag(False); + subToC := TMockSubscriber.Create; + + subscriptionMock_C := flagC.State.Subscribe(subToC); + subscriptionC_B := flagB.State.Subscribe(flagC); + subscriptionB_A := flagA.State.Subscribe(flagB); + + // 1. Trigger A + flagA.Notify; // A, B, C become dirty. subToC notified (count = 1). + Assert.IsTrue(flagC.State.IsSet, 'C is dirty after 1st trigger.'); + Assert.AreEqual(1, subToC.NotifyCount, 'subToC count after 1st trigger.'); + + // 2. Reset A (B and C remain dirty) + flagA.Reset; + Assert.IsFalse(flagA.State.IsSet, 'A is clean.'); + Assert.IsTrue(flagB.State.IsSet, 'B remains dirty.'); + Assert.IsTrue(flagC.State.IsSet, 'C remains dirty.'); + + // 3. Trigger A again + flagA.Notify; // A (was clean) becomes dirty. A notifies B. + // B.Notify() is called. B was dirty. B.Notify sets FFlag to true (no change), returns false. + // B does NOT notify C. C remains dirty. subToC is NOT notified again. + Assert.IsTrue(flagA.State.IsSet, 'A is dirty after 2nd trigger.'); + Assert.IsTrue(flagB.State.IsSet, 'B is still dirty (state did not flip to clean then dirty).'); + Assert.IsTrue(flagC.State.IsSet, 'C is still dirty.'); + Assert.AreEqual(1, subToC.NotifyCount, 'subToC count should remain 1.'); +end; + +initialization + TDUnitX.RegisterTestFixture(TTestMycDirtyFlag); +end. diff --git a/Test/TestSignals_Latch.pas b/Test/TestSignals_Latch.pas index ccf11cd..123f60d 100644 --- a/Test/TestSignals_Latch.pas +++ b/Test/TestSignals_Latch.pas @@ -1,22 +1,22 @@ +// Suggested filename: TestSignals_Latch.pas unit TestSignals_Latch; interface uses DUnitX.TestFramework, - Myc.Signals, // Unit under test, using TMycLatch static members System.SysUtils, - System.StrUtils; + Myc.Signals; // Unit under test, using TMycLatch static members type // Helper class to mock a subscriber. TMockSubscriber = class(TInterfacedObject, IMycSubscriber) public NotifyCount: Integer; - NotifyShouldReturn: Boolean; + NotifyShouldReturn: Boolean; // Determines what this mock's Notify method returns WasCalled: Boolean; - constructor Create(ShouldReturn: Boolean = True); + constructor Create(AShouldReturn: Boolean = True); // Parameter name AShouldReturn for clarity function Notify: Boolean; // IMycSubscriber implementation. end; @@ -30,15 +30,15 @@ type // --- Category 1: Basic Counter and State Functionality (Parameterized) --- [TestCase('InitialPositive', '1,False')] - [TestCase('InitialZero', '0,True')] // TMycLatch.CreateLatch(0) will return TMycLatch.Null - [TestCase('InitialNegative', '-1,True')] // TMycLatch.CreateLatch(-1) will return TMycLatch.Null + [TestCase('InitialZero_ReturnsNullLatch', '0,True')] + [TestCase('InitialNegative_ReturnsNullLatch', '-1,True')] [TestCase('InitialLargePositive', '5,False')] procedure TestCreate_InitialState(InitialCount: Integer; ExpectedIsSet: Boolean); - [TestCase('DecrementPositiveToZero', '1,False,True')] + [TestCase('DecrementPositiveToZero', '1,False,True')] // InitialCount, ExpectedReturnFromLatchNotify, ExpectedIsSetAfterNotify [TestCase('DecrementPositiveToPositive', '2,True,False')] - [TestCase('DecrementZeroToNegative', '0,False,True')] - [TestCase('DecrementNegativeToNegative', '-1,False,True')] + [TestCase('DecrementZeroToNegative', '0,False,True')] // Latch.Notify on count 0 returns false (0 > 0 is false) + [TestCase('DecrementNegativeToNegative', '-1,False,True')] // Latch.Notify on count -1 returns false (-1 > 0 is false) procedure TestNotify_ReturnValueAndState_AfterOneNotify(InitialCount: Integer; ExpectedReturn: Boolean; ExpectedIsSet: Boolean); [Test] @@ -54,11 +54,11 @@ type [Test] procedure TestSubscriber_NotNotified_BeforeLatchSet; [Test] - procedure TestSubscriber_NotifiedOnlyOnce_AfterLatchSet; + procedure TestSubscriber_NotifiedOnlyOnce_AfterLatchSetAndUnadvised; // Clarified name [Test] procedure TestSubscribe_ToAlreadySetLatch_NotifiesImmediately; - // --- Category 3: Chaining and Cascading --- + // --- Category 3: Chaining and Cascading Latches --- [Test] procedure TestChaining_A_Notifies_B; [Test] @@ -68,25 +68,33 @@ type // --- Category 4: Special Cases --- [Test] - procedure TestInitiallySetLatch_NotifiesNewSubscriberImmediately; + procedure TestInitiallySetLatch_NotifiesNewSubscriberImmediately; // Using CreateLatch(0) [Test] procedure TestUnsubscribe_SubscriberNotNotified; - // --- Category 5: Signal Loss / Counter Integrity --- + // --- Category 5: Counter Integrity / State for Later Subscribers --- [Test] procedure TestMultipleTriggersNoSubscriber_StateCorrectForLaterSubscriber; + + // --- Category 6: UnadviseAll Behavior on Latch Set --- + [Test] + procedure TestLatchSet_ClearsSubscribers_NoFurtherNotification; + [Test] + procedure TestLatchSet_SubscriptionFinalize_IsSafePostUnadviseAll; + [Test] + procedure TestLatchSet_NewSubscriberToSetLatch_NotifiedImmediatelyButNotPersistedForLatchNotify; end; implementation { TMockSubscriber } -constructor TMockSubscriber.Create(ShouldReturn: Boolean = True); +constructor TMockSubscriber.Create(AShouldReturn: Boolean = True); begin inherited Create; NotifyCount := 0; - NotifyShouldReturn := ShouldReturn; + NotifyShouldReturn := AShouldReturn; WasCalled := False; end; @@ -94,7 +102,7 @@ function TMockSubscriber.Notify: Boolean; begin Inc(NotifyCount); WasCalled := True; - Result := NotifyShouldReturn; + Result := NotifyShouldReturn; // This mock subscriber returns what it's configured to. end; { TTestMycLatch } @@ -109,61 +117,66 @@ begin // Per-test teardown code can go here (if any). end; +// --- Category 1: Basic Counter and State Functionality (Parameterized) --- + procedure TTestMycLatch.TestCreate_InitialState(InitialCount: Integer; ExpectedIsSet: Boolean); var latch: IMycLatch; begin - latch := TMycLatch.CreateLatch(InitialCount); // Changed to use TMycLatch.CreateLatch - Assert.AreEqual(ExpectedIsSet, latch.State.IsSet, 'Latch initial IsSet state mismatch.'); + // TMycLatch.CreateLatch returns TMycLatch.Null if InitialCount <= 0 + latch := TMycLatch.CreateLatch(InitialCount); + 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); var latch: IMycLatch; - returnedValue: Boolean; + returnedValueFromNotify: Boolean; begin - latch := TMycLatch.CreateLatch(InitialCount); // Changed to use TMycLatch.CreateLatch - returnedValue := latch.Notify; + latch := TMycLatch.CreateLatch(InitialCount); + returnedValueFromNotify := latch.Notify; // This is IMycLatch (as IMycSubscriber).Notify - Assert.AreEqual(ExpectedReturn, returnedValue, 'Unexpected return value from Latch.Notify call.'); - Assert.AreEqual(ExpectedIsSet, latch.State.IsSet, 'Unexpected IsSet state after Latch.Notify call.'); + 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; var latch: IMycLatch; begin - latch := TMycLatch.CreateLatch(1); // Changed to use TMycLatch.CreateLatch - Assert.IsFalse(latch.State.IsSet, 'Latch should initially not be set.'); - latch.Notify; - Assert.IsTrue(latch.State.IsSet, 'Latch should be set after Notify.'); + latch := TMycLatch.CreateLatch(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).'); end; procedure TTestMycLatch.TestNotify_MultipleNotifies_CounterBecomesNegativeAndStaysSet; var latch: IMycLatch; begin - latch := TMycLatch.CreateLatch(1); // Changed to use TMycLatch.CreateLatch - latch.Notify; + latch := TMycLatch.CreateLatch(1); + latch.Notify; // Count becomes 0, IsSet = True Assert.IsTrue(latch.State.IsSet, 'Latch should be set after first Notify.'); - latch.Notify; + latch.Notify; // Count becomes -1, IsSet should remain True Assert.IsTrue(latch.State.IsSet, 'Latch should remain set after second Notify.'); end; +// --- Category 2: Notification to Subscribers --- + procedure TTestMycLatch.TestSubscriber_Single_IsNotifiedWhenLatchSet; var latch: IMycLatch; mockSub: TMockSubscriber; subscription: TMycSubscription; begin - latch := TMycLatch.CreateLatch(1); // Changed to use TMycLatch.CreateLatch + latch := TMycLatch.CreateLatch(1); mockSub := TMockSubscriber.Create; - subscription := latch.State.Subscribe(mockSub); + subscription := latch.State.Subscribe(mockSub); // Subscribing to the Latch's state Assert.IsFalse(latch.State.IsSet, 'Latch should initially not be set.'); Assert.AreEqual(0, mockSub.NotifyCount, 'MockSub should not have been notified yet (before latch set).'); - latch.Notify; + latch.Notify; // Latch becomes set, notifies subscribers Assert.IsTrue(latch.State.IsSet, 'Latch should be set after its Notify is called.'); Assert.AreEqual(1, mockSub.NotifyCount, 'MockSub should have been notified once when latch becomes set.'); @@ -173,9 +186,9 @@ procedure TTestMycLatch.TestSubscriber_Multiple_AreNotifiedWhenLatchSet; var latch: IMycLatch; mockSub1, mockSub2, mockSub3: TMockSubscriber; - sub1, sub2, sub3: TMycSubscription; + sub1, sub2, sub3: TMycSubscription; // Keep subscriptions in scope begin - latch := TMycLatch.CreateLatch(1); // Changed to use TMycLatch.CreateLatch + latch := TMycLatch.CreateLatch(1); mockSub1 := TMockSubscriber.Create; mockSub2 := TMockSubscriber.Create; mockSub3 := TMockSubscriber.Create; @@ -184,7 +197,7 @@ begin sub2 := latch.State.Subscribe(mockSub2); sub3 := latch.State.Subscribe(mockSub3); - latch.Notify; + latch.Notify; // Latch becomes set Assert.AreEqual(1, mockSub1.NotifyCount, 'MockSub1 notification count mismatch.'); Assert.AreEqual(1, mockSub2.NotifyCount, 'MockSub2 notification count mismatch.'); @@ -197,29 +210,29 @@ var mockSub: TMockSubscriber; subscription: TMycSubscription; begin - latch := TMycLatch.CreateLatch(2); // Changed to use TMycLatch.CreateLatch + latch := TMycLatch.CreateLatch(2); // Count = 2 mockSub := TMockSubscriber.Create; subscription := latch.State.Subscribe(mockSub); Assert.AreEqual(0, mockSub.NotifyCount, 'MockSub should not be notified upon subscription if latch is not set.'); - latch.Notify; - Assert.AreEqual(0, mockSub.NotifyCount, 'MockSub should still not be notified as latch is not yet set.'); + latch.Notify; // Count becomes 1, still not set + Assert.AreEqual(0, mockSub.NotifyCount, 'MockSub should still not be notified as latch is not yet set (Count=1).'); end; -procedure TTestMycLatch.TestSubscriber_NotifiedOnlyOnce_AfterLatchSet; +procedure TTestMycLatch.TestSubscriber_NotifiedOnlyOnce_AfterLatchSetAndUnadvised; var latch: IMycLatch; mockSub: TMockSubscriber; subscription: TMycSubscription; begin - latch := TMycLatch.CreateLatch(1); // Changed to use TMycLatch.CreateLatch + latch := TMycLatch.CreateLatch(1); mockSub := TMockSubscriber.Create; subscription := latch.State.Subscribe(mockSub); - latch.Notify; + latch.Notify; // Sets latch, notifies MockSub. Subscribers are then unadvised by UnadviseAll. Assert.AreEqual(1, mockSub.NotifyCount, 'MockSub notify count should be 1 after latch set.'); - latch.Notify; + latch.Notify; // Call Notify on latch again (FCount becomes more negative). Assert.AreEqual(1, mockSub.NotifyCount, 'MockSub notify count should remain 1 (not notified again as it was unadvised).'); end; @@ -229,42 +242,47 @@ var mockSub1, mockSub2: TMockSubscriber; subscription1, subscription2: TMycSubscription; begin - latch := TMycLatch.CreateLatch(1); // Changed to use TMycLatch.CreateLatch + latch := TMycLatch.CreateLatch(1); // Create with count 1 mockSub1 := TMockSubscriber.Create; - subscription1 := latch.State.Subscribe(mockSub1); - latch.Notify; + subscription1 := latch.State.Subscribe(mockSub1); // Subscribe before set + + latch.Notify; // Latch becomes set. mockSub1 is notified. Assert.IsTrue(latch.State.IsSet, 'Latch should be set after initial trigger.'); Assert.AreEqual(1, mockSub1.NotifyCount, 'MockSub1 should have been notified once.'); + // Attempt to subscribe mockSub2 after the latch is already set. mockSub2 := TMockSubscriber.Create; - subscription2 := latch.State.Subscribe(mockSub2); + subscription2 := latch.State.Subscribe(mockSub2); // TMycLatch.Subscribe (via TMycAbstractFlag) notifies immediately if already set. Assert.AreEqual(1, mockSub2.NotifyCount, 'MockSub2 should be notified immediately upon subscribing to an already set latch.'); - latch.Notify; - Assert.AreEqual(1, mockSub1.NotifyCount, 'MockSub1 notify count should remain 1.'); - Assert.AreEqual(1, mockSub2.NotifyCount, 'MockSub2 notify count should remain 1 after re-triggering.'); + latch.Notify; // Call Notify on latch again (FCount becomes more negative). + Assert.AreEqual(1, mockSub1.NotifyCount, 'MockSub1 notify count should remain 1 (was unadvised).'); + Assert.AreEqual(1, mockSub2.NotifyCount, 'MockSub2 notify count should remain 1 (was only notified on subscribe, not added to list).'); end; +// --- Category 3: Chaining and Cascading Latches --- + procedure TTestMycLatch.TestChaining_A_Notifies_B; var latchA, latchB: IMycLatch; mockSubForB: TMockSubscriber; subHandle_B_listens_A, subHandle_Mock_listens_B: TMycSubscription; begin - latchA := TMycLatch.CreateLatch(1); // Changed to use TMycLatch.CreateLatch - latchB := TMycLatch.CreateLatch(1); // Changed to use TMycLatch.CreateLatch + latchA := TMycLatch.CreateLatch(1); + latchB := TMycLatch.CreateLatch(1); // latchB is an IMycSubscriber mockSubForB := TMockSubscriber.Create; subHandle_Mock_listens_B := latchB.State.Subscribe(mockSubForB); + // LatchA's state is an IMycSignal. LatchB (as IMycSubscriber) subscribes to it. subHandle_B_listens_A := latchA.State.Subscribe(latchB); Assert.IsFalse(latchA.State.IsSet, 'LatchA initially not set.'); Assert.IsFalse(latchB.State.IsSet, 'LatchB initially not set.'); Assert.AreEqual(0, mockSubForB.NotifyCount, 'MockSubForB initially not notified.'); - latchA.Notify; + latchA.Notify; // Call Notify on LatchA (as IMycSubscriber) Assert.IsTrue(latchA.State.IsSet, 'LatchA should be set after notify.'); Assert.IsTrue(latchB.State.IsSet, 'LatchB should be set after being notified by LatchA.'); @@ -277,16 +295,16 @@ var mockSubForC: TMockSubscriber; sub_Mock_C, sub_C_B, sub_B_A: TMycSubscription; begin - latchA := TMycLatch.CreateLatch(1); // Changed to use TMycLatch.CreateLatch - latchB := TMycLatch.CreateLatch(1); // Changed to use TMycLatch.CreateLatch - latchC := TMycLatch.CreateLatch(1); // Changed to use TMycLatch.CreateLatch + latchA := TMycLatch.CreateLatch(1); + latchB := TMycLatch.CreateLatch(1); + latchC := TMycLatch.CreateLatch(1); mockSubForC := TMockSubscriber.Create; sub_Mock_C := latchC.State.Subscribe(mockSubForC); - sub_C_B := latchB.State.Subscribe(latchC); - sub_B_A := latchA.State.Subscribe(latchB); + sub_C_B := latchB.State.Subscribe(latchC); // LatchC subscribes to LatchB's state + sub_B_A := latchA.State.Subscribe(latchB); // LatchB subscribes to LatchA's state - latchA.Notify; + latchA.Notify; // Call Notify on LatchA Assert.IsTrue(latchA.State.IsSet, 'LatchA state mismatch in cascade.'); Assert.IsTrue(latchB.State.IsSet, 'LatchB state mismatch in cascade.'); @@ -300,37 +318,42 @@ var mockSubForB: TMockSubscriber; sub_Mock_B, sub_B_A: TMycSubscription; begin - latchA := TMycLatch.CreateLatch(2); // Changed to use TMycLatch.CreateLatch - latchB := TMycLatch.CreateLatch(1); // Changed to use TMycLatch.CreateLatch + // 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 := TMycLatch.CreateLatch(2); + latchB := TMycLatch.CreateLatch(1); mockSubForB := TMockSubscriber.Create; sub_Mock_B := latchB.State.Subscribe(mockSubForB); sub_B_A := latchA.State.Subscribe(latchB); - latchA.Notify; + latchA.Notify; // First notify for LatchA (count becomes 1) Assert.IsFalse(latchA.State.IsSet, 'LatchA should not be set after first notify of two.'); Assert.IsFalse(latchB.State.IsSet, 'LatchB should not have been triggered yet by LatchA.'); Assert.AreEqual(0, mockSubForB.NotifyCount, 'MockSubForB should not have been notified yet.'); - latchA.Notify; + latchA.Notify; // Second notify for LatchA (count becomes 0, LatchA becomes set) Assert.IsTrue(latchA.State.IsSet, 'LatchA should be set after second notify.'); + // When LatchA becomes set, it notifies its subscribers (LatchB). LatchB.Notify is called. Assert.IsTrue(latchB.State.IsSet, 'LatchB should now be set by LatchA.'); Assert.AreEqual(1, mockSubForB.NotifyCount, 'MockSubForB should have been notified by LatchB.'); end; +// --- Category 4: Special Cases --- + procedure TTestMycLatch.TestInitiallySetLatch_NotifiesNewSubscriberImmediately; var - latch: IMycLatch; + latch: IMycLatch; // Will be TMycLatch.Null mockSub: TMockSubscriber; subscription: TMycSubscription; begin - latch := TMycLatch.CreateLatch(0); // Changed to use TMycLatch.CreateLatch. Will return TMycLatch.Null. + latch := TMycLatch.CreateLatch(0); // Returns TMycLatch.Null which is set. mockSub := TMockSubscriber.Create; - subscription := latch.State.Subscribe(mockSub); + subscription := latch.State.Subscribe(mockSub); // TMycLatch.Subscribe notifies immediately if already set. - Assert.IsTrue(latch.State.IsSet, 'Latch IsSet property mismatch after creation with count 0.'); - Assert.AreEqual(1, mockSub.NotifyCount, 'MockSub should be notified immediately upon subscribing to an already set latch.'); + Assert.IsTrue(latch.State.IsSet, 'Latch IsSet property mismatch (should be true for Null latch).'); + Assert.AreEqual(1, mockSub.NotifyCount, 'MockSub should be notified immediately upon subscribing to an initially set latch.'); end; procedure TTestMycLatch.TestUnsubscribe_SubscriberNotNotified; @@ -339,38 +362,139 @@ var mockSub: TMockSubscriber; subscription: TMycSubscription; begin - latch := TMycLatch.CreateLatch(1); // Changed to use TMycLatch.CreateLatch + latch := TMycLatch.CreateLatch(1); mockSub := TMockSubscriber.Create; subscription := latch.State.Subscribe(mockSub); - subscription := Default(TMycSubscription); // Simulates leaving scope / destruction, calls Finalize for unsubscription. + subscription.Unsubscribe; // Explicitly call Unsubscribe on the record - latch.Notify; + latch.Notify; // Latch becomes set Assert.AreEqual(0, mockSub.NotifyCount, 'Unsubscribed MockSub should not be notified.'); end; +// --- Category 5: Counter Integrity / State for Later Subscribers --- + procedure TTestMycLatch.TestMultipleTriggersNoSubscriber_StateCorrectForLaterSubscriber; var latch: IMycLatch; mockSub: TMockSubscriber; subscription: TMycSubscription; begin - latch := TMycLatch.CreateLatch(3); // Changed to use TMycLatch.CreateLatch + latch := TMycLatch.CreateLatch(3); - latch.Notify; - latch.Notify; + latch.Notify; // Count -> 2 + latch.Notify; // Count -> 1 Assert.IsFalse(latch.State.IsSet, 'Latch should not be set yet after partial notifies.'); mockSub := TMockSubscriber.Create; subscription := latch.State.Subscribe(mockSub); Assert.AreEqual(0, mockSub.NotifyCount, 'MockSub should not be notified on subscribe if latch not yet set.'); - latch.Notify; + latch.Notify; // Count -> 0, Latch becomes set and notifies mockSub Assert.IsTrue(latch.State.IsSet, 'Latch should now be set.'); Assert.AreEqual(1, mockSub.NotifyCount, 'MockSub should have been notified when latch becomes set.'); end; +// --- Category 6: UnadviseAll Behavior on Latch Set --- + +procedure TTestMycLatch.TestLatchSet_ClearsSubscribers_NoFurtherNotification; +var + latch: IMycLatch; + mockSub1, mockSub2: TMockSubscriber; + subscription1, subscription2: TMycSubscription; +begin + latch := TMycLatch.CreateLatch(1); + mockSub1 := TMockSubscriber.Create; + mockSub2 := TMockSubscriber.Create; + + subscription1 := latch.State.Subscribe(mockSub1); + subscription2 := latch.State.Subscribe(mockSub2); + + Assert.AreEqual(0, mockSub1.NotifyCount, 'MockSub1 initial NotifyCount should be 0.'); + Assert.AreEqual(0, mockSub2.NotifyCount, 'MockSub2 initial NotifyCount should be 0.'); + + latch.Notify; // FCount becomes 0. Subscribers notified, then UnadviseAll called. + + Assert.IsTrue(latch.State.IsSet, 'Latch should be set.'); + Assert.AreEqual(1, mockSub1.NotifyCount, 'MockSub1 should have been notified once when latch became set.'); + Assert.AreEqual(1, mockSub2.NotifyCount, 'MockSub2 should have been notified once when latch became set.'); + + latch.Notify; // Call Notify on the latch again (FCount becomes -1) + + Assert.AreEqual(1, mockSub1.NotifyCount, 'MockSub1 should NOT be notified again after UnadviseAll.'); + Assert.AreEqual(1, mockSub2.NotifyCount, 'MockSub2 should NOT be notified again after UnadviseAll.'); +end; + +procedure TTestMycLatch.TestLatchSet_SubscriptionFinalize_IsSafePostUnadviseAll; +var + latch: IMycLatch; + mockSub: TMockSubscriber; + // 'subscription' will be declared in an inner scope to control its finalization +begin + latch := TMycLatch.CreateLatch(1); + mockSub := TMockSubscriber.Create; + + var noException: Boolean := True; + try + begin // Inner block to control lifetime of 'subscription' + var subscription: TMycSubscription; // Local to this block + subscription := latch.State.Subscribe(mockSub); + + latch.Notify; // Sets the latch, mockSub is notified, UnadviseAll is called internally. + Assert.AreEqual(1, mockSub.NotifyCount, 'MockSub was notified when latch set.'); + + // When 'subscription' goes out of scope at the end of this 'begin..end' block, + // its Finalize operator will be called, which in turn calls subscription.Unsubscribe. + // This happens *after* UnadviseAll was triggered by latch.Notify. + end; // <-- subscription.Finalize (and thus Unsubscribe) is called here. + except + on E: Exception do + begin + noException := False; + // Optional: Log.Error('Exception in TestLatchSet_SubscriptionFinalize_IsSafePostUnadviseAll: ' + E.Message); + end; + end; + Assert.IsTrue(noException, 'Finalizing subscription after Latch set (and UnadviseAll) should not raise an exception.'); + + // Further check: calling Notify on latch again should not affect the original mockSub + latch.Notify; + Assert.AreEqual(1, mockSub.NotifyCount, 'MockSub should not be notified after its subscription was finalized post UnadviseAll.'); +end; + +procedure TTestMycLatch.TestLatchSet_NewSubscriberToSetLatch_NotifiedImmediatelyButNotPersistedForLatchNotify; +var + latch: IMycLatch; + mockSubInitial, mockSubNew: TMockSubscriber; + subscriptionInitial, subscriptionNew: TMycSubscription; +begin + latch := TMycLatch.CreateLatch(1); + mockSubInitial := TMockSubscriber.Create; + subscriptionInitial := latch.State.Subscribe(mockSubInitial); + + // Set the latch; mockSubInitial is notified, UnadviseAll is called. + latch.Notify; + Assert.AreEqual(1, mockSubInitial.NotifyCount, 'Initial subscriber notified.'); + + // Subscribe a new subscriber to the already set latch + mockSubNew := TMockSubscriber.Create; + subscriptionNew := latch.State.Subscribe(mockSubNew); + + // New subscriber should be notified immediately upon subscription to an already set latch + Assert.AreEqual(1, mockSubNew.NotifyCount, 'New subscriber should be notified immediately upon subscription.'); + // The direct check of subscriptionNew.FTag was removed as FTag is private. + // The correct behavior (no persistent subscription) is verified by the next step. + + // Call Notify on the latch again. + latch.Notify; + + // mockSubInitial should not be notified again (was unadvised). + 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.'); +end; + initialization TDUnitX.RegisterTestFixture(TTestMycLatch); end. diff --git a/Test/TestStack.pas b/Test/TestStack.pas index e9eba90..1dec766 100644 --- a/Test/TestStack.pas +++ b/Test/TestStack.pas @@ -453,7 +453,6 @@ var stack: TMycAtomicStack; nilIntf: ITestInterface; // This is already nil by default nonNilIntf: ITestInterface; - popped: ITestInterface; begin nilIntf := nil; // Explicitly nil nonNilIntf := TTestImplementingObject.Create(999); diff --git a/Test/TestTasks.pas b/Test/TestTasks.pas index 39de34f..cdc6435 100644 --- a/Test/TestTasks.pas +++ b/Test/TestTasks.pas @@ -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