paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-08 10:48:12 +02:00
Code Issues Packages Projects Releases Wiki Activity

* use the sort algorithm from sortbase for TStringList

Browse Source 
git-svn-id: trunk@41194 -
This commit is contained in:
nickysn 2019-02-03 17:00:21 +00:00
parent d9954e410e
commit d86da19570
2 changed files with 53 additions and 48 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
rtl/objpas/classes/classesh.inc
View File

@ -768,7 +768,6 @@ type
function GetSorted: Boolean;
procedure Grow;
procedure InternalClear(FromIndex : Integer = 0; ClearOnly : Boolean = False);
procedure QuickSort(L, R: Integer; CompareFn: TStringListSortCompare);
procedure SetSorted(Value: Boolean);
procedure SetCaseSensitive(b : boolean);
procedure SetSortStyle(AValue: TStringsSortStyle);
@ -800,7 +799,9 @@ type
function IndexOf(const S: string): Integer; override;
procedure Insert(Index: Integer; const S: string); override;
procedure Sort; virtual;
procedure Sort(SortingAlgorithm: PSortingAlgorithm); virtual;
procedure CustomSort(CompareFn: TStringListSortCompare); virtual;
procedure CustomSort(CompareFn: TStringListSortCompare; SortingAlgorithm: PSortingAlgorithm); virtual;
property Duplicates: TDuplicates read FDuplicates write FDuplicates;
property Sorted: Boolean read GetSorted write SetSorted;
property CaseSensitive: Boolean read FCaseSensitive write SetCaseSensitive;

98
rtl/objpas/classes/stringl.inc
View File

@ -1285,52 +1285,6 @@ begin
SetCapacity(0);
end;
procedure TStringList.QuickSort(L, R: Integer; CompareFn: TStringListSortCompare
);
var
Pivot, vL, vR: Integer;
ExchangeProc: procedure(Left, Right: Integer) of object;
begin
//if ExchangeItems is override call that, else call (faster) ExchangeItemsInt
if TMethod(@Self.ExchangeItems).Code = CodePointer(@TStringList.ExchangeItems) then
ExchangeProc := @ExchangeItemsInt
else
ExchangeProc := @ExchangeItems;
if R - L <= 1 then begin // a little bit of time saver
if L < R then
if CompareFn(Self, L, R) > 0 then
ExchangeProc(L, R);
Exit;
end;
vL := L;
vR := R;
Pivot := L + Random(R - L); // they say random is best
while vL < vR do begin
while (vL < Pivot) and (CompareFn(Self, vL, Pivot) <= 0) do
Inc(vL);
while (vR > Pivot) and (CompareFn(Self, vR, Pivot) > 0) do
Dec(vR);
ExchangeProc(vL, vR);
if Pivot = vL then // swap pivot if we just hit it from one side
Pivot := vR
else if Pivot = vR then
Pivot := vL;
end;
if Pivot - 1 >= L then
QuickSort(L, Pivot - 1, CompareFn);
if Pivot + 1 <= R then
QuickSort(Pivot + 1, R, CompareFn);
end;
procedure TStringList.InsertItem(Index: Integer; const S: string);
begin
@ -1670,11 +1624,55 @@ end;
procedure TStringList.CustomSort(CompareFn: TStringListSortCompare);
begin
CustomSort(CompareFn, SortBase.DefaultSortingAlgorithm);
end;
type
PStringList_CustomSort_Context = ^TStringList_CustomSort_Context;
TStringList_CustomSort_Context = record
List: TStringList;
ListStartPtr: Pointer;
CompareFn: TStringListSortCompare;
end;
function TStringList_CustomSort_Comparer(Item1, Item2, Context: Pointer): Integer;
begin
with PStringList_CustomSort_Context(Context)^ do
Result := CompareFn(List,
(Item1 - ListStartPtr) div SizeOf(TStringItem),
(Item2 - ListStartPtr) div SizeOf(TStringItem));
end;
procedure TStringList_CustomSort_Exchanger(Item1, Item2, Context: Pointer);
begin
with PStringList_CustomSort_Context(Context)^ do
List.ExchangeItems((Item1 - ListStartPtr) div SizeOf(TStringItem),
(Item2 - ListStartPtr) div SizeOf(TStringItem));
end;
procedure TStringList.CustomSort(CompareFn: TStringListSortCompare; SortingAlgorithm: PSortingAlgorithm);
var
Context: TStringList_CustomSort_Context;
begin
If (FForceSort or (Not (FSortStyle=sslAuto))) and (FCount>1) then
begin
Changing;
QuickSort(0,FCount-1, CompareFn);
Context.List := Self;
Context.ListStartPtr := FList;
Context.CompareFn := CompareFn;
//if ExchangeItems is overriden call that, else call (faster) ItemListSorter_ContextComparer
if TMethod(@Self.ExchangeItems).Code = CodePointer(@TStringList.ExchangeItems) then
SortingAlgorithm^.ItemListSorter_ContextComparer(
FList, FCount, SizeOf(TStringItem), @TStringList_CustomSort_Comparer,
@Context)
else
SortingAlgorithm^.ItemListSorter_CustomItemExchanger_ContextComparer(
FList, FCount, SizeOf(TStringItem), @TStringList_CustomSort_Comparer,
@TStringList_CustomSort_Exchanger, @Context);
Changed;
end;
end;
@ -1692,6 +1690,12 @@ begin
CustomSort(@StringListAnsiCompare);
end;
procedure TStringList.Sort(SortingAlgorithm: PSortingAlgorithm);
begin
CustomSort(@StringListAnsiCompare, SortingAlgorithm);
end;
{$else}
{ generics based implementation of TStringList follows }