From a08120f6e44fb68d600d94957bf71c73f1c2c7c1 Mon Sep 17 00:00:00 2001
From: Aly <alasdair.douglas@brookesbell.com>
Date: Fri, 10 Apr 2020 10:56:00 +0100
Subject: [PATCH 1/8] Fixed issue #125 Access violation in
TValueHelper.CompareValue for tkRecord
Added ability to register custom comparison routines which cann be used for all types but primarily designed to be used with records
---
Source/Delphi.Mocks.Helpers.pas | 46 ++++++++++++++++++++++++++++++++-
1 file changed, 45 insertions(+), 1 deletion(-)
diff --git a/Source/Delphi.Mocks.Helpers.pas b/Source/Delphi.Mocks.Helpers.pas
index cf4434f..b53e7e5 100644
--- a/Source/Delphi.Mocks.Helpers.pas
+++ b/Source/Delphi.Mocks.Helpers.pas
@@ -33,9 +33,20 @@
interface
uses
- Rtti;
+ System.Generics.Collections,
+ System.Rtti;
type
+ //Allow custom comparisons
+ TCustomValueComparer = reference to function(const a, b: TValue): Integer;
+ TCustomValueComparerStore = record
+ private
+ class var CustomComparers: TDictionary<Pointer, TCustomValueComparer>;
+ public
+ class procedure RegisterCustomComparer<T>(const AComparer: TCustomValueComparer); static;
+ class procedure UnRegisterCustomComparer<T>; static;
+ end;
+
//TValue really needs to have an Equals operator overload!
TValueHelper = record helper for TValue
private
@@ -64,6 +75,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;
@@ -101,11 +113,14 @@ function CompareValue(const Left, Right: TValue): Integer;
EmptyResults: array[Boolean, Boolean] of Integer = ((0, -1), (1, 0));
var
leftIsEmpty, rightIsEmpty: Boolean;
+ CustomComparer: TCustomValueComparer;
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(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 +131,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('Use Delphi.Mocks.Helpers.TCustomValueComparerStore.RegisterCustomComparer<T> to add a method to compare records.')
else if left.IsVariant and right.IsVariant then
begin
case VarCompareValue(left.AsVariant, right.AsVariant) of
@@ -236,6 +253,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 +329,26 @@ function TRttiTypeHelper.TryGetMethod(const AName: string; out AMethod: TRttiMet
Result := Assigned(AMethod);
end;
+
+
+{ TCustomValueComparerStore }
+
+class procedure TCustomValueComparerStore.RegisterCustomComparer<T>(const AComparer: TCustomValueComparer);
+begin
+ CustomComparers.Add(System.TypeInfo(T), AComparer);
+end;
+
+class procedure TCustomValueComparerStore.UnRegisterCustomComparer<T>;
+begin
+ CustomComparers.Remove(System.TypeInfo(T));
+end;
+
+
+
+initialization
+ TCustomValueComparerStore.CustomComparers := TDictionary<Pointer, TCustomValueComparer>.Create;
+
+finalization
+ TCustomValueComparerStore.CustomComparers.Free;
+
end.
From 9d3fc3451547e14c7806424dd3a72d18be2c8bae Mon Sep 17 00:00:00 2001
From: Aly <alasdair.douglas@brookesbell.com>
Date: Fri, 10 Apr 2020 10:57:38 +0100
Subject: [PATCH 2/8] Fixed E1234 compiler error when {$M+} is specified at
project level
This was removed in commit e90fee5.
---
Source/Delphi.Mocks.WeakReference.pas | 8 ++++++++
1 file changed, 8 insertions(+)
diff --git a/Source/Delphi.Mocks.WeakReference.pas b/Source/Delphi.Mocks.WeakReference.pas
index 708ab04..9baf754 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;
+ {$IFOPT 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
From 936635e0c4171efa24fd0c45648d79c22a4ec528 Mon Sep 17 00:00:00 2001
From: Aly <alasdair.douglas@brookesbell.com>
Date: Fri, 10 Apr 2020 11:26:18 +0100
Subject: [PATCH 3/8] Added better error message when custom comparer is not
available
---
Source/Delphi.Mocks.Helpers.pas | 5 ++++-
1 file changed, 4 insertions(+), 1 deletion(-)
diff --git a/Source/Delphi.Mocks.Helpers.pas b/Source/Delphi.Mocks.Helpers.pas
index b53e7e5..4581ea9 100644
--- a/Source/Delphi.Mocks.Helpers.pas
+++ b/Source/Delphi.Mocks.Helpers.pas
@@ -114,6 +114,9 @@ function CompareValue(const Left, Right: TValue): Integer;
var
leftIsEmpty, rightIsEmpty: Boolean;
CustomComparer: TCustomValueComparer;
+const
+ ErrorStr: String = 'Unable to compare %s. Use Delphi.Mocks.Helpers.TCustomValueComparerStore.RegisterCustomComparer<T> to add a ' +
+ 'method to compare records.';
begin
leftIsEmpty := left.IsEmpty;
rightIsEmpty := right.IsEmpty;
@@ -132,7 +135,7 @@ function CompareValue(const Left, Right: TValue): Integer;
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('Use Delphi.Mocks.Helpers.TCustomValueComparerStore.RegisterCustomComparer<T> to add a method to compare records.')
+ raise Exception.Create(Format(ErrorStr ,[Left.TypeInfo.Name]))
else if left.IsVariant and right.IsVariant then
begin
case VarCompareValue(left.AsVariant, right.AsVariant) of
From f46ace6a65ece666a33ec15ae5d9ec69829e6e7f Mon Sep 17 00:00:00 2001
From: Aly <alasdair.douglas@brookesbell.com>
Date: Fri, 10 Apr 2020 11:27:06 +0100
Subject: [PATCH 4/8] Avoid error in
TCustomValueComparerStore.RegisterCustomComparer when comparer already exists
---
Source/Delphi.Mocks.Helpers.pas | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/Source/Delphi.Mocks.Helpers.pas b/Source/Delphi.Mocks.Helpers.pas
index 4581ea9..e0353a3 100644
--- a/Source/Delphi.Mocks.Helpers.pas
+++ b/Source/Delphi.Mocks.Helpers.pas
@@ -338,7 +338,7 @@ function TRttiTypeHelper.TryGetMethod(const AName: string; out AMethod: TRttiMet
class procedure TCustomValueComparerStore.RegisterCustomComparer<T>(const AComparer: TCustomValueComparer);
begin
- CustomComparers.Add(System.TypeInfo(T), AComparer);
+ CustomComparers.AddOrSetValue(System.TypeInfo(T), AComparer);
end;
class procedure TCustomValueComparerStore.UnRegisterCustomComparer<T>;
From f84d4491de84f0eb00c593cac17d4d1321a62753 Mon Sep 17 00:00:00 2001
From: Aly <alasdair.douglas@brookesbell.com>
Date: Sat, 11 Apr 2020 22:13:54 +0100
Subject: [PATCH 5/8] Fixed typo as was checking {$IFOPT M+} rather than
{$IFDEF ENABLED_M+}
---
Source/Delphi.Mocks.WeakReference.pas | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/Source/Delphi.Mocks.WeakReference.pas b/Source/Delphi.Mocks.WeakReference.pas
index 9baf754..1c5dc67 100644
--- a/Source/Delphi.Mocks.WeakReference.pas
+++ b/Source/Delphi.Mocks.WeakReference.pas
@@ -49,7 +49,7 @@ interface
procedure RemoveWeakRef(value : Pointer);
function GetRefCount : integer;
end;
- {$IFOPT M+}
+ {$IFDEF ENABLED_M+}
{$M+}
{$UNDEF ENABLED_M+}
{$ENDIF}
From 613eccff2df3f5fb3494dc2335bd9fc81710714d Mon Sep 17 00:00:00 2001
From: Aly <alasdair.douglas@brookesbell.com>
Date: Sat, 11 Apr 2020 22:16:00 +0100
Subject: [PATCH 6/8] Changed Pointer to PTypeInfo so it is stronger typed
---
Source/Delphi.Mocks.Helpers.pas | 7 +++----
1 file changed, 3 insertions(+), 4 deletions(-)
diff --git a/Source/Delphi.Mocks.Helpers.pas b/Source/Delphi.Mocks.Helpers.pas
index e0353a3..6c9febe 100644
--- a/Source/Delphi.Mocks.Helpers.pas
+++ b/Source/Delphi.Mocks.Helpers.pas
@@ -34,14 +34,14 @@ interface
uses
System.Generics.Collections,
- System.Rtti;
+ System.Rtti, System.TypInfo;
type
//Allow custom comparisons
TCustomValueComparer = reference to function(const a, b: TValue): Integer;
TCustomValueComparerStore = record
private
- class var CustomComparers: TDictionary<Pointer, TCustomValueComparer>;
+ class var CustomComparers: TDictionary<PTypeInfo, TCustomValueComparer>;
public
class procedure RegisterCustomComparer<T>(const AComparer: TCustomValueComparer); static;
class procedure UnRegisterCustomComparer<T>; static;
@@ -99,7 +99,6 @@ implementation
uses
SysUtils,
Math,
- TypInfo,
Variants,
StrUtils;
@@ -349,7 +348,7 @@ class procedure TCustomValueComparerStore.UnRegisterCustomComparer<T>;
initialization
- TCustomValueComparerStore.CustomComparers := TDictionary<Pointer, TCustomValueComparer>.Create;
+ TCustomValueComparerStore.CustomComparers := TDictionary<PTypeInfo, TCustomValueComparer>.Create;
finalization
TCustomValueComparerStore.CustomComparers.Free;
From ccd3c6a9ee64ff74f6b71bd5afe17e0b71a9981a Mon Sep 17 00:00:00 2001
From: Aly <alasdair.douglas@brookesbell.com>
Date: Sat, 11 Apr 2020 22:17:03 +0100
Subject: [PATCH 7/8] Updated TCustomValueComparer so that it can be used
without TValue and directly with T
---
Source/Delphi.Mocks.Helpers.pas | 20 +++++++++++++++-----
1 file changed, 15 insertions(+), 5 deletions(-)
diff --git a/Source/Delphi.Mocks.Helpers.pas b/Source/Delphi.Mocks.Helpers.pas
index 6c9febe..9e19b21 100644
--- a/Source/Delphi.Mocks.Helpers.pas
+++ b/Source/Delphi.Mocks.Helpers.pas
@@ -38,12 +38,22 @@ interface
type
//Allow custom comparisons
- TCustomValueComparer = reference to function(const a, b: TValue): Integer;
+ {$IFOPT M+}
+ {$M-}
+ {$DEFINE ENABLED_M+}
+ {$ENDIF}
+ TCustomValueComparer = reference to function(const a, b): Integer;
+ {$IFDEF ENABLED_M+}
+ {$M+}
+ {$UNDEF ENABLED_M+}
+ {$ENDIF}
+
+ TCustomValueComparer<T> = reference to function(const a, b: T): Integer;
TCustomValueComparerStore = record
private
class var CustomComparers: TDictionary<PTypeInfo, TCustomValueComparer>;
public
- class procedure RegisterCustomComparer<T>(const AComparer: TCustomValueComparer); static;
+ class procedure RegisterCustomComparer<T>(const AComparer: TCustomValueComparer<T>); static;
class procedure UnRegisterCustomComparer<T>; static;
end;
@@ -122,7 +132,7 @@ function CompareValue(const Left, Right: TValue): Integer;
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(Left, Right)
+ Result := CustomComparer(Left.GetReferenceToRawData^, Right.GetReferenceToRawData^)
else if left.IsOrdinal and right.IsOrdinal then
Result := Math.CompareValue(left.AsOrdinal, right.AsOrdinal)
else if left.IsFloat and right.IsFloat then
@@ -335,9 +345,9 @@ function TRttiTypeHelper.TryGetMethod(const AName: string; out AMethod: TRttiMet
{ TCustomValueComparerStore }
-class procedure TCustomValueComparerStore.RegisterCustomComparer<T>(const AComparer: TCustomValueComparer);
+class procedure TCustomValueComparerStore.RegisterCustomComparer<T>(const AComparer: TCustomValueComparer<T>);
begin
- CustomComparers.AddOrSetValue(System.TypeInfo(T), AComparer);
+ CustomComparers.AddOrSetValue(System.TypeInfo(T), TCustomValueComparer(AComparer));
end;
class procedure TCustomValueComparerStore.UnRegisterCustomComparer<T>;
From ec5e5b6d08608dca8e381dbbd59522c50a19b029 Mon Sep 17 00:00:00 2001
From: Aly <alasdair.douglas@brookesbell.com>
Date: Mon, 13 Apr 2020 10:37:28 +0100
Subject: [PATCH 8/8] Updated TCustomValueComparer behaviour to use generics
and not rely on a function with untyped parameters
---
Source/Delphi.Mocks.Helpers.pas | 62 ++++++++++++++++++++++-----------
1 file changed, 42 insertions(+), 20 deletions(-)
diff --git a/Source/Delphi.Mocks.Helpers.pas b/Source/Delphi.Mocks.Helpers.pas
index 9e19b21..e0a887d 100644
--- a/Source/Delphi.Mocks.Helpers.pas
+++ b/Source/Delphi.Mocks.Helpers.pas
@@ -37,23 +37,29 @@ interface
System.Rtti, System.TypInfo;
type
- //Allow custom comparisons
- {$IFOPT M+}
- {$M-}
- {$DEFINE ENABLED_M+}
- {$ENDIF}
- TCustomValueComparer = reference to function(const a, b): Integer;
- {$IFDEF ENABLED_M+}
- {$M+}
- {$UNDEF ENABLED_M+}
- {$ENDIF}
-
- TCustomValueComparer<T> = reference to function(const a, b: T): Integer;
+ // 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<T> = reference to function(const a, b: T): Integer;
+ TCustomValueComparer<T> = class(TInterfacedObject, ICustomValueComparer)
+ private
+ FComparer: TCustomValueComparerFunction<T>;
+ public
+ constructor Create(const ACustomComparer: TCustomValueComparerFunction<T>);
+
+ {$REGION 'ICustomValueComparer'}
+ function Compare(const ALeft, ARight: TValue): Integer;
+ {$ENDREGION}
+ end;
+
TCustomValueComparerStore = record
private
- class var CustomComparers: TDictionary<PTypeInfo, TCustomValueComparer>;
+ class var CustomComparers: TDictionary<PTypeInfo, ICustomValueComparer>;
public
- class procedure RegisterCustomComparer<T>(const AComparer: TCustomValueComparer<T>); static;
+ class procedure RegisterCustomComparer<T>(const AComparer: TCustomValueComparerFunction<T>); static;
class procedure UnRegisterCustomComparer<T>; static;
end;
@@ -122,7 +128,7 @@ function CompareValue(const Left, Right: TValue): Integer;
EmptyResults: array[Boolean, Boolean] of Integer = ((0, -1), (1, 0));
var
leftIsEmpty, rightIsEmpty: Boolean;
- CustomComparer: TCustomValueComparer;
+ CustomComparer: ICustomValueComparer;
const
ErrorStr: String = 'Unable to compare %s. Use Delphi.Mocks.Helpers.TCustomValueComparerStore.RegisterCustomComparer<T> to add a ' +
'method to compare records.';
@@ -132,7 +138,7 @@ function CompareValue(const Left, Right: TValue): Integer;
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(Left.GetReferenceToRawData^, Right.GetReferenceToRawData^)
+ 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
@@ -341,13 +347,30 @@ function TRttiTypeHelper.TryGetMethod(const AName: string; out AMethod: TRttiMet
Result := Assigned(AMethod);
end;
+{ TCustomValueComparer<T> }
+
+function TCustomValueComparer<T>.Compare(const ALeft, ARight: TValue): Integer;
+var
+ Left, Right: T;
+begin
+ Left := ALeft.AsType<T>;
+ Right := ARight.AsType<T>;
+
+ Result := FComparer(Left, Right);
+end;
+
+constructor TCustomValueComparer<T>.Create(const ACustomComparer: TCustomValueComparerFunction<T>);
+begin
+ inherited Create;
+ FComparer := ACustomComparer;
+end;
{ TCustomValueComparerStore }
-class procedure TCustomValueComparerStore.RegisterCustomComparer<T>(const AComparer: TCustomValueComparer<T>);
+class procedure TCustomValueComparerStore.RegisterCustomComparer<T>(const AComparer: TCustomValueComparerFunction<T>);
begin
- CustomComparers.AddOrSetValue(System.TypeInfo(T), TCustomValueComparer(AComparer));
+ CustomComparers.AddOrSetValue(TypeInfo(T), TCustomValueComparer<T>.Create(AComparer))
end;
class procedure TCustomValueComparerStore.UnRegisterCustomComparer<T>;
@@ -356,9 +379,8 @@ class procedure TCustomValueComparerStore.UnRegisterCustomComparer<T>;
end;
-
initialization
- TCustomValueComparerStore.CustomComparers := TDictionary<PTypeInfo, TCustomValueComparer>.Create;
+ TCustomValueComparerStore.CustomComparers := TDictionary<PTypeInfo, ICustomValueComparer>.Create;
finalization
TCustomValueComparerStore.CustomComparers.Free;