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

* use a more robust QuickSort implementation, that is guaranteed to never loop

Browse Source 
forever and never access index out of bounds elements from the array when
  being passed an incorrect comparison function. The resulting sort order is
  still undefined in this case, though.

git-svn-id: trunk@41229 -
This commit is contained in:
nickysn 2019-02-05 16:00:42 +00:00
parent de80621e1e
commit f5f25f7ae6
1 changed files with 114 additions and 81 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

195
rtl/inc/sortbase.pp
View File

@ -76,37 +76,49 @@ begin
PivotIdx := (L + R) div 2; PivotIdx := (L + R) div 2;
P := ItemPtrs[PivotIdx]; P := ItemPtrs[PivotIdx];
repeat repeat
while Comparer(P, ItemPtrs[i]) > 0 do while (I < PivotIdx) and (Comparer(P, ItemPtrs[i]) >= 0) do
Inc(I); Inc(I);
while Comparer(P, ItemPtrs[J]) < 0 do while (J > PivotIdx) and (Comparer(P, ItemPtrs[J]) < 0) do
Dec(J); Dec(J);
If I <= J then if I < J then
begin begin
Q := ItemPtrs[I]; Q := ItemPtrs[I];
ItemPtrs[I] := ItemPtrs[J]; ItemPtrs[I] := ItemPtrs[J];
ItemPtrs[J] := Q; ItemPtrs[J] := Q;
if PivotIdx = I then if PivotIdx = I then
PivotIdx := J begin
PivotIdx := J;
Inc(I);
end
else if PivotIdx = J then else if PivotIdx = J then
begin
PivotIdx := I; PivotIdx := I;
Inc(I); Dec(J);
Dec(J); end
else
begin
Inc(I);
Dec(J);
end;
end; end;
until I > J; until I >= J;
// sort the smaller range recursively // sort the smaller range recursively
// sort the bigger range via the loop // sort the bigger range via the loop
// Reasons: memory usage is O(log(n)) instead of O(n) and loop is faster than recursion // Reasons: memory usage is O(log(n)) instead of O(n) and loop is faster than recursion
if J - L < R - I then if (PivotIdx - L) < (R - PivotIdx) then
begin begin
if L < J then if (L + 1) < PivotIdx then
QuickSort_PtrList_NoContext(ItemPtrs, L, J, Comparer); QuickSort_PtrList_NoContext(ItemPtrs, L, PivotIdx - 1, Comparer);
L := I; L := PivotIdx + 1;
end end
else else
begin begin
if I < R then if (PivotIdx + 1) < R then
QuickSort_PtrList_NoContext(ItemPtrs, I, R, Comparer); QuickSort_PtrList_NoContext(ItemPtrs, PivotIdx + 1, R, Comparer);
R := J; if (L + 1) < PivotIdx then
R := PivotIdx - 1
else
exit;
end; end;
until L >= R; until L >= R;
end; end;
@ -131,38 +143,49 @@ procedure QuickSort_PtrList_Context(ItemPtrs: PPointer; ItemCount: SizeUInt; Com
PivotIdx := (L + R) div 2; PivotIdx := (L + R) div 2;
P := ItemPtrs[PivotIdx]; P := ItemPtrs[PivotIdx];
repeat repeat
while Comparer(P, ItemPtrs[I], Context) > 0 do while (I < PivotIdx) and (Comparer(P, ItemPtrs[I], Context) >= 0) do
Inc(I); Inc(I);
while Comparer(P, ItemPtrs[J], Context) < 0 do while (J > PivotIdx) and (Comparer(P, ItemPtrs[J], Context) < 0) do
Dec(J); Dec(J);
If I <= J then if I < J then
begin begin
Q := ItemPtrs[I]; Q := ItemPtrs[I];
ItemPtrs[I] := ItemPtrs[J]; ItemPtrs[I] := ItemPtrs[J];
ItemPtrs[J] := Q; ItemPtrs[J] := Q;
if PivotIdx = I then if PivotIdx = I then
PivotIdx := J begin
PivotIdx := J;
Inc(I);
end
else if PivotIdx = J then else if PivotIdx = J then
begin
PivotIdx := I; PivotIdx := I;
Dec(J);
Inc(I); end
Dec(J); else
begin
Inc(I);
Dec(J);
end;
end; end;
until I > J; until I >= J;
// sort the smaller range recursively // sort the smaller range recursively
// sort the bigger range via the loop // sort the bigger range via the loop
// Reasons: memory usage is O(log(n)) instead of O(n) and loop is faster than recursion // Reasons: memory usage is O(log(n)) instead of O(n) and loop is faster than recursion
if J - L < R - I then if (PivotIdx - L) < (R - PivotIdx) then
begin begin
if L < J then if (L + 1) < PivotIdx then
QuickSort(L, J); QuickSort(L, PivotIdx - 1);
L := I; L := PivotIdx + 1;
end end
else else
begin begin
if I < R then if (PivotIdx + 1) < R then
QuickSort(I, R); QuickSort(PivotIdx + 1, R);
R := J; if (L + 1) < PivotIdx then
R := PivotIdx - 1
else
exit;
end; end;
until L >= R; until L >= R;
end; end;
@ -189,46 +212,51 @@ var
PivotIdx := (L + R) div 2; PivotIdx := (L + R) div 2;
P := Items + ItemSize*PivotIdx; P := Items + ItemSize*PivotIdx;
repeat repeat
while Comparer(P, Items + ItemSize*I, Context) > 0 do while (I < PivotIdx) and (Comparer(P, Items + ItemSize*I, Context) >= 0) do
Inc(I); Inc(I);
while Comparer(P, Items + ItemSize*J, Context) < 0 do while (J > PivotIdx) and (Comparer(P, Items + ItemSize*J, Context) < 0) do
Dec(J); Dec(J);
If I <= J then if I < J then
begin begin
if I < J then Move((Items + ItemSize*I)^, TempBuf^, ItemSize);
Move((Items + ItemSize*J)^, (Items + ItemSize*I)^, ItemSize);
Move(TempBuf^, (Items + ItemSize*J)^, ItemSize);
if PivotIdx = I then
begin begin
Move((Items + ItemSize*I)^, TempBuf^, ItemSize); PivotIdx := J;
Move((Items + ItemSize*J)^, (Items + ItemSize*I)^, ItemSize); P := Items + ItemSize*PivotIdx;
Move(TempBuf^, (Items + ItemSize*J)^, ItemSize); Inc(I);
if PivotIdx = I then end
begin else if PivotIdx = J then
PivotIdx := J; begin
P := Items + ItemSize*PivotIdx PivotIdx := I;
end P := Items + ItemSize*PivotIdx;
else if PivotIdx = J then Dec(J);
begin end
PivotIdx := I; else
P := Items + ItemSize*PivotIdx; begin
end; Inc(I);
Dec(J);
end; end;
Inc(I);
Dec(J);
end; end;
until I > J; until I >= J;
// sort the smaller range recursively // sort the smaller range recursively
// sort the bigger range via the loop // sort the bigger range via the loop
// Reasons: memory usage is O(log(n)) instead of O(n) and loop is faster than recursion // Reasons: memory usage is O(log(n)) instead of O(n) and loop is faster than recursion
if J - L < R - I then if (PivotIdx - L) < (R - PivotIdx) then
begin begin
if L < J then if (L + 1) < PivotIdx then
QuickSort(L, J); QuickSort(L, PivotIdx - 1);
L := I; L := PivotIdx + 1;
end end
else else
begin begin
if I < R then if (PivotIdx + 1) < R then
QuickSort(I, R); QuickSort(PivotIdx + 1, R);
R := J; if (L + 1) < PivotIdx then
R := PivotIdx - 1
else
exit;
end; end;
until L >= R; until L >= R;
end; end;
@ -262,44 +290,49 @@ procedure QuickSort_ItemList_CustomItemExchanger_Context(
PivotIdx := (L + R) div 2; PivotIdx := (L + R) div 2;
P := Items + ItemSize*PivotIdx; P := Items + ItemSize*PivotIdx;
repeat repeat
while Comparer(P, Items + ItemSize*I, Context) > 0 do while (I < PivotIdx) and (Comparer(P, Items + ItemSize*I, Context) >= 0) do
Inc(I); Inc(I);
while Comparer(P, Items + ItemSize*J, Context) < 0 do while (J > PivotIdx) and (Comparer(P, Items + ItemSize*J, Context) < 0) do
Dec(J); Dec(J);
If I <= J then if I < J then
begin begin
if I < J then Exchanger(Items + ItemSize*I, Items + ItemSize*J, Context);
if PivotIdx = I then
begin begin
Exchanger(Items + ItemSize*I, Items + ItemSize*J, Context); PivotIdx := J;
if PivotIdx = I then P := Items + ItemSize*PivotIdx;
begin Inc(I);
PivotIdx := J; end
P := Items + ItemSize*PivotIdx else if PivotIdx = J then
end begin
else if PivotIdx = J then PivotIdx := I;
begin P := Items + ItemSize*PivotIdx;
PivotIdx := I; Dec(J);
P := Items + ItemSize*PivotIdx; end
end; else
begin
Inc(I);
Dec(J);
end; end;
Inc(I);
Dec(J);
end; end;
until I > J; until I >= J;
// sort the smaller range recursively // sort the smaller range recursively
// sort the bigger range via the loop // sort the bigger range via the loop
// Reasons: memory usage is O(log(n)) instead of O(n) and loop is faster than recursion // Reasons: memory usage is O(log(n)) instead of O(n) and loop is faster than recursion
if J - L < R - I then if (PivotIdx - L) < (R - PivotIdx) then
begin begin
if L < J then if (L + 1) < PivotIdx then
QuickSort(L, J); QuickSort(L, PivotIdx - 1);
L := I; L := PivotIdx + 1;
end end
else else
begin begin
if I < R then if (PivotIdx + 1) < R then
QuickSort(I, R); QuickSort(PivotIdx + 1, R);
R := J; if (L + 1) < PivotIdx then
R := PivotIdx - 1
else
exit;
end; end;
until L >= R; until L >= R;
end; end;