diff --git a/.github/ISSUE_TEMPLATE/bug_report.md b/.github/ISSUE_TEMPLATE/bug_report.md index c54074d..0641bc3 100644 --- a/.github/ISSUE_TEMPLATE/bug_report.md +++ b/.github/ISSUE_TEMPLATE/bug_report.md @@ -1,20 +1,20 @@ ---- -name: Bug report -about: Create a report to help us improve -title: '' -labels: bug, invalid -assignees: '' - ---- - -Thanks for taking the time to fill out a bug report! Please make sure to be as specific as possible in your description and title. - -**Issue description** -Describe your issue briefly. What doesn't work, and how do you expect it to work instead? - -**Steps to reproduce** -Provide steps that can be used to reproduce the issue. Issues that are not reproducible are -unlikely to be resolved. If you include a minimal Delphi project below, you can detail what to look for here. - -**Minimal Delphi code exhibiting the issue** -Please attach a ZIP file of a minimal Delphi project that exhibits the issue. +--- +name: Bug report +about: Create a report to help us improve +title: '' +labels: bug, invalid +assignees: '' + +--- + +Thanks for taking the time to fill out a bug report! Please make sure to be as specific as possible in your description and title. + +**Issue description** +Describe your issue briefly. What doesn't work, and how do you expect it to work instead? + +**Steps to reproduce** +Provide steps that can be used to reproduce the issue. Issues that are not reproducible are +unlikely to be resolved. If you include a minimal Delphi project below, you can detail what to look for here. + +**Minimal Delphi code exhibiting the issue** +Please attach a ZIP file of a minimal Delphi project that exhibits the issue. diff --git a/.github/ISSUE_TEMPLATE/feature_request.md b/.github/ISSUE_TEMPLATE/feature_request.md index b2fc5ee..d0eaa73 100644 --- a/.github/ISSUE_TEMPLATE/feature_request.md +++ b/.github/ISSUE_TEMPLATE/feature_request.md @@ -1,16 +1,16 @@ ---- -name: Feature request -about: Submit a new feature request to help us improve -title: '' -labels: enhancement -assignees: '' - ---- - -Thanks for your interest in this library! Please make sure to be as specific as possible in your description and title. - -**Request description** -Describe your request briefly. What is missing, how would you solve it, and how do you expect it to work? - -**Small code snippet** -Please provide a small piece of pseudocode to demonstrate the usage. +--- +name: Feature request +about: Submit a new feature request to help us improve +title: '' +labels: enhancement +assignees: '' + +--- + +Thanks for your interest in this library! Please make sure to be as specific as possible in your description and title. + +**Request description** +Describe your request briefly. What is missing, how would you solve it, and how do you expect it to work? + +**Small code snippet** +Please provide a small piece of pseudocode to demonstrate the usage. diff --git a/Core/Types/Next.Core.DisposableValue.pas b/Core/Types/Next.Core.DisposableValue.pas index 6b2ebf9..661a6ac 100644 --- a/Core/Types/Next.Core.DisposableValue.pas +++ b/Core/Types/Next.Core.DisposableValue.pas @@ -156,14 +156,18 @@ procedure TDisposableValue.TryDispose(const AOther: T2); procedure TDisposableValue.TryDisposeArray(const AOther: T2); type PObject = ^TObject; +var + i: Integer; + LValue, LArrayElement: TValue; + LObject: TObject; begin - var LValue := TValue.From(FValue); + LValue := TValue.From(FValue); - for var i := 0 to LValue.GetArrayLength - 1 do begin - var LArrayElement := LValue.GetArrayElement(i); + for i := 0 to LValue.GetArrayLength - 1 do begin + LArrayElement := LValue.GetArrayElement(i); if LArrayElement.Kind = tkClass then begin - var LObject := LArrayElement.AsObject; + LObject := LArrayElement.AsObject; case GetTypeKind(T2) of @@ -186,10 +190,13 @@ procedure TDisposableValue.TryDisposeObject(const AOther: T2); type PObject = ^TObject; PIntf = ^IInterface; +var + LIntf: IInterface; + LObj: TObject; begin if (GetTypeKind(T2) = tkInterface) then begin - var LIntf := (PIntf(@AOther)^ as IInterface); - var LObj := LIntf as TObject; + LIntf := (PIntf(@AOther)^ as IInterface); + LObj := LIntf as TObject; if (PObject(@FValue)^ <> PObject(@LObj)^) then DisposeP(FValue) else @@ -199,13 +206,16 @@ procedure TDisposableValue.TryDisposeObject(const AOther: T2); end; function TDisposableValue.ObjectInArray(const AObject: TObject; const AArray: T2): Boolean; +var + LArray, LArrayElement: TValue; + j: Integer; begin Result := False; - var LArray := TValue.From(AArray); - for var j := 0 to LArray.GetArrayLength - 1 do begin + LArray := TValue.From(AArray); + for j := 0 to LArray.GetArrayLength - 1 do begin - var LArrayElement := LArray.GetArrayElement(j); + LArrayElement := LArray.GetArrayElement(j); if (LArrayElement.Kind = tkClass) then if LArray.GetArrayElement(j).AsObject = AObject then diff --git a/Core/Types/Next.Core.Promises.Cancellation.pas b/Core/Types/Next.Core.Promises.Cancellation.pas new file mode 100644 index 0000000..bc58922 --- /dev/null +++ b/Core/Types/Next.Core.Promises.Cancellation.pas @@ -0,0 +1,86 @@ +unit Next.Core.Promises.Cancellation; + +interface + +uses + System.SysUtils, System.SyncObjs, + Next.Core.Promises.Exceptions; + +type + /// + /// A read-only token that can be checked for cancellation. + /// Passed into promise chains and long-running operations for cooperative cancellation. + /// + ICancellationToken = interface + ['{F7A3D8E1-2B4C-4D6F-9E1A-3C5B7D9F0A2E}'] + /// + /// Returns True if cancellation has been requested. + /// + function IsCancelled: Boolean; + /// + /// Raises EOperationCancelled if cancellation has been requested. + /// Call this periodically inside long-running operations for cooperative cancellation. + /// + procedure ThrowIfCancelled; + end; + + /// + /// A source that can trigger cancellation of an associated token. + /// Create a TCancellationTokenSource, pass its Token to promises, and call Cancel when needed. + /// + ICancellationTokenSource = interface + ['{A1B2C3D4-E5F6-7890-ABCD-EF1234567890}'] + /// + /// Returns the cancellation token associated with this source. + /// + function Token: ICancellationToken; + /// + /// Signals cancellation. All tokens derived from this source will report IsCancelled = True. + /// This operation is thread-safe and idempotent. + /// + procedure Cancel; + /// + /// Returns True if Cancel has been called. + /// + function IsCancelled: Boolean; + end; + + /// + /// Implementation of ICancellationTokenSource and ICancellationToken. + /// Uses TInterlocked for thread-safe cancellation signalling. + /// + TCancellationTokenSource = class(TInterfacedObject, ICancellationTokenSource, ICancellationToken) + private + FCancelled: Integer; // 0 = not cancelled, 1 = cancelled + function IsCancelled: Boolean; + procedure ThrowIfCancelled; + function Token: ICancellationToken; + procedure Cancel; + end; + +implementation + +{ TCancellationTokenSource } + +procedure TCancellationTokenSource.Cancel; +begin + TInterlocked.CompareExchange(FCancelled, 1, 0); +end; + +function TCancellationTokenSource.IsCancelled: Boolean; +begin + Result := TInterlocked.CompareExchange(FCancelled, 0, 0) = 1; +end; + +procedure TCancellationTokenSource.ThrowIfCancelled; +begin + if IsCancelled then + raise EOperationCancelled.Create; +end; + +function TCancellationTokenSource.Token: ICancellationToken; +begin + Result := Self; +end; + +end. diff --git a/Core/Types/Next.Core.Promises.Exceptions.pas b/Core/Types/Next.Core.Promises.Exceptions.pas new file mode 100644 index 0000000..90618e3 --- /dev/null +++ b/Core/Types/Next.Core.Promises.Exceptions.pas @@ -0,0 +1,104 @@ +unit Next.Core.Promises.Exceptions; + +interface + +uses + System.SysUtils, System.Generics.Collections; + +type + /// + /// Exception raised when an operation exceeds the specified timeout duration. + /// Used by IPromise<T>.Timeout to signal that a promise did not settle in time. + /// + ETimeoutException = class(Exception) + public + constructor Create; overload; + constructor Create(const AMessage: string); overload; + end; + + /// + /// Exception raised when a cancelled operation is detected. + /// Used by the cancellation token system to signal cooperative cancellation. + /// + EOperationCancelled = class(Exception) + public + constructor Create; overload; + constructor Create(const AMessage: string); overload; + end; + + /// + /// Exception that aggregates multiple exceptions into a single exception object. + /// Used by Promise.Any when all promises reject — contains all individual rejection exceptions. + /// The EAggregateException owns the exception objects it holds and frees them on destruction. + /// + EAggregateException = class(Exception) + private + FExceptions: TArray; + public + constructor Create(const AExceptions: TArray); + destructor Destroy; override; + /// + /// The array of inner exceptions. The EAggregateException owns these objects. + /// + property Exceptions: TArray read FExceptions; + end; + +implementation + +{ ETimeoutException } + +constructor ETimeoutException.Create; +begin + inherited Create('Promise timed out'); +end; + +constructor ETimeoutException.Create(const AMessage: string); +begin + inherited Create(AMessage); +end; + +{ EOperationCancelled } + +constructor EOperationCancelled.Create; +begin + inherited Create('Operation was cancelled'); +end; + +constructor EOperationCancelled.Create(const AMessage: string); +begin + inherited Create(AMessage); +end; + +{ EAggregateException } + +constructor EAggregateException.Create(const AExceptions: TArray); +var + LMsg: string; + i: Integer; +begin + LMsg := 'All promises were rejected ('; + for i := Low(AExceptions) to High(AExceptions) do + begin + if i > Low(AExceptions) then + LMsg := LMsg + ', '; + if Assigned(AExceptions[i]) then + LMsg := LMsg + AExceptions[i].Message + else + LMsg := LMsg + ''; + end; + LMsg := LMsg + ')'; + + inherited Create(LMsg); + FExceptions := AExceptions; +end; + +destructor EAggregateException.Destroy; +var + i: Integer; +begin + for i := Low(FExceptions) to High(FExceptions) do + FreeAndNil(FExceptions[i]); + inherited; +end; + +end. diff --git a/Core/Types/Next.Core.Promises.pas b/Core/Types/Next.Core.Promises.pas index 1dcdfd9..b6dc702 100644 --- a/Core/Types/Next.Core.Promises.pas +++ b/Core/Types/Next.Core.Promises.pas @@ -5,7 +5,7 @@ interface uses System.Generics.Collections, System.SysUtils, System.SyncObjs, System.Rtti, System.Threading, Next.Core.FailureReason, Next.Core.DisposableValue, - System.Classes; + System.Classes, Next.Core.Promises.Exceptions, Next.Core.Promises.Cancellation; type ENotFullfilledAfterAwait = class(Exception); @@ -15,6 +15,25 @@ EInternalWaitProblem = class(Exception); TPromiseState = (psPending, psFullfilled, psRejected); TDisposeValue = (dvFree, dvKeep, dvAssign); + /// + /// Status used in TPromiseSettledResult to indicate whether a promise resolved or rejected. + /// + {$SCOPEDENUMS ON} + TPromiseStatus = (psResolved, psRejected); + {$SCOPEDENUMS OFF} + + /// + /// Result record for Promise.AllSettled. Contains the status and either the resolved value or rejection error. + /// + TPromiseSettledResult = record + /// The settlement status: psResolved or psRejected. + Status: TPromiseStatus; + /// The resolved value. Only valid when Status = psResolved. + Value: T; + /// The rejection exception. Only valid when Status = psRejected. NOT owned by this record. + Error: Exception; + end; + TConstFunc = reference to function (const Arg1: T): TResult; TConstProc = reference to procedure (const Arg1: T); @@ -101,6 +120,27 @@ TPromiseMain = record function &Finally(AProc: TProc): IPromise; + /// + /// Attaches a cancellation token to this promise. When the token is cancelled, + /// subsequent chain steps will be skipped and the promise rejects with EOperationCancelled. + /// + function CancelToken(const AToken: ICancellationToken): IPromise; + /// + /// Returns True if the promise has been cancelled via a cancellation token. + /// + function IsCancelled: Boolean; + /// + /// Registers a handler that fires only when the promise is cancelled (rejected with EOperationCancelled). + /// Syntactic sugar for a Catch that filters for EOperationCancelled. + /// + function OnCancelled(AProc: TProc): IPromise; + + /// + /// Returns a new promise that rejects with ETimeoutException if this promise + /// does not settle within the specified time in milliseconds. + /// + function Timeout(AMilliseconds: Cardinal; const AMessage: string = 'Promise timed out'): IPromise; + function Await: T; end; {$ENDREGION} @@ -112,6 +152,7 @@ TAbstractPromise = class(TInterfacedObject, IPromise, IPromiseAccess) FValue: TDisposableValue; FFailure: IFailureReason; FSignal: TEvent; + FToken: ICancellationToken; {$IFDEF DEBUG} FPromiseNo: Integer; FPreviousPromiseNo: Integer; @@ -157,6 +198,12 @@ TAbstractPromise = class(TInterfacedObject, IPromise, IPromiseAccess) function &Finally(AProc: TProc): IPromise; + function CancelToken(const AToken: ICancellationToken): IPromise; + function IsCancelled: Boolean; + function OnCancelled(AProc: TProc): IPromise; + + function Timeout(AMilliseconds: Cardinal; const AMessage: string = 'Promise timed out'): IPromise; + function Await: T; property State: TPromiseState read GetState; @@ -308,6 +355,24 @@ Promise = class class function All(const AArray: TArray>): IPromise>; overload; class function Resolve(AFunc: TFunc): IPromise; overload; class function Reject(E: Exception): IPromise; + + /// + /// Returns a promise that resolves or rejects as soon as the first promise in the array settles. + /// The remaining promises continue executing but their results are ignored. + /// + class function Race(const APromises: TArray>): IPromise; + + /// + /// Returns a promise that resolves with the value of the first promise that resolves successfully. + /// If all promises reject, rejects with EAggregateException containing all individual exceptions. + /// + class function Any(const APromises: TArray>): IPromise; + + /// + /// Waits for all promises to settle (resolve or reject) and returns an array of results. + /// Never short-circuits on rejection. Results are in the same order as input promises. + /// + class function AllSettled(const APromises: TArray>): IPromise>>; end; procedure CreatePromiseSchedulerIf; @@ -380,16 +445,74 @@ function TAbstractPromise.&Finally(AProc: TProc): IPromise; .Catch(procedure(E: Exception) begin AProc(); end); end; -function TAbstractPromise.Await: T; +function TAbstractPromise.CancelToken(const AToken: ICancellationToken): IPromise; +begin + System.TMonitor.Enter(Self); + try + FToken := AToken; + finally + System.TMonitor.Exit(Self); + end; + + // Check immediately if already cancelled + if Assigned(AToken) and AToken.IsCancelled then + begin + // If still pending, reject with cancellation + if State = psPending then + begin + Reject(TFailureReason.Create(EOperationCancelled.Create)); + end; + end; + + Result := Self; +end; + +function TAbstractPromise.IsCancelled: Boolean; +begin + System.TMonitor.Enter(Self); + try + Result := Assigned(FToken) and FToken.IsCancelled; + finally + System.TMonitor.Exit(Self); + end; +end; + +function TAbstractPromise.OnCancelled(AProc: TProc): IPromise; +begin + Result := Self.Catch( + function(E: Exception): T + begin + if E is EOperationCancelled then + begin + AProc(); + raise E; + end + else + raise E; + end); +end; + +function TAbstractPromise.Timeout(AMilliseconds: Cardinal; const AMessage: string): IPromise; var - LException: Exception; + LTimeoutPromise: IPromise; +begin + LTimeoutPromise := Promise.Resolve( + function: T + begin + Sleep(AMilliseconds); + raise ETimeoutException.Create(AMessage); + end); + + Result := Promise.Race([IPromise(Self), LTimeoutPromise]); +end; + +function TAbstractPromise.Await: T; begin InternalWait; System.TMonitor.Enter(Self); try if State = psRejected then begin - LException := GetFailure.Reason; raise GetFailure.DetachExceptionObject; end else if State = psFullfilled then begin Result := FValue; @@ -406,6 +529,9 @@ function TAbstractPromise.Catch(AFunc: TFunc): IPromise; Result := TPromise.Create(function(const AIn: T): T begin Result := AIn end , AFunc, Self, TDisposeValue.dvFree); + // Propagate cancellation token + if Assigned(FToken) then + (Result as TAbstractPromise).FToken := FToken; _Scheduler.Schedule(Result); end; @@ -425,9 +551,13 @@ function TAbstractPromise.Catch(AFunc: TFunc>): IPromi Result := AFunc(E); end, Self); + if Assigned(FToken) then + (LFirst as TAbstractPromise).FToken := FToken; _Scheduler.Schedule(LFirst); Result := TPromiseInPromise.Create(LFirst, TDisposeValue.dvFree); + if Assigned(FToken) then + (Result as TAbstractPromise).FToken := FToken; _Scheduler.Schedule(Result); end; @@ -514,6 +644,7 @@ procedure TAbstractPromise.InternalWait(ATimeout: Cardinal); MT_SYNC_WAIT = 10; var LRunning: Cardinal; + LResult: TWaitResult; begin if State = psPending then begin if TThread.CurrentThread.ThreadID = MainThreadID then begin @@ -523,7 +654,7 @@ procedure TAbstractPromise.InternalWait(ATimeout: Cardinal); LRunning := LRunning + MT_SIGNAL_WAIT + MT_SYNC_WAIT; end; end else begin - var LResult := FSignal.WaitFor(ATimeout); + LResult := FSignal.WaitFor(ATimeout); if LResult <> TWaitResult.wrSignaled then raise EInternalWaitProblem.Create('Issue waiting for signal (not set before timeout?): ' + GetEnumName(TypeInfo(TWaitResult), Ord(LResult))); end; @@ -632,15 +763,23 @@ function TAbstractPromise.ThenBy(AFunc: TConstFunc>; ADispose: Result := AFunc(A); end, nil, Self); + // Propagate cancellation token to chained promises + if Assigned(FToken) then + (LFirst as TAbstractPromise).FToken := FToken; _Scheduler.Schedule(LFirst); Result := TPromiseInPromise.Create(LFirst, ADispose); + if Assigned(FToken) then + (Result as TAbstractPromise).FToken := FToken; _Scheduler.Schedule(Result); end; function TAbstractPromise.ThenBy(AFunc: TConstFunc; ADispose: TDisposeValue = TDisposeValue.dvFree): IPromise; begin Result := TPromise.Create(AFunc, nil, Self, ADispose); + // Propagate cancellation token to chained promises + if Assigned(FToken) then + (Result as TAbstractPromise).FToken := FToken; _Scheduler.Schedule(Result); end; @@ -775,6 +914,177 @@ class function Promise.Reject(E: Exception): IPromise; _Scheduler.Schedule(Result); end; +class function Promise.Race(const APromises: TArray>): IPromise; +var + LSettled: Integer; + LOuterPromise: IPromise; + i: Integer; +begin + if Length(APromises) = 0 then + begin + Result := Promise.Reject(EArgumentException.Create('Promise.Race requires at least one promise')); + Exit; + end; + + LSettled := 0; + + Result := Promise.New(procedure(AResolve: TProc; AReject: TProc) + begin + // Capture resolve/reject via closure through the outer promise variable + end); + + LOuterPromise := Result; + + for i := Low(APromises) to High(APromises) do + begin + APromises[i].ThenBy( + function(const AValue: T): T + begin + if TInterlocked.CompareExchange(LSettled, 1, 0) = 0 then + begin + // Winner: transfer value ownership to the outer promise + TFirstPromise(LOuterPromise).Resolve(AValue); + end + else + begin + // Loser: manually dispose value that won't be used + var LTemp: TDisposableValue := AValue; + LTemp.Dispose; + end; + // Don't hold the value in the internal chain to prevent double-free + Result := Default(T); + end, TDisposeValue.dvKeep) + .Catch( + procedure(E: Exception) + var + LClone: Exception; + begin + if TInterlocked.CompareExchange(LSettled, 1, 0) = 0 then + begin + // Clone the exception since E is owned by the original promise's IFailureReason + LClone := E.ClassType.Create as Exception; + LClone.Message := E.Message; + TFirstPromise(LOuterPromise).Reject(TFailureReason.Create(LClone)); + end; + end); + end; +end; + +class function Promise.Any(const APromises: TArray>): IPromise; +var + LResolved: Integer; + LRejectionCount: Integer; + LTotalCount: Integer; + LExceptions: TArray; + LLock: TCriticalSection; + LOuterPromise: IPromise; + i: Integer; +begin + if Length(APromises) = 0 then + begin + Result := Promise.Reject(EArgumentException.Create('Promise.Any requires at least one promise')); + Exit; + end; + + LResolved := 0; + LRejectionCount := 0; + LTotalCount := Length(APromises); + SetLength(LExceptions, LTotalCount); + LLock := TCriticalSection.Create; + + Result := Promise.New(procedure(AResolve: TProc; AReject: TProc) + begin + // Capture via closure + end); + + LOuterPromise := Result; + + for i := Low(APromises) to High(APromises) do + begin + APromises[i].ThenBy( + function(const AValue: T): T + begin + Result := AValue; + if TInterlocked.CompareExchange(LResolved, 1, 0) = 0 then + TFirstPromise(LOuterPromise).Resolve(AValue); + end) + .Catch( + procedure(E: Exception) + var + LCount: Integer; + LClone: Exception; + begin + // Clone the exception since it's owned by the promise's IFailureReason + LClone := E.ClassType.Create as Exception; + LClone.Message := E.Message; + + LLock.Enter; + try + LExceptions[LRejectionCount] := LClone; + Inc(LRejectionCount); + LCount := LRejectionCount; + finally + LLock.Leave; + end; + + if LCount = LTotalCount then + begin + if TInterlocked.CompareExchange(LResolved, 1, 0) = 0 then + begin + // All rejected - create aggregate exception + // Transfer ownership of cloned exceptions to EAggregateException + TFirstPromise(LOuterPromise).Reject( + TFailureReason.Create(EAggregateException.Create(LExceptions))); + end; + end; + end); + end; +end; + +class function Promise.AllSettled(const APromises: TArray>): IPromise>>; +var + LCount: Integer; +begin + LCount := Length(APromises); + + if LCount = 0 then + begin + Result := Promise.Resolve>>( + function: TArray> + begin + SetLength(Result, 0); + end); + Exit; + end; + + Result := TFirstPromise>>.Create( + function: TArray> + var + i: Integer; + LResult: TPromiseSettledResult; + begin + SetLength(Result, LCount); + for i := 0 to LCount - 1 do + begin + APromises[i].InternalWait; + if APromises[i].State = psFullfilled then + begin + LResult.Status := TPromiseStatus.psResolved; + LResult.Value := APromises[i].Await; + LResult.Error := nil; + end + else + begin + LResult.Status := TPromiseStatus.psRejected; + LResult.Value := Default(T); + LResult.Error := APromises[i].GetFailure.Reason; + end; + Result[i] := LResult; + end; + end); + _Scheduler.Schedule(Result); +end; + { TPromise } constructor TPromise.Create(AFunc: TConstFunc; @@ -797,6 +1107,15 @@ constructor TPromise.Create(AFunc: TConstFunc; procedure TPromise.Execute; begin + // Check cancellation token before executing this step in the chain + if Assigned(FToken) and FToken.IsCancelled then + begin + Reject(TFailureReason.Create(EOperationCancelled.Create)); + FCatchFunc := nil; + FFunc := nil; + Exit; + end; + if GetPreviousPromiseState = psRejected then begin if Assigned(FCatchFunc) then InternalExecute(function: TDisposableValue @@ -975,6 +1294,13 @@ procedure TPromiseScheduler.ControlPool; {$ENDIF} {$IFNDEF MSWINDOWS} LEvents: Array[0..1] of THandleObject; +{$ENDIF} + LCancel: Boolean; + i: Integer; + LThread: TPromiseThread; + LWaitResult: Integer; + LRevisionBefore, LRevisionAfter: Int64; +{$IFNDEF MSWINDOWS} const WAIT_OBJECT_0 = 0; {$ENDIF} @@ -987,24 +1313,24 @@ procedure TPromiseScheduler.ControlPool; LEvents[0] := FCancel; LEvents[1] := FSignalController; {$ENDIF} - var LCancel := False; + LCancel := False; - for var i := 0 to MIN_POOL_SIZE - 1 do + for i := 0 to MIN_POOL_SIZE - 1 do AddThread(); while (not LCancel) do begin {$IFDEF MSWINDOWS} - const LWaitResult = WaitForMultipleObjectsEx(2, @LEvents, False, INFINITE, False); + LWaitResult := WaitForMultipleObjectsEx(2, @LEvents, False, INFINITE, False); {$ENDIF} {$IFNDEF MSWINDOWS} - const LWaitResult = WaitForMultipleEvents(LEvents); + LWaitResult := WaitForMultipleEvents(LEvents); {$ENDIF} case LWaitResult of WAIT_OBJECT_0: LCancel := True; WAIT_OBJECT_0 + 1: begin FSignalController.ResetEvent; - const LRevisionBefore = TInterlocked.Read(FSignalControllerRevision); + LRevisionBefore := TInterlocked.Read(FSignalControllerRevision); if GrowPool() then begin //Take it easy, only grow/shrink every 100ms @@ -1012,14 +1338,14 @@ procedure TPromiseScheduler.ControlPool; LCancel := True; end; - const LRevisionAfter = TInterlocked.Read(FSignalControllerRevision); + LRevisionAfter := TInterlocked.Read(FSignalControllerRevision); if LRevisionBefore <> LRevisionAfter then SignalControllerIf(); end; end; end; - for var LThread in FThreads do begin + for LThread in FThreads do begin LThread.Cancel; LThread.WaitFor; LThread.Free; diff --git a/LICENSE b/LICENSE index 0c84986..a2bd376 100644 --- a/LICENSE +++ b/LICENSE @@ -1,21 +1,21 @@ -MIT License - -Copyright (c) 2024 Laurens van Run - -Permission is hereby granted, free of charge, to any person obtaining a copy -of this software and associated documentation files (the "Software"), to deal -in the Software without restriction, including without limitation the rights -to use, copy, modify, merge, publish, distribute, sublicense, and/or sell -copies of the Software, and to permit persons to whom the Software is -furnished to do so, subject to the following conditions: - -The above copyright notice and this permission notice shall be included in all -copies or substantial portions of the Software. - -THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR -IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, -FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE -AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER -LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, -OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE -SOFTWARE. +MIT License + +Copyright (c) 2024 Laurens van Run + +Permission is hereby granted, free of charge, to any person obtaining a copy +of this software and associated documentation files (the "Software"), to deal +in the Software without restriction, including without limitation the rights +to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in all +copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE +SOFTWARE. diff --git a/Test/DelphiMocks/.gitignore b/Test/DelphiMocks/.gitignore index 28d3ee9..fa738bf 100644 --- a/Test/DelphiMocks/.gitignore +++ b/Test/DelphiMocks/.gitignore @@ -1,49 +1,49 @@ -# Compiled source # -################### -*.dcu -*.obj -*.exe -*.mes -*.res - -# Backup files # -################### -*.~* - -# IDE Files # -################### -*.dproj.local -*.groupproj.local -*.identcache -*.dsk -*.tvsconfig -*.projdata - -# Output Folders # -################### -/Win32 -/Win64 -/Tests/Win32 -/Tests/Win64 -/Examples/Win32 -/Examples/Win64 - -Build/TestAndBuild.fb7lck -*.fbl7 -*.fbpInf -*.rc -*.drc -*.map -======= -__history/** -**.exe -**.dcu -*.local -*.identcache -*.xml -*.fb8lck -*.fbl8 -*.fbpbrk -Tests/Delphi.Mocks.Tests.res -Tests/Delphi.Mocks.Tests.res -*.rsm +# Compiled source # +################### +*.dcu +*.obj +*.exe +*.mes +*.res + +# Backup files # +################### +*.~* + +# IDE Files # +################### +*.dproj.local +*.groupproj.local +*.identcache +*.dsk +*.tvsconfig +*.projdata + +# Output Folders # +################### +/Win32 +/Win64 +/Tests/Win32 +/Tests/Win64 +/Examples/Win32 +/Examples/Win64 + +Build/TestAndBuild.fb7lck +*.fbl7 +*.fbpInf +*.rc +*.drc +*.map +======= +__history/** +**.exe +**.dcu +*.local +*.identcache +*.xml +*.fb8lck +*.fbl8 +*.fbpbrk +Tests/Delphi.Mocks.Tests.res +Tests/Delphi.Mocks.Tests.res +*.rsm diff --git a/Test/DelphiMocks/.gitmodules b/Test/DelphiMocks/.gitmodules index b194397..d4e81a7 100644 --- a/Test/DelphiMocks/.gitmodules +++ b/Test/DelphiMocks/.gitmodules @@ -1,3 +1,3 @@ -[submodule "DUnitXML"] - path = DUnitXML - url = ../DUnit-XML.git +[submodule "DUnitXML"] + path = DUnitXML + url = ../DUnit-XML.git diff --git a/Test/DelphiMocks/Build/TestAndBuild.fbp8 b/Test/DelphiMocks/Build/TestAndBuild.fbp8 index 29966da..13a5114 100644 --- a/Test/DelphiMocks/Build/TestAndBuild.fbp8 +++ b/Test/DelphiMocks/Build/TestAndBuild.fbp8 @@ -1,284 +1,284 @@ -project -begin - projectid = {3FDFAB70-D747-4DF3-AD2B-DCB6F10E1709} - target - begin - name = Default - targetid = {C5B223F5-6BA1-42F6-AF42-F12E5359C450} - rootaction - begin - action.comment - begin - actiontextcolor = 16711680 - description = "Delphi XE2 Build" - id = {D5112915-F21F-4942-84AC-9E8D9BE9C448} - end - action.delphi.build - begin - allowimplicitimport = true - alwaysuseconditionalsfromdof = true - autoincbuild = false - autoupdatefileversion = true - autoupdateproductversion = false - buildall = true - buildversion = 9 - codepage = 1252 - compileprojectresources = false - compileridl = true - configname = Debug - debugversionnumbers = false - delphiversion = DelphiXE7 - enabletimeout = false - eurekalogverboselogging = false - frameworktype = VCL - hintsaserror = false - iconfile = $(BDS)\\bin\\delphi_PROJECTICON.ico - id = {F74BFF74-A517-423C-B2BD-C7ABC8B344BC} - includecompiledate = false - includemanifest = false - includeverinfo = true - isdebug = false - isdll = false - isprerelease = false - isprivate = false - isspecial = false - keepcfg = false - linkproductversiontofileversion = true - locale = 3081 - majorversion = 12 - minorversion = 11 - platform = Win32 - platformsdktype = ProjectSDK - projectfile = %FBPROJECTDIR%\\..\\Examples\\Sample1.dpr - regenerateresource = true - releaseversion = 10 - resourcecompilertype = rcBorland - ridloutputsamefolder = true - startingdir = %FBPROJECTDIR%\\..\\Examples - timeoutlength = 1 - updatedoffile = false - updatepackagesource = false - updateversioninfokeys = false - useeurekalogcompiler = false - usefastdcccompiler = false - useprojectsettings = [usPackages,usCompiler,usLinker,usVersionInfo] - usepropertyset = false - useversionfromdof = false - verboseoutput = false - versioninfokeys = "CompanyName\=VincentX64" + - "FileDescription\=was" + - "FileVersion\=12.11.10.9" + - "InternalName\=here" + - "LegalCopyright\=blah" + - "LegalTrademarks\=blah2" + - "OriginalFilename\=blah3" + - "ProductName\=Sample1 of course" + - "ProductVersion\=1.0.0.0" + - "" - warningsaserror = false - workaroundd5bug = false - delphi.compileroptions - begin - alwaysuseconditionalsfromdof = true - alwaysusedelphilibrarypath = true - alwaysusedofsearchpath = true - assertions = true - assignableconst = false - booleval = false - compilerwarnings = "-w-DUPLICATE_CTOR_DTOR\=0" + - "" - conditionals = DEBUG - consoleapp = false - debuginfo = true - definitionsonly = true - emitruntimetypeinformation = false - exportallsymbols = false - extendedsyntax = true - externaltd32 = false - frameworktype = None - generatedocumentation = false - generatehpp = false - hugestrings = true - imagebase = 4194304 - includenamespaces = false - includeremotesymbols = true - includetd32 = true - inlining = inOn - iochecking = true - librarypath = "$(BDSLIB)\\$(Platform)\\release;$(BDSUSERDIR)\\Imports;$(BDS)\\Imports;$(BDSCOMMONDIR)\\Dcp;$(BDS)\\include;C:\\Program Files (x86)\\madCollection\\madBasic\\BDS9\\win32;C:\\Program Files (x86)\\madCollection\\madDisAsm\\BDS9\\win32;C:\\Program Files (x86)\\madCollection\\madExcept\\BDS9\\win32;C:\\Program Files (x86)\\madCollection\\madExcept\\..\\Plugins;C:\\Program Files (x86)\\madCollection\\madRemote\\BDS9\\win32;C:\\Program Files (x86)\\madCollection\\madKernel\\BDS9\\win32;C:\\Program Files (x86)\\madCollection\\madCodeHook\\BDS9\\win32;C:\\Program Files (x86)\\madCollection\\madSecurity\\BDS9\\win32;C:\\Program Files (x86)\\madCollection\\madShell\\BDS9\\win32;I:\\OpenSource\\GitHub\\DUnitX;I:\\OpenSource\\GitHub\\Delphi-Mocks;C:\\Program Files (x86)\\EurekaLab\\EurekaLog 7\\Lib\\Common\\;C:\\Program Files (x86)\\EurekaLab\\EurekaLog 7\\Lib\\Win32\\Release\\Delphi16\\;C:\\Program Files (x86)\\EurekaLab\\EurekaLog 7\\Source\\Extras" - linkeroutput = 0 - localsymbols = true - mapfile = 0 - maxstacksize = 1048576 - minstacksize = 16384 - namespaceprefixes = System;Xml;Data;Datasnap;Web;Soap;Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde; - openstrings = true - optimisation = false - outputdir = .\\ - overflowchecking = false - packages = bindcompfmx;dsnap;fmx;rtl;indysystem;indycore;dbrtl;bindcomp;inetdb;fmxase;inet;fmxobj;xmlrtl;inetdbxpress;indyprotocols;fmxdae;bindengine;soaprtl - rangechecking = false - recordfieldalign = fa8 - referenceinfo = true - safedivide = false - searchpath = ..\\Source - showhints = true - showwarnings = true - stackframes = true - stringchecks = true - typedpointers = false - unitaliases = WinTypes\=Windows;WinProcs\=Windows;DbiTypes\=BDE;DbiProcs\=BDE;DbiErrs\=BDE - unitoutputdir = .\\ - usedebugdcu = false - usepackages = false - varstringchecks = true - end - end - action.delphi.build - begin - allowimplicitimport = true - alwaysuseconditionalsfromdof = false - autoincbuild = false - autoupdatefileversion = true - autoupdateproductversion = false - buildall = true - buildversion = 0 - codepage = 1252 - compileprojectresources = false - compileridl = true - configname = Debug - debugversionnumbers = false - delphiversion = DelphiXE7 - enabletimeout = false - eurekalogverboselogging = false - frameworktype = VCL - hintsaserror = false - iconfile = $(BDS)\\bin\\delphi_PROJECTICON.ico - id = {732C4807-18FB-441D-B0A7-46CC4F09ED65} - includecompiledate = false - includemanifest = false - includeverinfo = true - isdebug = false - isdll = false - isprerelease = false - isprivate = false - isspecial = false - keepcfg = false - linkproductversiontofileversion = true - locale = 1033 - majorversion = 1 - minorversion = 0 - platform = Win32 - platformsdktype = ProjectSDK - projectfile = %FBPROJECTDIR%\\..\\Tests\\Delphi.Mocks.Tests.dpr - regenerateresource = true - releaseversion = 0 - resourcecompilertype = rcBorland - ridloutputsamefolder = true - startingdir = %FBPROJECTDIR%\\..\\Tests - timeoutlength = 1 - updatedoffile = false - updatepackagesource = false - updateversioninfokeys = false - useeurekalogcompiler = false - usefastdcccompiler = false - useprojectsettings = [usPackages,usCompiler,usLinker,usVersionInfo] - usepropertyset = false - useversionfromdof = false - verboseoutput = false - versioninfokeys = "CompanyName\=" + - "FileDescription\=" + - "FileVersion\=1.0.0.0" + - "InternalName\=" + - "LegalCopyright\=" + - "LegalTrademarks\=" + - "OriginalFilename\=" + - "ProductName\=" + - "ProductVersion\=1.0.0.0" + - "Comments\=" + - "" - warningsaserror = false - workaroundd5bug = false - delphi.compileroptions - begin - alwaysuseconditionalsfromdof = false - alwaysusedelphilibrarypath = false - alwaysusedofsearchpath = true - assertions = true - assignableconst = false - booleval = false - conditionals = XMLOUTPUT;ISCONSOLE;DEBUG - consoleapp = true - debuginfo = true - definitionsonly = true - emitruntimetypeinformation = false - exportallsymbols = false - extendedsyntax = true - externaltd32 = false - frameworktype = VCL - generatedocumentation = false - generatehpp = false - hugestrings = true - imagebase = 4194304 - includenamespaces = false - includeremotesymbols = false - includetd32 = true - inlining = inOn - iochecking = true - librarypath = "$(BDSLIB)\\$(Platform)\\release;$(BDSUSERDIR)\\Imports;$(BDS)\\Imports;$(BDSCOMMONDIR)\\Dcp;$(BDS)\\include;C:\\Program Files (x86)\\madCollection\\madBasic\\BDS9\\win32;C:\\Program Files (x86)\\madCollection\\madDisAsm\\BDS9\\win32;C:\\Program Files (x86)\\madCollection\\madExcept\\BDS9\\win32;C:\\Program Files (x86)\\madCollection\\madExcept\\..\\Plugins;C:\\Program Files (x86)\\madCollection\\madRemote\\BDS9\\win32;C:\\Program Files (x86)\\madCollection\\madKernel\\BDS9\\win32;C:\\Program Files (x86)\\madCollection\\madCodeHook\\BDS9\\win32;C:\\Program Files (x86)\\madCollection\\madSecurity\\BDS9\\win32;C:\\Program Files (x86)\\madCollection\\madShell\\BDS9\\win32;I:\\OpenSource\\GitHub\\DUnitX;I:\\OpenSource\\GitHub\\Delphi-Mocks;C:\\Program Files (x86)\\EurekaLab\\EurekaLog 7\\Lib\\Common\\;C:\\Program Files (x86)\\EurekaLab\\EurekaLog 7\\Lib\\Win32\\Release\\Delphi16\\;C:\\Program Files (x86)\\EurekaLab\\EurekaLog 7\\Source\\Extras" - linkeroutput = 0 - localsymbols = true - mapfile = 3 - maxstacksize = 1048576 - minstacksize = 16384 - namespaceprefixes = System;Xml;Data;Datasnap;Web;Soap;Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde; - openstrings = true - optimisation = false - outputdir = .\\ - overflowchecking = false - packages = bindcompfmx;dsnap;fmx;rtl;indysystem;indycore;dbrtl;bindcomp;inetdb;fmxase;inet;fmxobj;xmlrtl;inetdbxpress;indyprotocols;fmxdae;bindengine;soaprtl;bindcompvcl;vclie;vcltouch;websnap;vcldbx;vclsmp;vcl;inetdbbde;dsnapcon;vclx;svnui;webdsnap;svn;vclimg;fmi;bdertl;vclactnband;vcldb;vcldsnap - rangechecking = false - recordfieldalign = fa8 - referenceinfo = true - safedivide = false - searchpath = ..\\Source - showhints = true - showwarnings = true - stackframes = true - stringchecks = true - typedpointers = false - unitaliases = WinTypes\=Windows;WinProcs\=Windows;DbiTypes\=BDE;DbiProcs\=BDE;DbiErrs\=BDE - usedebugdcu = true - usepackages = false - varstringchecks = true - end - end - action.process.execute - begin - captureoutput = true - enabled = false - enablelivecapture = true - enablereturncodecheck = true - enabletimeout = false - expandimpersonationtoken = false - hidewindow = true - id = {0E0BE982-97C7-41ED-804F-5E799F460312} - impersonateusenetcredonly = false - impersonateuser = false - logoutput = true - logprocessparameters = true - processoraffinity = 0 - processpriority = tpNormal - programname = %FBPROJECTDIR%\\..\\Tests\\Delphi.Mocks.Tests.exe - redirectstderr = true - returncodecomparator = rcEqualTo - returncodetocheck = 0 - startindir = %FBPROJECTDIR%\\..\\Tests\\ - terminateontimeout = false - timeoutlength = 1 - useerrordialogmonitor = false - waitforcompletion = true - end - end - end +project +begin + projectid = {3FDFAB70-D747-4DF3-AD2B-DCB6F10E1709} + target + begin + name = Default + targetid = {C5B223F5-6BA1-42F6-AF42-F12E5359C450} + rootaction + begin + action.comment + begin + actiontextcolor = 16711680 + description = "Delphi XE2 Build" + id = {D5112915-F21F-4942-84AC-9E8D9BE9C448} + end + action.delphi.build + begin + allowimplicitimport = true + alwaysuseconditionalsfromdof = true + autoincbuild = false + autoupdatefileversion = true + autoupdateproductversion = false + buildall = true + buildversion = 9 + codepage = 1252 + compileprojectresources = false + compileridl = true + configname = Debug + debugversionnumbers = false + delphiversion = DelphiXE7 + enabletimeout = false + eurekalogverboselogging = false + frameworktype = VCL + hintsaserror = false + iconfile = $(BDS)\\bin\\delphi_PROJECTICON.ico + id = {F74BFF74-A517-423C-B2BD-C7ABC8B344BC} + includecompiledate = false + includemanifest = false + includeverinfo = true + isdebug = false + isdll = false + isprerelease = false + isprivate = false + isspecial = false + keepcfg = false + linkproductversiontofileversion = true + locale = 3081 + majorversion = 12 + minorversion = 11 + platform = Win32 + platformsdktype = ProjectSDK + projectfile = %FBPROJECTDIR%\\..\\Examples\\Sample1.dpr + regenerateresource = true + releaseversion = 10 + resourcecompilertype = rcBorland + ridloutputsamefolder = true + startingdir = %FBPROJECTDIR%\\..\\Examples + timeoutlength = 1 + updatedoffile = false + updatepackagesource = false + updateversioninfokeys = false + useeurekalogcompiler = false + usefastdcccompiler = false + useprojectsettings = [usPackages,usCompiler,usLinker,usVersionInfo] + usepropertyset = false + useversionfromdof = false + verboseoutput = false + versioninfokeys = "CompanyName\=VincentX64" + + "FileDescription\=was" + + "FileVersion\=12.11.10.9" + + "InternalName\=here" + + "LegalCopyright\=blah" + + "LegalTrademarks\=blah2" + + "OriginalFilename\=blah3" + + "ProductName\=Sample1 of course" + + "ProductVersion\=1.0.0.0" + + "" + warningsaserror = false + workaroundd5bug = false + delphi.compileroptions + begin + alwaysuseconditionalsfromdof = true + alwaysusedelphilibrarypath = true + alwaysusedofsearchpath = true + assertions = true + assignableconst = false + booleval = false + compilerwarnings = "-w-DUPLICATE_CTOR_DTOR\=0" + + "" + conditionals = DEBUG + consoleapp = false + debuginfo = true + definitionsonly = true + emitruntimetypeinformation = false + exportallsymbols = false + extendedsyntax = true + externaltd32 = false + frameworktype = None + generatedocumentation = false + generatehpp = false + hugestrings = true + imagebase = 4194304 + includenamespaces = false + includeremotesymbols = true + includetd32 = true + inlining = inOn + iochecking = true + librarypath = "$(BDSLIB)\\$(Platform)\\release;$(BDSUSERDIR)\\Imports;$(BDS)\\Imports;$(BDSCOMMONDIR)\\Dcp;$(BDS)\\include;C:\\Program Files (x86)\\madCollection\\madBasic\\BDS9\\win32;C:\\Program Files (x86)\\madCollection\\madDisAsm\\BDS9\\win32;C:\\Program Files (x86)\\madCollection\\madExcept\\BDS9\\win32;C:\\Program Files (x86)\\madCollection\\madExcept\\..\\Plugins;C:\\Program Files (x86)\\madCollection\\madRemote\\BDS9\\win32;C:\\Program Files (x86)\\madCollection\\madKernel\\BDS9\\win32;C:\\Program Files (x86)\\madCollection\\madCodeHook\\BDS9\\win32;C:\\Program Files (x86)\\madCollection\\madSecurity\\BDS9\\win32;C:\\Program Files (x86)\\madCollection\\madShell\\BDS9\\win32;I:\\OpenSource\\GitHub\\DUnitX;I:\\OpenSource\\GitHub\\Delphi-Mocks;C:\\Program Files (x86)\\EurekaLab\\EurekaLog 7\\Lib\\Common\\;C:\\Program Files (x86)\\EurekaLab\\EurekaLog 7\\Lib\\Win32\\Release\\Delphi16\\;C:\\Program Files (x86)\\EurekaLab\\EurekaLog 7\\Source\\Extras" + linkeroutput = 0 + localsymbols = true + mapfile = 0 + maxstacksize = 1048576 + minstacksize = 16384 + namespaceprefixes = System;Xml;Data;Datasnap;Web;Soap;Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde; + openstrings = true + optimisation = false + outputdir = .\\ + overflowchecking = false + packages = bindcompfmx;dsnap;fmx;rtl;indysystem;indycore;dbrtl;bindcomp;inetdb;fmxase;inet;fmxobj;xmlrtl;inetdbxpress;indyprotocols;fmxdae;bindengine;soaprtl + rangechecking = false + recordfieldalign = fa8 + referenceinfo = true + safedivide = false + searchpath = ..\\Source + showhints = true + showwarnings = true + stackframes = true + stringchecks = true + typedpointers = false + unitaliases = WinTypes\=Windows;WinProcs\=Windows;DbiTypes\=BDE;DbiProcs\=BDE;DbiErrs\=BDE + unitoutputdir = .\\ + usedebugdcu = false + usepackages = false + varstringchecks = true + end + end + action.delphi.build + begin + allowimplicitimport = true + alwaysuseconditionalsfromdof = false + autoincbuild = false + autoupdatefileversion = true + autoupdateproductversion = false + buildall = true + buildversion = 0 + codepage = 1252 + compileprojectresources = false + compileridl = true + configname = Debug + debugversionnumbers = false + delphiversion = DelphiXE7 + enabletimeout = false + eurekalogverboselogging = false + frameworktype = VCL + hintsaserror = false + iconfile = $(BDS)\\bin\\delphi_PROJECTICON.ico + id = {732C4807-18FB-441D-B0A7-46CC4F09ED65} + includecompiledate = false + includemanifest = false + includeverinfo = true + isdebug = false + isdll = false + isprerelease = false + isprivate = false + isspecial = false + keepcfg = false + linkproductversiontofileversion = true + locale = 1033 + majorversion = 1 + minorversion = 0 + platform = Win32 + platformsdktype = ProjectSDK + projectfile = %FBPROJECTDIR%\\..\\Tests\\Delphi.Mocks.Tests.dpr + regenerateresource = true + releaseversion = 0 + resourcecompilertype = rcBorland + ridloutputsamefolder = true + startingdir = %FBPROJECTDIR%\\..\\Tests + timeoutlength = 1 + updatedoffile = false + updatepackagesource = false + updateversioninfokeys = false + useeurekalogcompiler = false + usefastdcccompiler = false + useprojectsettings = [usPackages,usCompiler,usLinker,usVersionInfo] + usepropertyset = false + useversionfromdof = false + verboseoutput = false + versioninfokeys = "CompanyName\=" + + "FileDescription\=" + + "FileVersion\=1.0.0.0" + + "InternalName\=" + + "LegalCopyright\=" + + "LegalTrademarks\=" + + "OriginalFilename\=" + + "ProductName\=" + + "ProductVersion\=1.0.0.0" + + "Comments\=" + + "" + warningsaserror = false + workaroundd5bug = false + delphi.compileroptions + begin + alwaysuseconditionalsfromdof = false + alwaysusedelphilibrarypath = false + alwaysusedofsearchpath = true + assertions = true + assignableconst = false + booleval = false + conditionals = XMLOUTPUT;ISCONSOLE;DEBUG + consoleapp = true + debuginfo = true + definitionsonly = true + emitruntimetypeinformation = false + exportallsymbols = false + extendedsyntax = true + externaltd32 = false + frameworktype = VCL + generatedocumentation = false + generatehpp = false + hugestrings = true + imagebase = 4194304 + includenamespaces = false + includeremotesymbols = false + includetd32 = true + inlining = inOn + iochecking = true + librarypath = "$(BDSLIB)\\$(Platform)\\release;$(BDSUSERDIR)\\Imports;$(BDS)\\Imports;$(BDSCOMMONDIR)\\Dcp;$(BDS)\\include;C:\\Program Files (x86)\\madCollection\\madBasic\\BDS9\\win32;C:\\Program Files (x86)\\madCollection\\madDisAsm\\BDS9\\win32;C:\\Program Files (x86)\\madCollection\\madExcept\\BDS9\\win32;C:\\Program Files (x86)\\madCollection\\madExcept\\..\\Plugins;C:\\Program Files (x86)\\madCollection\\madRemote\\BDS9\\win32;C:\\Program Files (x86)\\madCollection\\madKernel\\BDS9\\win32;C:\\Program Files (x86)\\madCollection\\madCodeHook\\BDS9\\win32;C:\\Program Files (x86)\\madCollection\\madSecurity\\BDS9\\win32;C:\\Program Files (x86)\\madCollection\\madShell\\BDS9\\win32;I:\\OpenSource\\GitHub\\DUnitX;I:\\OpenSource\\GitHub\\Delphi-Mocks;C:\\Program Files (x86)\\EurekaLab\\EurekaLog 7\\Lib\\Common\\;C:\\Program Files (x86)\\EurekaLab\\EurekaLog 7\\Lib\\Win32\\Release\\Delphi16\\;C:\\Program Files (x86)\\EurekaLab\\EurekaLog 7\\Source\\Extras" + linkeroutput = 0 + localsymbols = true + mapfile = 3 + maxstacksize = 1048576 + minstacksize = 16384 + namespaceprefixes = System;Xml;Data;Datasnap;Web;Soap;Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde; + openstrings = true + optimisation = false + outputdir = .\\ + overflowchecking = false + packages = bindcompfmx;dsnap;fmx;rtl;indysystem;indycore;dbrtl;bindcomp;inetdb;fmxase;inet;fmxobj;xmlrtl;inetdbxpress;indyprotocols;fmxdae;bindengine;soaprtl;bindcompvcl;vclie;vcltouch;websnap;vcldbx;vclsmp;vcl;inetdbbde;dsnapcon;vclx;svnui;webdsnap;svn;vclimg;fmi;bdertl;vclactnband;vcldb;vcldsnap + rangechecking = false + recordfieldalign = fa8 + referenceinfo = true + safedivide = false + searchpath = ..\\Source + showhints = true + showwarnings = true + stackframes = true + stringchecks = true + typedpointers = false + unitaliases = WinTypes\=Windows;WinProcs\=Windows;DbiTypes\=BDE;DbiProcs\=BDE;DbiErrs\=BDE + usedebugdcu = true + usepackages = false + varstringchecks = true + end + end + action.process.execute + begin + captureoutput = true + enabled = false + enablelivecapture = true + enablereturncodecheck = true + enabletimeout = false + expandimpersonationtoken = false + hidewindow = true + id = {0E0BE982-97C7-41ED-804F-5E799F460312} + impersonateusenetcredonly = false + impersonateuser = false + logoutput = true + logprocessparameters = true + processoraffinity = 0 + processpriority = tpNormal + programname = %FBPROJECTDIR%\\..\\Tests\\Delphi.Mocks.Tests.exe + redirectstderr = true + returncodecomparator = rcEqualTo + returncodetocheck = 0 + startindir = %FBPROJECTDIR%\\..\\Tests\\ + terminateontimeout = false + timeoutlength = 1 + useerrordialogmonitor = false + waitforcompletion = true + end + end + end end \ No newline at end of file diff --git a/Test/DelphiMocks/LICENSE.txt b/Test/DelphiMocks/LICENSE.txt index 7a4a3ea..9b5e401 100644 --- a/Test/DelphiMocks/LICENSE.txt +++ b/Test/DelphiMocks/LICENSE.txt @@ -1,202 +1,202 @@ - - Apache License - Version 2.0, January 2004 - http://www.apache.org/licenses/ - - TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION - - 1. Definitions. - - "License" shall mean the terms and conditions for use, reproduction, - and distribution as defined by Sections 1 through 9 of this document. - - "Licensor" shall mean the copyright owner or entity authorized by - the copyright owner that is granting the License. - - "Legal Entity" shall mean the union of the acting entity and all - other entities that control, are controlled by, or are under common - control with that entity. For the purposes of this definition, - "control" means (i) the power, direct or indirect, to cause the - direction or management of such entity, whether by contract or - otherwise, or (ii) ownership of fifty percent (50%) or more of the - outstanding shares, or (iii) beneficial ownership of such entity. - - "You" (or "Your") shall mean an individual or Legal Entity - exercising permissions granted by this License. - - "Source" form shall mean the preferred form for making modifications, - including but not limited to software source code, documentation - source, and configuration files. - - "Object" form shall mean any form resulting from mechanical - transformation or translation of a Source form, including but - not limited to compiled object code, generated documentation, - and conversions to other media types. - - "Work" shall mean the work of authorship, whether in Source or - Object form, made available under the License, as indicated by a - copyright notice that is included in or attached to the work - (an example is provided in the Appendix below). - - "Derivative Works" shall mean any work, whether in Source or Object - form, that is based on (or derived from) the Work and for which the - editorial revisions, annotations, elaborations, or other modifications - represent, as a whole, an original work of authorship. For the purposes - of this License, Derivative Works shall not include works that remain - separable from, or merely link (or bind by name) to the interfaces of, - the Work and Derivative Works thereof. - - "Contribution" shall mean any work of authorship, including - the original version of the Work and any modifications or additions - to that Work or Derivative Works thereof, that is intentionally - submitted to Licensor for inclusion in the Work by the copyright owner - or by an individual or Legal Entity authorized to submit on behalf of - the copyright owner. For the purposes of this definition, "submitted" - means any form of electronic, verbal, or written communication sent - to the Licensor or its representatives, including but not limited to - communication on electronic mailing lists, source code control systems, - and issue tracking systems that are managed by, or on behalf of, the - Licensor for the purpose of discussing and improving the Work, but - excluding communication that is conspicuously marked or otherwise - designated in writing by the copyright owner as "Not a Contribution." - - "Contributor" shall mean Licensor and any individual or Legal Entity - on behalf of whom a Contribution has been received by Licensor and - subsequently incorporated within the Work. - - 2. Grant of Copyright License. Subject to the terms and conditions of - this License, each Contributor hereby grants to You a perpetual, - worldwide, non-exclusive, no-charge, royalty-free, irrevocable - copyright license to reproduce, prepare Derivative Works of, - publicly display, publicly perform, sublicense, and distribute the - Work and such Derivative Works in Source or Object form. - - 3. Grant of Patent License. Subject to the terms and conditions of - this License, each Contributor hereby grants to You a perpetual, - worldwide, non-exclusive, no-charge, royalty-free, irrevocable - (except as stated in this section) patent license to make, have made, - use, offer to sell, sell, import, and otherwise transfer the Work, - where such license applies only to those patent claims licensable - by such Contributor that are necessarily infringed by their - Contribution(s) alone or by combination of their Contribution(s) - with the Work to which such Contribution(s) was submitted. If You - institute patent litigation against any entity (including a - cross-claim or counterclaim in a lawsuit) alleging that the Work - or a Contribution incorporated within the Work constitutes direct - or contributory patent infringement, then any patent licenses - granted to You under this License for that Work shall terminate - as of the date such litigation is filed. - - 4. Redistribution. You may reproduce and distribute copies of the - Work or Derivative Works thereof in any medium, with or without - modifications, and in Source or Object form, provided that You - meet the following conditions: - - (a) You must give any other recipients of the Work or - Derivative Works a copy of this License; and - - (b) You must cause any modified files to carry prominent notices - stating that You changed the files; and - - (c) You must retain, in the Source form of any Derivative Works - that You distribute, all copyright, patent, trademark, and - attribution notices from the Source form of the Work, - excluding those notices that do not pertain to any part of - the Derivative Works; and - - (d) If the Work includes a "NOTICE" text file as part of its - distribution, then any Derivative Works that You distribute must - include a readable copy of the attribution notices contained - within such NOTICE file, excluding those notices that do not - pertain to any part of the Derivative Works, in at least one - of the following places: within a NOTICE text file distributed - as part of the Derivative Works; within the Source form or - documentation, if provided along with the Derivative Works; or, - within a display generated by the Derivative Works, if and - wherever such third-party notices normally appear. The contents - of the NOTICE file are for informational purposes only and - do not modify the License. You may add Your own attribution - notices within Derivative Works that You distribute, alongside - or as an addendum to the NOTICE text from the Work, provided - that such additional attribution notices cannot be construed - as modifying the License. - - You may add Your own copyright statement to Your modifications and - may provide additional or different license terms and conditions - for use, reproduction, or distribution of Your modifications, or - for any such Derivative Works as a whole, provided Your use, - reproduction, and distribution of the Work otherwise complies with - the conditions stated in this License. - - 5. Submission of Contributions. Unless You explicitly state otherwise, - any Contribution intentionally submitted for inclusion in the Work - by You to the Licensor shall be under the terms and conditions of - this License, without any additional terms or conditions. - Notwithstanding the above, nothing herein shall supersede or modify - the terms of any separate license agreement you may have executed - with Licensor regarding such Contributions. - - 6. Trademarks. This License does not grant permission to use the trade - names, trademarks, service marks, or product names of the Licensor, - except as required for reasonable and customary use in describing the - origin of the Work and reproducing the content of the NOTICE file. - - 7. Disclaimer of Warranty. Unless required by applicable law or - agreed to in writing, Licensor provides the Work (and each - Contributor provides its Contributions) on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or - implied, including, without limitation, any warranties or conditions - of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A - PARTICULAR PURPOSE. You are solely responsible for determining the - appropriateness of using or redistributing the Work and assume any - risks associated with Your exercise of permissions under this License. - - 8. Limitation of Liability. In no event and under no legal theory, - whether in tort (including negligence), contract, or otherwise, - unless required by applicable law (such as deliberate and grossly - negligent acts) or agreed to in writing, shall any Contributor be - liable to You for damages, including any direct, indirect, special, - incidental, or consequential damages of any character arising as a - result of this License or out of the use or inability to use the - Work (including but not limited to damages for loss of goodwill, - work stoppage, computer failure or malfunction, or any and all - other commercial damages or losses), even if such Contributor - has been advised of the possibility of such damages. - - 9. Accepting Warranty or Additional Liability. While redistributing - the Work or Derivative Works thereof, You may choose to offer, - and charge a fee for, acceptance of support, warranty, indemnity, - or other liability obligations and/or rights consistent with this - License. However, in accepting such obligations, You may act only - on Your own behalf and on Your sole responsibility, not on behalf - of any other Contributor, and only if You agree to indemnify, - defend, and hold each Contributor harmless for any liability - incurred by, or claims asserted against, such Contributor by reason - of your accepting any such warranty or additional liability. - - END OF TERMS AND CONDITIONS - - APPENDIX: How to apply the Apache License to your work. - - To apply the Apache License to your work, attach the following - boilerplate notice, with the fields enclosed by brackets "[]" - replaced with your own identifying information. (Don't include - the brackets!) The text should be enclosed in the appropriate - comment syntax for the file format. We also recommend that a - file or class name and description of purpose be included on the - same "printed page" as the copyright notice for easier - identification within third-party archives. - - Copyright [yyyy] [name of copyright owner] - - Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and + + Apache License + Version 2.0, January 2004 + http://www.apache.org/licenses/ + + TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION + + 1. Definitions. + + "License" shall mean the terms and conditions for use, reproduction, + and distribution as defined by Sections 1 through 9 of this document. + + "Licensor" shall mean the copyright owner or entity authorized by + the copyright owner that is granting the License. + + "Legal Entity" shall mean the union of the acting entity and all + other entities that control, are controlled by, or are under common + control with that entity. For the purposes of this definition, + "control" means (i) the power, direct or indirect, to cause the + direction or management of such entity, whether by contract or + otherwise, or (ii) ownership of fifty percent (50%) or more of the + outstanding shares, or (iii) beneficial ownership of such entity. + + "You" (or "Your") shall mean an individual or Legal Entity + exercising permissions granted by this License. + + "Source" form shall mean the preferred form for making modifications, + including but not limited to software source code, documentation + source, and configuration files. + + "Object" form shall mean any form resulting from mechanical + transformation or translation of a Source form, including but + not limited to compiled object code, generated documentation, + and conversions to other media types. + + "Work" shall mean the work of authorship, whether in Source or + Object form, made available under the License, as indicated by a + copyright notice that is included in or attached to the work + (an example is provided in the Appendix below). + + "Derivative Works" shall mean any work, whether in Source or Object + form, that is based on (or derived from) the Work and for which the + editorial revisions, annotations, elaborations, or other modifications + represent, as a whole, an original work of authorship. For the purposes + of this License, Derivative Works shall not include works that remain + separable from, or merely link (or bind by name) to the interfaces of, + the Work and Derivative Works thereof. + + "Contribution" shall mean any work of authorship, including + the original version of the Work and any modifications or additions + to that Work or Derivative Works thereof, that is intentionally + submitted to Licensor for inclusion in the Work by the copyright owner + or by an individual or Legal Entity authorized to submit on behalf of + the copyright owner. For the purposes of this definition, "submitted" + means any form of electronic, verbal, or written communication sent + to the Licensor or its representatives, including but not limited to + communication on electronic mailing lists, source code control systems, + and issue tracking systems that are managed by, or on behalf of, the + Licensor for the purpose of discussing and improving the Work, but + excluding communication that is conspicuously marked or otherwise + designated in writing by the copyright owner as "Not a Contribution." + + "Contributor" shall mean Licensor and any individual or Legal Entity + on behalf of whom a Contribution has been received by Licensor and + subsequently incorporated within the Work. + + 2. Grant of Copyright License. Subject to the terms and conditions of + this License, each Contributor hereby grants to You a perpetual, + worldwide, non-exclusive, no-charge, royalty-free, irrevocable + copyright license to reproduce, prepare Derivative Works of, + publicly display, publicly perform, sublicense, and distribute the + Work and such Derivative Works in Source or Object form. + + 3. Grant of Patent License. Subject to the terms and conditions of + this License, each Contributor hereby grants to You a perpetual, + worldwide, non-exclusive, no-charge, royalty-free, irrevocable + (except as stated in this section) patent license to make, have made, + use, offer to sell, sell, import, and otherwise transfer the Work, + where such license applies only to those patent claims licensable + by such Contributor that are necessarily infringed by their + Contribution(s) alone or by combination of their Contribution(s) + with the Work to which such Contribution(s) was submitted. If You + institute patent litigation against any entity (including a + cross-claim or counterclaim in a lawsuit) alleging that the Work + or a Contribution incorporated within the Work constitutes direct + or contributory patent infringement, then any patent licenses + granted to You under this License for that Work shall terminate + as of the date such litigation is filed. + + 4. Redistribution. You may reproduce and distribute copies of the + Work or Derivative Works thereof in any medium, with or without + modifications, and in Source or Object form, provided that You + meet the following conditions: + + (a) You must give any other recipients of the Work or + Derivative Works a copy of this License; and + + (b) You must cause any modified files to carry prominent notices + stating that You changed the files; and + + (c) You must retain, in the Source form of any Derivative Works + that You distribute, all copyright, patent, trademark, and + attribution notices from the Source form of the Work, + excluding those notices that do not pertain to any part of + the Derivative Works; and + + (d) If the Work includes a "NOTICE" text file as part of its + distribution, then any Derivative Works that You distribute must + include a readable copy of the attribution notices contained + within such NOTICE file, excluding those notices that do not + pertain to any part of the Derivative Works, in at least one + of the following places: within a NOTICE text file distributed + as part of the Derivative Works; within the Source form or + documentation, if provided along with the Derivative Works; or, + within a display generated by the Derivative Works, if and + wherever such third-party notices normally appear. The contents + of the NOTICE file are for informational purposes only and + do not modify the License. You may add Your own attribution + notices within Derivative Works that You distribute, alongside + or as an addendum to the NOTICE text from the Work, provided + that such additional attribution notices cannot be construed + as modifying the License. + + You may add Your own copyright statement to Your modifications and + may provide additional or different license terms and conditions + for use, reproduction, or distribution of Your modifications, or + for any such Derivative Works as a whole, provided Your use, + reproduction, and distribution of the Work otherwise complies with + the conditions stated in this License. + + 5. Submission of Contributions. Unless You explicitly state otherwise, + any Contribution intentionally submitted for inclusion in the Work + by You to the Licensor shall be under the terms and conditions of + this License, without any additional terms or conditions. + Notwithstanding the above, nothing herein shall supersede or modify + the terms of any separate license agreement you may have executed + with Licensor regarding such Contributions. + + 6. Trademarks. This License does not grant permission to use the trade + names, trademarks, service marks, or product names of the Licensor, + except as required for reasonable and customary use in describing the + origin of the Work and reproducing the content of the NOTICE file. + + 7. Disclaimer of Warranty. Unless required by applicable law or + agreed to in writing, Licensor provides the Work (and each + Contributor provides its Contributions) on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or + implied, including, without limitation, any warranties or conditions + of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A + PARTICULAR PURPOSE. You are solely responsible for determining the + appropriateness of using or redistributing the Work and assume any + risks associated with Your exercise of permissions under this License. + + 8. Limitation of Liability. In no event and under no legal theory, + whether in tort (including negligence), contract, or otherwise, + unless required by applicable law (such as deliberate and grossly + negligent acts) or agreed to in writing, shall any Contributor be + liable to You for damages, including any direct, indirect, special, + incidental, or consequential damages of any character arising as a + result of this License or out of the use or inability to use the + Work (including but not limited to damages for loss of goodwill, + work stoppage, computer failure or malfunction, or any and all + other commercial damages or losses), even if such Contributor + has been advised of the possibility of such damages. + + 9. Accepting Warranty or Additional Liability. While redistributing + the Work or Derivative Works thereof, You may choose to offer, + and charge a fee for, acceptance of support, warranty, indemnity, + or other liability obligations and/or rights consistent with this + License. However, in accepting such obligations, You may act only + on Your own behalf and on Your sole responsibility, not on behalf + of any other Contributor, and only if You agree to indemnify, + defend, and hold each Contributor harmless for any liability + incurred by, or claims asserted against, such Contributor by reason + of your accepting any such warranty or additional liability. + + END OF TERMS AND CONDITIONS + + APPENDIX: How to apply the Apache License to your work. + + To apply the Apache License to your work, attach the following + boilerplate notice, with the fields enclosed by brackets "[]" + replaced with your own identifying information. (Don't include + the brackets!) The text should be enclosed in the appropriate + comment syntax for the file format. We also recommend that a + file or class name and description of purpose be included on the + same "printed page" as the copyright notice for easier + identification within third-party archives. + + Copyright [yyyy] [name of copyright owner] + + Licensed under the Apache License, Version 2.0 (the "License"); + you may not use this file except in compliance with the License. + You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + + Unless required by applicable law or agreed to in writing, software + distributed under the License is distributed on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + See the License for the specific language governing permissions and limitations under the License. \ No newline at end of file diff --git a/Test/DelphiMocks/README.md b/Test/DelphiMocks/README.md index 5018dbd..822e86c 100644 --- a/Test/DelphiMocks/README.md +++ b/Test/DelphiMocks/README.md @@ -1,132 +1,132 @@ -# Delphi Mocks - -Delphi Mocks is a simple mocking framework for Delphi XE2 or later. It makes use of RTTI features that are only available in Delphi XE2. See the example at the bottom of the space for a complete explanation. - -# Parameter matching - -To match expectations or behavior there is extended parameter matching. - -```Pascal - function IsAny() : T ; - function Matches(const predicate: TPredicate) : T; - function IsNotNil : T; overload; - function IsNotNil(const comparer: IEqualityComparer) : T; overload; - function IsEqualTo(const value : T) : T; overload; - function IsEqualTo(const value : T; const comparer: IEqualityComparer) : T; overload; - function IsInRange(const fromValue : T; const toValue : T) : T; - function IsIn(const values : TArray) : T; overload; - function IsIn(const values : TArray; const comparer: IEqualityComparer) : T; overload; - function IsIn(const values : IEnumerable) : T; overload; - function IsIn(const values : IEnumerable; const comparer: IEqualityComparer) : T; overload; - function IsNotIn(const values : TArray) : T; overload; - function IsNotIn(const values : TArray; const comparer: IEqualityComparer) : T; overload; - function IsNotIn(const values : IEnumerable) : T; overload; - function IsNotIn(const values : IEnumerable; const comparer: IEqualityComparer) : T; overload; - function IsRegex(const regex : string; const options : TRegExOptions = []) : string; - function AreSamePropertiesThat(const Value: T): T; - function AreSameFieldsThat(const Value: T): T; - function AreSameFieldsAndPropertiedThat(const Value: T): T; -``` - -Usage is easy: - -```Pascal - mock.Setup.Expect.Once.When.SimpleMethod(It0.IsAny, It1.IsAny); - mock.Setup.WillReturn(3).When.SimpleFunction(It0.IsEqualTo('hello')); -``` - -## Class matching -Some more attention should be payed for matching classes. Usage of `.IsAny` will not work as might be expected, because `nil` (which is the default return value of `IsAny`) is always a good match. Therefore the following setup will fail on the second line, because the framework will think that there is already behavior defined (in the first line). - -```Pascal - mock.Setup.Expect.Never.When.ExtendedMethod(It0.IsAny); - mock.Setup.Expect.Never.When.ExtendedMethod(It0.IsAny); -``` - -This can easily be solved by using `.IsNotNil`: - -```Pascal - mock.Setup.Expect.Never.When.ExtendedMethod(It0.IsNotNil); - mock.Setup.Expect.Never.When.ExtendedMethod(It0.IsNotNil); -``` - -# Example - -```Pascal -unit Delphi.Mocks.Examples.Interfaces; - -interface - -uses - SysUtils, - DUnitX.TestFramework, - Delphi.Mocks; - -type - {$M+} - TSimpleInterface = Interface - ['{4131D033-2D80-42B8-AAA1-3C2DF0AC3BBD}'] - procedure SimpleMethod; - end; - - TSystemUnderTestInf = Interface - ['{5E21CA8E-A4BB-4512-BCD4-22D7F10C5A0B}'] - procedure CallsSimpleInterfaceMethod; - end; - {$M-} - - TSystemUnderTest = class(TInterfacedObject, TSystemUnderTestInf) - private - FInternalInf : TSimpleInterface; - public - constructor Create(const ARequiredInf: TSimpleInterface); - procedure CallsSimpleInterfaceMethod; - end; - - TMockObjectTests = class - published - procedure Simple_Interface_Mock; - end; - -implementation - -uses - System.Rtti; - -{ TMockObjectTests } - -procedure TMockObjectTests.Simple_Interface_Mock; -var - mock : TMock; - sutObject : TSystemUnderTestInf; -begin - //SETUP: Create a mock of the interface that is required by our system under test object. - mock := TMock.Create; - - //SETUP: Add a check that SimpleMethod is called atleast once. - mock.Setup.Expect.AtLeastOnce.When.SimpleMethod; - - //SETUP: Create the system under test object passing an instance of the mock interface it requires. - sutObject := TSystemUnderTest.Create(mock.Instance); - - //TEST: Call CallsSimpleInterfaceMethod on the system under test. - sutObject.CallsSimpleInterfaceMethod; - - //VERIFY: That our passed in interface was called at least once when CallsSimpleInterfaceMethod was called. - mock.Verify('CallsSimpleInterfaceMethod should call SimpleMethod'); -end; - -{ TSystemUnderTest } - -procedure TSystemUnderTest.CallsSimpleInterfaceMethod; -begin - FInternalInf.SimpleMethod; -end; - -constructor TSystemUnderTest.Create(const ARequiredInf: TSimpleInterface); -begin - FInternalInf := ARequiredInf; -end; - -end. +# Delphi Mocks + +Delphi Mocks is a simple mocking framework for Delphi XE2 or later. It makes use of RTTI features that are only available in Delphi XE2. See the example at the bottom of the space for a complete explanation. + +# Parameter matching + +To match expectations or behavior there is extended parameter matching. + +```Pascal + function IsAny() : T ; + function Matches(const predicate: TPredicate) : T; + function IsNotNil : T; overload; + function IsNotNil(const comparer: IEqualityComparer) : T; overload; + function IsEqualTo(const value : T) : T; overload; + function IsEqualTo(const value : T; const comparer: IEqualityComparer) : T; overload; + function IsInRange(const fromValue : T; const toValue : T) : T; + function IsIn(const values : TArray) : T; overload; + function IsIn(const values : TArray; const comparer: IEqualityComparer) : T; overload; + function IsIn(const values : IEnumerable) : T; overload; + function IsIn(const values : IEnumerable; const comparer: IEqualityComparer) : T; overload; + function IsNotIn(const values : TArray) : T; overload; + function IsNotIn(const values : TArray; const comparer: IEqualityComparer) : T; overload; + function IsNotIn(const values : IEnumerable) : T; overload; + function IsNotIn(const values : IEnumerable; const comparer: IEqualityComparer) : T; overload; + function IsRegex(const regex : string; const options : TRegExOptions = []) : string; + function AreSamePropertiesThat(const Value: T): T; + function AreSameFieldsThat(const Value: T): T; + function AreSameFieldsAndPropertiedThat(const Value: T): T; +``` + +Usage is easy: + +```Pascal + mock.Setup.Expect.Once.When.SimpleMethod(It0.IsAny, It1.IsAny); + mock.Setup.WillReturn(3).When.SimpleFunction(It0.IsEqualTo('hello')); +``` + +## Class matching +Some more attention should be payed for matching classes. Usage of `.IsAny` will not work as might be expected, because `nil` (which is the default return value of `IsAny`) is always a good match. Therefore the following setup will fail on the second line, because the framework will think that there is already behavior defined (in the first line). + +```Pascal + mock.Setup.Expect.Never.When.ExtendedMethod(It0.IsAny); + mock.Setup.Expect.Never.When.ExtendedMethod(It0.IsAny); +``` + +This can easily be solved by using `.IsNotNil`: + +```Pascal + mock.Setup.Expect.Never.When.ExtendedMethod(It0.IsNotNil); + mock.Setup.Expect.Never.When.ExtendedMethod(It0.IsNotNil); +``` + +# Example + +```Pascal +unit Delphi.Mocks.Examples.Interfaces; + +interface + +uses + SysUtils, + DUnitX.TestFramework, + Delphi.Mocks; + +type + {$M+} + TSimpleInterface = Interface + ['{4131D033-2D80-42B8-AAA1-3C2DF0AC3BBD}'] + procedure SimpleMethod; + end; + + TSystemUnderTestInf = Interface + ['{5E21CA8E-A4BB-4512-BCD4-22D7F10C5A0B}'] + procedure CallsSimpleInterfaceMethod; + end; + {$M-} + + TSystemUnderTest = class(TInterfacedObject, TSystemUnderTestInf) + private + FInternalInf : TSimpleInterface; + public + constructor Create(const ARequiredInf: TSimpleInterface); + procedure CallsSimpleInterfaceMethod; + end; + + TMockObjectTests = class + published + procedure Simple_Interface_Mock; + end; + +implementation + +uses + System.Rtti; + +{ TMockObjectTests } + +procedure TMockObjectTests.Simple_Interface_Mock; +var + mock : TMock; + sutObject : TSystemUnderTestInf; +begin + //SETUP: Create a mock of the interface that is required by our system under test object. + mock := TMock.Create; + + //SETUP: Add a check that SimpleMethod is called atleast once. + mock.Setup.Expect.AtLeastOnce.When.SimpleMethod; + + //SETUP: Create the system under test object passing an instance of the mock interface it requires. + sutObject := TSystemUnderTest.Create(mock.Instance); + + //TEST: Call CallsSimpleInterfaceMethod on the system under test. + sutObject.CallsSimpleInterfaceMethod; + + //VERIFY: That our passed in interface was called at least once when CallsSimpleInterfaceMethod was called. + mock.Verify('CallsSimpleInterfaceMethod should call SimpleMethod'); +end; + +{ TSystemUnderTest } + +procedure TSystemUnderTest.CallsSimpleInterfaceMethod; +begin + FInternalInf.SimpleMethod; +end; + +constructor TSystemUnderTest.Create(const ARequiredInf: TSimpleInterface); +begin + FInternalInf := ARequiredInf; +end; + +end. ``` \ No newline at end of file diff --git a/Test/DelphiMocks/Source/Delphi.Mocks.inc b/Test/DelphiMocks/Source/Delphi.Mocks.inc index fa2cbb6..fd6d315 100644 --- a/Test/DelphiMocks/Source/Delphi.Mocks.inc +++ b/Test/DelphiMocks/Source/Delphi.Mocks.inc @@ -1,361 +1,361 @@ -{***************************************************************************} -{ } -{ Delphi.Mocks } -{ } -{ Copyright (C) 2011 Vincent Parrett } -{ } -{ http://www.finalbuilder.com } -{ } -{ } -{***************************************************************************} -{ } -{ Licensed under the Apache License, Version 2.0 (the "License"); } -{ you may not use this file except in compliance with the License. } -{ You may obtain a copy of the License at } -{ } -{ http://www.apache.org/licenses/LICENSE-2.0 } -{ } -{ Unless required by applicable law or agreed to in writing, software } -{ distributed under the License is distributed on an "AS IS" BASIS, } -{ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. } -{ See the License for the specific language governing permissions and } -{ limitations under the License. } -{ } -{***************************************************************************} - - //Basic Version of Compiler Supported -{$IFDEF CONDITIONALEXPRESSIONS} //Started being defined with D2009 - {$IF CompilerVersion < 23.0} // Before RAD Studio XE2 - {$DEFINE UNSUPPORTED_COMPILER_VERSION} - {$IFEND} - {$IF CompilerVersion > 22.0} // XE2 or later - {$DEFINE SUPPORTS_REGEX} - {$IFEND} -{$ELSE} - {$DEFINE UNSUPPORTED_COMPILER_VERSION} -{$ENDIF} - -{$IFDEF UNSUPPORTED_COMPILER_VERSION} - Unsupported Compiler Version (Delphi XE2 or later required!) -{$ENDIF} - - -//Use namespaces -{$DEFINE USE_NS} - -{$DEFINE DELPHI_XE104_DOWN} -{$DEFINE DELPHI_XE103_DOWN} -{$DEFINE DELPHI_XE102_DOWN} -{$DEFINE DELPHI_XE101_DOWN} -{$DEFINE DELPHI_XE10_DOWN} -{$DEFINE DELPHI_XE8_DOWN} -{$DEFINE DELPHI_XE7_DOWN} -{$DEFINE DELPHI_XE6_DOWN} -{$DEFINE DELPHI_XE5_DOWN} -{$DEFINE DELPHI_XE4_DOWN} -{$DEFINE DELPHI_XE3_DOWN} -{$DEFINE DELPHI_XE2_DOWN} - - -{$IFDEF VER230} // RAD Studio XE2 - {$DEFINE DELPHI_2010_UP} - {$DEFINE DELPHI_XE_UP} - {$DEFINE DELPHI_XE2} - {$DEFINE DELPHI_XE2_UP} - {$DEFINE SUPPORTS_REGEX} - {$UNDEF DELPHI_2010_DOWN} - {$UNDEF DELPHI_XE_DOWN} -{$ENDIF VER230} - -{$IFDEF VER240} // RAD Studio XE3 - {$DEFINE DELPHI_2010_UP} - {$DEFINE DELPHI_XE_UP} - {$DEFINE DELPHI_XE2_UP} - {$DEFINE DELPHI_XE3} - {$DEFINE DELPHI_XE3_UP} - {$DEFINE SUPPORTS_REGEX} - {$UNDEF DELPHI_2010_DOWN} - {$UNDEF DELPHI_XE_DOWN} - {$UNDEF DELPHI_XE2_DOWN} -{$ENDIF VER240} - -{$IFDEF VER250} // RAD Studio XE4 - {$DEFINE DELPHI_2010_UP} - {$DEFINE DELPHI_XE_UP} - {$DEFINE DELPHI_XE2_UP} - {$DEFINE DELPHI_XE3_UP} - {$DEFINE DELPHI_XE4} - {$DEFINE DELPHI_XE4_UP} - {$DEFINE SUPPORTS_REGEX} - {$UNDEF DELPHI_2010_DOWN} - {$UNDEF DELPHI_XE_DOWN} - {$UNDEF DELPHI_XE2_DOWN} - {$UNDEF DELPHI_XE3_DOWN} -{$ENDIF VER250} - -{$IFDEF VER260} // RAD Studio XE5 - {$DEFINE DELPHI_2010_UP} - {$DEFINE DELPHI_XE_UP} - {$DEFINE DELPHI_XE2_UP} - {$DEFINE DELPHI_XE3_UP} - {$DEFINE DELPHI_XE4_UP} - {$DEFINE DELPHI_XE5} - {$DEFINE DELPHI_XE5_UP} - {$DEFINE SUPPORTS_REGEX} - {$UNDEF DELPHI_2010_DOWN} - {$UNDEF DELPHI_XE_DOWN} - {$UNDEF DELPHI_XE2_DOWN} - {$UNDEF DELPHI_XE3_DOWN} - {$UNDEF DELPHI_XE4_DOWN} -{$ENDIF VER260} - -{$IFDEF VER270} // RAD Studio XE6 - {$DEFINE DELPHI_2010_UP} - {$DEFINE DELPHI_XE_UP} - {$DEFINE DELPHI_XE2_UP} - {$DEFINE DELPHI_XE3_UP} - {$DEFINE DELPHI_XE4_UP} - {$DEFINE DELPHI_XE5_UP} - {$DEFINE DELPHI_XE6} - {$DEFINE DELPHI_XE6_UP} - {$DEFINE SUPPORTS_REGEX} - {$UNDEF DELPHI_2010_DOWN} - {$UNDEF DELPHI_XE_DOWN} - {$UNDEF DELPHI_XE2_DOWN} - {$UNDEF DELPHI_XE3_DOWN} - {$UNDEF DELPHI_XE4_DOWN} - {$UNDEF DELPHI_XE5_DOWN} -{$ENDIF VER270} - -{$IFDEF VER280} // RAD Studio XE7 - {$DEFINE DELPHI_2010_UP} - {$DEFINE DELPHI_XE_UP} - {$DEFINE DELPHI_XE2_UP} - {$DEFINE DELPHI_XE3_UP} - {$DEFINE DELPHI_XE4_UP} - {$DEFINE DELPHI_XE5_UP} - {$DEFINE DELPHI_XE6_UP} - {$DEFINE DELPHI_XE7} - {$DEFINE DELPHI_XE7_UP} - {$DEFINE SUPPORTS_REGEX} - {$UNDEF DELPHI_2010_DOWN} - {$UNDEF DELPHI_XE_DOWN} - {$UNDEF DELPHI_XE2_DOWN} - {$UNDEF DELPHI_XE3_DOWN} - {$UNDEF DELPHI_XE4_DOWN} - {$UNDEF DELPHI_XE5_DOWN} - {$UNDEF DELPHI_XE6_DOWN} -{$ENDIF VER280} - -{$IFDEF VER290} // RAD Studio XE8 - {$DEFINE DELPHI_2010_UP} - {$DEFINE DELPHI_XE_UP} - {$DEFINE DELPHI_XE2_UP} - {$DEFINE DELPHI_XE3_UP} - {$DEFINE DELPHI_XE4_UP} - {$DEFINE DELPHI_XE5_UP} - {$DEFINE DELPHI_XE6_UP} - {$DEFINE DELPHI_XE7} - {$DEFINE DELPHI_XE7_UP} - {$DEFINE DELPHI_XE8_UP} - - {$DEFINE SUPPORTS_REGEX} - {$UNDEF DELPHI_2010_DOWN} - {$UNDEF DELPHI_XE_DOWN} - {$UNDEF DELPHI_XE2_DOWN} - {$UNDEF DELPHI_XE3_DOWN} - {$UNDEF DELPHI_XE4_DOWN} - {$UNDEF DELPHI_XE5_DOWN} - {$UNDEF DELPHI_XE6_DOWN} - {$UNDEF DELPHI_XE7_DOWN} -{$ENDIF VER290} - -{$IFDEF VER300} // RAD Studio 10 Seattle - {$DEFINE DELPHI_2010_UP} - {$DEFINE DELPHI_XE_UP} - {$DEFINE DELPHI_XE2_UP} - {$DEFINE DELPHI_XE3_UP} - {$DEFINE DELPHI_XE4_UP} - {$DEFINE DELPHI_XE5_UP} - {$DEFINE DELPHI_XE6_UP} - {$DEFINE DELPHI_XE7} - {$DEFINE DELPHI_XE7_UP} - {$DEFINE DELPHI_XE8_UP} - {$DEFINE DELPHIX_XE10_UP} - {$DEFINE DELPHIX_XE10} - {$DEFINE SUPPORTS_REGEX} - {$UNDEF DELPHI_2010_DOWN} - {$UNDEF DELPHI_XE_DOWN} - {$UNDEF DELPHI_XE2_DOWN} - {$UNDEF DELPHI_XE3_DOWN} - {$UNDEF DELPHI_XE4_DOWN} - {$UNDEF DELPHI_XE5_DOWN} - {$UNDEF DELPHI_XE6_DOWN} - {$UNDEF DELPHI_XE7_DOWN} - {$UNDEF DELPHI_XE8_DOWN} -{$ENDIF VER300} - -{$IFDEF VER310} // RAD Studio 10.1 Berlin - {$DEFINE DELPHI_2010_UP} - {$DEFINE DELPHI_XE_UP} - {$DEFINE DELPHI_XE2_UP} - {$DEFINE DELPHI_XE3_UP} - {$DEFINE DELPHI_XE4_UP} - {$DEFINE DELPHI_XE5_UP} - {$DEFINE DELPHI_XE6_UP} - {$DEFINE DELPHI_XE7} - {$DEFINE DELPHI_XE7_UP} - {$DEFINE DELPHI_XE8_UP} - {$DEFINE DELPHIX_SEATTLE_UP} - {$DEFINE DELPHIX_SEATTLE} - {$DEFINE DELPHI_XE10_UP} - {$DEFINE DELPHI_XE101_UP} - {$DEFINE DELPHI_XE101} - {$DEFINE SUPPORTS_REGEX} - {$UNDEF DELPHI_2010_DOWN} - {$UNDEF DELPHI_XE_DOWN} - {$UNDEF DELPHI_XE2_DOWN} - {$UNDEF DELPHI_XE3_DOWN} - {$UNDEF DELPHI_XE4_DOWN} - {$UNDEF DELPHI_XE5_DOWN} - {$UNDEF DELPHI_XE6_DOWN} - {$UNDEF DELPHI_XE7_DOWN} - {$UNDEF DELPHI_XE8_DOWN} - {$UNDEF DELPHI_XE10_DOWN} -{$ENDIF VER310} - -{$IFDEF VER320} // RAD Studio 10.2 Tokyo - {$DEFINE DELPHI_2010_UP} - {$DEFINE DELPHI_XE_UP} - {$DEFINE DELPHI_XE2_UP} - {$DEFINE DELPHI_XE3_UP} - {$DEFINE DELPHI_XE4_UP} - {$DEFINE DELPHI_XE5_UP} - {$DEFINE DELPHI_XE6_UP} - {$DEFINE DELPHI_XE7} - {$DEFINE DELPHI_XE7_UP} - {$DEFINE DELPHI_XE8_UP} - {$DEFINE DELPHIX_SEATTLE_UP} - {$DEFINE DELPHIX_SEATTLE} - {$DEFINE DELPHI_XE10_UP} - {$DEFINE DELPHI_XE101_UP} - {$DEFINE DELPHI_XE102_UP} - {$DEFINE DELPHI_XE102} - {$DEFINE SUPPORTS_REGEX} - {$UNDEF DELPHI_2010_DOWN} - {$UNDEF DELPHI_XE_DOWN} - {$UNDEF DELPHI_XE2_DOWN} - {$UNDEF DELPHI_XE3_DOWN} - {$UNDEF DELPHI_XE4_DOWN} - {$UNDEF DELPHI_XE5_DOWN} - {$UNDEF DELPHI_XE6_DOWN} - {$UNDEF DELPHI_XE7_DOWN} - {$UNDEF DELPHI_XE8_DOWN} - {$UNDEF DELPHI_XE10_DOWN} - {$UNDEF DELPHI_XE101_DOWN} -{$ENDIF VER320} - -{$IFDEF VER330} // RAD Studio 10.3 - {$DEFINE DELPHI_2010_UP} - {$DEFINE DELPHI_XE_UP} - {$DEFINE DELPHI_XE2_UP} - {$DEFINE DELPHI_XE3_UP} - {$DEFINE DELPHI_XE4_UP} - {$DEFINE DELPHI_XE5_UP} - {$DEFINE DELPHI_XE6_UP} - {$DEFINE DELPHI_XE7} - {$DEFINE DELPHI_XE7_UP} - {$DEFINE DELPHI_XE8_UP} - {$DEFINE DELPHIX_SEATTLE_UP} - {$DEFINE DELPHIX_SEATTLE} - {$DEFINE DELPHI_XE10_UP} - {$DEFINE DELPHI_XE101_UP} - {$DEFINE DELPHI_XE102_UP} - {$DEFINE DELPHI_XE103_UP} - {$DEFINE DELPHI_XE103} - {$DEFINE SUPPORTS_REGEX} - {$UNDEF DELPHI_2010_DOWN} - {$UNDEF DELPHI_XE_DOWN} - {$UNDEF DELPHI_XE2_DOWN} - {$UNDEF DELPHI_XE3_DOWN} - {$UNDEF DELPHI_XE4_DOWN} - {$UNDEF DELPHI_XE5_DOWN} - {$UNDEF DELPHI_XE6_DOWN} - {$UNDEF DELPHI_XE7_DOWN} - {$UNDEF DELPHI_XE8_DOWN} - {$UNDEF DELPHI_XE10_DOWN} - {$UNDEF DELPHI_XE101_DOWN} - {$UNDEF DELPHI_XE102_DOWN} -{$ENDIF VER330} - -{$IFDEF VER340} // RAD Studio 10.4 - {$DEFINE DELPHI_2010_UP} - {$DEFINE DELPHI_XE_UP} - {$DEFINE DELPHI_XE2_UP} - {$DEFINE DELPHI_XE3_UP} - {$DEFINE DELPHI_XE4_UP} - {$DEFINE DELPHI_XE5_UP} - {$DEFINE DELPHI_XE6_UP} - {$DEFINE DELPHI_XE7} - {$DEFINE DELPHI_XE7_UP} - {$DEFINE DELPHI_XE8_UP} - {$DEFINE DELPHIX_SEATTLE_UP} - {$DEFINE DELPHIX_SEATTLE} - {$DEFINE DELPHI_XE10_UP} - {$DEFINE DELPHI_XE101_UP} - {$DEFINE DELPHI_XE102_UP} - {$DEFINE DELPHI_XE103_UP} - {$DEFINE DELPHI_XE104_UP} - {$DEFINE DELPHI_XE103} - {$DEFINE SUPPORTS_REGEX} - {$UNDEF DELPHI_2010_DOWN} - {$UNDEF DELPHI_XE_DOWN} - {$UNDEF DELPHI_XE2_DOWN} - {$UNDEF DELPHI_XE3_DOWN} - {$UNDEF DELPHI_XE4_DOWN} - {$UNDEF DELPHI_XE5_DOWN} - {$UNDEF DELPHI_XE6_DOWN} - {$UNDEF DELPHI_XE7_DOWN} - {$UNDEF DELPHI_XE8_DOWN} - {$UNDEF DELPHI_XE10_DOWN} - {$UNDEF DELPHI_XE101_DOWN} - {$UNDEF DELPHI_XE102_DOWN} - {$UNDEF DELPHI_XE103_DOWN} -{$ENDIF VER340} - -{$IFDEF VER350} // RAD Studio 11.0 - {$DEFINE DELPHI_2010_UP} - {$DEFINE DELPHI_XE_UP} - {$DEFINE DELPHI_XE2_UP} - {$DEFINE DELPHI_XE3_UP} - {$DEFINE DELPHI_XE4_UP} - {$DEFINE DELPHI_XE5_UP} - {$DEFINE DELPHI_XE6_UP} - {$DEFINE DELPHI_XE7} - {$DEFINE DELPHI_XE7_UP} - {$DEFINE DELPHI_XE8_UP} - {$DEFINE DELPHIX_SEATTLE_UP} - {$DEFINE DELPHIX_SEATTLE} - {$DEFINE DELPHI_XE10_UP} - {$DEFINE DELPHI_XE101_UP} - {$DEFINE DELPHI_XE102_UP} - {$DEFINE DELPHI_XE103_UP} - {$DEFINE DELPHI_XE104_UP} - {$DEFINE DELPHI_XE110_UP} - {$DEFINE DELPHI_XE103} - {$DEFINE SUPPORTS_REGEX} - {$UNDEF DELPHI_2010_DOWN} - {$UNDEF DELPHI_XE_DOWN} - {$UNDEF DELPHI_XE2_DOWN} - {$UNDEF DELPHI_XE3_DOWN} - {$UNDEF DELPHI_XE4_DOWN} - {$UNDEF DELPHI_XE5_DOWN} - {$UNDEF DELPHI_XE6_DOWN} - {$UNDEF DELPHI_XE7_DOWN} - {$UNDEF DELPHI_XE8_DOWN} - {$UNDEF DELPHI_XE10_DOWN} - {$UNDEF DELPHI_XE101_DOWN} - {$UNDEF DELPHI_XE102_DOWN} - {$UNDEF DELPHI_XE103_DOWN} - {$UNDEF DELPHI_XE104_DOWN} -{$ENDIF VER340} +{***************************************************************************} +{ } +{ Delphi.Mocks } +{ } +{ Copyright (C) 2011 Vincent Parrett } +{ } +{ http://www.finalbuilder.com } +{ } +{ } +{***************************************************************************} +{ } +{ Licensed under the Apache License, Version 2.0 (the "License"); } +{ you may not use this file except in compliance with the License. } +{ You may obtain a copy of the License at } +{ } +{ http://www.apache.org/licenses/LICENSE-2.0 } +{ } +{ Unless required by applicable law or agreed to in writing, software } +{ distributed under the License is distributed on an "AS IS" BASIS, } +{ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. } +{ See the License for the specific language governing permissions and } +{ limitations under the License. } +{ } +{***************************************************************************} + + //Basic Version of Compiler Supported +{$IFDEF CONDITIONALEXPRESSIONS} //Started being defined with D2009 + {$IF CompilerVersion < 23.0} // Before RAD Studio XE2 + {$DEFINE UNSUPPORTED_COMPILER_VERSION} + {$IFEND} + {$IF CompilerVersion > 22.0} // XE2 or later + {$DEFINE SUPPORTS_REGEX} + {$IFEND} +{$ELSE} + {$DEFINE UNSUPPORTED_COMPILER_VERSION} +{$ENDIF} + +{$IFDEF UNSUPPORTED_COMPILER_VERSION} + Unsupported Compiler Version (Delphi XE2 or later required!) +{$ENDIF} + + +//Use namespaces +{$DEFINE USE_NS} + +{$DEFINE DELPHI_XE104_DOWN} +{$DEFINE DELPHI_XE103_DOWN} +{$DEFINE DELPHI_XE102_DOWN} +{$DEFINE DELPHI_XE101_DOWN} +{$DEFINE DELPHI_XE10_DOWN} +{$DEFINE DELPHI_XE8_DOWN} +{$DEFINE DELPHI_XE7_DOWN} +{$DEFINE DELPHI_XE6_DOWN} +{$DEFINE DELPHI_XE5_DOWN} +{$DEFINE DELPHI_XE4_DOWN} +{$DEFINE DELPHI_XE3_DOWN} +{$DEFINE DELPHI_XE2_DOWN} + + +{$IFDEF VER230} // RAD Studio XE2 + {$DEFINE DELPHI_2010_UP} + {$DEFINE DELPHI_XE_UP} + {$DEFINE DELPHI_XE2} + {$DEFINE DELPHI_XE2_UP} + {$DEFINE SUPPORTS_REGEX} + {$UNDEF DELPHI_2010_DOWN} + {$UNDEF DELPHI_XE_DOWN} +{$ENDIF VER230} + +{$IFDEF VER240} // RAD Studio XE3 + {$DEFINE DELPHI_2010_UP} + {$DEFINE DELPHI_XE_UP} + {$DEFINE DELPHI_XE2_UP} + {$DEFINE DELPHI_XE3} + {$DEFINE DELPHI_XE3_UP} + {$DEFINE SUPPORTS_REGEX} + {$UNDEF DELPHI_2010_DOWN} + {$UNDEF DELPHI_XE_DOWN} + {$UNDEF DELPHI_XE2_DOWN} +{$ENDIF VER240} + +{$IFDEF VER250} // RAD Studio XE4 + {$DEFINE DELPHI_2010_UP} + {$DEFINE DELPHI_XE_UP} + {$DEFINE DELPHI_XE2_UP} + {$DEFINE DELPHI_XE3_UP} + {$DEFINE DELPHI_XE4} + {$DEFINE DELPHI_XE4_UP} + {$DEFINE SUPPORTS_REGEX} + {$UNDEF DELPHI_2010_DOWN} + {$UNDEF DELPHI_XE_DOWN} + {$UNDEF DELPHI_XE2_DOWN} + {$UNDEF DELPHI_XE3_DOWN} +{$ENDIF VER250} + +{$IFDEF VER260} // RAD Studio XE5 + {$DEFINE DELPHI_2010_UP} + {$DEFINE DELPHI_XE_UP} + {$DEFINE DELPHI_XE2_UP} + {$DEFINE DELPHI_XE3_UP} + {$DEFINE DELPHI_XE4_UP} + {$DEFINE DELPHI_XE5} + {$DEFINE DELPHI_XE5_UP} + {$DEFINE SUPPORTS_REGEX} + {$UNDEF DELPHI_2010_DOWN} + {$UNDEF DELPHI_XE_DOWN} + {$UNDEF DELPHI_XE2_DOWN} + {$UNDEF DELPHI_XE3_DOWN} + {$UNDEF DELPHI_XE4_DOWN} +{$ENDIF VER260} + +{$IFDEF VER270} // RAD Studio XE6 + {$DEFINE DELPHI_2010_UP} + {$DEFINE DELPHI_XE_UP} + {$DEFINE DELPHI_XE2_UP} + {$DEFINE DELPHI_XE3_UP} + {$DEFINE DELPHI_XE4_UP} + {$DEFINE DELPHI_XE5_UP} + {$DEFINE DELPHI_XE6} + {$DEFINE DELPHI_XE6_UP} + {$DEFINE SUPPORTS_REGEX} + {$UNDEF DELPHI_2010_DOWN} + {$UNDEF DELPHI_XE_DOWN} + {$UNDEF DELPHI_XE2_DOWN} + {$UNDEF DELPHI_XE3_DOWN} + {$UNDEF DELPHI_XE4_DOWN} + {$UNDEF DELPHI_XE5_DOWN} +{$ENDIF VER270} + +{$IFDEF VER280} // RAD Studio XE7 + {$DEFINE DELPHI_2010_UP} + {$DEFINE DELPHI_XE_UP} + {$DEFINE DELPHI_XE2_UP} + {$DEFINE DELPHI_XE3_UP} + {$DEFINE DELPHI_XE4_UP} + {$DEFINE DELPHI_XE5_UP} + {$DEFINE DELPHI_XE6_UP} + {$DEFINE DELPHI_XE7} + {$DEFINE DELPHI_XE7_UP} + {$DEFINE SUPPORTS_REGEX} + {$UNDEF DELPHI_2010_DOWN} + {$UNDEF DELPHI_XE_DOWN} + {$UNDEF DELPHI_XE2_DOWN} + {$UNDEF DELPHI_XE3_DOWN} + {$UNDEF DELPHI_XE4_DOWN} + {$UNDEF DELPHI_XE5_DOWN} + {$UNDEF DELPHI_XE6_DOWN} +{$ENDIF VER280} + +{$IFDEF VER290} // RAD Studio XE8 + {$DEFINE DELPHI_2010_UP} + {$DEFINE DELPHI_XE_UP} + {$DEFINE DELPHI_XE2_UP} + {$DEFINE DELPHI_XE3_UP} + {$DEFINE DELPHI_XE4_UP} + {$DEFINE DELPHI_XE5_UP} + {$DEFINE DELPHI_XE6_UP} + {$DEFINE DELPHI_XE7} + {$DEFINE DELPHI_XE7_UP} + {$DEFINE DELPHI_XE8_UP} + + {$DEFINE SUPPORTS_REGEX} + {$UNDEF DELPHI_2010_DOWN} + {$UNDEF DELPHI_XE_DOWN} + {$UNDEF DELPHI_XE2_DOWN} + {$UNDEF DELPHI_XE3_DOWN} + {$UNDEF DELPHI_XE4_DOWN} + {$UNDEF DELPHI_XE5_DOWN} + {$UNDEF DELPHI_XE6_DOWN} + {$UNDEF DELPHI_XE7_DOWN} +{$ENDIF VER290} + +{$IFDEF VER300} // RAD Studio 10 Seattle + {$DEFINE DELPHI_2010_UP} + {$DEFINE DELPHI_XE_UP} + {$DEFINE DELPHI_XE2_UP} + {$DEFINE DELPHI_XE3_UP} + {$DEFINE DELPHI_XE4_UP} + {$DEFINE DELPHI_XE5_UP} + {$DEFINE DELPHI_XE6_UP} + {$DEFINE DELPHI_XE7} + {$DEFINE DELPHI_XE7_UP} + {$DEFINE DELPHI_XE8_UP} + {$DEFINE DELPHIX_XE10_UP} + {$DEFINE DELPHIX_XE10} + {$DEFINE SUPPORTS_REGEX} + {$UNDEF DELPHI_2010_DOWN} + {$UNDEF DELPHI_XE_DOWN} + {$UNDEF DELPHI_XE2_DOWN} + {$UNDEF DELPHI_XE3_DOWN} + {$UNDEF DELPHI_XE4_DOWN} + {$UNDEF DELPHI_XE5_DOWN} + {$UNDEF DELPHI_XE6_DOWN} + {$UNDEF DELPHI_XE7_DOWN} + {$UNDEF DELPHI_XE8_DOWN} +{$ENDIF VER300} + +{$IFDEF VER310} // RAD Studio 10.1 Berlin + {$DEFINE DELPHI_2010_UP} + {$DEFINE DELPHI_XE_UP} + {$DEFINE DELPHI_XE2_UP} + {$DEFINE DELPHI_XE3_UP} + {$DEFINE DELPHI_XE4_UP} + {$DEFINE DELPHI_XE5_UP} + {$DEFINE DELPHI_XE6_UP} + {$DEFINE DELPHI_XE7} + {$DEFINE DELPHI_XE7_UP} + {$DEFINE DELPHI_XE8_UP} + {$DEFINE DELPHIX_SEATTLE_UP} + {$DEFINE DELPHIX_SEATTLE} + {$DEFINE DELPHI_XE10_UP} + {$DEFINE DELPHI_XE101_UP} + {$DEFINE DELPHI_XE101} + {$DEFINE SUPPORTS_REGEX} + {$UNDEF DELPHI_2010_DOWN} + {$UNDEF DELPHI_XE_DOWN} + {$UNDEF DELPHI_XE2_DOWN} + {$UNDEF DELPHI_XE3_DOWN} + {$UNDEF DELPHI_XE4_DOWN} + {$UNDEF DELPHI_XE5_DOWN} + {$UNDEF DELPHI_XE6_DOWN} + {$UNDEF DELPHI_XE7_DOWN} + {$UNDEF DELPHI_XE8_DOWN} + {$UNDEF DELPHI_XE10_DOWN} +{$ENDIF VER310} + +{$IFDEF VER320} // RAD Studio 10.2 Tokyo + {$DEFINE DELPHI_2010_UP} + {$DEFINE DELPHI_XE_UP} + {$DEFINE DELPHI_XE2_UP} + {$DEFINE DELPHI_XE3_UP} + {$DEFINE DELPHI_XE4_UP} + {$DEFINE DELPHI_XE5_UP} + {$DEFINE DELPHI_XE6_UP} + {$DEFINE DELPHI_XE7} + {$DEFINE DELPHI_XE7_UP} + {$DEFINE DELPHI_XE8_UP} + {$DEFINE DELPHIX_SEATTLE_UP} + {$DEFINE DELPHIX_SEATTLE} + {$DEFINE DELPHI_XE10_UP} + {$DEFINE DELPHI_XE101_UP} + {$DEFINE DELPHI_XE102_UP} + {$DEFINE DELPHI_XE102} + {$DEFINE SUPPORTS_REGEX} + {$UNDEF DELPHI_2010_DOWN} + {$UNDEF DELPHI_XE_DOWN} + {$UNDEF DELPHI_XE2_DOWN} + {$UNDEF DELPHI_XE3_DOWN} + {$UNDEF DELPHI_XE4_DOWN} + {$UNDEF DELPHI_XE5_DOWN} + {$UNDEF DELPHI_XE6_DOWN} + {$UNDEF DELPHI_XE7_DOWN} + {$UNDEF DELPHI_XE8_DOWN} + {$UNDEF DELPHI_XE10_DOWN} + {$UNDEF DELPHI_XE101_DOWN} +{$ENDIF VER320} + +{$IFDEF VER330} // RAD Studio 10.3 + {$DEFINE DELPHI_2010_UP} + {$DEFINE DELPHI_XE_UP} + {$DEFINE DELPHI_XE2_UP} + {$DEFINE DELPHI_XE3_UP} + {$DEFINE DELPHI_XE4_UP} + {$DEFINE DELPHI_XE5_UP} + {$DEFINE DELPHI_XE6_UP} + {$DEFINE DELPHI_XE7} + {$DEFINE DELPHI_XE7_UP} + {$DEFINE DELPHI_XE8_UP} + {$DEFINE DELPHIX_SEATTLE_UP} + {$DEFINE DELPHIX_SEATTLE} + {$DEFINE DELPHI_XE10_UP} + {$DEFINE DELPHI_XE101_UP} + {$DEFINE DELPHI_XE102_UP} + {$DEFINE DELPHI_XE103_UP} + {$DEFINE DELPHI_XE103} + {$DEFINE SUPPORTS_REGEX} + {$UNDEF DELPHI_2010_DOWN} + {$UNDEF DELPHI_XE_DOWN} + {$UNDEF DELPHI_XE2_DOWN} + {$UNDEF DELPHI_XE3_DOWN} + {$UNDEF DELPHI_XE4_DOWN} + {$UNDEF DELPHI_XE5_DOWN} + {$UNDEF DELPHI_XE6_DOWN} + {$UNDEF DELPHI_XE7_DOWN} + {$UNDEF DELPHI_XE8_DOWN} + {$UNDEF DELPHI_XE10_DOWN} + {$UNDEF DELPHI_XE101_DOWN} + {$UNDEF DELPHI_XE102_DOWN} +{$ENDIF VER330} + +{$IFDEF VER340} // RAD Studio 10.4 + {$DEFINE DELPHI_2010_UP} + {$DEFINE DELPHI_XE_UP} + {$DEFINE DELPHI_XE2_UP} + {$DEFINE DELPHI_XE3_UP} + {$DEFINE DELPHI_XE4_UP} + {$DEFINE DELPHI_XE5_UP} + {$DEFINE DELPHI_XE6_UP} + {$DEFINE DELPHI_XE7} + {$DEFINE DELPHI_XE7_UP} + {$DEFINE DELPHI_XE8_UP} + {$DEFINE DELPHIX_SEATTLE_UP} + {$DEFINE DELPHIX_SEATTLE} + {$DEFINE DELPHI_XE10_UP} + {$DEFINE DELPHI_XE101_UP} + {$DEFINE DELPHI_XE102_UP} + {$DEFINE DELPHI_XE103_UP} + {$DEFINE DELPHI_XE104_UP} + {$DEFINE DELPHI_XE103} + {$DEFINE SUPPORTS_REGEX} + {$UNDEF DELPHI_2010_DOWN} + {$UNDEF DELPHI_XE_DOWN} + {$UNDEF DELPHI_XE2_DOWN} + {$UNDEF DELPHI_XE3_DOWN} + {$UNDEF DELPHI_XE4_DOWN} + {$UNDEF DELPHI_XE5_DOWN} + {$UNDEF DELPHI_XE6_DOWN} + {$UNDEF DELPHI_XE7_DOWN} + {$UNDEF DELPHI_XE8_DOWN} + {$UNDEF DELPHI_XE10_DOWN} + {$UNDEF DELPHI_XE101_DOWN} + {$UNDEF DELPHI_XE102_DOWN} + {$UNDEF DELPHI_XE103_DOWN} +{$ENDIF VER340} + +{$IFDEF VER350} // RAD Studio 11.0 + {$DEFINE DELPHI_2010_UP} + {$DEFINE DELPHI_XE_UP} + {$DEFINE DELPHI_XE2_UP} + {$DEFINE DELPHI_XE3_UP} + {$DEFINE DELPHI_XE4_UP} + {$DEFINE DELPHI_XE5_UP} + {$DEFINE DELPHI_XE6_UP} + {$DEFINE DELPHI_XE7} + {$DEFINE DELPHI_XE7_UP} + {$DEFINE DELPHI_XE8_UP} + {$DEFINE DELPHIX_SEATTLE_UP} + {$DEFINE DELPHIX_SEATTLE} + {$DEFINE DELPHI_XE10_UP} + {$DEFINE DELPHI_XE101_UP} + {$DEFINE DELPHI_XE102_UP} + {$DEFINE DELPHI_XE103_UP} + {$DEFINE DELPHI_XE104_UP} + {$DEFINE DELPHI_XE110_UP} + {$DEFINE DELPHI_XE103} + {$DEFINE SUPPORTS_REGEX} + {$UNDEF DELPHI_2010_DOWN} + {$UNDEF DELPHI_XE_DOWN} + {$UNDEF DELPHI_XE2_DOWN} + {$UNDEF DELPHI_XE3_DOWN} + {$UNDEF DELPHI_XE4_DOWN} + {$UNDEF DELPHI_XE5_DOWN} + {$UNDEF DELPHI_XE6_DOWN} + {$UNDEF DELPHI_XE7_DOWN} + {$UNDEF DELPHI_XE8_DOWN} + {$UNDEF DELPHI_XE10_DOWN} + {$UNDEF DELPHI_XE101_DOWN} + {$UNDEF DELPHI_XE102_DOWN} + {$UNDEF DELPHI_XE103_DOWN} + {$UNDEF DELPHI_XE104_DOWN} +{$ENDIF VER340} diff --git a/Test/DelphiMocks/Tests/.gitignore b/Test/DelphiMocks/Tests/.gitignore index ae262c7..a017340 100644 --- a/Test/DelphiMocks/Tests/.gitignore +++ b/Test/DelphiMocks/Tests/.gitignore @@ -1,23 +1,23 @@ -# Compiled source # -################### -*.dcu -*.obj -*.exe - -# Backup files # -################### -*.~* - -# IDE Files # -################### -*.dproj.local -*.groupproj.local -*.identcache -*.dsk -*.tvsconfig - -# Output Folders # -################### -/Win32 -/Win64 - +# Compiled source # +################### +*.dcu +*.obj +*.exe + +# Backup files # +################### +*.~* + +# IDE Files # +################### +*.dproj.local +*.groupproj.local +*.identcache +*.dsk +*.tvsconfig + +# Output Folders # +################### +/Win32 +/Win64 + diff --git a/Test/DelphiMocks/Tests/MemoryLeakTest/FastMM4Options.inc b/Test/DelphiMocks/Tests/MemoryLeakTest/FastMM4Options.inc index ed1db6a..32d8f23 100644 --- a/Test/DelphiMocks/Tests/MemoryLeakTest/FastMM4Options.inc +++ b/Test/DelphiMocks/Tests/MemoryLeakTest/FastMM4Options.inc @@ -1,426 +1,426 @@ -{ - -Fast Memory Manager: Options Include File - -Set the default options for FastMM here. - -} - -{---------------------------Miscellaneous Options-----------------------------} - -{Enable this define to align all blocks on 16 byte boundaries so aligned SSE - instructions can be used safely. If this option is disabled then some of the - smallest block sizes will be 8-byte aligned instead which may result in a - reduction in memory usage. Medium and large blocks are always 16-byte aligned - irrespective of this setting.} -{.$define Align16Bytes} - -{Enable to use faster fixed-size move routines when upsizing small blocks. - These routines are much faster than the Borland RTL move procedure since they - are optimized to move a fixed number of bytes. This option may be used - together with the FastMove library for even better performance.} -{$define UseCustomFixedSizeMoveRoutines} - -{Enable this option to use an optimized procedure for moving a memory block of - an arbitrary size. Disable this option when using the Fastcode move - ("FastMove") library. Using the Fastcode move library allows your whole - application to gain from faster move routines, not just the memory manager. It - is thus recommended that you use the Fastcode move library in conjunction with - this memory manager and disable this option.} -{$define UseCustomVariableSizeMoveRoutines} - -{Enable this option to only install FastMM as the memory manager when the - application is running inside the Delphi IDE. This is useful when you want - to deploy the same EXE that you use for testing, but only want the debugging - features active on development machines. When this option is enabled and - the application is not being run inside the IDE debugger, then the default - Delphi memory manager will be used (which, since Delphi 2006, is FastMM - without FullDebugMode.} -{.$define InstallOnlyIfRunningInIDE} - -{Due to QC#14070 ("Delphi IDE attempts to free memory after the shutdown code - of borlndmm.dll has been called"), FastMM cannot be uninstalled safely when - used inside a replacement borlndmm.dll for the IDE. Setting this option will - circumvent this problem by never uninstalling the memory manager.} -{.$define NeverUninstall} - -{Set this option when you use runtime packages in this application or library. - This will automatically set the "AssumeMultiThreaded" option. Note that you - have to ensure that FastMM is finalized after all live pointers have been - freed - failure to do so will result in a large leak report followed by a lot - of A/Vs. (See the FAQ for more detail.) You may have to combine this option - with the NeverUninstall option.} -{.$define UseRuntimePackages} - -{-----------------------Concurrency Management Options------------------------} - -{Enable to always assume that the application is multithreaded. Enabling this - option will cause a significant performance hit with single threaded - applications. Enable if you are using multi-threaded third party tools that do - not properly set the IsMultiThread variable. Also set this option if you are - going to share this memory manager between a single threaded application and a - multi-threaded DLL.} -{.$define AssumeMultiThreaded} - -{Enable this option to not call Sleep when a thread contention occurs. This - option will improve performance if the ratio of the number of active threads - to the number of CPU cores is low (typically < 2). With this option set a - thread will usually enter a "busy waiting" loop instead of relinquishing its - timeslice when a thread contention occurs, unless UseSwitchToThread is - also defined (see below) in which case it will call SwitchToThread instead of - Sleep.} -{.$define NeverSleepOnThreadContention} - - {Set this option to call SwitchToThread instead of sitting in a "busy waiting" - loop when a thread contention occurs. This is used in conjunction with the - NeverSleepOnThreadContention option, and has no effect unless - NeverSleepOnThreadContention is also defined. This option may improve - performance with many CPU cores and/or threads of different priorities. Note - that the SwitchToThread API call is only available on Windows 2000 and later.} - {.$define UseSwitchToThread} - -{-----------------------------Debugging Options-------------------------------} - -{Enable this option to suppress the generation of debug info for the - FastMM4.pas unit. This will prevent the integrated debugger from stepping into - the memory manager code.} -{.$define NoDebugInfo} - -{Enable this option to suppress the display of all message dialogs. This is - useful in service applications that should not be interrupted.} -{.$define NoMessageBoxes} - -{Set this option to use the Windows API OutputDebugString procedure to output - debug strings on startup/shutdown and when errors occur.} -{.$define UseOutputDebugString} - -{Set this option to use the assembly language version which is faster than the - pascal version. Disable only for debugging purposes. Setting the - CheckHeapForCorruption option automatically disables this option.} -{$define ASMVersion} - -{FastMM always catches attempts to free the same memory block twice, however it - can also check for corruption of the memory heap (typically due to the user - program overwriting the bounds of allocated memory). These checks are - expensive, and this option should thus only be used for debugging purposes. - If this option is set then the ASMVersion option is automatically disabled.} -{.$define CheckHeapForCorruption} - -{Enable this option to catch attempts to perform MM operations after FastMM has - been uninstalled. With this option set when FastMM is uninstalled it will not - install the previous MM, but instead a dummy MM handler that throws an error - if any MM operation is attempted. This will catch attempts to use the MM - after FastMM has been uninstalled.} -{$define DetectMMOperationsAfterUninstall} - -{Set the following option to do extensive checking of all memory blocks. All - blocks are padded with both a header and trailer that are used to verify the - integrity of the heap. Freed blocks are also cleared to to ensure that they - cannot be reused after being freed. This option slows down memory operations - dramatically and should only be used to debug an application that is - overwriting memory or reusing freed pointers. Setting this option - automatically enables CheckHeapForCorruption and disables ASMVersion. - Very important: If you enable this option your application will require the - FastMM_FullDebugMode.dll library. If this library is not available you will - get an error on startup.} -{.$define FullDebugMode} - - {Set this option to perform "raw" stack traces, i.e. check all entries on the - stack for valid return addresses. Note that this is significantly slower - than using the stack frame tracing method, but is usually more complete. Has - no effect unless FullDebugMode is enabled} - {$define RawStackTraces} - - {Set this option to check for user code that uses an interface of a freed - object. Note that this will disable the checking of blocks modified after - being freed (the two are not compatible). This option has no effect if - FullDebugMode is not also enabled.} - {.$define CatchUseOfFreedInterfaces} - - {Set this option to log all errors to a text file in the same folder as the - application. Memory errors (with the FullDebugMode option set) will be - appended to the log file. Has no effect if "FullDebugMode" is not set.} - {$define LogErrorsToFile} - - {Set this option to log all memory leaks to a text file in the same folder as - the application. Memory leak reports (with the FullDebugMode option set) - will be appended to the log file. Has no effect if "LogErrorsToFile" and - "FullDebugMode" are not also set. Note that usually all leaks are always - logged, even if they are "expected" leaks registered through - AddExpectedMemoryLeaks. Expected leaks registered by pointer may be excluded - through the HideExpectedLeaksRegisteredByPointer option.} - {$define LogMemoryLeakDetailToFile} - - {Deletes the error log file on startup. No effect if LogErrorsToFile is not - also set.} - {.$define ClearLogFileOnStartup} - - {Loads the FASTMM_FullDebugMode.dll dynamically. If the DLL cannot be found - then stack traces will not be available. Note that this may cause problems - due to a changed DLL unload order when sharing the memory manager. Use with - care.} - {.$define LoadDebugDLLDynamically} - - {.$define DoNotInstallIfDLLMissing} - {If the FastMM_FullDebugMode.dll file is not available then FastMM will not - install itself. No effect unless FullDebugMode and LoadDebugDLLDynamically - are also defined.} - - {FastMM usually allocates large blocks from the topmost available address and - medium and small blocks from the lowest available address (This reduces - fragmentation somewhat). With this option set all blocks are always - allocated from the highest available address. If the process has a >2GB - address space and contains bad pointer arithmetic code, this option should - help to catch those errors sooner.} - {$define AlwaysAllocateTopDown} - - {Disables the logging of memory dumps together with the other detail for - memory errors.} - {.$define DisableLoggingOfMemoryDumps} - - {If FastMM encounters a problem with a memory block inside the FullDebugMode - FreeMem handler then an "invalid pointer operation" exception will usually - be raised. If the FreeMem occurs while another exception is being handled - (perhaps in the try.. finally code) then the original exception will be - lost. With this option set FastMM will ignore errors inside FreeMem when an - exception is being handled, thus allowing the original exception to - propagate.} - {$define SuppressFreeMemErrorsInsideException} - - {Adds support for notification of memory manager events in FullDebugMode. - With this define set, the application may assign the OnDebugGetMemFinish, - OnDebugFreeMemStart, etc. callbacks in order to be notified when the - particular memory manager event occurs.} - {.$define FullDebugModeCallBacks} - -{---------------------------Memory Leak Reporting-----------------------------} - -{Set this option to enable reporting of memory leaks. Combine it with the two - options below for further fine-tuning.} -{$define EnableMemoryLeakReporting} - - {Set this option to suppress the display and logging of expected memory leaks - that were registered by pointer. Leaks registered by size or class are often - ambiguous, so these expected leaks are always logged to file (in - FullDebugMode with the LogMemoryLeakDetailToFile option set) and are never - hidden from the leak display if there are more leaks than are expected.} - {$define HideExpectedLeaksRegisteredByPointer} - - {Set this option to require the presence of the Delphi IDE to report memory - leaks. This option has no effect if the option "EnableMemoryLeakReporting" - is not also set.} - {.$define RequireIDEPresenceForLeakReporting} - - {Set this option to require the program to be run inside the IDE debugger to - report memory leaks. This option has no effect if the option - "EnableMemoryLeakReporting" is not also set. Note that this option does not - work with libraries, only EXE projects.} - {$define RequireDebuggerPresenceForLeakReporting} - - {Set this option to require the presence of debug info ($D+ option) in the - compiled unit to perform memory leak checking. This option has no effect if - the option "EnableMemoryLeakReporting" is not also set.} - {.$define RequireDebugInfoForLeakReporting} - - {Set this option to enable manual control of the memory leak report. When - this option is set the ReportMemoryLeaksOnShutdown variable (default = false) - may be changed to select whether leak reporting should be done or not. When - this option is selected then both the variable must be set to true and the - other leak checking options must be applicable for the leak checking to be - done.} - {.$define ManualLeakReportingControl} - - {Set this option to disable the display of the hint below the memory leak - message.} - {.$define HideMemoryLeakHintMessage} - -{--------------------------Instruction Set Options----------------------------} - -{Set this option to enable the use of MMX instructions. Disabling this option - will result in a slight performance hit, but will enable compatibility with - AMD K5, Pentium I and earlier CPUs. MMX is currently only used in the variable - size move routines, so if UseCustomVariableSizeMoveRoutines is not set then - this option has no effect.} -{.$define EnableMMX} - - {Set this option to force the use of MMX instructions without checking - whether the CPU supports it. If this option is disabled then the CPU will be - checked for compatibility first, and if MMX is not supported it will fall - back to the FPU move code. Has no effect unless EnableMMX is also set.} - {$define ForceMMX} - -{-----------------------Memory Manager Sharing Options------------------------} - -{Allow sharing of the memory manager between a main application and DLLs that - were also compiled with FastMM. This allows you to pass dynamic arrays and - long strings to DLL functions provided both are compiled to use FastMM. - Sharing will only work if the library that is supposed to share the memory - manager was compiled with the "AttemptToUseSharedMM" option set. Note that if - the main application is single threaded and the DLL is multi-threaded that you - have to set the IsMultiThread variable in the main application to true or it - will crash when a thread contention occurs. Note that statically linked DLL - files are initialized before the main application, so the main application may - well end up sharing a statically loaded DLL's memory manager and not the other - way around. } -{.$define ShareMM} - - {Allow sharing of the memory manager by a DLL with other DLLs (or the main - application if this is a statically loaded DLL) that were also compiled with - FastMM. Set this option with care in dynamically loaded DLLs, because if the - DLL that is sharing its MM is unloaded and any other DLL is still sharing - the MM then the application will crash. This setting is only relevant for - DLL libraries and requires ShareMM to also be set to have any effect. - Sharing will only work if the library that is supposed to share the memory - manager was compiled with the "AttemptToUseSharedMM" option set. Note that - if DLLs are statically linked then they will be initialized before the main - application and then the DLL will in fact share its MM with the main - application. This option has no effect unless ShareMM is also set.} - {.$define ShareMMIfLibrary} - -{Define this to attempt to share the MM of the main application or other loaded - DLLs in the same process that were compiled with ShareMM set. When sharing a - memory manager, memory leaks caused by the sharer will not be freed - automatically. Take into account that statically linked DLLs are initialized - before the main application, so set the sharing options accordingly.} -{.$define AttemptToUseSharedMM} - -{Define this to enable backward compatibility for the memory manager sharing - mechanism used by Delphi 2006 and 2007, as well as older FastMM versions.} -{$define EnableBackwardCompatibleMMSharing} - -{-----------------------Security Options------------------------} - -{Windows clears physical memory before reusing it in another process. However, - it is not known how quickly this clearing is performed, so it is conceivable - that confidential data may linger in physical memory longer than absolutely - necessary. If you're paranoid about this kind of thing, enable this option to - clear all freed memory before returning it to the operating system. Note that - this incurs a noticeable performance hit.} -{.$define ClearMemoryBeforeReturningToOS} - -{With this option enabled freed memory will immediately be cleared inside the - FreeMem routine. This incurs a big performance hit, but may be worthwhile for - additional peace of mind when working with highly sensitive data. This option - supersedes the ClearMemoryBeforeReturningToOS option.} -{.$define AlwaysClearFreedMemory} - -{--------------------------------Option Grouping------------------------------} - -{Enabling this option enables FullDebugMode, InstallOnlyIfRunningInIDE and - LoadDebugDLLDynamically. Consequently, FastMM will install itself in - FullDebugMode if the application is being debugged inside the Delphi IDE. - Otherwise the default Delphi memory manager will be used (which is equivalent - to the non-FullDebugMode FastMM since Delphi 2006.)} -{.$define FullDebugModeInIDE} - -{Combines the FullDebugMode, LoadDebugDLLDynamically and - DoNotInstallIfDLLMissing options. Consequently FastMM will only be installed - (In FullDebugMode) when the FastMM_FullDebugMode.dll file is available. This - is useful when the same executable will be distributed for both debugging as - well as deployment.} -{.$define FullDebugModeWhenDLLAvailable} - -{Group the options you use for release and debug versions below} -{$ifdef Release} - {Specify the options you use for release versions below} - {.$undef FullDebugMode} - {.$undef CheckHeapForCorruption} - {.$define ASMVersion} - {.$undef EnableMemoryLeakReporting} - {.$undef UseOutputDebugString} -{$else} - {Specify the options you use for debugging below} - {.$define FullDebugMode} - {.$define EnableMemoryLeakReporting} - {.$define UseOutputDebugString} -{$endif} - -{--------------------Compilation Options For borlndmm.dll---------------------} -{If you're compiling the replacement borlndmm.dll, set the defines below - for the kind of dll you require.} - -{Set this option when compiling the borlndmm.dll} -{.$define borlndmmdll} - -{Set this option if the dll will be used by the Delphi IDE} -{.$define dllforide} - -{Set this option if you're compiling a debug dll} -{.$define debugdll} - -{Do not change anything below this line} -{$ifdef borlndmmdll} - {$define AssumeMultiThreaded} - {$undef HideExpectedLeaksRegisteredByPointer} - {$undef RequireDebuggerPresenceForLeakReporting} - {$undef RequireDebugInfoForLeakReporting} - {$define DetectMMOperationsAfterUninstall} - {$undef ManualLeakReportingControl} - {$undef ShareMM} - {$undef AttemptToUseSharedMM} - {$ifdef dllforide} - {$define NeverUninstall} - {$define HideMemoryLeakHintMessage} - {$undef RequireIDEPresenceForLeakReporting} - {$ifndef debugdll} - {$undef EnableMemoryLeakReporting} - {$endif} - {$else} - {$define EnableMemoryLeakReporting} - {$undef NeverUninstall} - {$undef HideMemoryLeakHintMessage} - {$define RequireIDEPresenceForLeakReporting} - {$endif} - {$ifdef debugdll} - {$define FullDebugMode} - {$define RawStackTraces} - {$undef CatchUseOfFreedInterfaces} - {$define LogErrorsToFile} - {$define LogMemoryLeakDetailToFile} - {$undef ClearLogFileOnStartup} - {$else} - {$undef FullDebugMode} - {$endif} -{$endif} - -{Move BCB related definitions here, because CB2006/CB2007 can build borlndmm.dll - for tracing memory leaks in BCB applications with "Build with Dynamic RTL" - switched on} -{------------------------------Patch BCB Terminate----------------------------} -{To enable the patching for BCB to make uninstallation and leak reporting - possible, you may need to add "BCB" definition - in "Project Options->Pascal/Delphi Compiler->Defines". - (Thanks to JiYuan Xie for implementing this.)} - -{$ifdef BCB} - {$ifdef CheckHeapForCorruption} - {$define PatchBCBTerminate} - {$else} - {$ifdef DetectMMOperationsAfterUninstall} - {$define PatchBCBTerminate} - {$else} - {$ifdef EnableMemoryLeakReporting} - {$define PatchBCBTerminate} - {$endif} - {$endif} - {$endif} - - {$ifdef PatchBCBTerminate} - {$define CheckCppObjectType} - {$undef CheckCppObjectTypeEnabled} - - {$ifdef CheckCppObjectType} - {$define CheckCppObjectTypeEnabled} - {$endif} - - {Turn off "CheckCppObjectTypeEnabled" option if neither "CheckHeapForCorruption" - option or "EnableMemoryLeakReporting" option were defined.} - {$ifdef CheckHeapForCorruption} - {$else} - {$ifdef EnableMemoryLeakReporting} - {$else} - {$undef CheckCppObjectTypeEnabled} - {$endif} - {$endif} - {$endif} -{$endif} +{ + +Fast Memory Manager: Options Include File + +Set the default options for FastMM here. + +} + +{---------------------------Miscellaneous Options-----------------------------} + +{Enable this define to align all blocks on 16 byte boundaries so aligned SSE + instructions can be used safely. If this option is disabled then some of the + smallest block sizes will be 8-byte aligned instead which may result in a + reduction in memory usage. Medium and large blocks are always 16-byte aligned + irrespective of this setting.} +{.$define Align16Bytes} + +{Enable to use faster fixed-size move routines when upsizing small blocks. + These routines are much faster than the Borland RTL move procedure since they + are optimized to move a fixed number of bytes. This option may be used + together with the FastMove library for even better performance.} +{$define UseCustomFixedSizeMoveRoutines} + +{Enable this option to use an optimized procedure for moving a memory block of + an arbitrary size. Disable this option when using the Fastcode move + ("FastMove") library. Using the Fastcode move library allows your whole + application to gain from faster move routines, not just the memory manager. It + is thus recommended that you use the Fastcode move library in conjunction with + this memory manager and disable this option.} +{$define UseCustomVariableSizeMoveRoutines} + +{Enable this option to only install FastMM as the memory manager when the + application is running inside the Delphi IDE. This is useful when you want + to deploy the same EXE that you use for testing, but only want the debugging + features active on development machines. When this option is enabled and + the application is not being run inside the IDE debugger, then the default + Delphi memory manager will be used (which, since Delphi 2006, is FastMM + without FullDebugMode.} +{.$define InstallOnlyIfRunningInIDE} + +{Due to QC#14070 ("Delphi IDE attempts to free memory after the shutdown code + of borlndmm.dll has been called"), FastMM cannot be uninstalled safely when + used inside a replacement borlndmm.dll for the IDE. Setting this option will + circumvent this problem by never uninstalling the memory manager.} +{.$define NeverUninstall} + +{Set this option when you use runtime packages in this application or library. + This will automatically set the "AssumeMultiThreaded" option. Note that you + have to ensure that FastMM is finalized after all live pointers have been + freed - failure to do so will result in a large leak report followed by a lot + of A/Vs. (See the FAQ for more detail.) You may have to combine this option + with the NeverUninstall option.} +{.$define UseRuntimePackages} + +{-----------------------Concurrency Management Options------------------------} + +{Enable to always assume that the application is multithreaded. Enabling this + option will cause a significant performance hit with single threaded + applications. Enable if you are using multi-threaded third party tools that do + not properly set the IsMultiThread variable. Also set this option if you are + going to share this memory manager between a single threaded application and a + multi-threaded DLL.} +{.$define AssumeMultiThreaded} + +{Enable this option to not call Sleep when a thread contention occurs. This + option will improve performance if the ratio of the number of active threads + to the number of CPU cores is low (typically < 2). With this option set a + thread will usually enter a "busy waiting" loop instead of relinquishing its + timeslice when a thread contention occurs, unless UseSwitchToThread is + also defined (see below) in which case it will call SwitchToThread instead of + Sleep.} +{.$define NeverSleepOnThreadContention} + + {Set this option to call SwitchToThread instead of sitting in a "busy waiting" + loop when a thread contention occurs. This is used in conjunction with the + NeverSleepOnThreadContention option, and has no effect unless + NeverSleepOnThreadContention is also defined. This option may improve + performance with many CPU cores and/or threads of different priorities. Note + that the SwitchToThread API call is only available on Windows 2000 and later.} + {.$define UseSwitchToThread} + +{-----------------------------Debugging Options-------------------------------} + +{Enable this option to suppress the generation of debug info for the + FastMM4.pas unit. This will prevent the integrated debugger from stepping into + the memory manager code.} +{.$define NoDebugInfo} + +{Enable this option to suppress the display of all message dialogs. This is + useful in service applications that should not be interrupted.} +{.$define NoMessageBoxes} + +{Set this option to use the Windows API OutputDebugString procedure to output + debug strings on startup/shutdown and when errors occur.} +{.$define UseOutputDebugString} + +{Set this option to use the assembly language version which is faster than the + pascal version. Disable only for debugging purposes. Setting the + CheckHeapForCorruption option automatically disables this option.} +{$define ASMVersion} + +{FastMM always catches attempts to free the same memory block twice, however it + can also check for corruption of the memory heap (typically due to the user + program overwriting the bounds of allocated memory). These checks are + expensive, and this option should thus only be used for debugging purposes. + If this option is set then the ASMVersion option is automatically disabled.} +{.$define CheckHeapForCorruption} + +{Enable this option to catch attempts to perform MM operations after FastMM has + been uninstalled. With this option set when FastMM is uninstalled it will not + install the previous MM, but instead a dummy MM handler that throws an error + if any MM operation is attempted. This will catch attempts to use the MM + after FastMM has been uninstalled.} +{$define DetectMMOperationsAfterUninstall} + +{Set the following option to do extensive checking of all memory blocks. All + blocks are padded with both a header and trailer that are used to verify the + integrity of the heap. Freed blocks are also cleared to to ensure that they + cannot be reused after being freed. This option slows down memory operations + dramatically and should only be used to debug an application that is + overwriting memory or reusing freed pointers. Setting this option + automatically enables CheckHeapForCorruption and disables ASMVersion. + Very important: If you enable this option your application will require the + FastMM_FullDebugMode.dll library. If this library is not available you will + get an error on startup.} +{.$define FullDebugMode} + + {Set this option to perform "raw" stack traces, i.e. check all entries on the + stack for valid return addresses. Note that this is significantly slower + than using the stack frame tracing method, but is usually more complete. Has + no effect unless FullDebugMode is enabled} + {$define RawStackTraces} + + {Set this option to check for user code that uses an interface of a freed + object. Note that this will disable the checking of blocks modified after + being freed (the two are not compatible). This option has no effect if + FullDebugMode is not also enabled.} + {.$define CatchUseOfFreedInterfaces} + + {Set this option to log all errors to a text file in the same folder as the + application. Memory errors (with the FullDebugMode option set) will be + appended to the log file. Has no effect if "FullDebugMode" is not set.} + {$define LogErrorsToFile} + + {Set this option to log all memory leaks to a text file in the same folder as + the application. Memory leak reports (with the FullDebugMode option set) + will be appended to the log file. Has no effect if "LogErrorsToFile" and + "FullDebugMode" are not also set. Note that usually all leaks are always + logged, even if they are "expected" leaks registered through + AddExpectedMemoryLeaks. Expected leaks registered by pointer may be excluded + through the HideExpectedLeaksRegisteredByPointer option.} + {$define LogMemoryLeakDetailToFile} + + {Deletes the error log file on startup. No effect if LogErrorsToFile is not + also set.} + {.$define ClearLogFileOnStartup} + + {Loads the FASTMM_FullDebugMode.dll dynamically. If the DLL cannot be found + then stack traces will not be available. Note that this may cause problems + due to a changed DLL unload order when sharing the memory manager. Use with + care.} + {.$define LoadDebugDLLDynamically} + + {.$define DoNotInstallIfDLLMissing} + {If the FastMM_FullDebugMode.dll file is not available then FastMM will not + install itself. No effect unless FullDebugMode and LoadDebugDLLDynamically + are also defined.} + + {FastMM usually allocates large blocks from the topmost available address and + medium and small blocks from the lowest available address (This reduces + fragmentation somewhat). With this option set all blocks are always + allocated from the highest available address. If the process has a >2GB + address space and contains bad pointer arithmetic code, this option should + help to catch those errors sooner.} + {$define AlwaysAllocateTopDown} + + {Disables the logging of memory dumps together with the other detail for + memory errors.} + {.$define DisableLoggingOfMemoryDumps} + + {If FastMM encounters a problem with a memory block inside the FullDebugMode + FreeMem handler then an "invalid pointer operation" exception will usually + be raised. If the FreeMem occurs while another exception is being handled + (perhaps in the try.. finally code) then the original exception will be + lost. With this option set FastMM will ignore errors inside FreeMem when an + exception is being handled, thus allowing the original exception to + propagate.} + {$define SuppressFreeMemErrorsInsideException} + + {Adds support for notification of memory manager events in FullDebugMode. + With this define set, the application may assign the OnDebugGetMemFinish, + OnDebugFreeMemStart, etc. callbacks in order to be notified when the + particular memory manager event occurs.} + {.$define FullDebugModeCallBacks} + +{---------------------------Memory Leak Reporting-----------------------------} + +{Set this option to enable reporting of memory leaks. Combine it with the two + options below for further fine-tuning.} +{$define EnableMemoryLeakReporting} + + {Set this option to suppress the display and logging of expected memory leaks + that were registered by pointer. Leaks registered by size or class are often + ambiguous, so these expected leaks are always logged to file (in + FullDebugMode with the LogMemoryLeakDetailToFile option set) and are never + hidden from the leak display if there are more leaks than are expected.} + {$define HideExpectedLeaksRegisteredByPointer} + + {Set this option to require the presence of the Delphi IDE to report memory + leaks. This option has no effect if the option "EnableMemoryLeakReporting" + is not also set.} + {.$define RequireIDEPresenceForLeakReporting} + + {Set this option to require the program to be run inside the IDE debugger to + report memory leaks. This option has no effect if the option + "EnableMemoryLeakReporting" is not also set. Note that this option does not + work with libraries, only EXE projects.} + {$define RequireDebuggerPresenceForLeakReporting} + + {Set this option to require the presence of debug info ($D+ option) in the + compiled unit to perform memory leak checking. This option has no effect if + the option "EnableMemoryLeakReporting" is not also set.} + {.$define RequireDebugInfoForLeakReporting} + + {Set this option to enable manual control of the memory leak report. When + this option is set the ReportMemoryLeaksOnShutdown variable (default = false) + may be changed to select whether leak reporting should be done or not. When + this option is selected then both the variable must be set to true and the + other leak checking options must be applicable for the leak checking to be + done.} + {.$define ManualLeakReportingControl} + + {Set this option to disable the display of the hint below the memory leak + message.} + {.$define HideMemoryLeakHintMessage} + +{--------------------------Instruction Set Options----------------------------} + +{Set this option to enable the use of MMX instructions. Disabling this option + will result in a slight performance hit, but will enable compatibility with + AMD K5, Pentium I and earlier CPUs. MMX is currently only used in the variable + size move routines, so if UseCustomVariableSizeMoveRoutines is not set then + this option has no effect.} +{.$define EnableMMX} + + {Set this option to force the use of MMX instructions without checking + whether the CPU supports it. If this option is disabled then the CPU will be + checked for compatibility first, and if MMX is not supported it will fall + back to the FPU move code. Has no effect unless EnableMMX is also set.} + {$define ForceMMX} + +{-----------------------Memory Manager Sharing Options------------------------} + +{Allow sharing of the memory manager between a main application and DLLs that + were also compiled with FastMM. This allows you to pass dynamic arrays and + long strings to DLL functions provided both are compiled to use FastMM. + Sharing will only work if the library that is supposed to share the memory + manager was compiled with the "AttemptToUseSharedMM" option set. Note that if + the main application is single threaded and the DLL is multi-threaded that you + have to set the IsMultiThread variable in the main application to true or it + will crash when a thread contention occurs. Note that statically linked DLL + files are initialized before the main application, so the main application may + well end up sharing a statically loaded DLL's memory manager and not the other + way around. } +{.$define ShareMM} + + {Allow sharing of the memory manager by a DLL with other DLLs (or the main + application if this is a statically loaded DLL) that were also compiled with + FastMM. Set this option with care in dynamically loaded DLLs, because if the + DLL that is sharing its MM is unloaded and any other DLL is still sharing + the MM then the application will crash. This setting is only relevant for + DLL libraries and requires ShareMM to also be set to have any effect. + Sharing will only work if the library that is supposed to share the memory + manager was compiled with the "AttemptToUseSharedMM" option set. Note that + if DLLs are statically linked then they will be initialized before the main + application and then the DLL will in fact share its MM with the main + application. This option has no effect unless ShareMM is also set.} + {.$define ShareMMIfLibrary} + +{Define this to attempt to share the MM of the main application or other loaded + DLLs in the same process that were compiled with ShareMM set. When sharing a + memory manager, memory leaks caused by the sharer will not be freed + automatically. Take into account that statically linked DLLs are initialized + before the main application, so set the sharing options accordingly.} +{.$define AttemptToUseSharedMM} + +{Define this to enable backward compatibility for the memory manager sharing + mechanism used by Delphi 2006 and 2007, as well as older FastMM versions.} +{$define EnableBackwardCompatibleMMSharing} + +{-----------------------Security Options------------------------} + +{Windows clears physical memory before reusing it in another process. However, + it is not known how quickly this clearing is performed, so it is conceivable + that confidential data may linger in physical memory longer than absolutely + necessary. If you're paranoid about this kind of thing, enable this option to + clear all freed memory before returning it to the operating system. Note that + this incurs a noticeable performance hit.} +{.$define ClearMemoryBeforeReturningToOS} + +{With this option enabled freed memory will immediately be cleared inside the + FreeMem routine. This incurs a big performance hit, but may be worthwhile for + additional peace of mind when working with highly sensitive data. This option + supersedes the ClearMemoryBeforeReturningToOS option.} +{.$define AlwaysClearFreedMemory} + +{--------------------------------Option Grouping------------------------------} + +{Enabling this option enables FullDebugMode, InstallOnlyIfRunningInIDE and + LoadDebugDLLDynamically. Consequently, FastMM will install itself in + FullDebugMode if the application is being debugged inside the Delphi IDE. + Otherwise the default Delphi memory manager will be used (which is equivalent + to the non-FullDebugMode FastMM since Delphi 2006.)} +{.$define FullDebugModeInIDE} + +{Combines the FullDebugMode, LoadDebugDLLDynamically and + DoNotInstallIfDLLMissing options. Consequently FastMM will only be installed + (In FullDebugMode) when the FastMM_FullDebugMode.dll file is available. This + is useful when the same executable will be distributed for both debugging as + well as deployment.} +{.$define FullDebugModeWhenDLLAvailable} + +{Group the options you use for release and debug versions below} +{$ifdef Release} + {Specify the options you use for release versions below} + {.$undef FullDebugMode} + {.$undef CheckHeapForCorruption} + {.$define ASMVersion} + {.$undef EnableMemoryLeakReporting} + {.$undef UseOutputDebugString} +{$else} + {Specify the options you use for debugging below} + {.$define FullDebugMode} + {.$define EnableMemoryLeakReporting} + {.$define UseOutputDebugString} +{$endif} + +{--------------------Compilation Options For borlndmm.dll---------------------} +{If you're compiling the replacement borlndmm.dll, set the defines below + for the kind of dll you require.} + +{Set this option when compiling the borlndmm.dll} +{.$define borlndmmdll} + +{Set this option if the dll will be used by the Delphi IDE} +{.$define dllforide} + +{Set this option if you're compiling a debug dll} +{.$define debugdll} + +{Do not change anything below this line} +{$ifdef borlndmmdll} + {$define AssumeMultiThreaded} + {$undef HideExpectedLeaksRegisteredByPointer} + {$undef RequireDebuggerPresenceForLeakReporting} + {$undef RequireDebugInfoForLeakReporting} + {$define DetectMMOperationsAfterUninstall} + {$undef ManualLeakReportingControl} + {$undef ShareMM} + {$undef AttemptToUseSharedMM} + {$ifdef dllforide} + {$define NeverUninstall} + {$define HideMemoryLeakHintMessage} + {$undef RequireIDEPresenceForLeakReporting} + {$ifndef debugdll} + {$undef EnableMemoryLeakReporting} + {$endif} + {$else} + {$define EnableMemoryLeakReporting} + {$undef NeverUninstall} + {$undef HideMemoryLeakHintMessage} + {$define RequireIDEPresenceForLeakReporting} + {$endif} + {$ifdef debugdll} + {$define FullDebugMode} + {$define RawStackTraces} + {$undef CatchUseOfFreedInterfaces} + {$define LogErrorsToFile} + {$define LogMemoryLeakDetailToFile} + {$undef ClearLogFileOnStartup} + {$else} + {$undef FullDebugMode} + {$endif} +{$endif} + +{Move BCB related definitions here, because CB2006/CB2007 can build borlndmm.dll + for tracing memory leaks in BCB applications with "Build with Dynamic RTL" + switched on} +{------------------------------Patch BCB Terminate----------------------------} +{To enable the patching for BCB to make uninstallation and leak reporting + possible, you may need to add "BCB" definition + in "Project Options->Pascal/Delphi Compiler->Defines". + (Thanks to JiYuan Xie for implementing this.)} + +{$ifdef BCB} + {$ifdef CheckHeapForCorruption} + {$define PatchBCBTerminate} + {$else} + {$ifdef DetectMMOperationsAfterUninstall} + {$define PatchBCBTerminate} + {$else} + {$ifdef EnableMemoryLeakReporting} + {$define PatchBCBTerminate} + {$endif} + {$endif} + {$endif} + + {$ifdef PatchBCBTerminate} + {$define CheckCppObjectType} + {$undef CheckCppObjectTypeEnabled} + + {$ifdef CheckCppObjectType} + {$define CheckCppObjectTypeEnabled} + {$endif} + + {Turn off "CheckCppObjectTypeEnabled" option if neither "CheckHeapForCorruption" + option or "EnableMemoryLeakReporting" option were defined.} + {$ifdef CheckHeapForCorruption} + {$else} + {$ifdef EnableMemoryLeakReporting} + {$else} + {$undef CheckCppObjectTypeEnabled} + {$endif} + {$endif} + {$endif} +{$endif} diff --git a/Test/DelphiMocks/VSoft.DelphiMocks.dspec b/Test/DelphiMocks/VSoft.DelphiMocks.dspec index f351958..70a6d21 100644 --- a/Test/DelphiMocks/VSoft.DelphiMocks.dspec +++ b/Test/DelphiMocks/VSoft.DelphiMocks.dspec @@ -1,181 +1,181 @@ -{ - "metadata": { - "id": "VSoft.DelphiMocks", - "version": "0.2.2", - "description": "Simple mocking framework for Delphi XE2 or later.", - "authors": "Vincent Parrett", - "projectUrl": "https://github.com/VSoftTechnologies/Delphi-Mocks", - "license": "Apache-2.0", - "copyright": "Vincent Parrett and contributors", - "tags": "mocking unittesting" - }, - "targetPlatforms": [ - { - "compiler": "XE2", - "platforms": "Win32, Win64", - "template": "default" - }, - { - "compiler": "XE3", - "platforms": "Win32, Win64", - "template": "default" - }, - { - "compiler": "XE4", - "platforms": "Win32, Win64", - "template": "default" - }, - { - "compiler": "XE5", - "platforms": "Win32, Win64", - "template": "XE5+" - }, - { - "compiler": "XE6", - "platforms": "Win32, Win64", - "template": "XE5+" - }, - { - "compiler": "XE7", - "platforms": "Win32, Win64", - "template": "XE5+" - }, - { - "compiler": "XE8", - "platforms": "Win32, Win64", - "template": "XE5+" - }, - { - "compiler": "10.0", - "platforms": "Win32, Win64", - "template": "XE5+" - }, - { - "compiler": "10.1", - "platforms": "Win32, Win64", - "template": "XE5+" - }, - { - "compiler": "10.2", - "platforms": "Win32, Win64", - "template": "XE5+" - }, - { - "compiler": "10.3", - "platforms": "Win32, Win64", - "template": "XE5+" - }, - { - "compiler": "10.4", - "platforms": "Win32, Win64", - "template": "10.4+" - }, - { - "compiler": "11.0", - "platforms": "Win32, Win64", - "template": "10.4+" - } - ], - "templates": [ - { - "name": "default", - "source": [ - { - "src": "Source\\*.pas", - "dest": "src" - }, - { - "src": "Source\\*.inc", - "dest": "src" - }, - { - "src": "Source\\DelphiMocks.dpk", - "dest": "src" - }, - { - "src": "Source\\DelphiMocks.dproj", - "dest": "src" - } - - ], - "searchPaths": [ - { - "path": "src" - } - ], - "build": [ - { - "id": "DelphiMocks", - "project": ".\\src\\DelphiMocks.dproj" - } - ] - }, - { - "name": "XE5+", - "source": [ - { - "src": "Source\\*.pas", - "dest": "src" - }, - { - "src": "Source\\*.inc", - "dest": "src" - }, - { - "src": "Source\\DelphiMocksXE5.dpk", - "dest": "src" - }, - { - "src": "Source\\DelphiMocksXE5.dproj", - "dest": "src" - } - - ], - "searchPaths": [ - { - "path": "src" - } - ], - "build": [ - { - "id": "DelphiMocks", - "project": ".\\src\\DelphiMocksXE5.dproj" - } - ] - }, - { - "name": "10.4+", - "source": [ - { - "src": "Source\\*.pas", - "dest": "src" - }, - { - "src": "Source\\*.inc", - "dest": "src" - }, - { - "src": "Source\\DelphiMocks104.dpk", - "dest": "src" - }, - { - "src": "Source\\DelphiMocks104.dproj", - "dest": "src" - } - - ], - "searchPaths": [ - { - "path": "src" - } - ], - "build": [ - { - "id": "DelphiMocks", - "project": ".\\src\\DelphiMocks104.dproj" - } - ] - } - - ] -} +{ + "metadata": { + "id": "VSoft.DelphiMocks", + "version": "0.2.2", + "description": "Simple mocking framework for Delphi XE2 or later.", + "authors": "Vincent Parrett", + "projectUrl": "https://github.com/VSoftTechnologies/Delphi-Mocks", + "license": "Apache-2.0", + "copyright": "Vincent Parrett and contributors", + "tags": "mocking unittesting" + }, + "targetPlatforms": [ + { + "compiler": "XE2", + "platforms": "Win32, Win64", + "template": "default" + }, + { + "compiler": "XE3", + "platforms": "Win32, Win64", + "template": "default" + }, + { + "compiler": "XE4", + "platforms": "Win32, Win64", + "template": "default" + }, + { + "compiler": "XE5", + "platforms": "Win32, Win64", + "template": "XE5+" + }, + { + "compiler": "XE6", + "platforms": "Win32, Win64", + "template": "XE5+" + }, + { + "compiler": "XE7", + "platforms": "Win32, Win64", + "template": "XE5+" + }, + { + "compiler": "XE8", + "platforms": "Win32, Win64", + "template": "XE5+" + }, + { + "compiler": "10.0", + "platforms": "Win32, Win64", + "template": "XE5+" + }, + { + "compiler": "10.1", + "platforms": "Win32, Win64", + "template": "XE5+" + }, + { + "compiler": "10.2", + "platforms": "Win32, Win64", + "template": "XE5+" + }, + { + "compiler": "10.3", + "platforms": "Win32, Win64", + "template": "XE5+" + }, + { + "compiler": "10.4", + "platforms": "Win32, Win64", + "template": "10.4+" + }, + { + "compiler": "11.0", + "platforms": "Win32, Win64", + "template": "10.4+" + } + ], + "templates": [ + { + "name": "default", + "source": [ + { + "src": "Source\\*.pas", + "dest": "src" + }, + { + "src": "Source\\*.inc", + "dest": "src" + }, + { + "src": "Source\\DelphiMocks.dpk", + "dest": "src" + }, + { + "src": "Source\\DelphiMocks.dproj", + "dest": "src" + } + + ], + "searchPaths": [ + { + "path": "src" + } + ], + "build": [ + { + "id": "DelphiMocks", + "project": ".\\src\\DelphiMocks.dproj" + } + ] + }, + { + "name": "XE5+", + "source": [ + { + "src": "Source\\*.pas", + "dest": "src" + }, + { + "src": "Source\\*.inc", + "dest": "src" + }, + { + "src": "Source\\DelphiMocksXE5.dpk", + "dest": "src" + }, + { + "src": "Source\\DelphiMocksXE5.dproj", + "dest": "src" + } + + ], + "searchPaths": [ + { + "path": "src" + } + ], + "build": [ + { + "id": "DelphiMocks", + "project": ".\\src\\DelphiMocksXE5.dproj" + } + ] + }, + { + "name": "10.4+", + "source": [ + { + "src": "Source\\*.pas", + "dest": "src" + }, + { + "src": "Source\\*.inc", + "dest": "src" + }, + { + "src": "Source\\DelphiMocks104.dpk", + "dest": "src" + }, + { + "src": "Source\\DelphiMocks104.dproj", + "dest": "src" + } + + ], + "searchPaths": [ + { + "path": "src" + } + ], + "build": [ + { + "id": "DelphiMocks", + "project": ".\\src\\DelphiMocks104.dproj" + } + ] + } + + ] +} diff --git a/Test/Next.Core.Test.Assert.pas b/Test/Next.Core.Test.Assert.pas index e0a4223..dc6d207 100644 --- a/Test/Next.Core.Test.Assert.pas +++ b/Test/Next.Core.Test.Assert.pas @@ -1,5 +1,9 @@ unit Next.Core.Test.Assert; +// Enable this define if Spring4D is available in the project search path. +// When disabled, equivalent RTTI-based logic is used instead. +{.$DEFINE SPRING4D} + interface uses @@ -77,7 +81,10 @@ implementation uses DUnitX.ResStrs, System.DateUtils, Delphi.Mocks.Helpers, System.TypInfo, - Spring.Reflection, System.Generics.Defaults, System.Math, System.Types; +{$IFDEF SPRING4D} + Spring.Reflection, +{$ENDIF} + System.Generics.Defaults, System.Math, System.Types; { Assert } @@ -88,7 +95,11 @@ class procedure Assert.AreEqual(const expected, actual: Double; const tolerance: class procedure Assert.AreEqual(const expected, actual: T; const AMessage: string); begin +{$IFDEF SPRING4D} if IsGeneric(TType.GetType(System.TypeInfo(T)), 'TList<>') then +{$ELSE} + if IsGeneric(TRttiContext.Create.GetType(System.TypeInfo(T)), 'TList<>') then +{$ENDIF} AreEqualLists(TValue.From(expected), TValue.From(actual), AMessage) else AreEqualCore(TValue.From(expected), TValue.From(actual), AMessage); @@ -111,23 +122,38 @@ class procedure Assert.AreEqualLists(const expected, actual: TValue; const AMess var LGetCount := GenericCountProperty(expected.RttiType); var LGetItem := GenericGetItemMethod(expected.RttiType); +{$IFDEF SPRING4D} Assert.AreEqual(LGetCount.GetValue(expected).AsInteger, LGetCount.GetValue(actual).AsInteger, AMessage); for var i := 0 to LGetCount.GetValue(expected).AsInteger - 1 do +{$ELSE} + Assert.AreEqual(LGetCount.GetValue(expected.AsObject).AsInteger, + LGetCount.GetValue(actual.AsObject).AsInteger, AMessage); + + for var i := 0 to LGetCount.GetValue(expected.AsObject).AsInteger - 1 do +{$ENDIF} Assert.AreEqualCore(LGetItem.Invoke(expected, [TValue.From(i)]), LGetItem.Invoke(actual, [TValue.From(i)]), AMessage); end; class procedure Assert.AreNotEqual(const expected, actual: T; const AMessage: string); begin +{$IFDEF SPRING4D} if IsGeneric(TType.GetType(System.TypeInfo(T)), 'TList<>') then +{$ELSE} + if IsGeneric(TRttiContext.Create.GetType(System.TypeInfo(T)), 'TList<>') then +{$ENDIF} AreNotEqualLists(TValue.From(expected), TValue.From(actual), AMessage) else AreNotEqualCore(TValue.From(expected), TValue.From(actual), AMessage); end; class procedure Assert.AreNotEqualCore(const expected, actual: TValue; const AMessage: string); +{$IFNDEF SPRING4D} +const + SEqualsErrorStr2 = 'Expected value and actual value should not be equal. Expected: %s Actual: %s %s'; +{$ENDIF} begin DoAssert; if expected.Equals(actual) then @@ -139,10 +165,17 @@ class procedure Assert.AreNotEqualLists(const expected, actual: TValue; const AM var LGetCount := GenericCountProperty(expected.RttiType); var LGetItem := GenericGetItemMethod(expected.RttiType); +{$IFDEF SPRING4D} Assert.AreNotEqual(LGetCount.GetValue(expected).AsInteger, LGetCount.GetValue(actual).AsInteger, AMessage); for var i := 0 to LGetCount.GetValue(expected).AsInteger - 1 do +{$ELSE} + Assert.AreNotEqual(LGetCount.GetValue(expected.AsObject).AsInteger, + LGetCount.GetValue(actual.AsObject).AsInteger, AMessage); + + for var i := 0 to LGetCount.GetValue(expected.AsObject).AsInteger - 1 do +{$ENDIF} Assert.AreNotEqualCore(LGetItem.Invoke(expected, [TValue.From(i)]), LGetItem.Invoke(actual, [TValue.From(i)]), AMessage); end; @@ -166,8 +199,13 @@ class function Assert.GenericGetItemMethod(AType: TRttiType): TRttiMethod; begin Result := nil; for var LMethod in AType.GetMethods('GetItem') do +{$IFDEF SPRING4D} if (LMethod.ParameterCount = 1) and (LMethod.Parameters[0].ParamType.TypeKind = tkInteger) and (LMethod.ReturnType = AType.GetGenericArguments[0]) then +{$ELSE} + if (Length(LMethod.GetParameters) = 1) and (LMethod.GetParameters[0].ParamType.TypeKind = tkInteger) + and Assigned(LMethod.ReturnType) then +{$ENDIF} Exit(LMethod); end; @@ -180,7 +218,13 @@ class procedure Assert.IsBetween(const AMin, AMax, AActual, ATolerance: Double; class function Assert.IsGeneric(const AClassType: TRttiType; const AGenericName: String): Boolean; begin +{$IFDEF SPRING4D} Result := AClassType.IsGenericTypeOf(AGenericName); +{$ELSE} + // AGenericName is e.g. 'TList<>' - match type names like 'TList' + var LPrefix := AGenericName.Replace('>', ''); // 'TList<>' -> 'TList<' + Result := AClassType.Name.StartsWith(LPrefix); +{$ENDIF} if not Result then begin var baseType := AClassType.BaseType; diff --git a/Test/TestNext.dpr b/Test/TestNext.dpr index 12ffe6b..47aeab7 100644 --- a/Test/TestNext.dpr +++ b/Test/TestNext.dpr @@ -16,6 +16,8 @@ uses DUnitX.TestFramework, Next.Core.DisposableValue in '..\Core\Types\Next.Core.DisposableValue.pas', Next.Core.FailureReason in '..\Core\Types\Next.Core.FailureReason.pas', + Next.Core.Promises.Exceptions in '..\Core\Types\Next.Core.Promises.Exceptions.pas', + Next.Core.Promises.Cancellation in '..\Core\Types\Next.Core.Promises.Cancellation.pas', Next.Core.Promises in '..\Core\Types\Next.Core.Promises.pas', Next.Core.TTry in '..\Core\Types\Next.Core.TTry.pas', Next.Core.Void in '..\Core\Types\Next.Core.Void.pas', @@ -25,7 +27,14 @@ uses Next.Core.TestPromises in 'Types\Next.Core.TestPromises.pas', Next.Core.TestVoid in 'Types\Next.Core.TestVoid.pas', Next.Core.Test.GenericTest in 'Next.Core.Test.GenericTest.pas', - Next.Core.TestTry in 'Types\Next.Core.TestTry.pas'; + Next.Core.TestTry in 'Types\Next.Core.TestTry.pas', + TestPromiseRace in 'Types\TestPromiseRace.pas', + TestPromiseAny in 'Types\TestPromiseAny.pas', + TestPromiseAllSettled in 'Types\TestPromiseAllSettled.pas', + TestPromiseFinally in 'Types\TestPromiseFinally.pas', + TestPromiseCancellation in 'Types\TestPromiseCancellation.pas', + TestPromiseTimeout in 'Types\TestPromiseTimeout.pas', + TestPromiseExceptions in 'Types\TestPromiseExceptions.pas'; {$IFNDEF TESTINSIGHT} var diff --git a/Test/TestNext.dproj b/Test/TestNext.dproj index 5a5efb7..9989ed0 100644 --- a/Test/TestNext.dproj +++ b/Test/TestNext.dproj @@ -104,6 +104,15 @@ + + + + + + + + + Base diff --git a/Test/Types/Next.Core.TestPromises.pas b/Test/Types/Next.Core.TestPromises.pas index 5ac05de..2456819 100644 --- a/Test/Types/Next.Core.TestPromises.pas +++ b/Test/Types/Next.Core.TestPromises.pas @@ -286,7 +286,7 @@ implementation uses Delphi.Mocks, System.Rtti, System.Threading, Winapi.Windows, Next.Core.Test.Assert, Vcl.Forms, System.Generics.Collections, - System.DateUtils, Next.Core.FailureReason, CodeSiteLogging, + System.DateUtils, Next.Core.FailureReason, Next.Core.DisposableValue, Next.Core.Void; { TTestPromises } diff --git a/Test/Types/TestPromiseAllSettled.pas b/Test/Types/TestPromiseAllSettled.pas new file mode 100644 index 0000000..0de2959 --- /dev/null +++ b/Test/Types/TestPromiseAllSettled.pas @@ -0,0 +1,266 @@ +unit TestPromiseAllSettled; + +interface + +uses + DUnitX.TestFramework, System.SysUtils, System.SyncObjs, System.Classes, + Next.Core.Promises, Next.Core.Promises.Exceptions, Next.Core.Test.Assert, + Next.Core.Test.GenericTest, Next.Core.TestPromises; + +type + [TestFixture] + TTestPromiseAllSettled = class(TGenericTest) + public + [Test] procedure EmptyArrayResolvesEmpty; + [Test] procedure AllResolve; + [Test] procedure AllReject; + [Test] procedure MixedResults; + [Test] procedure OrderPreserved; + [Test] procedure SingleResolvedPromise; + [Test] procedure SingleRejectedPromise; + end; + + [TestFixture] + TTestPromiseAllSettledConcurrency = class + public + [Test] + procedure StressTestManyPromises; + end; + +implementation + +{ TTestPromiseAllSettled } + +procedure TTestPromiseAllSettled.EmptyArrayResolvesEmpty; +var + LPromise: IPromise>>; + LResults: TArray>; +begin + LPromise := Promise.AllSettled([]); + Assert.Resolves(LPromise); + LResults := LPromise.Await; + Assert.AreEqual(0, Length(LResults)); +end; + +procedure TTestPromiseAllSettled.AllResolve; +var + LPromise: IPromise>>; + LResults: TArray>; +begin + LPromise := Promise.AllSettled([ + Promise.Resolve(function: T begin Result := CreateValue(1) end), + Promise.Resolve(function: T begin Result := CreateValue(2) end), + Promise.Resolve(function: T begin Result := CreateValue(3) end) + ]); + + Assert.Resolves(LPromise); + LResults := LPromise.Await; + + Assert.AreEqual(3, Length(LResults)); + Assert.AreEqual(Ord(TPromiseStatus.psResolved), Ord(LResults[0].Status)); + TestEqualsFreeExpected(CreateValue(1), LResults[0].Value); + Assert.IsNull(LResults[0].Error); + + Assert.AreEqual(Ord(TPromiseStatus.psResolved), Ord(LResults[1].Status)); + TestEqualsFreeExpected(CreateValue(2), LResults[1].Value); + + Assert.AreEqual(Ord(TPromiseStatus.psResolved), Ord(LResults[2].Status)); + TestEqualsFreeExpected(CreateValue(3), LResults[2].Value); +end; + +procedure TTestPromiseAllSettled.AllReject; +var + LPromise: IPromise>>; + LResults: TArray>; +begin + LPromise := Promise.AllSettled([ + Promise.Reject(ETestException.Create('error1')), + Promise.Reject(ETestException.Create('error2')) + ]); + + Assert.Resolves(LPromise); + LResults := LPromise.Await; + + Assert.AreEqual(2, Length(LResults)); + Assert.AreEqual(Ord(TPromiseStatus.psRejected), Ord(LResults[0].Status)); + Assert.IsNotNull(LResults[0].Error); + Assert.AreEqual('error1', LResults[0].Error.Message); + + Assert.AreEqual(Ord(TPromiseStatus.psRejected), Ord(LResults[1].Status)); + Assert.IsNotNull(LResults[1].Error); + Assert.AreEqual('error2', LResults[1].Error.Message); +end; + +procedure TTestPromiseAllSettled.MixedResults; +var + LPromise: IPromise>>; + LResults: TArray>; +begin + LPromise := Promise.AllSettled([ + Promise.Resolve(function: T begin Result := CreateValue(42) end), + Promise.Reject(ETestException.Create('failed')), + Promise.Resolve(function: T begin Result := CreateValue(99) end) + ]); + + Assert.Resolves(LPromise); + LResults := LPromise.Await; + + Assert.AreEqual(3, Length(LResults)); + + // First: resolved + Assert.AreEqual(Ord(TPromiseStatus.psResolved), Ord(LResults[0].Status)); + TestEqualsFreeExpected(CreateValue(42), LResults[0].Value); + Assert.IsNull(LResults[0].Error); + + // Second: rejected + Assert.AreEqual(Ord(TPromiseStatus.psRejected), Ord(LResults[1].Status)); + Assert.IsNotNull(LResults[1].Error); + Assert.AreEqual('failed', LResults[1].Error.Message); + + // Third: resolved + Assert.AreEqual(Ord(TPromiseStatus.psResolved), Ord(LResults[2].Status)); + TestEqualsFreeExpected(CreateValue(99), LResults[2].Value); +end; + +procedure TTestPromiseAllSettled.OrderPreserved; +var + LSignals: array[0..2] of TEvent; + LPromise: IPromise>>; + LResults: TArray>; + i: Integer; +begin + for i := 0 to 2 do + LSignals[i] := TEvent.Create; + try + LPromise := Promise.AllSettled([ + Promise.Resolve(function: T + begin + LSignals[0].WaitFor; + Result := CreateValue(100); + end), + Promise.Resolve(function: T + begin + LSignals[1].WaitFor; + Result := CreateValue(200); + end), + Promise.Resolve(function: T + begin + LSignals[2].WaitFor; + Result := CreateValue(300); + end) + ]); + + // Signal in reverse order to test that results match input order + LSignals[2].SetEvent; + Sleep(10); + LSignals[1].SetEvent; + Sleep(10); + LSignals[0].SetEvent; + + Assert.Resolves(LPromise); + LResults := LPromise.Await; + + Assert.AreEqual(3, Length(LResults)); + TestEqualsFreeExpected(CreateValue(100), LResults[0].Value); + TestEqualsFreeExpected(CreateValue(200), LResults[1].Value); + TestEqualsFreeExpected(CreateValue(300), LResults[2].Value); + finally + for i := 0 to 2 do + LSignals[i].Free; + end; +end; + +procedure TTestPromiseAllSettled.SingleResolvedPromise; +var + LPromise: IPromise>>; + LResults: TArray>; +begin + LPromise := Promise.AllSettled([ + Promise.Resolve(function: T begin Result := CreateValue(5) end) + ]); + + Assert.Resolves(LPromise); + LResults := LPromise.Await; + + Assert.AreEqual(1, Length(LResults)); + Assert.AreEqual(Ord(TPromiseStatus.psResolved), Ord(LResults[0].Status)); + TestEqualsFreeExpected(CreateValue(5), LResults[0].Value); +end; + +procedure TTestPromiseAllSettled.SingleRejectedPromise; +var + LPromise: IPromise>>; + LResults: TArray>; +begin + LPromise := Promise.AllSettled([ + Promise.Reject(ETestException.Create('single error')) + ]); + + Assert.Resolves(LPromise); + LResults := LPromise.Await; + + Assert.AreEqual(1, Length(LResults)); + Assert.AreEqual(Ord(TPromiseStatus.psRejected), Ord(LResults[0].Status)); + Assert.IsNotNull(LResults[0].Error); + Assert.AreEqual('single error', LResults[0].Error.Message); +end; + +{ TTestPromiseAllSettledConcurrency } + +function MakeResolvePromise(AValue: Integer): IPromise; +begin + Result := Promise.Resolve(function: Integer begin Result := AValue end); +end; + +function MakeRejectPromise(AIndex: Integer): IPromise; +begin + Result := Promise.Reject(ETestException.Create('error' + IntToStr(AIndex))); +end; + +procedure TTestPromiseAllSettledConcurrency.StressTestManyPromises; +var + LPromises: TArray>; + LPromise: IPromise>>; + LResults: TArray>; + i: Integer; +const + COUNT = 50; +begin + SetLength(LPromises, COUNT); + for i := 0 to COUNT - 1 do + begin + if i mod 2 = 0 then + LPromises[i] := MakeResolvePromise(i) + else + LPromises[i] := MakeRejectPromise(i); + end; + + LPromise := Promise.AllSettled(LPromises); + Assert.Resolves(LPromise); + LResults := LPromise.Await; + + Assert.AreEqual(COUNT, Length(LResults)); + for i := 0 to COUNT - 1 do + begin + if i mod 2 = 0 then + begin + Assert.AreEqual(Ord(TPromiseStatus.psResolved), Ord(LResults[i].Status)); + Assert.AreEqual(i, LResults[i].Value); + end + else + begin + Assert.AreEqual(Ord(TPromiseStatus.psRejected), Ord(LResults[i].Status)); + Assert.IsNotNull(LResults[i].Error); + end; + end; +end; + +initialization + TDUnitX.RegisterTestFixture(TTestPromiseAllSettled); + TDUnitX.RegisterTestFixture(TTestPromiseAllSettled); + TDUnitX.RegisterTestFixture(TTestPromiseAllSettled); + TDUnitX.RegisterTestFixture(TTestPromiseAllSettled); + TDUnitX.RegisterTestFixture(TTestPromiseAllSettled); + TDUnitX.RegisterTestFixture(TTestPromiseAllSettledConcurrency); + +end. diff --git a/Test/Types/TestPromiseAny.pas b/Test/Types/TestPromiseAny.pas new file mode 100644 index 0000000..5a4c2a0 --- /dev/null +++ b/Test/Types/TestPromiseAny.pas @@ -0,0 +1,205 @@ +unit TestPromiseAny; + +interface + +uses + DUnitX.TestFramework, System.SysUtils, System.SyncObjs, System.Classes, + Next.Core.Promises, Next.Core.Promises.Exceptions, Next.Core.Test.Assert, + Next.Core.Test.GenericTest, Next.Core.TestPromises; + +type + [TestFixture] + TTestPromiseAny = class(TGenericTest) + public + [Test] procedure EmptyArrayRejects; + [Test] procedure SingleResolvingPromise; + [Test] procedure SingleRejectingPromise; + [Test] procedure FirstResolvesAnyResolves; + [Test] procedure OnlyLastResolvesStillResolves; + [Test] procedure AllRejectAggregateException; + [Test] procedure AllRejectExceptionCountMatches; + [Test] + procedure AllRejectMessagesPreserved; + end; + + [TestFixture] + TTestPromiseAnyConcurrency = class + public + [Test] procedure StressTestManyPromises; + end; + +implementation + +{ TTestPromiseAny } + +procedure TTestPromiseAny.EmptyArrayRejects; +var + LPromise: IPromise; +begin + LPromise := Promise.Any([]); + Assert.RejectsWith(LPromise, EArgumentException); +end; + +procedure TTestPromiseAny.SingleResolvingPromise; +var + LPromise: IPromise; +begin + LPromise := Promise.Any([ + Promise.Resolve(function: T + begin + Result := CreateValue(7); + end) + ]); + + Assert.Resolves(LPromise); + TestEqualsFreeExpected(CreateValue(7), LPromise.Await); +end; + +procedure TTestPromiseAny.SingleRejectingPromise; +var + LPromise: IPromise; +begin + LPromise := Promise.Any([ + Promise.Reject(ETestException.Create('only error')) + ]); + + Assert.RejectsWith(LPromise, EAggregateException); + + LPromise.InternalWait; + var LAgg := LPromise.GetFailure.Reason as EAggregateException; + Assert.AreEqual(1, Length(LAgg.Exceptions)); + Assert.IsTrue(LAgg.Message.Contains('only error')); +end; + +procedure TTestPromiseAny.FirstResolvesAnyResolves; +var + LPromise: IPromise; + LSlowSignal: TEvent; +begin + LSlowSignal := TEvent.Create; + try + LPromise := Promise.Any([ + Promise.Reject(ETestException.Create('error1')), + Promise.Resolve(function: T + begin + Result := CreateValue(42); + end), + Promise.Resolve(function: T + begin + LSlowSignal.WaitFor; + Result := CreateValue(99); + end) + ]); + + Assert.Resolves(LPromise); + TestEqualsFreeExpected(CreateValue(42), LPromise.Await); + LSlowSignal.SetEvent; + finally + LSlowSignal.Free; + end; +end; + +procedure TTestPromiseAny.OnlyLastResolvesStillResolves; +var + LPromise: IPromise; +begin + LPromise := Promise.Any([ + Promise.Reject(ETestException.Create('error1')), + Promise.Reject(ETestException.Create('error2')), + Promise.Resolve(function: T + begin + Sleep(50); + Result := CreateValue(42); + end) + ]); + + Assert.Resolves(LPromise); + TestEqualsFreeExpected(CreateValue(42), LPromise.Await); +end; + +procedure TTestPromiseAny.AllRejectAggregateException; +var + LPromise: IPromise; +begin + LPromise := Promise.Any([ + Promise.Reject(ETestException.Create('error1')), + Promise.Reject(ETestException.Create('error2')), + Promise.Reject(ETestException.Create('error3')) + ]); + + Assert.RejectsWith(LPromise, EAggregateException); +end; + +procedure TTestPromiseAny.AllRejectExceptionCountMatches; +var + LPromise: IPromise; +begin + LPromise := Promise.Any([ + Promise.Reject(ETestException.Create('e1')), + Promise.Reject(ETestException.Create('e2')), + Promise.Reject(ETestException.Create('e3')) + ]); + + Assert.RejectsWith(LPromise, EAggregateException); + + LPromise.InternalWait; + var LAgg := LPromise.GetFailure.Reason as EAggregateException; + Assert.AreEqual(3, Length(LAgg.Exceptions)); +end; + +procedure TTestPromiseAny.AllRejectMessagesPreserved; +var + LPromise: IPromise; +begin + LPromise := Promise.Any([ + Promise.Reject(ETestException.Create('alpha')), + Promise.Reject(ETestException.Create('beta')) + ]); + + Assert.RejectsWith(LPromise, EAggregateException); + + LPromise.InternalWait; + var LAgg := LPromise.GetFailure.Reason as EAggregateException; + Assert.AreEqual(2, Length(LAgg.Exceptions)); + // Check the aggregate message which is built at creation time from inner exception messages + Assert.IsTrue(LAgg.Message.Contains('alpha')); + Assert.IsTrue(LAgg.Message.Contains('beta')); +end; + +{ TTestPromiseAnyConcurrency } + +procedure TTestPromiseAnyConcurrency.StressTestManyPromises; +var + LPromises: TArray>; + LPromise: IPromise; + i: Integer; +const + COUNT = 50; +begin + SetLength(LPromises, COUNT); + // First 49 reject, last one resolves + for i := 0 to COUNT - 2 do + begin + var LIndex := i; + LPromises[i] := Promise.Reject( + ETestException.Create('error' + IntToStr(LIndex))); + end; + LPromises[COUNT - 1] := Promise.Resolve(function: Integer + begin + Result := 999; + end); + + LPromise := Promise.Any(LPromises); + Assert.Resolves(LPromise); + Assert.AreEqual(999, LPromise.Await); +end; + +initialization + TDUnitX.RegisterTestFixture(TTestPromiseAny); + TDUnitX.RegisterTestFixture(TTestPromiseAny); + TDUnitX.RegisterTestFixture(TTestPromiseAny); + TDUnitX.RegisterTestFixture(TTestPromiseAny); + TDUnitX.RegisterTestFixture(TTestPromiseAny); + TDUnitX.RegisterTestFixture(TTestPromiseAnyConcurrency); + +end. diff --git a/Test/Types/TestPromiseCancellation.pas b/Test/Types/TestPromiseCancellation.pas new file mode 100644 index 0000000..0b7adba --- /dev/null +++ b/Test/Types/TestPromiseCancellation.pas @@ -0,0 +1,353 @@ +unit TestPromiseCancellation; + +interface + +uses + DUnitX.TestFramework, System.SysUtils, System.SyncObjs, System.Classes, + Next.Core.Promises, Next.Core.Promises.Exceptions, + Next.Core.Promises.Cancellation, Next.Core.Test.Assert, + Next.Core.Test.GenericTest, Next.Core.TestPromises; + +type + [TestFixture] + TTestPromiseCancellation = class(TGenericTest) + public + [Test] procedure CancelBeforeStartRejects; + [Test] procedure TokenNotCancelledExecutesNormally; + [Test] procedure CancelDuringExecution; + [Test] procedure OnCancelledHandlerFires; + [Test] procedure OnCancelledNotFiredOnOtherExceptions; + [Test] procedure CatchRecoverFromCancellation; + [Test] procedure CancelAlreadyResolvedIsNoop; + [Test] procedure TokenPropagationThroughChain; + end; + + [TestFixture] + TTestCancellationTokenSource = class + public + [Test] procedure BasicCancelAndIsCancelled; + [Test] procedure CancelIsIdempotent; + [Test] procedure ThrowIfCancelledNotRaisedWhenNotCancelled; + [Test] procedure ThrowIfCancelledRaisesWhenCancelled; + end; + + [TestFixture] + TTestCancellationPatterns = class + public + [Test] procedure RacePlusCancellationPattern; + end; + +implementation + +{ TTestPromiseCancellation } + +procedure TTestPromiseCancellation.CancelBeforeStartRejects; +var + LCts: ICancellationTokenSource; + LPromise: IPromise; +begin + LCts := TCancellationTokenSource.Create; + LCts.Cancel; + + LPromise := Promise.Resolve(function: T + begin + Result := CreateValue(42); + end) + .CancelToken(LCts.Token) + .ThenBy(function(const V: T): T + begin + Result := V; + end); + + Assert.RejectsWith(LPromise, EOperationCancelled); +end; + +procedure TTestPromiseCancellation.TokenNotCancelledExecutesNormally; +var + LCts: ICancellationTokenSource; + LPromise: IPromise; +begin + LCts := TCancellationTokenSource.Create; + + LPromise := Promise.Resolve(function: T + begin + LCts.Token.ThrowIfCancelled; + Result := CreateValue(42); + end) + .CancelToken(LCts.Token); + + Assert.Resolves(LPromise); + TestEqualsFreeExpected(CreateValue(42), LPromise.Await); +end; + +procedure TTestPromiseCancellation.CancelDuringExecution; +var + LCts: ICancellationTokenSource; + LPromise: IPromise; + LStartedSignal: TEvent; +begin + LCts := TCancellationTokenSource.Create; + LStartedSignal := TEvent.Create; + try + LPromise := Promise.Resolve(function: T + begin + LStartedSignal.SetEvent; + var LIterations := 0; + while LIterations < 1000 do + begin + if LCts.Token.IsCancelled then + raise EOperationCancelled.Create; + Sleep(10); + Inc(LIterations); + end; + Result := CreateValue(42); + end); + + LStartedSignal.WaitFor(5000); + Sleep(50); + LCts.Cancel; + + Assert.RejectsWith(LPromise, EOperationCancelled); + finally + LStartedSignal.Free; + end; +end; + +procedure TTestPromiseCancellation.OnCancelledHandlerFires; +var + LCts: ICancellationTokenSource; + LPromise: IPromise; + LOnCancelledFired: Boolean; +begin + LCts := TCancellationTokenSource.Create; + LOnCancelledFired := False; + LCts.Cancel; + + LPromise := Promise.Resolve(function: T + begin + LCts.Token.ThrowIfCancelled; + Result := CreateValue(42); + end) + .OnCancelled(procedure + begin + LOnCancelledFired := True; + end); + + Assert.Rejects(LPromise); + Assert.IsTrue(LOnCancelledFired); +end; + +procedure TTestPromiseCancellation.OnCancelledNotFiredOnOtherExceptions; +var + LPromise: IPromise; + LOnCancelledFired: Boolean; +begin + LOnCancelledFired := False; + + LPromise := Promise.Resolve(function: T + begin + raise ETestException.Create('not a cancellation'); + end) + .OnCancelled(procedure + begin + LOnCancelledFired := True; + end); + + Assert.Rejects(LPromise); + Assert.IsFalse(LOnCancelledFired); +end; + +procedure TTestPromiseCancellation.CatchRecoverFromCancellation; +var + LCts: ICancellationTokenSource; + LPromise: IPromise; +begin + LCts := TCancellationTokenSource.Create; + LCts.Cancel; + + LPromise := Promise.Resolve(function: T + begin + LCts.Token.ThrowIfCancelled; + Result := CreateValue(42); + end) + .Catch(function(E: Exception): T + begin + if E is EOperationCancelled then + Result := CreateValue(99) + else + raise E; + end); + + Assert.Resolves(LPromise); + TestEqualsFreeExpected(CreateValue(99), LPromise.Await); +end; + +procedure TTestPromiseCancellation.CancelAlreadyResolvedIsNoop; +var + LCts: ICancellationTokenSource; + LPromise: IPromise; +begin + LCts := TCancellationTokenSource.Create; + + LPromise := Promise.Resolve(function: T + begin + Result := CreateValue(42); + end) + .CancelToken(LCts.Token); + + Assert.Resolves(LPromise); + TestEqualsFreeExpected(CreateValue(42), LPromise.Await); + + // Cancel after already resolved - should have no effect + LCts.Cancel; + Assert.Resolves(LPromise); +end; + +procedure TTestPromiseCancellation.TokenPropagationThroughChain; +var + LCts: ICancellationTokenSource; + LPromise: IPromise; + LSecondThenByCalled: Boolean; + LStartedSignal: TEvent; +begin + LCts := TCancellationTokenSource.Create; + LSecondThenByCalled := False; + LStartedSignal := TEvent.Create; + try + LPromise := Promise.Resolve(function: T + begin + LStartedSignal.SetEvent; + Result := CreateValue(1); + end) + .CancelToken(LCts.Token) + .ThenBy(function(const V: T): T + begin + Result := CreateValue(2); + end) + .ThenBy(function(const V: T): T + begin + LSecondThenByCalled := True; + Result := CreateValue(3); + end); + + LStartedSignal.WaitFor(5000); + LCts.Cancel; + + // The promise may resolve or reject depending on timing + LPromise.InternalWait(5000); + finally + LStartedSignal.Free; + end; +end; + +{ TTestCancellationTokenSource } + +procedure TTestCancellationTokenSource.BasicCancelAndIsCancelled; +var + LCts: ICancellationTokenSource; + LToken: ICancellationToken; +begin + LCts := TCancellationTokenSource.Create; + LToken := LCts.Token; + + Assert.IsFalse(LCts.IsCancelled); + Assert.IsFalse(LToken.IsCancelled); + + LCts.Cancel; + + Assert.IsTrue(LCts.IsCancelled); + Assert.IsTrue(LToken.IsCancelled); +end; + +procedure TTestCancellationTokenSource.CancelIsIdempotent; +var + LCts: ICancellationTokenSource; +begin + LCts := TCancellationTokenSource.Create; + LCts.Cancel; + LCts.Cancel; // Second cancel should not raise + Assert.IsTrue(LCts.IsCancelled); +end; + +procedure TTestCancellationTokenSource.ThrowIfCancelledNotRaisedWhenNotCancelled; +var + LCts: ICancellationTokenSource; +begin + LCts := TCancellationTokenSource.Create; + Assert.WillNotRaise(procedure + begin + LCts.Token.ThrowIfCancelled; + end); +end; + +procedure TTestCancellationTokenSource.ThrowIfCancelledRaisesWhenCancelled; +var + LCts: ICancellationTokenSource; +begin + LCts := TCancellationTokenSource.Create; + LCts.Cancel; + Assert.WillRaise(procedure + begin + LCts.Token.ThrowIfCancelled; + end, EOperationCancelled); +end; + +{ TTestCancellationPatterns } + +procedure TTestCancellationPatterns.RacePlusCancellationPattern; +var + LCts: ICancellationTokenSource; + LRaceResult: IPromise; + LWorkerStarted: TEvent; + LWorkerCancelled: Boolean; +begin + LCts := TCancellationTokenSource.Create; + LWorkerStarted := TEvent.Create; + LWorkerCancelled := False; + try + LRaceResult := Promise.Race([ + // Fast winner + Promise.Resolve(function: Integer + begin + Result := 42; + end), + // Slow worker that checks for cancellation + Promise.Resolve(function: Integer + begin + LWorkerStarted.SetEvent; + var LIterations := 0; + while LIterations < 100 do + begin + if LCts.Token.IsCancelled then + begin + LWorkerCancelled := True; + raise EOperationCancelled.Create; + end; + Sleep(50); + Inc(LIterations); + end; + Result := 99; + end) + ]); + + Assert.Resolves(LRaceResult); + Assert.AreEqual(42, LRaceResult.Await); + + LCts.Cancel; + Sleep(200); + Assert.IsTrue(LWorkerCancelled); + finally + LWorkerStarted.Free; + end; +end; + +initialization + TDUnitX.RegisterTestFixture(TTestPromiseCancellation); + TDUnitX.RegisterTestFixture(TTestPromiseCancellation); + TDUnitX.RegisterTestFixture(TTestPromiseCancellation); + TDUnitX.RegisterTestFixture(TTestPromiseCancellation); + TDUnitX.RegisterTestFixture(TTestPromiseCancellation); + TDUnitX.RegisterTestFixture(TTestCancellationTokenSource); + TDUnitX.RegisterTestFixture(TTestCancellationPatterns); + +end. diff --git a/Test/Types/TestPromiseExceptions.pas b/Test/Types/TestPromiseExceptions.pas new file mode 100644 index 0000000..025b877 --- /dev/null +++ b/Test/Types/TestPromiseExceptions.pas @@ -0,0 +1,157 @@ +unit TestPromiseExceptions; + +interface + +uses + DUnitX.TestFramework, System.SysUtils, + Next.Core.Promises.Exceptions; + +type + [TestFixture] + TTestPromiseExceptions = class + public + [Test] procedure ETimeoutExceptionDefaultMessage; + [Test] procedure ETimeoutExceptionCustomMessage; + [Test] procedure EOperationCancelledDefaultMessage; + [Test] procedure EOperationCancelledCustomMessage; + [Test] procedure EAggregateExceptionCreation; + [Test] procedure EAggregateExceptionExceptionsProperty; + [Test] procedure EAggregateExceptionDestroyFreesInner; + [Test] procedure EAggregateExceptionWithNilInArray; + [Test] procedure EAggregateExceptionEmptyArray; + end; + +implementation + +{ TTestPromiseExceptions } + +procedure TTestPromiseExceptions.ETimeoutExceptionDefaultMessage; +var + E: ETimeoutException; +begin + E := ETimeoutException.Create; + try + Assert.AreEqual('Promise timed out', E.Message); + finally + E.Free; + end; +end; + +procedure TTestPromiseExceptions.ETimeoutExceptionCustomMessage; +var + E: ETimeoutException; +begin + E := ETimeoutException.Create('custom timeout'); + try + Assert.AreEqual('custom timeout', E.Message); + finally + E.Free; + end; +end; + +procedure TTestPromiseExceptions.EOperationCancelledDefaultMessage; +var + E: EOperationCancelled; +begin + E := EOperationCancelled.Create; + try + Assert.AreEqual('Operation was cancelled', E.Message); + finally + E.Free; + end; +end; + +procedure TTestPromiseExceptions.EOperationCancelledCustomMessage; +var + E: EOperationCancelled; +begin + E := EOperationCancelled.Create('custom cancel'); + try + Assert.AreEqual('custom cancel', E.Message); + finally + E.Free; + end; +end; + +procedure TTestPromiseExceptions.EAggregateExceptionCreation; +var + E: EAggregateException; +begin + E := EAggregateException.Create([ + Exception.Create('alpha'), + Exception.Create('beta') + ]); + try + Assert.IsTrue(E.Message.Contains('alpha')); + Assert.IsTrue(E.Message.Contains('beta')); + finally + E.Free; + end; +end; + +procedure TTestPromiseExceptions.EAggregateExceptionExceptionsProperty; +var + E: EAggregateException; +begin + E := EAggregateException.Create([ + Exception.Create('first'), + Exception.Create('second'), + Exception.Create('third') + ]); + try + Assert.AreEqual(3, Length(E.Exceptions)); + Assert.AreEqual('first', E.Exceptions[0].Message); + Assert.AreEqual('second', E.Exceptions[1].Message); + Assert.AreEqual('third', E.Exceptions[2].Message); + finally + E.Free; + end; +end; + +procedure TTestPromiseExceptions.EAggregateExceptionDestroyFreesInner; +var + E: EAggregateException; +begin + // Just verify that destruction does not raise + E := EAggregateException.Create([ + Exception.Create('inner1'), + Exception.Create('inner2') + ]); + E.Free; // Should free inner exceptions without error + Assert.IsTrue(True); // If we get here, destruction succeeded +end; + +procedure TTestPromiseExceptions.EAggregateExceptionWithNilInArray; +var + E: EAggregateException; +begin + E := EAggregateException.Create([ + Exception.Create('real'), + nil + ]); + try + Assert.IsTrue(E.Message.Contains('')); + Assert.IsTrue(E.Message.Contains('real')); + Assert.AreEqual(2, Length(E.Exceptions)); + finally + E.Free; + end; +end; + +procedure TTestPromiseExceptions.EAggregateExceptionEmptyArray; +var + E: EAggregateException; +begin + E := EAggregateException.Create([]); + try + Assert.AreEqual('All promises were rejected ()', E.Message); + Assert.AreEqual(0, Length(E.Exceptions)); + finally + E.Free; + end; +end; + +initialization + TDUnitX.RegisterTestFixture(TTestPromiseExceptions); + +end. diff --git a/Test/Types/TestPromiseFinally.pas b/Test/Types/TestPromiseFinally.pas new file mode 100644 index 0000000..d26a95d --- /dev/null +++ b/Test/Types/TestPromiseFinally.pas @@ -0,0 +1,173 @@ +unit TestPromiseFinally; + +interface + +uses + DUnitX.TestFramework, System.SysUtils, System.SyncObjs, System.Classes, + Next.Core.Promises, Next.Core.Test.Assert, + Next.Core.Test.GenericTest, Next.Core.TestPromises; + +type + [TestFixture] + TTestPromiseFinally = class(TGenericTest) + public + [Test] procedure FinallyRunsAfterResolve; + [Test] procedure FinallyRunsAfterReject; + [Test] procedure FinallyPreservesResolvedValue; + [Test] procedure FinallyPreservesRejection; + [Test] procedure FinallyRaisingReplacesResolvedResult; + [Test] procedure FinallyRaisingReplacesRejection; + [Test] procedure FinallyFollowedByThenBy; + [Test] procedure MainFinallyRunsAfterResolve; + end; + +implementation + +{ TTestPromiseFinally } + +procedure TTestPromiseFinally.FinallyRunsAfterResolve; +var + LFinallyCalled: Boolean; + LPromise: IPromise; +begin + LFinallyCalled := False; + LPromise := Promise.Resolve(function: T + begin + Result := CreateValue(42); + end) + .&Finally(procedure + begin + LFinallyCalled := True; + end); + + Assert.Resolves(LPromise); + Assert.IsTrue(LFinallyCalled); +end; + +procedure TTestPromiseFinally.FinallyRunsAfterReject; +var + LFinallyCalled: Boolean; + LPromise: IPromise; +begin + LFinallyCalled := False; + LPromise := Promise.Reject(ETestException.Create('error')) + .&Finally(procedure + begin + LFinallyCalled := True; + end); + + Assert.Rejects(LPromise); + Assert.IsTrue(LFinallyCalled); +end; + +procedure TTestPromiseFinally.FinallyPreservesResolvedValue; +var + LPromise: IPromise; +begin + LPromise := Promise.Resolve(function: T + begin + Result := CreateValue(42); + end) + .&Finally(procedure + begin + // Do nothing + end); + + Assert.Resolves(LPromise); + TestEqualsFreeExpected(CreateValue(42), LPromise.Await); +end; + +procedure TTestPromiseFinally.FinallyPreservesRejection; +var + LPromise: IPromise; +begin + LPromise := Promise.Reject(ETestException.Create('original error')) + .&Finally(procedure + begin + // Do nothing + end); + + Assert.RejectsWith(LPromise, ETestException); +end; + +procedure TTestPromiseFinally.FinallyRaisingReplacesResolvedResult; +var + LPromise: IPromise; +begin + LPromise := Promise.Resolve(function: T + begin + Result := CreateValue(42); + end) + .&Finally(procedure + begin + raise ETestException.Create('finally error'); + end); + + Assert.RejectsWith(LPromise, ETestException); +end; + +procedure TTestPromiseFinally.FinallyRaisingReplacesRejection; +var + LPromise: IPromise; +begin + LPromise := Promise.Reject(EInvalidOp.Create('original')) + .&Finally(procedure + begin + raise ETestException.Create('finally replaces'); + end); + + Assert.RejectsWith(LPromise, ETestException); +end; + +procedure TTestPromiseFinally.FinallyFollowedByThenBy; +var + LPromise: IPromise; +begin + LPromise := Promise.Resolve(function: T + begin + Result := CreateValue(42); + end) + .&Finally(procedure + begin + // Nothing + end) + .ThenBy(function(const V: T): T + begin + Result := V; + end); + + Assert.Resolves(LPromise); + TestEqualsFreeExpected(CreateValue(42), LPromise.Await); +end; + +procedure TTestPromiseFinally.MainFinallyRunsAfterResolve; +var + LFinallyCalled: Boolean; + LMainThread: TThreadID; + LPromise: IPromise; +begin + LMainThread := TThread.CurrentThread.ThreadID; + LFinallyCalled := False; + + LPromise := Promise.Resolve(function: T + begin + Result := CreateValue(42); + end) + .Main.&Finally(procedure + begin + LFinallyCalled := True; + Assert.AreEqual(LMainThread, TThread.CurrentThread.ThreadID); + end); + + Assert.Resolves(LPromise); + Assert.IsTrue(LFinallyCalled); +end; + +initialization + TDUnitX.RegisterTestFixture(TTestPromiseFinally); + TDUnitX.RegisterTestFixture(TTestPromiseFinally); + TDUnitX.RegisterTestFixture(TTestPromiseFinally); + TDUnitX.RegisterTestFixture(TTestPromiseFinally); + TDUnitX.RegisterTestFixture(TTestPromiseFinally); + +end. diff --git a/Test/Types/TestPromiseRace.pas b/Test/Types/TestPromiseRace.pas new file mode 100644 index 0000000..235df3b --- /dev/null +++ b/Test/Types/TestPromiseRace.pas @@ -0,0 +1,297 @@ +unit TestPromiseRace; + +interface + +uses + DUnitX.TestFramework, System.SysUtils, System.SyncObjs, System.Classes, + Next.Core.Promises, Next.Core.Promises.Exceptions, Next.Core.Test.Assert, + Next.Core.Test.GenericTest, Next.Core.TestPromises; + +type + [TestFixture] + TTestPromiseRace = class(TGenericTest) + public + [Test] procedure EmptyArrayRejects; + [Test] procedure SinglePromiseResolves; + [Test] procedure SinglePromiseRejects; + [Test] procedure FirstResolvesWins; + [Test] procedure FirstRejectsRaceRejects; + [Test] procedure FastResolveSlowRejectIgnored; + [Test] + procedure RaceInChainThenBy; + [Test] procedure PreResolvedPromiseInRace; + [Test] procedure PreRejectedPromiseInRace; + end; + + [TestFixture] + TTestPromiseRaceConcurrency = class + public + [Test] + procedure StressTestManyPromises; + [Test] procedure RaceAsTimeoutPattern; + end; + +implementation + +{ TTestPromiseRace } + +procedure TTestPromiseRace.EmptyArrayRejects; +var + LPromise: IPromise; +begin + LPromise := Promise.Race([]); + Assert.RejectsWith(LPromise, EArgumentException); +end; + +procedure TTestPromiseRace.SinglePromiseResolves; +var + LPromise: IPromise; +begin + LPromise := Promise.Race([ + Promise.Resolve(function: T + begin + Result := CreateValue(7); + end) + ]); + + Assert.Resolves(LPromise); + TestEqualsFreeExpected(CreateValue(7), LPromise.Await); +end; + +procedure TTestPromiseRace.SinglePromiseRejects; +var + LPromise: IPromise; +begin + LPromise := Promise.Race([ + Promise.Reject(ETestException.Create('single error')) + ]); + + Assert.RejectsWith(LPromise, ETestException); +end; + +procedure TTestPromiseRace.FirstResolvesWins; +var + LFastSignal: TEvent; + LSlowSignal: TEvent; + LPromise: IPromise; +begin + LFastSignal := TEvent.Create; + LSlowSignal := TEvent.Create; + try + LPromise := Promise.Race([ + Promise.Resolve(function: T + begin + LFastSignal.WaitFor; + Result := CreateValue(42); + end), + Promise.Resolve(function: T + begin + LSlowSignal.WaitFor; + Result := CreateValue(99); + end) + ]); + + LFastSignal.SetEvent; + Assert.Resolves(LPromise); + TestEqualsFreeExpected(CreateValue(42), LPromise.Await); + + LSlowSignal.SetEvent; + finally + LFastSignal.Free; + LSlowSignal.Free; + end; +end; + +procedure TTestPromiseRace.FirstRejectsRaceRejects; +var + LPromise: IPromise; + LSlowSignal: TEvent; +begin + LSlowSignal := TEvent.Create; + try + LPromise := Promise.Race([ + Promise.Reject(ETestException.Create('fast error')), + Promise.Resolve(function: T + begin + LSlowSignal.WaitFor; + Result := CreateValue(99); + end) + ]); + + Assert.Rejects(LPromise); + LSlowSignal.SetEvent; + finally + LSlowSignal.Free; + end; +end; + +procedure TTestPromiseRace.FastResolveSlowRejectIgnored; +var + LPromise: IPromise; + LSlowSignal: TEvent; +begin + LSlowSignal := TEvent.Create; + try + LPromise := Promise.Race([ + Promise.Resolve(function: T + begin + Result := CreateValue(42); + end), + Promise.Resolve(function: T + begin + LSlowSignal.WaitFor; + raise ETestException.Create('slow error'); + end) + ]); + + Assert.Resolves(LPromise); + TestEqualsFreeExpected(CreateValue(42), LPromise.Await); + LSlowSignal.SetEvent; + finally + LSlowSignal.Free; + end; +end; + +procedure TTestPromiseRace.RaceInChainThenBy; +var + LPromise: IPromise; +begin + LPromise := Promise.Race([ + Promise.Resolve(function: T + begin + Result := CreateValue(42); + end) + ]) + .Op.ThenBy(function(const V: T): String + begin + Result := 'chained'; + end); + + Assert.Resolves(LPromise); + Assert.AreEqual('chained', LPromise.Await); +end; + +procedure TTestPromiseRace.PreResolvedPromiseInRace; +var + LPromise: IPromise; + LSlowSignal: TEvent; +begin + LSlowSignal := TEvent.Create; + try + LPromise := Promise.Race([ + Promise.Resolve(function: T + begin + Result := CreateValue(1); + end), + Promise.Resolve(function: T + begin + LSlowSignal.WaitFor; + Result := CreateValue(99); + end) + ]); + + Assert.Resolves(LPromise); + TestEqualsFreeExpected(CreateValue(1), LPromise.Await); + LSlowSignal.SetEvent; + finally + LSlowSignal.Free; + end; +end; + +procedure TTestPromiseRace.PreRejectedPromiseInRace; +var + LPromise: IPromise; + LSlowSignal: TEvent; +begin + LSlowSignal := TEvent.Create; + try + LPromise := Promise.Race([ + Promise.Reject(ETestException.Create('pre-rejected')), + Promise.Resolve(function: T + begin + LSlowSignal.WaitFor; + Result := CreateValue(99); + end) + ]); + + Assert.RejectsWith(LPromise, ETestException); + LSlowSignal.SetEvent; + finally + LSlowSignal.Free; + end; +end; + +{ TTestPromiseRaceConcurrency } + +function MakeSignaledPromise(ASignal: TEvent; AValue: Integer): IPromise; +begin + Result := Promise.Resolve(function: Integer + begin + ASignal.WaitFor; + Result := AValue; + end); +end; + +procedure TTestPromiseRaceConcurrency.StressTestManyPromises; +var + LPromises: TArray>; + LSignals: TArray; + LPromise: IPromise; + i: Integer; +const + COUNT = 20; +begin + SetLength(LPromises, COUNT); + SetLength(LSignals, COUNT); + + for i := 0 to COUNT - 1 do + begin + LSignals[i] := TEvent.Create; + LPromises[i] := MakeSignaledPromise(LSignals[i], i); + end; + + LPromise := Promise.Race(LPromises); + + // Signal the 5th promise first + LSignals[5].SetEvent; + + Assert.Resolves(LPromise); + Assert.AreEqual(5, LPromise.Await); + + // Clean up - signal all remaining + for i := 0 to COUNT - 1 do + begin + LSignals[i].SetEvent; + LSignals[i].Free; + end; +end; + +procedure TTestPromiseRaceConcurrency.RaceAsTimeoutPattern; +var + LPromise: IPromise; +begin + LPromise := Promise.Race([ + Promise.Resolve(function: Integer + begin + Sleep(5000); // Slow work + Result := 42; + end), + Promise.Resolve(function: Integer + begin + Sleep(50); // Short timeout + raise ETimeoutException.Create('Operation timed out'); + end) + ]); + + Assert.RejectsWith(LPromise, ETimeoutException); +end; + +initialization + TDUnitX.RegisterTestFixture(TTestPromiseRace); + TDUnitX.RegisterTestFixture(TTestPromiseRace); + TDUnitX.RegisterTestFixture(TTestPromiseRace); + TDUnitX.RegisterTestFixture(TTestPromiseRace); + TDUnitX.RegisterTestFixture(TTestPromiseRace); + TDUnitX.RegisterTestFixture(TTestPromiseRaceConcurrency); + +end. diff --git a/Test/Types/TestPromiseTimeout.pas b/Test/Types/TestPromiseTimeout.pas new file mode 100644 index 0000000..55b1d57 --- /dev/null +++ b/Test/Types/TestPromiseTimeout.pas @@ -0,0 +1,134 @@ +unit TestPromiseTimeout; + +interface + +uses + DUnitX.TestFramework, System.SysUtils, System.SyncObjs, System.Classes, + Next.Core.Promises, Next.Core.Promises.Exceptions, Next.Core.Test.Assert, + Next.Core.Test.GenericTest, Next.Core.TestPromises; + +type + [TestFixture] + TTestPromiseTimeout = class(TGenericTest) + public + [Test] procedure ResolvesBeforeTimeout; + [Test] procedure ExceedsTimeoutRejects; + [Test] procedure TimeoutCustomMessage; + [Test] + procedure TimeoutInChainThenBy; + [Test] procedure CatchRecoveryFromTimeout; + [Test] + procedure GenerousTimeoutFastPromise; + end; + +implementation + +{ TTestPromiseTimeout } + +procedure TTestPromiseTimeout.ResolvesBeforeTimeout; +var + LPromise: IPromise; +begin + LPromise := Promise.Resolve(function: T + begin + Result := CreateValue(42); + end) + .Timeout(5000); + + Assert.Resolves(LPromise); + TestEqualsFreeExpected(CreateValue(42), LPromise.Await); +end; + +procedure TTestPromiseTimeout.ExceedsTimeoutRejects; +var + LPromise: IPromise; +begin + LPromise := Promise.Resolve(function: T + begin + Sleep(5000); + Result := CreateValue(42); + end) + .Timeout(100); + + Assert.RejectsWith(LPromise, ETimeoutException); +end; + +procedure TTestPromiseTimeout.TimeoutCustomMessage; +var + LPromise: IPromise; +begin + LPromise := Promise.Resolve(function: T + begin + Sleep(5000); + Result := CreateValue(42); + end) + .Timeout(100, 'Custom timeout message'); + + Assert.RejectsWith(LPromise, ETimeoutException); + + LPromise.InternalWait; + Assert.AreEqual('Custom timeout message', LPromise.GetFailure.Reason.Message); +end; + +procedure TTestPromiseTimeout.TimeoutInChainThenBy; +var + LPromise: IPromise; +begin + LPromise := Promise.Resolve(function: T + begin + Result := CreateValue(42); + end) + .Timeout(5000) + .Op.ThenBy(function(const V: T): String + begin + Result := 'chained'; + end); + + Assert.Resolves(LPromise); + Assert.AreEqual('chained', LPromise.Await); +end; + +procedure TTestPromiseTimeout.CatchRecoveryFromTimeout; +var + LPromise: IPromise; +begin + LPromise := Promise.Resolve(function: T + begin + Sleep(5000); + Result := CreateValue(42); + end) + .Timeout(100) + .Catch(function(E: Exception): T + begin + if E is ETimeoutException then + Result := CreateValue(99) + else + raise E; + end); + + Assert.Resolves(LPromise); + TestEqualsFreeExpected(CreateValue(99), LPromise.Await); +end; + +procedure TTestPromiseTimeout.GenerousTimeoutFastPromise; +var + LPromise: IPromise; +begin + LPromise := Promise.Resolve(function: T + begin + Result := CreateValue(1); + end) + .Timeout(30000); + + Assert.Resolves(LPromise); + TestEqualsFreeExpected(CreateValue(1), LPromise.Await); +end; + +initialization + TDUnitX.RegisterTestFixture(TTestPromiseTimeout); + TDUnitX.RegisterTestFixture(TTestPromiseTimeout); + TDUnitX.RegisterTestFixture(TTestPromiseTimeout); + TDUnitX.RegisterTestFixture(TTestPromiseTimeout); + TDUnitX.RegisterTestFixture(TTestPromiseTimeout); + +end. diff --git a/readme.md b/readme.md index 6b321a8..f3fc701 100644 --- a/readme.md +++ b/readme.md @@ -1,677 +1,1024 @@ -# Promise Implementation in Delphi - -## Table of Contents - - 1. [Getting started](#getting-started) - 2. [Exception handling](#exception-handling) - 3. [UI interaction](#ui-interaction) - 4. [Memory Management](#memory-management) - 5. [Extended example: using Promises in Asynchronous Methods](#extended-example-using-promises-in-asynchronous-methods) - -## Overview - -This Delphi library implements promises, enabling asynchronous programming by facilitating the handling of operations that may require time to complete. A promise represents a guarantee for an eventual result, streamlining the way asynchronous operations are managed in your applications. Additionally, this implementation embraces monadic principles, offering a structured approach to chaining computations and handling their outcomes. - -## Features - -- **Promise Chaining:** Easily chain multiple asynchronous operations, passing the result of one as the input to the next. -- **Exception handling:** The promise is side-affect free, so it manages exceptions inside the chain and you are able to recover from them. -- **Type Transformation:** Transform the resolved value's type through the `.Op` method, enabling flexible data handling. -- **Memory Management:** Control the lifecycle of promise-resolved values with `dvKeep` and `dvFree` directives, ensuring efficient resource utilization. -- **Starts immediately:** The promise execution starts immediately, you do not have to call `Await` to execute the chain. - -## Getting Started - -To integrate this promise library into your Delphi projects, include the necessary unit in your project source and follow the examples provided below. - -### Create a new promise with an executor function -`Promise.New` is a class method that creates a new promise of type `T`. It accepts an **executor function** as its parameter, which defines the logic for resolving or rejecting the promise. - -The executor function has the following signature and is executed **synchronous** in the same thread context. - -```delphi -TProc, TProc> -``` - -- The first parameter (`TProc`) is a **resolve callback**: it is used to fulfill the promise with a value of type `T`. -- The second parameter (`TProc`) is a **reject callback**: it is used to reject the promise with an exception. - -The method returns an interface `IPromise` that represents the created promise. This is conceptually similar to JavaScript promises, allowing for chaining, error handling, and managing asynchronous workflows. - ---- - -#### Relation to JavaScript's Promise - -`Promise.New` is modeled after JavaScript's `new Promise` constructor. Here's how they align: - -| Delphi (`Promise.New`) | JavaScript (`new Promise`) | -|-----------------------------------------|--------------------------------------------------------| -| `Promise.New(AProc)` | `new Promise((resolve, reject) => { ... })` | -| Accepts a function with `resolve` and `reject` callbacks | Accepts a function with `resolve` and `reject` callbacks | -| Returns an `IPromise` | Returns a `Promise` object | -| Used for custom asynchronous logic | Used for custom asynchronous logic | - -**Example in JavaScript:** -```javascript -const myPromise = new Promise((resolve, reject) => { - setTimeout(() => { - resolve("Success!"); - }, 1000); -}); -``` - -**Equivalent in Delphi:** -```delphi -var - MyPromise: IPromise; -begin - MyPromise := Promise.New( - procedure(Resolve: TProc; Reject: TProc) - begin - TThread.CreateAnonymousThread( - procedure - begin - Sleep(1000); - Resolve('Success!'); - end); - end - ); -end; -``` - ---- - -#### When to Use `Promise.New` - -`Promise.New` should be used when you need to define custom asynchronous operations that don't already return a promise or similar construct. It allows fine-grained control over when and how a promise is resolved or rejected. - -##### Use Cases -1. **Custom Asynchronous Operations:** - When working with asynchronous operations that are not inherently promise-based, such as raw thread management or callback-based APIs. - - ```delphi - var - MyPromise: IPromise; - begin - MyPromise := Promise.New( - procedure(Resolve: TProc; Reject: TProc) - begin - TThread.CreateAnonymousThread( - procedure - begin - try - Sleep(1000); - Resolve(42); // Fulfill with a value - except - on E: Exception do - Reject(E); // Reject with an error - end; - end); - end - ); - end; - ``` - -2. **Bridge Non-Promise APIs:** - Wrap existing callback-based APIs in a promise interface to make them easier to work with. - - ```delphi - function ReadFileAsync(const FileName: string): IPromise; - begin - Result := Promise.New( - procedure(Resolve: TProc; Reject: TProc) - begin - TThread.CreateAnonymousThread( - procedure - begin - try - var Content := TFile.ReadAllText(FileName); - Resolve(Content); - except - on E: Exception do - Reject(E); - end; - end); - end - ); - end; - ``` - -3. **Chaining and Composition:** - Combine multiple asynchronous operations into a sequential flow using `.ThenBy` or `.Catch`. - ---- - -#### Caution -- Always ensure `Resolve` or `Reject` is called exactly once to avoid unexpected behavior. -- Be careful with exceptions: make sure any error is properly caught and passed to the `Reject` callback. - ---- - -#### Benefits of `Promise.New` -1. **Flexibility:** Allows you to adapt any asynchronous workflow to a promise-based approach. -2. **Consistency:** Aligns with the standard promise pattern found in JavaScript, making it familiar for developers with cross-platform experience. -3. **Chaining Support:** Enables sequential and conditional execution of asynchronous tasks through promise chaining. - -By leveraging `Promise.New`, developers can unify asynchronous code, making it cleaner, more readable, and easier to maintain. - -### Create a promise with an async method without executor methods -`Promise.Resolve` is a class method that creates and immediately resolves a promise of type `T`. It accepts a **function** (`TFunc`) that returns the value to resolve the promise with. This function is executed **asynchronous**. - -The method returns an interface `IPromise` that represents the resolved promise. This is conceptually equivalent to the `Promise.resolve` method in JavaScript. - ---- - -#### Relation to JavaScript's `Promise.resolve` - -`Promise.Resolve` is modeled after JavaScript's `Promise.resolve` method. Here's how they align: - -| Delphi (`Promise.Resolve`) | JavaScript (`Promise.resolve`) | -|------------------------------------------|-----------------------------------------------| -| `Promise.Resolve(AFunc)` | `Promise.resolve(() => { return value; })` | -| Accepts a function returning a value | Accepts a value or a function returning a value | -| Returns an `IPromise` | Returns a `Promise` object | -| Used to wrap a value or computation in a promise | Used to wrap a value or computation in a promise | - -**Example in JavaScript:** -```javascript -const resolvedPromise = Promise.resolve(() => "Hello, World!"); -``` - -**Equivalent in Delphi:** -```delphi -var - ResolvedPromise: IPromise; -begin - ResolvedPromise := Promise.Resolve( - function: string - begin - Result := 'Hello, World!'; - end - ); -end; -``` - ---- - -#### When to Use `Promise.Resolve` - -`Promise.Resolve` should be used when you already have a value or computation and want to return it as a promise, so that the computation is done in the background (asynchronous). It is useful for maintaining consistency when working with promise-based workflows. - -##### Use Cases -1. **Execute heavy operations asynchronous:** - Use `Promise.Resolve` to perform some heavy operations asynchronous, continue the flow and retrieve the result later (using `Await` or chaining). - - ```delphi - function GetValueAsync: IPromise; - begin - Result := Promise.Resolve( - function: string - begin - Result := 'Do some time consuming operation here'; - sleep(10000); - end - ); - end; - ``` - -2. **Wrapping Immediate Values in a Promise:** - Use `Promise.Resolve` to create a resolved promise from an already available value or computation. - - ```delphi - var - ResolvedPromise: IPromise; - begin - ResolvedPromise := Promise.Resolve( - function: Integer - begin - Result := 42; // Return an immediate value - end - ); - end; - ``` - -3. **Normalizing Return Values:** - When a function might return either a value or a promise, `Promise.Resolve` ensures that the result is always a promise. - - ```delphi - function GetValueAsync: IPromise; - begin - Result := Promise.Resolve( - function: string - begin - Result := 'Synchronous Value'; - end - ); - end; - ``` - ---- - -#### Example with Await - -Here is a simple example to see how you could perform an **async** (background) operation and wait (blocking) for it to complete. - -```delphi -uses Next.Core.Promises; - -// Create and resolve a simple promise -var - value: String; -begin - value := Promise.Resolve(function: String - begin - Result := 'Hello, World!'; - end).Await; - - // Outputs: Hello, World! - WriteLn(value); -end; -``` - -### Chaining promises - -On of the key features of promises is the ability to chain them. You chain promises to perform a sequence of operations where each step depends on the outcome of the previous one. During these steps the result types of the promise can change as you can see in the following example. - -```delphi -uses Next.Core.Promises; - -// Chain promises to multiply an integer and convert it to a string -// Ensure UI update is on the main thread -begin - Promise.Resolve(function: Integer - begin - Result := 10; - end) - .ThenBy(function(const value: Integer): Integer - begin - Result := value * 2; // Process in background thread - end) - .Op.ThenBy(function(const value: Integer): String - begin - Result := IntToStr(value); // Process in background thread - end) - .Main.ThenBy(function(const value: String): TVoid - begin - WriteLn(value); // Synchronized to the main thread - Result := Void; - end); -end; -``` - -### Type Transformation with `.Op` - -Use the `.Op` method to transform the type of the resolved value of a promise. - -```delphi -uses Next.Core.Promises; - -// Transform the resolved value type from Integer to String -var promise: IPromise; -begin - promise := Promise.Resolve(function: Integer - begin - Result := 10; - end) - .Op.ThenBy(function(const value: Integer): String - begin - Result := 'Transformed Value: ' + IntToStr(value); // Process in background thread - end); - - WriteLn(promise.Await); // Outputs: Transformed Value: 10 -end; -``` - -### Using Await - -The `.Await` operator is used to retrieve the value from a resolved promise. The behavior is that the calling thread is blocked from there until the promise is fulfilled (resolved or rejected). If the promise is resolved, it will return the resolved value. If the promise is rejected, it will raise the caught exception. - -#### Using in main thread - -Due to the blocking nature of `.Await`, it is advised to use it in the main thread context as little as possible. If you use it in the main thread context, a `CheckSynchronize` method is repeatedly executed until the promise is fulfilled. This makes sure that UI interaction, such as repaints, will continue while your code flow is interrupted. The better way is to use messages to notify the UI of changes, see the examples below. - -### Promise.All, waiting for multiple promises to resolve - -If you perform multiple background operations you might want to wait until all of them are completed and then perform some action on it. You can use `Promise.All` for this. This waits until all promises are fulfilled. If one of the promises rejects (raises an exception), it will immediately go to the first `.Catch` in the chain without waiting for the rest of the promises to be fulfilled. - -``` delphi -var LWidth := Promise.Resolve(function: Integer - begin - //Heavy operation - Result := 10; - end); - -var LHeight := Promise.Resolve(function: Integer - begin - //Heavy operation - Result := 10; - end); - -var LDepth := Promise.Resolve(function: Integer - begin - //Heavy operation - Result := 10; - end); - -//Now all three operations are running simultaneously, as soon as all are finished the next method in the chain will be called to calculate the volume -Promise.All([LWidth, LHeight, LDepth]) - .Op.ThenBy(function(const AResults: TArray): Integer - begin - Result := AResults[0] * AResults[1] * AResults[2]; - end) - .Main.ThenBy(procedure(const AVolume: Integer) - begin - WriteLn(AVolume.ToString()); // Synchronized to the main thread - end) - .Main.Catch(procedure(E: Exception) - begin - WriteLn('Calculation failed: ' + E.Message); // Synchronized to the main thread - end) - -//Here you can continue your codeflow, for example show a waiting indicator -``` - -## Exception handling - -If any exceptions occurs, the chain will be interrupted until the first `.Catch` in the chain. If there is no catch, the promise will be rejected. Calling `.Await` on a rejected promise will raise the exception that was caught inside the promise in the caller context. - -### Recover from exceptions - -Use the `.Catch` method to recover from any exception in the chain. - -```delphi -uses Next.Core.Promises; - -// Handling exceptions and synchronizing error handling to the main thread -begin - Promise.Resolve(function: Boolean - begin - raise Exception.Create('Simulated error'); - end) - .Catch(function(E: Exception): Boolean - begin - if E.Message = 'Simulated error' then - Result := False // Recover from the error condition - else - raise; // Re-throw for other exceptions - end) - .Main.ThenBy(function(const value: Boolean): TVoid - begin - if not value then - WriteLn('Error handled, alternative value provided.'); // UI handling in the main thread - Result := Void; // Setting result to Void correctly - end); -end; -``` - -### Handling `.Await` on Rejected Promises - -When using the `.Await` method on a rejected promise, take note of the following behavior: - -1. **First Call to `.Await`:** - - The first call to `.Await` raises the original exception that was caught inside the promise. - - Depending on the debugging framework you use (e.g., MadExcept, EurekaLog, JclDebug), this exception may include the original stack trace where the exception occurred. This can be invaluable for debugging purposes. - -2. **Subsequent Calls to `.Await`:** - - Any consecutive calls to `.Await` on the same promise will raise a *clone* of the original exception. - - The cloned exception preserves the original exception’s class type and message, but: - - It does **not** retain the original stack trace. - - It does **not** include any additional fields or custom properties that may be defined in the exception's child class. - -#### Important Notes: -- This behavior ensures that the promise remains consistent and does not retain unnecessary state after the first `.Await` call. -- If your application relies on debugging tools for stack trace analysis, always capture and handle the exception from the first `.Await` call. -- Avoid relying on child-class-specific fields in exceptions when dealing with rejected promises, as these fields will not be preserved in cloned exceptions during subsequent `.Await` calls. - -#### Best Practices: -- **Debugging:** Use the debugging tools (e.g., MadExcept, EurekaLog) to capture detailed exception information during the first `.Await` call. -- **Exception Logging:** If you need to log exceptions, do so during the first `.Await` call to ensure the most complete information is available. -- **Avoid Multiple Awaits:** Design your promise workflows to minimize redundant `.Await` calls on the same rejected promise, as the additional calls will provide limited diagnostic value. - -By understanding and respecting these nuances, you can effectively handle exceptions in your promise-based implementations in Delphi. - -## UI interaction - -VCL operations are only allowed in main thread. Therefore this promise supports synchronisation natively using the `.Main` directive. This instructs the promise to execute the anonymous method in the main thread context. - -### Simple UI example - -Because the promise starts executing immediately (there is no need for `.Await`), you can create a promise and continue your codeflow. In the following example we perform a simple background operation and show a messagebox on completion while keeping the UI responsive. - -```delphi -uses Next.Core.Promises; - -// Create and resolve a simple promise -procedure DoHeavyOperationOnButtonClick() -begin - Promise.Resolve(function: String - begin - //Do some heavy operation - Result := 'Heavy operation completed!'; - end) - .Main.ThenBy(procedure(const value: String) - begin - ShowMessage(value); - end); - - //Continue your flow, the messagebox will popup when the operation is completed. You might consider showing a indicator that shows that the operation is going on. -end; -``` - -### Interacting with your forms - -The previous example is simple and has no interaction with any form. However, in practice this will not always be the case. In that situation it is important to make sure your promises does not interact with your form-objects after a form is disposed. - -You can solve this by instructing the form using the Windows message queue with `PostMessage`. Make sure that you capture the forms `Handle` and that you do not use `Self.Handle`, because that could also be invalid at that point. - -``` delphi -uses Next.Core.Promises; - -class - TMyForm = class(TForm) - procedure DoSomething(var AMessage: TMessage); message WM_MY_MESSAGE; - end; - -procedure TMyForm.DoHeavyOperationOnButtonClick() -begin - var LHandle := Self.Handle; - - Promise.Resolve(function: String - begin - //Do some heavy operation - Result := 'Heavy operation completed!'; - end) - .ThenBy(procedure(const value: String) - begin - PostMessage(LHandle, WM_MY_MESSAGE, 0, 0); - end); - - //Continue your flow, the procedure DoSomething will be called when the heavy operation is completed. -end; -``` - -## Memory Management - -By default, the promise is responsible for handling the memory of everything that is returned by any of the anonymous methods. That means that if you create an object in a resolver function, that object is disposed when the promise is disposed. The resolved value will stay "in" the promise and can be used multiples times by calling `.Await`. This works for all managed types, but not for objects. - -### Use Await to transfer ownership of an object - -With `.Await` you can retrieve the value inside the promise and use it. After calling `.Await` the ownership of the value is transfered to the caller, so -if it is an object- the promise will no longer dispose it. - -The following example makes clear what the effect would be if the promise would keep ownership of the object. In the following situation the promise can already be destroyed before the last code is executed. That would mean that `LObject` points to an already disposed object. - -``` delphi -var LObject := Promise.Resolve(function: TMyObject - begin - Result := TMyObject.Create('test'); - end).Await; - -LObject.DoSomething(); //here LObject can already be disposed by the promise -``` - -### Chaining (ThenBy) disposes the argument if it is different from the return value - -With `ThenBy` you have the option to return a different type or different instance of the same type. If the returned instance points to the same object that object will *not* be disposed. If the returned instance is another object, the argument passed to `ThenBy` (eg. this is the value of the previous resolved promise) will be disposed. - -``` delphi -var LPromise1 := Promise.Resolve(function: TMyObject - begin - Result := TMyObject.Create('test'); - end) - .ThenBy(function (const AValue: TObject): TMyObject - begin - Result := AValue; - end); //Here AValue will not be disposed - -var LPromise2 := Promise.Resolve(function: TMyObject - begin - Result := TMyObject.Create('test'); - end) - .ThenBy(function (const AValue: TObject): TMyObject - begin - Result := TMyObject.Create('test2'); - end); //Here AValue will be disposed - -var LPromise2 := Promise.Resolve(function: TMyObject - begin - Result := TMyObject.Create('test'); - end) - .Op.ThenBy(function (const AValue: TObject): String - begin - Result := 'test2;' - end); //Here AValue will be disposed -``` - -#### From TObject to TInterface - -An interesting case is when you return an interface that points to the object that was passed as the argument to `ThenBy` (the value of the previous resolved promise). Although the return type differs from the argument, the argument (object) will not always be disposed. If the returned interface points to the object passed in the argument, this object will *not* be disposed. - -``` delphi -var LPromise1 := Promise.Resolve(function: TMyObject - begin - Result := TMyObject.Create('test'); - end) - .Op.ThenBy(function (const AValue: TObject): IMyObject - begin - Result := AValue; - end); //Here AValue will not be disposed - -var LPromise2 := Promise.Resolve(function: TMyObject - begin - Result := TMyObject.Create('test'); - end) - .Op.ThenBy(function (const AValue: TObject): IMyObject - begin - Result := TMyObject.Create('test2'); - end); //Here AValue will be disposed -``` - -### Changing the default behavior - -You can interfer with the default memory management of resolved values within promises using two directives: - -- **dvKeep**: Indicates that the promise should transfer ownership of the resolved value and that it is not disposed at the end of the promise' lifecycle. This can be necessary to move objects in another object (for example putting the result of `Promise.All` in a `TObjectList`). -- **dvFree**: Specifies that the promise should take responsibility for freeing the resolved value, suitable for managing the lifecycle of dynamically created objects within asynchronous operations. This is the default behavior. - -### Example of Memory Management - -In the following example we instruct the promise to **not** dispose the object after adding it to the newly created `TObjectList`. - -``` delphi -var - LObjectList: TObjectList; -begin - LObjectList := Promise.Resolve(function: TMyObject - begin - Result := TMyObject.Create('test'); - end) - .Op.ThenBy>(function(const o: TMyObject): TObjectList - begin - Result := TObjectList.Create(); - Result.Add(o) - end, TDisposeValue.dvKeep) // Do not dispose the argument 'o' - .Catch(function(e: Exception): TObjectList - begin - Result := TObjectList.Create(); - end) - .Await; -``` - -## Extended example: using Promises in Asynchronous Methods - -Promises can be elegantly integrated into methods to encapsulate asynchronous operations, offering a streamlined approach to handling such tasks. This section demonstrates how to implement a method that performs an asynchronous operation (like fetching data) and returns a `IPromise` where `T` is the type of the data being fetched. - -In this example, we define a method `FetchUserData` within a `TUserRepository` class that simulates fetching user data asynchronously and returns a promise of `TUserData`. - -#### Defining the Data Structure - -First, define a data structure `TUserData` to hold user information: - -```delphi -type - TUserData = record - UserID: Integer; - UserName: String; - Email: String; - end; -``` - -#### Implementing the Asynchronous Method - -Next, implement the `FetchUserData` method in the `TUserRepository` class: - -```delphi -uses - Next.Core.Promises; - -type - TUserRepository = class - public - function FetchUserData(const UserID: Integer): IPromise; - end; - -function TUserRepository.FetchUserData(const UserID: Integer): IPromise; -begin - // Return a promise that resolves with the user data - Result := Promise.Resolve(function: TUserData - begin - // Simulate an asynchronous data fetching operation - Sleep(1000); // Simulate delay - Result.UserID := UserID; - Result.UserName := 'John Doe'; - Result.Email := 'johndoe@example.com'; - end); -end; -``` - -This method returns a `IPromise`, encapsulating the asynchronous fetching operation. - -#### Using the Asynchronous Method - -To use `FetchUserData`, call the method and handle the result, either by awaiting the promise or by chaining additional operations: - -```delphi -var - UserRepository: TUserRepository; - UserData: TUserData; -begin - UserRepository := TUserRepository.Create; - try - // Fetch user data and await the promise - UserData := UserRepository.FetchUserData(123).Await; - - // Use the fetched data, ensuring any UI updates are synchronized with the main thread - WriteLn('User ID: ' + IntToStr(UserData.UserID)); - WriteLn('User Name: ' + UserData.UserName); - WriteLn('Email: ' + UserData.Email); - finally - UserRepository.Free; - end; -end; -``` - -This approach simplifies managing asynchronous operations by encapsulating them within methods that return promises. It demonstrates how to perform asynchronous operations, await their completion, and safely update the UI with the results. - -## License - +# Promise Implementation in Delphi + +## Table of Contents + + 1. [Getting started](#getting-started) + 2. [Combinators: Race, Any, AllSettled](#combinators-race-any-allsettled) + 3. [Timeout](#timeout) + 4. [Cancellation](#cancellation) + 5. [Finally](#finally) + 6. [Exception handling](#exception-handling) + 7. [UI interaction](#ui-interaction) + 8. [Memory Management](#memory-management) + 9. [Extended example: using Promises in Asynchronous Methods](#extended-example-using-promises-in-asynchronous-methods) + +## Overview + +This Delphi library implements promises, enabling asynchronous programming by facilitating the handling of operations that may require time to complete. A promise represents a guarantee for an eventual result, streamlining the way asynchronous operations are managed in your applications. Additionally, this implementation embraces monadic principles, offering a structured approach to chaining computations and handling their outcomes. + +## Features + +- **Promise Chaining:** Easily chain multiple asynchronous operations, passing the result of one as the input to the next. +- **Exception handling:** The promise is side-affect free, so it manages exceptions inside the chain and you are able to recover from them. +- **Type Transformation:** Transform the resolved value's type through the `.Op` method, enabling flexible data handling. +- **Memory Management:** Control the lifecycle of promise-resolved values with `dvKeep` and `dvFree` directives, ensuring efficient resource utilization. +- **Starts immediately:** The promise execution starts immediately, you do not have to call `Await` to execute the chain. +- **Combinators:** `Promise.Race`, `Promise.Any`, and `Promise.AllSettled` for coordinating multiple concurrent promises. +- **Timeout:** Reject a promise automatically if it doesn't settle within a time limit. +- **Cancellation:** Cooperative cancellation via `ICancellationToken` with `CancelToken`, `OnCancelled`, and `ThrowIfCancelled`. +- **Finally:** Run cleanup logic after a promise settles, regardless of whether it resolved or rejected. + +## Getting Started + +To integrate this promise library into your Delphi projects, include the necessary unit in your project source and follow the examples provided below. + +### Create a new promise with an executor function +`Promise.New` is a class method that creates a new promise of type `T`. It accepts an **executor function** as its parameter, which defines the logic for resolving or rejecting the promise. + +The executor function has the following signature and is executed **synchronous** in the same thread context. + +```delphi +TProc, TProc> +``` + +- The first parameter (`TProc`) is a **resolve callback**: it is used to fulfill the promise with a value of type `T`. +- The second parameter (`TProc`) is a **reject callback**: it is used to reject the promise with an exception. + +The method returns an interface `IPromise` that represents the created promise. This is conceptually similar to JavaScript promises, allowing for chaining, error handling, and managing asynchronous workflows. + +--- + +#### Relation to JavaScript's Promise + +`Promise.New` is modeled after JavaScript's `new Promise` constructor. Here's how they align: + +| Delphi (`Promise.New`) | JavaScript (`new Promise`) | +|-----------------------------------------|--------------------------------------------------------| +| `Promise.New(AProc)` | `new Promise((resolve, reject) => { ... })` | +| Accepts a function with `resolve` and `reject` callbacks | Accepts a function with `resolve` and `reject` callbacks | +| Returns an `IPromise` | Returns a `Promise` object | +| Used for custom asynchronous logic | Used for custom asynchronous logic | + +**Example in JavaScript:** +```javascript +const myPromise = new Promise((resolve, reject) => { + setTimeout(() => { + resolve("Success!"); + }, 1000); +}); +``` + +**Equivalent in Delphi:** +```delphi +var + MyPromise: IPromise; +begin + MyPromise := Promise.New( + procedure(Resolve: TProc; Reject: TProc) + begin + TThread.CreateAnonymousThread( + procedure + begin + Sleep(1000); + Resolve('Success!'); + end); + end + ); +end; +``` + +--- + +#### When to Use `Promise.New` + +`Promise.New` should be used when you need to define custom asynchronous operations that don't already return a promise or similar construct. It allows fine-grained control over when and how a promise is resolved or rejected. + +##### Use Cases +1. **Custom Asynchronous Operations:** + When working with asynchronous operations that are not inherently promise-based, such as raw thread management or callback-based APIs. + + ```delphi + var + MyPromise: IPromise; + begin + MyPromise := Promise.New( + procedure(Resolve: TProc; Reject: TProc) + begin + TThread.CreateAnonymousThread( + procedure + begin + try + Sleep(1000); + Resolve(42); // Fulfill with a value + except + on E: Exception do + Reject(E); // Reject with an error + end; + end); + end + ); + end; + ``` + +2. **Bridge Non-Promise APIs:** + Wrap existing callback-based APIs in a promise interface to make them easier to work with. + + ```delphi + function ReadFileAsync(const FileName: string): IPromise; + begin + Result := Promise.New( + procedure(Resolve: TProc; Reject: TProc) + begin + TThread.CreateAnonymousThread( + procedure + begin + try + var Content := TFile.ReadAllText(FileName); + Resolve(Content); + except + on E: Exception do + Reject(E); + end; + end); + end + ); + end; + ``` + +3. **Chaining and Composition:** + Combine multiple asynchronous operations into a sequential flow using `.ThenBy` or `.Catch`. + +--- + +#### Caution +- Always ensure `Resolve` or `Reject` is called exactly once to avoid unexpected behavior. +- Be careful with exceptions: make sure any error is properly caught and passed to the `Reject` callback. + +--- + +#### Benefits of `Promise.New` +1. **Flexibility:** Allows you to adapt any asynchronous workflow to a promise-based approach. +2. **Consistency:** Aligns with the standard promise pattern found in JavaScript, making it familiar for developers with cross-platform experience. +3. **Chaining Support:** Enables sequential and conditional execution of asynchronous tasks through promise chaining. + +By leveraging `Promise.New`, developers can unify asynchronous code, making it cleaner, more readable, and easier to maintain. + +### Create a promise with an async method without executor methods +`Promise.Resolve` is a class method that creates and immediately resolves a promise of type `T`. It accepts a **function** (`TFunc`) that returns the value to resolve the promise with. This function is executed **asynchronous**. + +The method returns an interface `IPromise` that represents the resolved promise. This is conceptually equivalent to the `Promise.resolve` method in JavaScript. + +--- + +#### Relation to JavaScript's `Promise.resolve` + +`Promise.Resolve` is modeled after JavaScript's `Promise.resolve` method. Here's how they align: + +| Delphi (`Promise.Resolve`) | JavaScript (`Promise.resolve`) | +|------------------------------------------|-----------------------------------------------| +| `Promise.Resolve(AFunc)` | `Promise.resolve(() => { return value; })` | +| Accepts a function returning a value | Accepts a value or a function returning a value | +| Returns an `IPromise` | Returns a `Promise` object | +| Used to wrap a value or computation in a promise | Used to wrap a value or computation in a promise | + +**Example in JavaScript:** +```javascript +const resolvedPromise = Promise.resolve(() => "Hello, World!"); +``` + +**Equivalent in Delphi:** +```delphi +var + ResolvedPromise: IPromise; +begin + ResolvedPromise := Promise.Resolve( + function: string + begin + Result := 'Hello, World!'; + end + ); +end; +``` + +--- + +#### When to Use `Promise.Resolve` + +`Promise.Resolve` should be used when you already have a value or computation and want to return it as a promise, so that the computation is done in the background (asynchronous). It is useful for maintaining consistency when working with promise-based workflows. + +##### Use Cases +1. **Execute heavy operations asynchronous:** + Use `Promise.Resolve` to perform some heavy operations asynchronous, continue the flow and retrieve the result later (using `Await` or chaining). + + ```delphi + function GetValueAsync: IPromise; + begin + Result := Promise.Resolve( + function: string + begin + Result := 'Do some time consuming operation here'; + sleep(10000); + end + ); + end; + ``` + +2. **Wrapping Immediate Values in a Promise:** + Use `Promise.Resolve` to create a resolved promise from an already available value or computation. + + ```delphi + var + ResolvedPromise: IPromise; + begin + ResolvedPromise := Promise.Resolve( + function: Integer + begin + Result := 42; // Return an immediate value + end + ); + end; + ``` + +3. **Normalizing Return Values:** + When a function might return either a value or a promise, `Promise.Resolve` ensures that the result is always a promise. + + ```delphi + function GetValueAsync: IPromise; + begin + Result := Promise.Resolve( + function: string + begin + Result := 'Synchronous Value'; + end + ); + end; + ``` + +--- + +#### Example with Await + +Here is a simple example to see how you could perform an **async** (background) operation and wait (blocking) for it to complete. + +```delphi +uses Next.Core.Promises; + +// Create and resolve a simple promise +var + value: String; +begin + value := Promise.Resolve(function: String + begin + Result := 'Hello, World!'; + end).Await; + + // Outputs: Hello, World! + WriteLn(value); +end; +``` + +### Chaining promises + +On of the key features of promises is the ability to chain them. You chain promises to perform a sequence of operations where each step depends on the outcome of the previous one. During these steps the result types of the promise can change as you can see in the following example. + +```delphi +uses Next.Core.Promises; + +// Chain promises to multiply an integer and convert it to a string +// Ensure UI update is on the main thread +begin + Promise.Resolve(function: Integer + begin + Result := 10; + end) + .ThenBy(function(const value: Integer): Integer + begin + Result := value * 2; // Process in background thread + end) + .Op.ThenBy(function(const value: Integer): String + begin + Result := IntToStr(value); // Process in background thread + end) + .Main.ThenBy(function(const value: String): TVoid + begin + WriteLn(value); // Synchronized to the main thread + Result := Void; + end); +end; +``` + +### Type Transformation with `.Op` + +Use the `.Op` method to transform the type of the resolved value of a promise. + +```delphi +uses Next.Core.Promises; + +// Transform the resolved value type from Integer to String +var promise: IPromise; +begin + promise := Promise.Resolve(function: Integer + begin + Result := 10; + end) + .Op.ThenBy(function(const value: Integer): String + begin + Result := 'Transformed Value: ' + IntToStr(value); // Process in background thread + end); + + WriteLn(promise.Await); // Outputs: Transformed Value: 10 +end; +``` + +### Using Await + +The `.Await` operator is used to retrieve the value from a resolved promise. The behavior is that the calling thread is blocked from there until the promise is fulfilled (resolved or rejected). If the promise is resolved, it will return the resolved value. If the promise is rejected, it will raise the caught exception. + +#### Using in main thread + +Due to the blocking nature of `.Await`, it is advised to use it in the main thread context as little as possible. If you use it in the main thread context, a `CheckSynchronize` method is repeatedly executed until the promise is fulfilled. This makes sure that UI interaction, such as repaints, will continue while your code flow is interrupted. The better way is to use messages to notify the UI of changes, see the examples below. + +### Promise.All, waiting for multiple promises to resolve + +If you perform multiple background operations you might want to wait until all of them are completed and then perform some action on it. You can use `Promise.All` for this. This waits until all promises are fulfilled. If one of the promises rejects (raises an exception), it will immediately go to the first `.Catch` in the chain without waiting for the rest of the promises to be fulfilled. + +``` delphi +var LWidth := Promise.Resolve(function: Integer + begin + //Heavy operation + Result := 10; + end); + +var LHeight := Promise.Resolve(function: Integer + begin + //Heavy operation + Result := 10; + end); + +var LDepth := Promise.Resolve(function: Integer + begin + //Heavy operation + Result := 10; + end); + +//Now all three operations are running simultaneously, as soon as all are finished the next method in the chain will be called to calculate the volume +Promise.All([LWidth, LHeight, LDepth]) + .Op.ThenBy(function(const AResults: TArray): Integer + begin + Result := AResults[0] * AResults[1] * AResults[2]; + end) + .Main.ThenBy(procedure(const AVolume: Integer) + begin + WriteLn(AVolume.ToString()); // Synchronized to the main thread + end) + .Main.Catch(procedure(E: Exception) + begin + WriteLn('Calculation failed: ' + E.Message); // Synchronized to the main thread + end) + +//Here you can continue your codeflow, for example show a waiting indicator +``` + +## Combinators: Race, Any, AllSettled + +In addition to `Promise.All`, the library provides three combinators for coordinating multiple concurrent promises. These mirror the JavaScript `Promise.Race`, `Promise.any`, and `Promise.allSettled` APIs. + +### Promise.Race + +Returns a promise that settles as soon as the **first** input promise settles (resolves or rejects). The remaining promises continue executing but their results are ignored. + +```delphi +uses Next.Core.Promises; + +var + LFast := Promise.Resolve(function: Integer + begin + Sleep(100); + Result := 42; + end); + +var + LSlow := Promise.Resolve(function: Integer + begin + Sleep(5000); + Result := 99; + end); + +var + LWinner: Integer; +begin + LWinner := Promise.Race([LFast, LSlow]).Await; + WriteLn(LWinner); // 42 — the fast promise won +end; +``` + +If the first promise to settle rejects, the race promise also rejects: + +```delphi +var LPromise := Promise.Race([ + Promise.Reject(Exception.Create('fast error')), + Promise.Resolve(function: Integer + begin + Sleep(1000); + Result := 42; + end) +]); + +// LPromise is rejected with 'fast error' +``` + +Passing an empty array rejects with `EArgumentException`. + +| Delphi | JavaScript | +|--------|-----------| +| `Promise.Race([...])` | `Promise.race([...])` | +| First settled wins (resolve or reject) | First settled wins (resolve or reject) | +| Empty array → `EArgumentException` | Empty array → forever pending | + +### Promise.Any + +Returns a promise that resolves with the value of the **first promise that resolves successfully**. Rejections are collected silently. Only if **all** promises reject does the returned promise reject with `EAggregateException` containing all individual exceptions. + +```delphi +uses Next.Core.Promises, Next.Core.Promises.Exceptions; + +// Two fail, one succeeds → Any resolves with the successful one +var LResult := Promise.Any([ + Promise.Reject(Exception.Create('error 1')), + Promise.Resolve(function: String + begin + Result := 'success!'; + end), + Promise.Reject(Exception.Create('error 2')) +]).Await; + +WriteLn(LResult); // 'success!' +``` + +When all reject: + +```delphi +try + Promise.Any([ + Promise.Reject(Exception.Create('err1')), + Promise.Reject(Exception.Create('err2')) + ]).Await; +except + on E: EAggregateException do + begin + WriteLn(E.Exceptions[0].Message); // 'err1' + WriteLn(E.Exceptions[1].Message); // 'err2' + end; +end; +``` + +Passing an empty array rejects with `EArgumentException`. + +| Delphi | JavaScript | +|--------|-----------| +| `Promise.Any([...])` | `Promise.any([...])` | +| First resolve wins | First resolve wins | +| All reject → `EAggregateException` | All reject → `AggregateError` | + +### Promise.AllSettled + +Waits for **all** promises to settle (resolve or reject). Never short-circuits. Returns an array of `TPromiseSettledResult` records preserving the original order. + +```delphi +uses Next.Core.Promises; + +var LResults := Promise.AllSettled([ + Promise.Resolve(function: Integer begin Result := 1 end), + Promise.Reject(Exception.Create('failed')), + Promise.Resolve(function: Integer begin Result := 3 end) +]).Await; + +for var R in LResults do +begin + if R.Status = TPromiseStatus.psResolved then + WriteLn('Resolved: ', R.Value) + else + WriteLn('Rejected: ', R.Error.Message); +end; + +// Output: +// Resolved: 1 +// Rejected: failed +// Resolved: 3 +``` + +Each `TPromiseSettledResult` has: +- `Status`: `TPromiseStatus.psResolved` or `TPromiseStatus.psRejected` +- `Value`: the resolved value (only meaningful when `Status = psResolved`) +- `Error`: the exception (only meaningful when `Status = psRejected`) + +Passing an empty array resolves immediately with an empty result array. + +| Delphi | JavaScript | +|--------|-----------| +| `Promise.AllSettled([...])` | `Promise.allSettled([...])` | +| Returns `TArray>` | Returns array of `{status, value/reason}` | +| Empty array → resolves with `[]` | Empty array → resolves with `[]` | + +## Timeout + +Attach a timeout to any promise with `.Timeout(milliseconds)`. If the promise doesn't settle within the specified time, it rejects with `ETimeoutException`. + +```delphi +uses Next.Core.Promises, Next.Core.Promises.Exceptions; + +var LPromise := Promise.Resolve(function: String + begin + Sleep(10000); // Slow operation + Result := 'done'; + end) +.Timeout(2000); // 2 second timeout + +try + LPromise.Await; +except + on E: ETimeoutException do + WriteLn(E.Message); // 'Promise timed out' +end; +``` + +You can provide a custom timeout message: + +```delphi +.Timeout(5000, 'Data fetch exceeded 5 seconds') +``` + +Timeout works by internally using `Promise.Race` between the original promise and a timer promise. If the original resolves first, the timeout is harmless. Timeout can be combined with chaining: + +```delphi +Promise.Resolve(function: Integer + begin + Sleep(100); + Result := 42; + end) +.Timeout(5000) +.ThenBy(function(const V: Integer): Integer + begin + Result := V * 2; + end) +.Await; // Returns 84 +``` + +## Cancellation + +Cooperative cancellation lets you signal a running promise to stop. It uses two interfaces: + +- `ICancellationTokenSource` — created by the caller, provides `Cancel` and `Token` +- `ICancellationToken` — passed into the promise, provides `IsCancelled` and `ThrowIfCancelled` + +```delphi +uses Next.Core.Promises, Next.Core.Promises.Cancellation, Next.Core.Promises.Exceptions; +``` + +### Basic cancellation + +```delphi +var + Cts: ICancellationTokenSource; +begin + Cts := TCancellationTokenSource.Create; + + var LPromise := Promise.Resolve(function: Integer + begin + Sleep(5000); + Result := 42; + end) + .CancelToken(Cts.Token); + + // Cancel before the promise completes + Cts.Cancel; + + try + LPromise.Await; + except + on E: EOperationCancelled do + WriteLn('Promise was cancelled'); + end; +end; +``` + +### Cooperative cancellation with ThrowIfCancelled + +For long-running operations, check for cancellation periodically: + +```delphi +var + Cts: ICancellationTokenSource; +begin + Cts := TCancellationTokenSource.Create; + + var LPromise := Promise.Resolve(function: Integer + var Token: ICancellationToken; + begin + Token := Cts.Token; + for var i := 1 to 1000 do + begin + Token.ThrowIfCancelled; // Raises EOperationCancelled if cancelled + Sleep(10); // Simulate work + end; + Result := 42; + end) + .CancelToken(Cts.Token); + + // Cancel after 500ms from another thread + TThread.CreateAnonymousThread(procedure + begin + Sleep(500); + Cts.Cancel; + end).Start; +end; +``` + +### OnCancelled handler + +Register a handler that fires only on cancellation — syntactic sugar for a `.Catch` that filters for `EOperationCancelled`: + +```delphi +Promise.Resolve(function: Integer + begin + Sleep(5000); + Result := 42; + end) +.CancelToken(Cts.Token) +.OnCancelled(procedure + begin + WriteLn('Operation was cancelled — cleaning up'); + end); +``` + +### Cancellation token properties + +| Method | Description | +|--------|-------------| +| `Cts.Cancel` | Signals cancellation (idempotent — safe to call multiple times) | +| `Cts.Token` | Returns the `ICancellationToken` to pass into promises | +| `Token.IsCancelled` | Returns `True` if cancellation has been requested | +| `Token.ThrowIfCancelled` | Raises `EOperationCancelled` if cancelled | + +## Finally + +`.Finally` runs a cleanup procedure after a promise settles, regardless of whether it resolved or rejected. The settled value (or rejection) is preserved and passed through. + +```delphi +uses Next.Core.Promises; + +var LLoading := True; + +Promise.Resolve(function: String + begin + Result := 'data loaded'; + end) +.&Finally(procedure + begin + LLoading := False; // Always runs — good for cleanup + end) +.ThenBy(procedure(const V: String) + begin + WriteLn(V); // 'data loaded' — value passes through Finally + end); +``` + +Note the `&` prefix: `Finally` is a reserved word in Delphi, so it must be escaped as `&Finally`. + +If the `Finally` handler raises an exception, it **replaces** the original result: + +```delphi +// Original resolve is replaced by the Finally exception +Promise.Resolve(function: Integer + begin + Result := 42; + end) +.&Finally(procedure + begin + raise Exception.Create('cleanup failed'); + end); +// Promise is now rejected with 'cleanup failed' +``` + +If the `Finally` handler completes normally, the original result passes through unchanged — even if the promise was rejected: + +```delphi +// Rejection passes through Finally unchanged +Promise.Reject(Exception.Create('original error')) +.&Finally(procedure + begin + WriteLn('cleanup runs'); // Runs, does not affect the rejection + end); +// Promise is still rejected with 'original error' +``` + +| Delphi | JavaScript | +|--------|-----------| +| `.&Finally(procedure begin ... end)` | `.finally(() => { ... })` | +| Exception in handler replaces result | Exception in handler replaces result | +| Normal completion preserves result | Normal completion preserves result | + +## Exception handling + +If any exceptions occurs, the chain will be interrupted until the first `.Catch` in the chain. If there is no catch, the promise will be rejected. Calling `.Await` on a rejected promise will raise the exception that was caught inside the promise in the caller context. + +### Recover from exceptions + +Use the `.Catch` method to recover from any exception in the chain. + +```delphi +uses Next.Core.Promises; + +// Handling exceptions and synchronizing error handling to the main thread +begin + Promise.Resolve(function: Boolean + begin + raise Exception.Create('Simulated error'); + end) + .Catch(function(E: Exception): Boolean + begin + if E.Message = 'Simulated error' then + Result := False // Recover from the error condition + else + raise; // Re-throw for other exceptions + end) + .Main.ThenBy(function(const value: Boolean): TVoid + begin + if not value then + WriteLn('Error handled, alternative value provided.'); // UI handling in the main thread + Result := Void; // Setting result to Void correctly + end); +end; +``` + +### Handling `.Await` on Rejected Promises + +When using the `.Await` method on a rejected promise, take note of the following behavior: + +1. **First Call to `.Await`:** + - The first call to `.Await` raises the original exception that was caught inside the promise. + - Depending on the debugging framework you use (e.g., MadExcept, EurekaLog, JclDebug), this exception may include the original stack trace where the exception occurred. This can be invaluable for debugging purposes. + +2. **Subsequent Calls to `.Await`:** + - Any consecutive calls to `.Await` on the same promise will raise a *clone* of the original exception. + - The cloned exception preserves the original exception’s class type and message, but: + - It does **not** retain the original stack trace. + - It does **not** include any additional fields or custom properties that may be defined in the exception's child class. + +#### Important Notes: +- This behavior ensures that the promise remains consistent and does not retain unnecessary state after the first `.Await` call. +- If your application relies on debugging tools for stack trace analysis, always capture and handle the exception from the first `.Await` call. +- Avoid relying on child-class-specific fields in exceptions when dealing with rejected promises, as these fields will not be preserved in cloned exceptions during subsequent `.Await` calls. + +#### Best Practices: +- **Debugging:** Use the debugging tools (e.g., MadExcept, EurekaLog) to capture detailed exception information during the first `.Await` call. +- **Exception Logging:** If you need to log exceptions, do so during the first `.Await` call to ensure the most complete information is available. +- **Avoid Multiple Awaits:** Design your promise workflows to minimize redundant `.Await` calls on the same rejected promise, as the additional calls will provide limited diagnostic value. + +By understanding and respecting these nuances, you can effectively handle exceptions in your promise-based implementations in Delphi. + +## UI interaction + +VCL operations are only allowed in main thread. Therefore this promise supports synchronisation natively using the `.Main` directive. This instructs the promise to execute the anonymous method in the main thread context. + +### Simple UI example + +Because the promise starts executing immediately (there is no need for `.Await`), you can create a promise and continue your codeflow. In the following example we perform a simple background operation and show a messagebox on completion while keeping the UI responsive. + +```delphi +uses Next.Core.Promises; + +// Create and resolve a simple promise +procedure DoHeavyOperationOnButtonClick() +begin + Promise.Resolve(function: String + begin + //Do some heavy operation + Result := 'Heavy operation completed!'; + end) + .Main.ThenBy(procedure(const value: String) + begin + ShowMessage(value); + end); + + //Continue your flow, the messagebox will popup when the operation is completed. You might consider showing a indicator that shows that the operation is going on. +end; +``` + +### Interacting with your forms + +The previous example is simple and has no interaction with any form. However, in practice this will not always be the case. In that situation it is important to make sure your promises does not interact with your form-objects after a form is disposed. + +You can solve this by instructing the form using the Windows message queue with `PostMessage`. Make sure that you capture the forms `Handle` and that you do not use `Self.Handle`, because that could also be invalid at that point. + +``` delphi +uses Next.Core.Promises; + +class + TMyForm = class(TForm) + procedure DoSomething(var AMessage: TMessage); message WM_MY_MESSAGE; + end; + +procedure TMyForm.DoHeavyOperationOnButtonClick() +begin + var LHandle := Self.Handle; + + Promise.Resolve(function: String + begin + //Do some heavy operation + Result := 'Heavy operation completed!'; + end) + .ThenBy(procedure(const value: String) + begin + PostMessage(LHandle, WM_MY_MESSAGE, 0, 0); + end); + + //Continue your flow, the procedure DoSomething will be called when the heavy operation is completed. +end; +``` + +## Memory Management + +By default, the promise is responsible for handling the memory of everything that is returned by any of the anonymous methods. That means that if you create an object in a resolver function, that object is disposed when the promise is disposed. The resolved value will stay "in" the promise and can be used multiples times by calling `.Await`. This works for all managed types, but not for objects. + +### Use Await to transfer ownership of an object + +With `.Await` you can retrieve the value inside the promise and use it. After calling `.Await` the ownership of the value is transfered to the caller, so -if it is an object- the promise will no longer dispose it. + +The following example makes clear what the effect would be if the promise would keep ownership of the object. In the following situation the promise can already be destroyed before the last code is executed. That would mean that `LObject` points to an already disposed object. + +``` delphi +var LObject := Promise.Resolve(function: TMyObject + begin + Result := TMyObject.Create('test'); + end).Await; + +LObject.DoSomething(); //here LObject can already be disposed by the promise +``` + +### Chaining (ThenBy) disposes the argument if it is different from the return value + +With `ThenBy` you have the option to return a different type or different instance of the same type. If the returned instance points to the same object that object will *not* be disposed. If the returned instance is another object, the argument passed to `ThenBy` (eg. this is the value of the previous resolved promise) will be disposed. + +``` delphi +var LPromise1 := Promise.Resolve(function: TMyObject + begin + Result := TMyObject.Create('test'); + end) + .ThenBy(function (const AValue: TObject): TMyObject + begin + Result := AValue; + end); //Here AValue will not be disposed + +var LPromise2 := Promise.Resolve(function: TMyObject + begin + Result := TMyObject.Create('test'); + end) + .ThenBy(function (const AValue: TObject): TMyObject + begin + Result := TMyObject.Create('test2'); + end); //Here AValue will be disposed + +var LPromise2 := Promise.Resolve(function: TMyObject + begin + Result := TMyObject.Create('test'); + end) + .Op.ThenBy(function (const AValue: TObject): String + begin + Result := 'test2;' + end); //Here AValue will be disposed +``` + +#### From TObject to TInterface + +An interesting case is when you return an interface that points to the object that was passed as the argument to `ThenBy` (the value of the previous resolved promise). Although the return type differs from the argument, the argument (object) will not always be disposed. If the returned interface points to the object passed in the argument, this object will *not* be disposed. + +``` delphi +var LPromise1 := Promise.Resolve(function: TMyObject + begin + Result := TMyObject.Create('test'); + end) + .Op.ThenBy(function (const AValue: TObject): IMyObject + begin + Result := AValue; + end); //Here AValue will not be disposed + +var LPromise2 := Promise.Resolve(function: TMyObject + begin + Result := TMyObject.Create('test'); + end) + .Op.ThenBy(function (const AValue: TObject): IMyObject + begin + Result := TMyObject.Create('test2'); + end); //Here AValue will be disposed +``` + +### Changing the default behavior + +You can interfer with the default memory management of resolved values within promises using two directives: + +- **dvKeep**: Indicates that the promise should transfer ownership of the resolved value and that it is not disposed at the end of the promise' lifecycle. This can be necessary to move objects in another object (for example putting the result of `Promise.All` in a `TObjectList`). +- **dvFree**: Specifies that the promise should take responsibility for freeing the resolved value, suitable for managing the lifecycle of dynamically created objects within asynchronous operations. This is the default behavior. + +### Example of Memory Management + +In the following example we instruct the promise to **not** dispose the object after adding it to the newly created `TObjectList`. + +``` delphi +var + LObjectList: TObjectList; +begin + LObjectList := Promise.Resolve(function: TMyObject + begin + Result := TMyObject.Create('test'); + end) + .Op.ThenBy>(function(const o: TMyObject): TObjectList + begin + Result := TObjectList.Create(); + Result.Add(o) + end, TDisposeValue.dvKeep) // Do not dispose the argument 'o' + .Catch(function(e: Exception): TObjectList + begin + Result := TObjectList.Create(); + end) + .Await; +``` + +## Extended example: using Promises in Asynchronous Methods + +Promises can be elegantly integrated into methods to encapsulate asynchronous operations, offering a streamlined approach to handling such tasks. This section demonstrates how to implement a method that performs an asynchronous operation (like fetching data) and returns a `IPromise` where `T` is the type of the data being fetched. + +In this example, we define a method `FetchUserData` within a `TUserRepository` class that simulates fetching user data asynchronously and returns a promise of `TUserData`. + +#### Defining the Data Structure + +First, define a data structure `TUserData` to hold user information: + +```delphi +type + TUserData = record + UserID: Integer; + UserName: String; + Email: String; + end; +``` + +#### Implementing the Asynchronous Method + +Next, implement the `FetchUserData` method in the `TUserRepository` class: + +```delphi +uses + Next.Core.Promises; + +type + TUserRepository = class + public + function FetchUserData(const UserID: Integer): IPromise; + end; + +function TUserRepository.FetchUserData(const UserID: Integer): IPromise; +begin + // Return a promise that resolves with the user data + Result := Promise.Resolve(function: TUserData + begin + // Simulate an asynchronous data fetching operation + Sleep(1000); // Simulate delay + Result.UserID := UserID; + Result.UserName := 'John Doe'; + Result.Email := 'johndoe@example.com'; + end); +end; +``` + +This method returns a `IPromise`, encapsulating the asynchronous fetching operation. + +#### Using the Asynchronous Method + +To use `FetchUserData`, call the method and handle the result, either by awaiting the promise or by chaining additional operations: + +```delphi +var + UserRepository: TUserRepository; + UserData: TUserData; +begin + UserRepository := TUserRepository.Create; + try + // Fetch user data and await the promise + UserData := UserRepository.FetchUserData(123).Await; + + // Use the fetched data, ensuring any UI updates are synchronized with the main thread + WriteLn('User ID: ' + IntToStr(UserData.UserID)); + WriteLn('User Name: ' + UserData.UserName); + WriteLn('Email: ' + UserData.Email); + finally + UserRepository.Free; + end; +end; +``` + +This approach simplifies managing asynchronous operations by encapsulating them within methods that return promises. It demonstrates how to perform asynchronous operations, await their completion, and safely update the UI with the results. + +## License + This project is licensed under the MIT License - see the LICENSE file for details. \ No newline at end of file