diff --git a/Source/Delphi.Mocks.Helpers.pas b/Source/Delphi.Mocks.Helpers.pas index cf4434f..e0a887d 100644 --- a/Source/Delphi.Mocks.Helpers.pas +++ b/Source/Delphi.Mocks.Helpers.pas @@ -33,9 +33,36 @@ interface uses - Rtti; + System.Generics.Collections, + System.Rtti, System.TypInfo; type + // Need to define a common 'non-generic' version and using interface gives bonus of reference counting for clean-up + ICustomValueComparer = Interface + ['{AA4E862E-F83E-4438-B8E3-BAE2BD0E9475}'] + function Compare(const ALeft, ARight: TValue): Integer; + End; + + TCustomValueComparerFunction = reference to function(const a, b: T): Integer; + TCustomValueComparer = class(TInterfacedObject, ICustomValueComparer) + private + FComparer: TCustomValueComparerFunction; + public + constructor Create(const ACustomComparer: TCustomValueComparerFunction); + + {$REGION 'ICustomValueComparer'} + function Compare(const ALeft, ARight: TValue): Integer; + {$ENDREGION} + end; + + TCustomValueComparerStore = record + private + class var CustomComparers: TDictionary; + public + class procedure RegisterCustomComparer(const AComparer: TCustomValueComparerFunction); static; + class procedure UnRegisterCustomComparer; static; + end; + //TValue really needs to have an Equals operator overload! TValueHelper = record helper for TValue private @@ -64,6 +91,7 @@ TValueHelper = record helper for TValue function IsWord: Boolean; function IsGuid: Boolean; function IsInterface : Boolean; + function IsRecord: Boolean; function AsDouble: Double; function AsFloat: Extended; function AsSingle: Single; @@ -87,7 +115,6 @@ implementation uses SysUtils, Math, - TypInfo, Variants, StrUtils; @@ -101,11 +128,17 @@ function CompareValue(const Left, Right: TValue): Integer; EmptyResults: array[Boolean, Boolean] of Integer = ((0, -1), (1, 0)); var leftIsEmpty, rightIsEmpty: Boolean; + CustomComparer: ICustomValueComparer; +const + ErrorStr: String = 'Unable to compare %s. Use Delphi.Mocks.Helpers.TCustomValueComparerStore.RegisterCustomComparer to add a ' + + 'method to compare records.'; begin leftIsEmpty := left.IsEmpty; rightIsEmpty := right.IsEmpty; if leftIsEmpty or rightIsEmpty then Result := EmptyResults[leftIsEmpty, rightIsEmpty] + else if (Left.TypeInfo = Right.TypeInfo) and TCustomValueComparerStore.CustomComparers.TryGetValue(Left.TypeInfo, CustomComparer) then + Result := CustomComparer.Compare(Left, Right) else if left.IsOrdinal and right.IsOrdinal then Result := Math.CompareValue(left.AsOrdinal, right.AsOrdinal) else if left.IsFloat and right.IsFloat then @@ -116,6 +149,8 @@ function CompareValue(const Left, Right: TValue): Integer; Result := NativeInt(left.AsObject) - NativeInt(right.AsObject) // TODO: instance comparer else if Left.IsInterface and Right.IsInterface then Result := NativeInt(left.AsInterface) - NativeInt(right.AsInterface) // TODO: instance comparer + else if Left.IsRecord and Right.IsRecord then + raise Exception.Create(Format(ErrorStr ,[Left.TypeInfo.Name])) else if left.IsVariant and right.IsVariant then begin case VarCompareValue(left.AsVariant, right.AsVariant) of @@ -236,6 +271,11 @@ function TValueHelper.IsPointer: Boolean; Result := Kind = tkPointer; end; +function TValueHelper.IsRecord: Boolean; +begin + Result := Kind = tkRecord; +end; + function TValueHelper.IsShortInt: Boolean; begin Result := TypeInfo = System.TypeInfo(ShortInt); @@ -307,4 +347,42 @@ function TRttiTypeHelper.TryGetMethod(const AName: string; out AMethod: TRttiMet Result := Assigned(AMethod); end; +{ TCustomValueComparer } + +function TCustomValueComparer.Compare(const ALeft, ARight: TValue): Integer; +var + Left, Right: T; +begin + Left := ALeft.AsType; + Right := ARight.AsType; + + Result := FComparer(Left, Right); +end; + +constructor TCustomValueComparer.Create(const ACustomComparer: TCustomValueComparerFunction); +begin + inherited Create; + + FComparer := ACustomComparer; +end; + +{ TCustomValueComparerStore } + +class procedure TCustomValueComparerStore.RegisterCustomComparer(const AComparer: TCustomValueComparerFunction); +begin + CustomComparers.AddOrSetValue(TypeInfo(T), TCustomValueComparer.Create(AComparer)) +end; + +class procedure TCustomValueComparerStore.UnRegisterCustomComparer; +begin + CustomComparers.Remove(System.TypeInfo(T)); +end; + + +initialization + TCustomValueComparerStore.CustomComparers := TDictionary.Create; + +finalization + TCustomValueComparerStore.CustomComparers.Free; + end. diff --git a/Source/Delphi.Mocks.WeakReference.pas b/Source/Delphi.Mocks.WeakReference.pas index 708ab04..1c5dc67 100644 --- a/Source/Delphi.Mocks.WeakReference.pas +++ b/Source/Delphi.Mocks.WeakReference.pas @@ -39,12 +39,20 @@ interface type /// Implemented by our weak referenced object base class + {$IFOPT M+} + {$M-} + {$DEFINE ENABLED_M+} + {$ENDIF} IWeakReferenceableObject = interface ['{3D7F9CB5-27F2-41BF-8C5F-F6195C578755}'] procedure AddWeakRef(value : Pointer); procedure RemoveWeakRef(value : Pointer); function GetRefCount : integer; end; + {$IFDEF ENABLED_M+} + {$M+} + {$UNDEF ENABLED_M+} + {$ENDIF} /// This is our base class for any object that can have a weak reference to /// it. It implements IInterface so the object can also be used just like