paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-21 19:49:40 +02:00
Code Issues Packages Projects Releases Wiki Activity

* use the explicit implementations of the I*Comparer<> interfaces for types like records and objects; fixes #40074 and #40077 on systems using the Sys V ABI

Browse Source
This commit is contained in:
Sven/Sarah Barth 2023-03-28 22:58:09 +02:00 committed by Pierre Muller
parent 2c573982f4
commit 2fd69363d1
1 changed files with 21 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -376,6 +376,8 @@ type
class function SelectBinaryComparer(ATypeData: PTypeData; ASize: SizeInt; AConstParaRef: Boolean): Pointer; static;
class function SelectDynArrayComparer(ATypeData: PTypeData; ASize: SizeInt; AConstParaRef: Boolean): Pointer; static;
private const
UseBinaryMethods: set of TTypeKind = [tkUnknown, tkSet, tkFile, tkArray, tkRecord, tkObject];
// IComparer VMT
Comparer_Int8_VMT : TComparerVMT = (STD_RAW_INTERFACE_METHODS; Compare: @TCompare.Int8);
Comparer_Int16_VMT : TComparerVMT = (STD_RAW_INTERFACE_METHODS; Compare: @TCompare.Int16 );
@ -1072,7 +1074,10 @@ implementation
class function TComparer<T>.Default: IComparer<T>;
begin
Result := _LookupVtableInfo(giComparer, TypeInfo(T), SizeOf(T), ConstParamIsRef<T>());
if GetTypeKind(T) in TComparerService.UseBinaryMethods then begin
Result := TBinaryComparer<T>.Create
end else
Result := _LookupVtableInfo(giComparer, TypeInfo(T), SizeOf(T), ConstParamIsRef<T>());
end;
class function TComparer<T>.Construct(const AComparison: TOnComparison<T>): IComparer<T>;
@ -2631,12 +2636,17 @@ end;
class function TEqualityComparer<T>.Default: IEqualityComparer<T>;
begin
Result := _LookupVtableInfo(giEqualityComparer, TypeInfo(T), SizeOf(T), ConstParamIsRef<T>());
if GetTypeKind(T) in TComparerService.UseBinaryMethods then
Result := TBinaryEqualityComparer<T>.Create(Nil)
else
Result := _LookupVtableInfo(giEqualityComparer, TypeInfo(T), SizeOf(T), ConstParamIsRef<T>());
end;
class function TEqualityComparer<T>.Default(AHashFactoryClass: THashFactoryClass): IEqualityComparer<T>;
begin
if AHashFactoryClass.InheritsFrom(TExtendedHashFactory) then
if GetTypeKind(T) in TComparerService.UseBinaryMethods then
Result := TBinaryEqualityComparer<T>.Create(AHashFactoryClass)
else if AHashFactoryClass.InheritsFrom(TExtendedHashFactory) then
Result := _LookupVtableInfoEx(giExtendedEqualityComparer, TypeInfo(T), SizeOf(T), ConstParamIsRef<T>(), AHashFactoryClass)
else if AHashFactoryClass.InheritsFrom(THashFactory) then
Result := _LookupVtableInfoEx(giEqualityComparer, TypeInfo(T), SizeOf(T), ConstParamIsRef<T>(), AHashFactoryClass);
@ -2778,14 +2788,20 @@ end;
class function TExtendedEqualityComparer<T>.Default: IExtendedEqualityComparer<T>;
begin
Result := _LookupVtableInfo(giExtendedEqualityComparer, TypeInfo(T), SizeOf(T), ConstParamIsRef<T>());
if GetTypeKind(T) in TComparerService.UseBinaryMethods then
Result := TBinaryExtendedEqualityComparer<T>.Create(Nil)
else
Result := _LookupVtableInfo(giExtendedEqualityComparer, TypeInfo(T), SizeOf(T), ConstParamIsRef<T>());
end;
class function TExtendedEqualityComparer<T>.Default(
AExtenedHashFactoryClass: TExtendedHashFactoryClass
): IExtendedEqualityComparer<T>;
begin
Result := _LookupVtableInfoEx(giExtendedEqualityComparer, TypeInfo(T), SizeOf(T), ConstParamIsRef<T>(), AExtenedHashFactoryClass);
if GetTypeKind(T) in TComparerService.UseBinaryMethods then
Result := TBinaryExtendedEqualityComparer<T>.Create(Nil)
else
Result := _LookupVtableInfoEx(giExtendedEqualityComparer, TypeInfo(T), SizeOf(T), ConstParamIsRef<T>(), AExtenedHashFactoryClass);
end;
class function TExtendedEqualityComparer<T>.Construct(