Skip to content

Solution for Issue #125 and reverted change made in commit e90fee5 related to {$M-} #126

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Open
wants to merge 8 commits into
base: master
Choose a base branch
from
Open

Solution for Issue #125 and reverted change made in commit e90fee5 related to {$M-} #126

Show file tree
Hide file tree
Changes from 4 commits
Commits
Show all changes
8 commits
Select commit Hold shift + click to select a range
a08120f
Fixed issue #125 Access violation in TValueHelper.CompareValue for tk…
aly-sas Apr 10, 2020
9d3fc34
Fixed E1234 compiler error when {$M+} is specified at project level
aly-sas Apr 10, 2020
936635e
Added better error message when custom comparer is not available
aly-sas Apr 10, 2020
f46ace6
Avoid error in TCustomValueComparerStore.RegisterCustomComparer when …
aly-sas Apr 10, 2020
f84d449
Fixed typo as was checking {$IFOPT M+} rather than {$IFDEF ENABLED_M+}
aly-sas Apr 11, 2020
613eccf
Changed Pointer to PTypeInfo so it is stronger typed
aly-sas Apr 11, 2020
ccd3c6a
Updated TCustomValueComparer so that it can be used without TValue an…
aly-sas Apr 11, 2020
ec5e5b6
Updated TCustomValueComparer behaviour to use generics and not rely o…
aly-sas Apr 13, 2020
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
49 changes: 48 additions & 1 deletion Source/Delphi.Mocks.Helpers.pas
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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;
Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

No idea if it's possible, but did you try doing something like
TCustomValueComparer = reference to function<T>(const a, b: T): Integer;
that would allow us to avoid TValue

Copy link
Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I don't think that would be possible as I think you might need to declare it as TCustomValueComparer<T> = reference to function<T>(const a, b: T): Integer; so it couldn't be stored in a common container. Having said that, I am sure there should be a way to do this without the need for TValue?

TCustomValueComparerStore = record
private
class var CustomComparers: TDictionary<Pointer, TCustomValueComparer>;
Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

could this not be
class var CustomComparers: TDictionary<PTypeInfo, TCustomValueComparer>;
ie more strongly typed.

Copy link
Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Yeah, good point, will update that.

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
Expand Down Expand Up @@ -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;
Expand Down Expand Up @@ -101,11 +113,17 @@ function CompareValue(const Left, Right: TValue): Integer;
EmptyResults: array[Boolean, Boolean] of Integer = ((0, -1), (1, 0));
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;
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
Expand All @@ -116,6 +134,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
Expand Down Expand Up @@ -236,6 +256,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);
Expand Down Expand Up @@ -307,4 +332,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.AddOrSetValue(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.
8 changes: 8 additions & 0 deletions Source/Delphi.Mocks.WeakReference.pas
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down