paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-28 19:20:17 +02:00
Code Issues Packages Projects Releases Wiki Activity

* fix #40074: adjust Generics.Defaults to make use of the new ConstParamIsRef<> utility function to correctly determine how a generic binary parameter needs to be compared

Browse Source
This commit is contained in:
Sven/Sarah Barth 2023-03-06 23:23:40 +01:00
parent b0e9b9d705
commit 4823ca7114
2 changed files with 168 additions and 80 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

169
packages/rtl-generics/src/generics.defaults.pas
View File

@ -330,19 +330,20 @@ type
TComparerService = class abstract TComparerService = class abstract
private type private type
TSelectMethod = function(ATypeData: PTypeData; ASize: SizeInt): Pointer of object; TSelectMethod = function(ATypeData: PTypeData; ASize: SizeInt; AConstParaRef: Boolean): Pointer of object;
private private
class function SelectIntegerEqualityComparer(ATypeData: PTypeData; ASize: SizeInt): Pointer; virtual; abstract; class function SelectIntegerEqualityComparer(ATypeData: PTypeData; ASize: SizeInt; AConstParaRef: Boolean): Pointer; virtual; abstract;
class function SelectFloatEqualityComparer(ATypeData: PTypeData; ASize: SizeInt): Pointer; virtual; abstract; class function SelectFloatEqualityComparer(ATypeData: PTypeData; ASize: SizeInt; AConstParaRef: Boolean): Pointer; virtual; abstract;
class function SelectShortStringEqualityComparer(ATypeData: PTypeData; ASize: SizeInt): Pointer; virtual; abstract; class function SelectShortStringEqualityComparer(ATypeData: PTypeData; ASize: SizeInt; AConstParaRef: Boolean): Pointer; virtual; abstract;
class function SelectBinaryEqualityComparer(ATypeData: PTypeData; ASize: SizeInt): Pointer; virtual; abstract; class function SelectBinaryEqualityComparer(ATypeData: PTypeData; ASize: SizeInt; AConstParaRef: Boolean): Pointer; virtual; abstract;
class function SelectDynArrayEqualityComparer(ATypeData: PTypeData; ASize: SizeInt): Pointer; virtual; abstract; class function SelectDynArrayEqualityComparer(ATypeData: PTypeData; ASize: SizeInt; AConstParaRef: Boolean): Pointer; virtual; abstract;
private type private type
PSpoofInterfacedTypeSizeObject = ^TSpoofInterfacedTypeSizeObject; PSpoofInterfacedTypeSizeObject = ^TSpoofInterfacedTypeSizeObject;
TSpoofInterfacedTypeSizeObject = record TSpoofInterfacedTypeSizeObject = record
VMT: Pointer; VMT: Pointer;
RefCount: LongInt; RefCount: LongInt;
Size: SizeInt; Size: SizeInt;
ConstParaRef: Boolean;
end; end;
PInstance = ^TInstance; PInstance = ^TInstance;
@ -363,17 +364,17 @@ type
Compare: CodePointer; Compare: CodePointer;
end; end;
TSelectFunc = function(ATypeData: PTypeData; ASize: SizeInt): Pointer; TSelectFunc = function(ATypeData: PTypeData; ASize: SizeInt; AConstParaRef: Boolean): Pointer;
private private
class function CreateInterface(AVMT: Pointer; ASize: SizeInt): PSpoofInterfacedTypeSizeObject; static; class function CreateInterface(AVMT: Pointer; ASize: SizeInt; AConstParaRef: Boolean): PSpoofInterfacedTypeSizeObject; static;
class function SelectIntegerComparer(ATypeData: PTypeData; ASize: SizeInt): Pointer; static; class function SelectIntegerComparer(ATypeData: PTypeData; ASize: SizeInt; AConstParaRef: Boolean): Pointer; static;
class function SelectInt64Comparer(ATypeData: PTypeData; ASize: SizeInt): Pointer; static; class function SelectInt64Comparer(ATypeData: PTypeData; ASize: SizeInt; AConstParaRef: Boolean): Pointer; static;
class function SelectFloatComparer(ATypeData: PTypeData; ASize: SizeInt): Pointer; static; class function SelectFloatComparer(ATypeData: PTypeData; ASize: SizeInt; AConstParaRef: Boolean): Pointer; static;
class function SelectShortStringComparer(ATypeData: PTypeData; ASize: SizeInt): Pointer; static; class function SelectShortStringComparer(ATypeData: PTypeData; ASize: SizeInt; AConstParaRef: Boolean): Pointer; static;
class function SelectBinaryComparer(ATypeData: PTypeData; ASize: SizeInt): Pointer; static; class function SelectBinaryComparer(ATypeData: PTypeData; ASize: SizeInt; AConstParaRef: Boolean): Pointer; static;
class function SelectDynArrayComparer(ATypeData: PTypeData; ASize: SizeInt): Pointer; static; class function SelectDynArrayComparer(ATypeData: PTypeData; ASize: SizeInt; AConstParaRef: Boolean): Pointer; static;
private const private const
// IComparer VMT // IComparer VMT
Comparer_Int8_VMT : TComparerVMT = (STD_RAW_INTERFACE_METHODS; Compare: @TCompare.Int8); Comparer_Int8_VMT : TComparerVMT = (STD_RAW_INTERFACE_METHODS; Compare: @TCompare.Int8);
@ -503,18 +504,18 @@ type
(Selector: False; Instance: @Comparer_Pointer_Instance) (Selector: False; Instance: @Comparer_Pointer_Instance)
); );
public public
class function LookupComparer(ATypeInfo: PTypeInfo; ASize: SizeInt): Pointer; static; class function LookupComparer(ATypeInfo: PTypeInfo; ASize: SizeInt; AConstParaRef: Boolean): Pointer; static;
end; end;
THashService = class(TComparerService) THashService = class(TComparerService)
public public
class function LookupEqualityComparer(ATypeInfo: PTypeInfo; ASize: SizeInt): Pointer; virtual; abstract; class function LookupEqualityComparer(ATypeInfo: PTypeInfo; ASize: SizeInt; AConstParaRef: Boolean): Pointer; virtual; abstract;
end; end;
TExtendedHashService = class(THashService) TExtendedHashService = class(THashService)
public public
class function LookupEqualityComparer(ATypeInfo: PTypeInfo; ASize: SizeInt): Pointer; override; class function LookupEqualityComparer(ATypeInfo: PTypeInfo; ASize: SizeInt; AConstParaRef: Boolean): Pointer; override;
class function LookupExtendedEqualityComparer(ATypeInfo: PTypeInfo; ASize: SizeInt): Pointer; virtual; abstract; class function LookupExtendedEqualityComparer(ATypeInfo: PTypeInfo; ASize: SizeInt; AConstParaRef: Boolean): Pointer; virtual; abstract;
end; end;
{$DEFINE HASH_FACTORY := PPEqualityComparerVMT(Self)^.__ClassRef} {$DEFINE HASH_FACTORY := PPEqualityComparerVMT(Self)^.__ClassRef}
@ -524,11 +525,11 @@ type
THashService<T: THashFactory> = class(THashService) THashService<T: THashFactory> = class(THashService)
private private
class function SelectIntegerEqualityComparer(ATypeData: PTypeData; ASize: SizeInt): Pointer; override; class function SelectIntegerEqualityComparer(ATypeData: PTypeData; ASize: SizeInt; AConstParaRef: Boolean): Pointer; override;
class function SelectFloatEqualityComparer(ATypeData: PTypeData; ASize: SizeInt): Pointer; override; class function SelectFloatEqualityComparer(ATypeData: PTypeData; ASize: SizeInt; AConstParaRef: Boolean): Pointer; override;
class function SelectShortStringEqualityComparer(ATypeData: PTypeData; ASize: SizeInt): Pointer; override; class function SelectShortStringEqualityComparer(ATypeData: PTypeData; ASize: SizeInt; AConstParaRef: Boolean): Pointer; override;
class function SelectBinaryEqualityComparer(ATypeData: PTypeData; ASize: SizeInt): Pointer; override; class function SelectBinaryEqualityComparer(ATypeData: PTypeData; ASize: SizeInt; AConstParaRef: Boolean): Pointer; override;
class function SelectDynArrayEqualityComparer(ATypeData: PTypeData; ASize: SizeInt): Pointer; override; class function SelectDynArrayEqualityComparer(ATypeData: PTypeData; ASize: SizeInt; AConstParaRef: Boolean): Pointer; override;
private const private const
// IEqualityComparer VMT templates // IEqualityComparer VMT templates
{$WARNINGS OFF} {$WARNINGS OFF}
@ -636,18 +637,18 @@ type
private private
class constructor Create; class constructor Create;
public public
class function LookupEqualityComparer(ATypeInfo: PTypeInfo; ASize: SizeInt): Pointer; override; class function LookupEqualityComparer(ATypeInfo: PTypeInfo; ASize: SizeInt; AConstParaRef: Boolean): Pointer; override;
end; end;
{ TExtendedHashService } { TExtendedHashService }
TExtendedHashService<T: TExtendedHashFactory> = class(TExtendedHashService) TExtendedHashService<T: TExtendedHashFactory> = class(TExtendedHashService)
private private
class function SelectIntegerEqualityComparer(ATypeData: PTypeData; ASize: SizeInt): Pointer; override; class function SelectIntegerEqualityComparer(ATypeData: PTypeData; ASize: SizeInt; AConstParaRef: Boolean): Pointer; override;
class function SelectFloatEqualityComparer(ATypeData: PTypeData; ASize: SizeInt): Pointer; override; class function SelectFloatEqualityComparer(ATypeData: PTypeData; ASize: SizeInt; AConstParaRef: Boolean): Pointer; override;
class function SelectShortStringEqualityComparer(ATypeData: PTypeData; ASize: SizeInt): Pointer; override; class function SelectShortStringEqualityComparer(ATypeData: PTypeData; ASize: SizeInt; AConstParaRef: Boolean): Pointer; override;
class function SelectBinaryEqualityComparer(ATypeData: PTypeData; ASize: SizeInt): Pointer; override; class function SelectBinaryEqualityComparer(ATypeData: PTypeData; ASize: SizeInt; AConstParaRef: Boolean): Pointer; override;
class function SelectDynArrayEqualityComparer(ATypeData: PTypeData; ASize: SizeInt): Pointer; override; class function SelectDynArrayEqualityComparer(ATypeData: PTypeData; ASize: SizeInt; AConstParaRef: Boolean): Pointer; override;
private const private const
// IExtendedEqualityComparer VMT templates // IExtendedEqualityComparer VMT templates
{$WARNINGS OFF} {$WARNINGS OFF}
@ -755,7 +756,7 @@ type
private private
class constructor Create; class constructor Create;
public public
class function LookupExtendedEqualityComparer(ATypeInfo: PTypeInfo; ASize: SizeInt): Pointer; override; class function LookupExtendedEqualityComparer(ATypeInfo: PTypeInfo; ASize: SizeInt; AConstParaRef: Boolean): Pointer; override;
end; end;
TOnEqualityComparison<T> = function(const ALeft, ARight: T): Boolean of object; TOnEqualityComparison<T> = function(const ALeft, ARight: T): Boolean of object;
@ -1038,9 +1039,10 @@ type
function BobJenkinsHash(const AData; ALength, AInitData: Integer): Integer; // same result as HashLittle_Delphi, just different interface function BobJenkinsHash(const AData; ALength, AInitData: Integer): Integer; // same result as HashLittle_Delphi, just different interface
function BinaryCompare(const ALeft, ARight: Pointer; ASize: PtrUInt): Integer; inline; function BinaryCompare(const ALeft, ARight: Pointer; ASize: PtrUInt): Integer; inline;
function _LookupVtableInfo(AGInterface: TDefaultGenericInterface; ATypeInfo: PTypeInfo; ASize: SizeInt): Pointer; inline; function _LookupVtableInfo(AGInterface: TDefaultGenericInterface; ATypeInfo: PTypeInfo; ASize: SizeInt;
AConstParaRef: Boolean): Pointer; inline;
function _LookupVtableInfoEx(AGInterface: TDefaultGenericInterface; ATypeInfo: PTypeInfo; ASize: SizeInt; function _LookupVtableInfoEx(AGInterface: TDefaultGenericInterface; ATypeInfo: PTypeInfo; ASize: SizeInt;
AFactory: THashFactoryClass): Pointer; AConstParaRef: Boolean; AFactory: THashFactoryClass): Pointer;
implementation implementation
@ -1048,7 +1050,7 @@ implementation
class function TComparer<T>.Default: IComparer<T>; class function TComparer<T>.Default: IComparer<T>;
begin begin
Result := _LookupVtableInfo(giComparer, TypeInfo(T), SizeOf(T)); Result := _LookupVtableInfo(giComparer, TypeInfo(T), SizeOf(T), ConstParamIsRef<T>());
end; end;
class function TComparer<T>.Construct(const AComparison: TOnComparison<T>): IComparer<T>; class function TComparer<T>.Construct(const AComparison: TOnComparison<T>): IComparer<T>;
@ -1269,7 +1271,10 @@ class function TCompare._Binary(const ALeft, ARight): Integer;
var var
_self: TComparerService.PSpoofInterfacedTypeSizeObject absolute Self; _self: TComparerService.PSpoofInterfacedTypeSizeObject absolute Self;
begin begin
Result := CompareMemRange(@ALeft, @ARight, _self.Size); if _self.ConstParaRef then
Result := CompareMemRange(@ALeft, @ARight, _self.Size)
else
Result := CompareMemRange(PPointer(@ALeft)^, PPointer(@ARight)^, _self.Size);
end; end;
class function TCompare._DynArray(const ALeft, ARight: Pointer): Integer; class function TCompare._DynArray(const ALeft, ARight: Pointer): Integer;
@ -1528,7 +1533,10 @@ class function TEquals._Binary(const ALeft, ARight): Boolean;
var var
_self: TComparerService.PSpoofInterfacedTypeSizeObject absolute Self; _self: TComparerService.PSpoofInterfacedTypeSizeObject absolute Self;
begin begin
Result := CompareMem(@ALeft, @ARight, _self.Size); if _self.ConstParaRef then
Result := CompareMem(@ALeft, @ARight, _self.Size)
else
Result := CompareMem(PPointer(@ALeft)^, PPointer(@ARight)^, _self.Size);
end; end;
class function TEquals._DynArray(const ALeft, ARight: Pointer): Boolean; class function TEquals._DynArray(const ALeft, ARight: Pointer): Boolean;
@ -2069,15 +2077,16 @@ end;
{ TComparerService } { TComparerService }
class function TComparerService.CreateInterface(AVMT: Pointer; ASize: SizeInt): PSpoofInterfacedTypeSizeObject; class function TComparerService.CreateInterface(AVMT: Pointer; ASize: SizeInt; AConstParaRef: Boolean): PSpoofInterfacedTypeSizeObject;
begin begin
Result := New(PSpoofInterfacedTypeSizeObject); Result := New(PSpoofInterfacedTypeSizeObject);
Result.VMT := AVMT; Result.VMT := AVMT;
Result.RefCount := 0; Result.RefCount := 0;
Result.Size := ASize; Result.Size := ASize;
Result.ConstParaRef := AConstParaRef;
end; end;
class function TComparerService.SelectIntegerComparer(ATypeData: PTypeData; ASize: SizeInt): Pointer; class function TComparerService.SelectIntegerComparer(ATypeData: PTypeData; ASize: SizeInt; AConstParaRef: Boolean): Pointer;
begin begin
case ATypeData.OrdType of case ATypeData.OrdType of
otSByte: otSByte:
@ -2098,7 +2107,7 @@ begin
end; end;
end; end;
class function TComparerService.SelectInt64Comparer(ATypeData: PTypeData; ASize: SizeInt): Pointer; class function TComparerService.SelectInt64Comparer(ATypeData: PTypeData; ASize: SizeInt; AConstParaRef: Boolean): Pointer;
begin begin
if ATypeData.MaxInt64Value > ATypeData.MinInt64Value then if ATypeData.MaxInt64Value > ATypeData.MinInt64Value then
Exit(@Comparer_Int64_Instance) Exit(@Comparer_Int64_Instance)
@ -2107,7 +2116,7 @@ begin
end; end;
class function TComparerService.SelectFloatComparer(ATypeData: PTypeData; class function TComparerService.SelectFloatComparer(ATypeData: PTypeData;
ASize: SizeInt): Pointer; ASize: SizeInt; AConstParaRef: Boolean): Pointer;
begin begin
case ATypeData.FloatType of case ATypeData.FloatType of
ftSingle: ftSingle:
@ -2127,7 +2136,7 @@ begin
end; end;
class function TComparerService.SelectShortStringComparer(ATypeData: PTypeData; class function TComparerService.SelectShortStringComparer(ATypeData: PTypeData;
ASize: SizeInt): Pointer; ASize: SizeInt; AConstParaRef: Boolean): Pointer;
begin begin
case ASize of case ASize of
2: Exit(@Comparer_ShortString1_Instance); 2: Exit(@Comparer_ShortString1_Instance);
@ -2139,27 +2148,27 @@ begin
end; end;
class function TComparerService.SelectBinaryComparer(ATypeData: PTypeData; class function TComparerService.SelectBinaryComparer(ATypeData: PTypeData;
ASize: SizeInt): Pointer; ASize: SizeInt; AConstParaRef: Boolean): Pointer;
begin begin
Result := CreateInterface(@Comparer_Binary_VMT, ASize); Result := CreateInterface(@Comparer_Binary_VMT, ASize, AConstParaRef);
end; end;
class function TComparerService.SelectDynArrayComparer(ATypeData: PTypeData; ASize: SizeInt): Pointer; class function TComparerService.SelectDynArrayComparer(ATypeData: PTypeData; ASize: SizeInt; AConstParaRef: Boolean): Pointer;
begin begin
Result := CreateInterface(@Comparer_DynArray_VMT, ATypeData.elSize); Result := CreateInterface(@Comparer_DynArray_VMT, ATypeData.elSize, AConstParaRef);
end; end;
class function TComparerService.LookupComparer(ATypeInfo: PTypeInfo; ASize: SizeInt): Pointer; class function TComparerService.LookupComparer(ATypeInfo: PTypeInfo; ASize: SizeInt; AConstParaRef: Boolean): Pointer;
var var
LInstance: PInstance; LInstance: PInstance;
begin begin
if ATypeInfo = nil then if ATypeInfo = nil then
Exit(SelectBinaryComparer(Nil, ASize)) Exit(SelectBinaryComparer(Nil, ASize, AConstParaRef))
else else
begin begin
LInstance := @ComparerInstances[ATypeInfo.Kind]; LInstance := @ComparerInstances[ATypeInfo.Kind];
if LInstance.Selector then if LInstance.Selector then
Result := TSelectFunc(LInstance.SelectorInstance)(GetTypeData(ATypeInfo), ASize) Result := TSelectFunc(LInstance.SelectorInstance)(GetTypeData(ATypeInfo), ASize, AConstParaRef)
else else
Result := LInstance.Instance; Result := LInstance.Instance;
end; end;
@ -2182,14 +2191,14 @@ end;
{ TExtendedHashService } { TExtendedHashService }
class function TExtendedHashService.LookupEqualityComparer(ATypeInfo: PTypeInfo; ASize: SizeInt): Pointer; class function TExtendedHashService.LookupEqualityComparer(ATypeInfo: PTypeInfo; ASize: SizeInt; AConstParaRef: Boolean): Pointer;
begin begin
Result := LookupExtendedEqualityComparer(ATypeInfo, ASize); Result := LookupExtendedEqualityComparer(ATypeInfo, ASize, AConstParaRef);
end; end;
{ THashService } { THashService }
class function THashService<T>.SelectIntegerEqualityComparer(ATypeData: PTypeData; ASize: SizeInt): Pointer; class function THashService<T>.SelectIntegerEqualityComparer(ATypeData: PTypeData; ASize: SizeInt; AConstParaRef: Boolean): Pointer;
begin begin
case ATypeData.OrdType of case ATypeData.OrdType of
otSByte: otSByte:
@ -2211,7 +2220,7 @@ begin
end; end;
class function THashService<T>.SelectFloatEqualityComparer(ATypeData: PTypeData; class function THashService<T>.SelectFloatEqualityComparer(ATypeData: PTypeData;
ASize: SizeInt): Pointer; ASize: SizeInt; AConstParaRef: Boolean): Pointer;
begin begin
case ATypeData.FloatType of case ATypeData.FloatType of
ftSingle: ftSingle:
@ -2231,7 +2240,7 @@ begin
end; end;
class function THashService<T>.SelectShortStringEqualityComparer( class function THashService<T>.SelectShortStringEqualityComparer(
ATypeData: PTypeData; ASize: SizeInt): Pointer; ATypeData: PTypeData; ASize: SizeInt; AConstParaRef: Boolean): Pointer;
begin begin
case ASize of case ASize of
2: Exit(@FEqualityComparer_ShortString1_Instance); 2: Exit(@FEqualityComparer_ShortString1_Instance);
@ -2243,25 +2252,25 @@ begin
end; end;
class function THashService<T>.SelectBinaryEqualityComparer(ATypeData: PTypeData; class function THashService<T>.SelectBinaryEqualityComparer(ATypeData: PTypeData;
ASize: SizeInt): Pointer; ASize: SizeInt; AConstParaRef: Boolean): Pointer;
begin begin
Result := CreateInterface(@FEqualityComparer_Binary_VMT, ASize); Result := CreateInterface(@FEqualityComparer_Binary_VMT, ASize, AConstParaRef);
end; end;
class function THashService<T>.SelectDynArrayEqualityComparer( class function THashService<T>.SelectDynArrayEqualityComparer(
ATypeData: PTypeData; ASize: SizeInt): Pointer; ATypeData: PTypeData; ASize: SizeInt; AConstParaRef: Boolean): Pointer;
begin begin
Result := CreateInterface(@FEqualityComparer_DynArray_VMT, ATypeData.elSize); Result := CreateInterface(@FEqualityComparer_DynArray_VMT, ATypeData.elSize, AConstParaRef);
end; end;
class function THashService<T>.LookupEqualityComparer(ATypeInfo: PTypeInfo; class function THashService<T>.LookupEqualityComparer(ATypeInfo: PTypeInfo;
ASize: SizeInt): Pointer; ASize: SizeInt; AConstParaRef: Boolean): Pointer;
var var
LInstance: PInstance; LInstance: PInstance;
LSelectMethod: TSelectMethod; LSelectMethod: TSelectMethod;
begin begin
if ATypeInfo = nil then if ATypeInfo = nil then
Exit(SelectBinaryEqualityComparer(Nil, ASize)) Exit(SelectBinaryEqualityComparer(Nil, ASize, AConstParaRef))
else else
begin begin
LInstance := @FEqualityComparerInstances[ATypeInfo.Kind]; LInstance := @FEqualityComparerInstances[ATypeInfo.Kind];
@ -2270,7 +2279,7 @@ begin
begin begin
TMethod(LSelectMethod).Code := LInstance.SelectorInstance; TMethod(LSelectMethod).Code := LInstance.SelectorInstance;
TMethod(LSelectMethod).Data := Self; TMethod(LSelectMethod).Data := Self;
Result := LSelectMethod(GetTypeData(ATypeInfo), ASize); Result := LSelectMethod(GetTypeData(ATypeInfo), ASize, AConstParaRef);
end; end;
end; end;
end; end;
@ -2394,7 +2403,7 @@ end;
{ TExtendedHashService } { TExtendedHashService }
class function TExtendedHashService<T>.SelectIntegerEqualityComparer(ATypeData: PTypeData; ASize: SizeInt): Pointer; class function TExtendedHashService<T>.SelectIntegerEqualityComparer(ATypeData: PTypeData; ASize: SizeInt; AConstParaRef: Boolean): Pointer;
begin begin
case ATypeData.OrdType of case ATypeData.OrdType of
otSByte: otSByte:
@ -2415,7 +2424,7 @@ begin
end; end;
end; end;
class function TExtendedHashService<T>.SelectFloatEqualityComparer(ATypeData: PTypeData; ASize: SizeInt): Pointer; class function TExtendedHashService<T>.SelectFloatEqualityComparer(ATypeData: PTypeData; ASize: SizeInt; AConstParaRef: Boolean): Pointer;
begin begin
case ATypeData.FloatType of case ATypeData.FloatType of
ftSingle: ftSingle:
@ -2435,7 +2444,7 @@ begin
end; end;
class function TExtendedHashService<T>.SelectShortStringEqualityComparer(ATypeData: PTypeData; class function TExtendedHashService<T>.SelectShortStringEqualityComparer(ATypeData: PTypeData;
ASize: SizeInt): Pointer; ASize: SizeInt; AConstParaRef: Boolean): Pointer;
begin begin
case ASize of case ASize of
2: Exit(@FExtendedEqualityComparer_ShortString1_Instance); 2: Exit(@FExtendedEqualityComparer_ShortString1_Instance);
@ -2447,25 +2456,25 @@ begin
end; end;
class function TExtendedHashService<T>.SelectBinaryEqualityComparer(ATypeData: PTypeData; class function TExtendedHashService<T>.SelectBinaryEqualityComparer(ATypeData: PTypeData;
ASize: SizeInt): Pointer; ASize: SizeInt; AConstParaRef: Boolean): Pointer;
begin begin
Result := CreateInterface(@FExtendedEqualityComparer_Binary_VMT, ASize); Result := CreateInterface(@FExtendedEqualityComparer_Binary_VMT, ASize, AConstParaRef);
end; end;
class function TExtendedHashService<T>.SelectDynArrayEqualityComparer( class function TExtendedHashService<T>.SelectDynArrayEqualityComparer(
ATypeData: PTypeData; ASize: SizeInt): Pointer; ATypeData: PTypeData; ASize: SizeInt; AConstParaRef: Boolean): Pointer;
begin begin
Result := CreateInterface(@FExtendedEqualityComparer_DynArray_VMT, ATypeData.elSize); Result := CreateInterface(@FExtendedEqualityComparer_DynArray_VMT, ATypeData.elSize, AConstParaRef);
end; end;
class function TExtendedHashService<T>.LookupExtendedEqualityComparer( class function TExtendedHashService<T>.LookupExtendedEqualityComparer(
ATypeInfo: PTypeInfo; ASize: SizeInt): Pointer; ATypeInfo: PTypeInfo; ASize: SizeInt; AConstParaRef: Boolean): Pointer;
var var
LInstance: PInstance; LInstance: PInstance;
LSelectMethod: TSelectMethod; LSelectMethod: TSelectMethod;
begin begin
if ATypeInfo = nil then if ATypeInfo = nil then
Exit(SelectBinaryEqualityComparer(Nil, ASize)) Exit(SelectBinaryEqualityComparer(Nil, ASize, AConstParaRef))
else else
begin begin
LInstance := @FExtendedEqualityComparerInstances[ATypeInfo.Kind]; LInstance := @FExtendedEqualityComparerInstances[ATypeInfo.Kind];
@ -2474,7 +2483,7 @@ begin
begin begin
TMethod(LSelectMethod).Code := LInstance.SelectorInstance; TMethod(LSelectMethod).Code := LInstance.SelectorInstance;
TMethod(LSelectMethod).Data := Self; TMethod(LSelectMethod).Data := Self;
Result := LSelectMethod(GetTypeData(ATypeInfo), ASize); Result := LSelectMethod(GetTypeData(ATypeInfo), ASize, AConstParaRef);
end; end;
end; end;
end; end;
@ -2600,15 +2609,15 @@ end;
class function TEqualityComparer<T>.Default: IEqualityComparer<T>; class function TEqualityComparer<T>.Default: IEqualityComparer<T>;
begin begin
Result := _LookupVtableInfo(giEqualityComparer, TypeInfo(T), SizeOf(T)); Result := _LookupVtableInfo(giEqualityComparer, TypeInfo(T), SizeOf(T), ConstParamIsRef<T>());
end; end;
class function TEqualityComparer<T>.Default(AHashFactoryClass: THashFactoryClass): IEqualityComparer<T>; class function TEqualityComparer<T>.Default(AHashFactoryClass: THashFactoryClass): IEqualityComparer<T>;
begin begin
if AHashFactoryClass.InheritsFrom(TExtendedHashFactory) then if AHashFactoryClass.InheritsFrom(TExtendedHashFactory) then
Result := _LookupVtableInfoEx(giExtendedEqualityComparer, TypeInfo(T), SizeOf(T), AHashFactoryClass) Result := _LookupVtableInfoEx(giExtendedEqualityComparer, TypeInfo(T), SizeOf(T), ConstParamIsRef<T>(), AHashFactoryClass)
else if AHashFactoryClass.InheritsFrom(THashFactory) then else if AHashFactoryClass.InheritsFrom(THashFactory) then
Result := _LookupVtableInfoEx(giEqualityComparer, TypeInfo(T), SizeOf(T), AHashFactoryClass); Result := _LookupVtableInfoEx(giEqualityComparer, TypeInfo(T), SizeOf(T), ConstParamIsRef<T>(), AHashFactoryClass);
end; end;
class function TEqualityComparer<T>.Construct(const AEqualityComparison: TOnEqualityComparison<T>; class function TEqualityComparer<T>.Construct(const AEqualityComparison: TOnEqualityComparison<T>;
@ -2747,14 +2756,14 @@ end;
class function TExtendedEqualityComparer<T>.Default: IExtendedEqualityComparer<T>; class function TExtendedEqualityComparer<T>.Default: IExtendedEqualityComparer<T>;
begin begin
Result := _LookupVtableInfo(giExtendedEqualityComparer, TypeInfo(T), SizeOf(T)); Result := _LookupVtableInfo(giExtendedEqualityComparer, TypeInfo(T), SizeOf(T), ConstParamIsRef<T>());
end; end;
class function TExtendedEqualityComparer<T>.Default( class function TExtendedEqualityComparer<T>.Default(
AExtenedHashFactoryClass: TExtendedHashFactoryClass AExtenedHashFactoryClass: TExtendedHashFactoryClass
): IExtendedEqualityComparer<T>; ): IExtendedEqualityComparer<T>;
begin begin
Result := _LookupVtableInfoEx(giExtendedEqualityComparer, TypeInfo(T), SizeOf(T), AExtenedHashFactoryClass); Result := _LookupVtableInfoEx(giExtendedEqualityComparer, TypeInfo(T), SizeOf(T), ConstParamIsRef<T>(), AExtenedHashFactoryClass);
end; end;
class function TExtendedEqualityComparer<T>.Construct( class function TExtendedEqualityComparer<T>.Construct(
@ -3293,25 +3302,25 @@ begin
Result := CompareMemRange(ALeft, ARight, ASize); Result := CompareMemRange(ALeft, ARight, ASize);
end; end;
function _LookupVtableInfo(AGInterface: TDefaultGenericInterface; ATypeInfo: PTypeInfo; ASize: SizeInt): Pointer; function _LookupVtableInfo(AGInterface: TDefaultGenericInterface; ATypeInfo: PTypeInfo; ASize: SizeInt; AConstParaRef: Boolean): Pointer;
begin begin
Result := _LookupVtableInfoEx(AGInterface, ATypeInfo, ASize, nil); Result := _LookupVtableInfoEx(AGInterface, ATypeInfo, ASize, AConstParaRef, nil);
end; end;
function _LookupVtableInfoEx(AGInterface: TDefaultGenericInterface; ATypeInfo: PTypeInfo; ASize: SizeInt; function _LookupVtableInfoEx(AGInterface: TDefaultGenericInterface; ATypeInfo: PTypeInfo; ASize: SizeInt;
AFactory: THashFactoryClass): Pointer; AConstParaRef: Boolean; AFactory: THashFactoryClass): Pointer;
begin begin
case AGInterface of case AGInterface of
giComparer: giComparer:
Exit( Exit(
TComparerService.LookupComparer(ATypeInfo, ASize)); TComparerService.LookupComparer(ATypeInfo, ASize, AConstParaRef));
giEqualityComparer: giEqualityComparer:
begin begin
if AFactory = nil then if AFactory = nil then
AFactory := TDefaultHashFactory; AFactory := TDefaultHashFactory;
Exit( Exit(
AFactory.GetHashService.LookupEqualityComparer(ATypeInfo, ASize)); AFactory.GetHashService.LookupEqualityComparer(ATypeInfo, ASize, AConstParaRef));
end; end;
giExtendedEqualityComparer: giExtendedEqualityComparer:
begin begin
@ -3319,7 +3328,7 @@ begin
AFactory := TDelphiDoubleHashFactory; AFactory := TDelphiDoubleHashFactory;
Exit( Exit(
TExtendedHashServiceClass(AFactory.GetHashService).LookupExtendedEqualityComparer(ATypeInfo, ASize)); TExtendedHashServiceClass(AFactory.GetHashService).LookupExtendedEqualityComparer(ATypeInfo, ASize, AConstParaRef));
end; end;
else else
System.Error(reRangeError); System.Error(reRangeError);

79
tests/webtbs/tw40074.pp Normal file
View File

@ -0,0 +1,79 @@
{ Test Generics.Collections, adapted from Castle Game Engine testcase
tests/code/testcases/testgenericscollections.pas
}
{$mode objfpc}{$H+}
{$assertions on}
uses Generics.Collections, Generics.Defaults;
type
TMyVector = packed array [0..1] of Single;
TMyVectorList = {$ifdef FPC}specialize{$endif} TList<TMyVector>;
var
List: TMyVectorList;
R1, R2, R: TMyVector;
begin
List := TMyVectorList.Create;
try
R1[0] := 11;
R1[1] := 22;
List.Add(R1);
R2[0] := 33;
R2[1] := 44;
List.Add(R2);
R2[0] := 33;
R2[1] := 44;
List.Add(R2);
Assert(3 = List.Count);
Assert(11 = List[0][0]);
Assert(22 = List[0][1]);
Assert(33 = List[1][0]);
Assert(44 = List[1][1]);
Assert(33 = List[2][0]);
Assert(44 = List[2][1]);
List.Delete(2);
Assert(2 = List.Count);
Assert(11 = List[0][0]);
Assert(22 = List[0][1]);
Assert(33 = List[1][0]);
Assert(44 = List[1][1]);
Assert(0 = List.IndexOf(R1));
Assert(1 = List.IndexOf(R2));
// change R1 and R2, to make sure it doesn't matter for tests
R1[0] := 111111;
R1[1] := 222222;
R2[0] := 333333;
R2[1] := 444444;
Assert(-1 = List.IndexOf(R1));
Assert(-1 = List.IndexOf(R2));
R[0] := 11;
R[1] := 22;
Assert(0 = List.IndexOf(R));
R[0] := 33;
R[1] := 44;
Assert(1 = List.IndexOf(R));
R[0] := 11;
R[1] := 22;
List.Remove(R);
Assert(1 = List.Count);
Assert(33 = List[0][0]);
Assert(44 = List[0][1]);
R[0] := 666;
R[1] := 22;
List.Remove(R); // does nothing, no such item
Assert(1 = List.Count);
Assert(33 = List[0][0]);
Assert(44 = List[0][1]);
finally List.Free end;
end.