TList的一个BUG

TList的一个BUG

TList提供Sort，其实现是QuickSort，但是在使用的时候我发现一个BUG，就是没有进行边界检查

因此，如果一个List中，所有结果的相同，进行排序的话，那么你的程序将死循环下去，或者发生异常。

其关键代码：

procedure QuickSort(SortList: PPointerList; L, R: Integer;

SCompare: TListSortCompare);

var

I, J: Integer;

P, T: Pointer;

begin

repeat

I := L;

J := R;

P := SortList^[(L + R) shr 1];

repeat

while SCompare(SortList^[I], P) < 0 do { Error }

Inc(I);

while SCompare(SortList^[J], P) > 0 do { Error }

Dec(J);

if I <= J then

begin

T := SortList^[I];

SortList^[I] := SortList^[J];

SortList^[J] := T;

Inc(I);

Dec(J);

end;

until I > J;

if L < J then

QuickSort(SortList, L, J, SCompare);

L := I;

until I >= R;

end;

procedure TList.Sort(Compare: TListSortCompare);

begin

if (FList <> nil) and (Count > 0) then

QuickSort(FList, 0, Count - 1, Compare);

end;

应该修正代码如下：

procedure QuickSort(SortList: PPointerList; L, R: Integer;

SCompare: TListSortCompare);

var

I, J: Integer;

P, T: Pointer;

begin

repeat

I := L;

J := R;

P := SortList^[(L + R) shr 1];

repeat

while (SCompare(SortList^[I], P) < 0) and (I < R) do

Inc(I);

while SCompare(SortList^[J], P) > 0 and (J > L)do

Dec(J);

if I <= J then

begin

T := SortList^[I];

SortList^[I] := SortList^[J];

SortList^[J] := T;

Inc(I);

Dec(J);

end;

until I > J;

if L < J then

QuickSort(SortList, L, J, SCompare);

L := I;

until I >= R;

end;

procedure TList.Sort(Compare: TListSortCompare);

begin

if (FList <> nil) and (Count > 1) then

QuickSort(FList, 0, Count - 1, Compare);

end;

实际上，不是BUG，主要是回调函数返回值由问题。 ：（，不过加上边界检查之后，就OK了。