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

* hook TFPSList.QuickSort to also call the default sorting algorithm from sortbase

Browse Source 
git-svn-id: trunk@41179 -
This commit is contained in:
nickysn 2019-02-02 23:08:25 +00:00
parent 59a75ea429
commit ad677070f4
1 changed files with 13 additions and 36 deletions

49
rtl/objpas/fgl.pp
View File

@ -791,42 +791,6 @@ begin
FCount:=NewCount;
end;
// Needed by Sort method.
procedure TFPSList.QuickSort(L, R: Integer; Compare: TFPSListCompareFunc);
var
I, J, P: Integer;
PivotItem: Pointer;
begin
repeat
I := L;
J := R;
{ cast to dword to avoid overflow to a negative number during addition which
would result again in a negative number when being divided }
P := (dword(L) + dword(R)) div 2;
repeat
PivotItem := InternalItems[P];
while Compare(PivotItem, InternalItems[I]) > 0 do
Inc(I);
while Compare(PivotItem, InternalItems[J]) < 0 do
Dec(J);
if I <= J then
begin
InternalExchange(I, J);
if P = I then
P := J
else if P = J then
P := I;
Inc(I);
Dec(J);
end;
until I > J;
if L < J then
QuickSort(L, J, Compare);
L := I;
until I >= R;
end;
procedure TFPSList.Sort(Compare: TFPSListCompareFunc);
begin
Sort(Compare, SortBase.DefaultSortingAlgorithm);
@ -851,6 +815,19 @@ begin
SortingAlgorithm^.ItemListSorter_ContextComparer(FList, FCount, FItemSize, @TFPSList_Sort_Comparer, @Context);
end;
procedure TFPSList.QuickSort(L, R: Integer; Compare: TFPSListCompareFunc);
var
Context: TFPSList_Sort_Comparer_Context;
SortingAlgorithm: PSortingAlgorithm;
begin
if (R > L) and (L >= 0) then
begin
Context.Compare := Compare;
SortingAlgorithm := SortBase.DefaultSortingAlgorithm;
SortingAlgorithm^.ItemListSorter_ContextComparer(FList + FItemSize*L, R-L+1, FItemSize, @TFPSList_Sort_Comparer, @Context);
end;
end;
procedure TFPSList.AddList(Obj: TFPSList);
var
i: Integer;