+ added .Sort overloads, that specify an algorithm and use the sortbase defined

  algorithms for sorting TList, TFPList and TStringList when FPC_TESTGENERICS is
  defined as well. Unfortunately, I couldn't test it, because the RTL doesn't
  compile with FPC_TESTGENERICS, due to errors, completely unrelated to the
  sortbase changes.

git-svn-id: trunk@41248 -

rtl/objpas/classes/classesh.inc

@@ -272,6 +272,7 @@ Type
   public
     procedure Assign(Source: TFPList);
     procedure Sort(Compare: TListSortCompare);
+    procedure Sort(Compare: TListSortCompare; SortingAlgorithm: PSortingAlgorithm);
     procedure ForEachCall(Proc2call: TListCallback; Arg: Pointer);
     procedure ForEachCall(Proc2call: TListStaticCallback; Arg: Pointer);
   end;
@@ -856,7 +857,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);
+    procedure CustomSort(CompareFn: TStringListSortCompare; SortingAlgorithm: PSortingAlgorithm);
     property Duplicates: TDuplicates read GetDuplicates write SetDuplicates;
     property Sorted: Boolean read GetSorted write SetSorted;
     property CaseSensitive: Boolean read FCaseSensitive write SetCaseSensitive;

rtl/objpas/classes/lists.inc

@@ -493,6 +493,11 @@ begin
   inherited Sort(TFPPtrListSortCompare(Compare));
 end;
 
+procedure TFPList.Sort(Compare: TListSortCompare; SortingAlgorithm: PSortingAlgorithm);
+begin
+  inherited Sort(TFPPtrListSortCompare(Compare), SortingAlgorithm);
+end;
+
 procedure TFPList.ForEachCall(Proc2call: TListCallback; Arg: Pointer);
 var
   I: integer;

rtl/objpas/classes/stringl.inc

@@ -1882,32 +1882,46 @@ begin
   Changed;
 end;
 
+type
+  PStringList_CustomSort_Context = ^TStringList_CustomSort_Context;
+  TStringList_CustomSort_Context = record
+    List: TStringList;
+    ListStartPtr: Pointer;
+    ItemSize: SizeUInt;
+    IndexBase: Integer;
+    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 ItemSize) + IndexBase,
+                        ((Item2 - ListStartPtr) div ItemSize) + IndexBase);
+end;
+
+procedure TStringList_CustomSort_Exchanger(Item1, Item2, Context: Pointer);
+begin
+  with PStringList_CustomSort_Context(Context)^ do
+    List.Exchange(((Item1 - ListStartPtr) div ItemSize) + IndexBase,
+                  ((Item2 - ListStartPtr) div ItemSize) + IndexBase);
+end;
+
 procedure TStringList.QuickSort(L, R: Integer; CompareFn: TStringListSortCompare);
-var 
-  I, J, Pivot: Integer;
-begin
-  repeat
-    I := L;
-    J := R;
-    Pivot := (L + R) div 2;
-    repeat
-      while CompareFn(Self, I, Pivot) < 0 do Inc(I);
-      while CompareFn(Self, J, Pivot) > 0 do Dec(J);
-      if I <= J then
-      begin
-        FMap.InternalExchange(I, J); // No check, indices are correct.
-        if Pivot = I then
-          Pivot := J
-        else if Pivot = J then
-          Pivot := I;
-        Inc(I);
-        Dec(j);
-      end;
-    until I > J;
-    if L < J then 
-      QuickSort(L,J, CompareFn);
-    L := I;
-  until I >= R;
+var
+  Context: TStringList_CustomSort_Context;
+begin
+  if L > R then
+    exit;
+  Context.List := Self;
+  Context.ListStartPtr := FMap.Items[L];
+  Context.CompareFn := CompareFn;
+  Context.ItemSize := FMap.KeySize + FMap.DataSize;
+  Context.IndexBase := L;
+
+  DefaultSortingAlgorithm^.ItemListSorter_CustomItemExchanger_ContextComparer(
+    Context.ListStartPtr, R - L + 1, Context.ItemSize, @TStringList_CustomSort_Comparer,
+    @TStringList_CustomSort_Exchanger, @Context);
 end;
 
 procedure TStringList.CustomSort(CompareFn: TStringListSortCompare);
@@ -1920,6 +1934,28 @@ begin
   end;
 end;
 
+procedure TStringList.CustomSort(CompareFn: TStringListSortCompare; SortingAlgorithm: PSortingAlgorithm);
+var
+  Context: TStringList_CustomSort_Context;
+begin
+  if not Sorted and (FMap.Count > 1) then
+  begin
+    Changing;
+
+    Context.List := Self;
+    Context.ListStartPtr := FMap.Items[0];
+    Context.CompareFn := CompareFn;
+    Context.ItemSize := FMap.KeySize + FMap.DataSize;
+    Context.IndexBase := 0;
+
+    SortingAlgorithm^.ItemListSorter_CustomItemExchanger_ContextComparer(
+      Context.ListStartPtr, FMap.Count, Context.ItemSize, @TStringList_CustomSort_Comparer,
+      @TStringList_CustomSort_Exchanger, @Context);
+
+    Changed;
+  end;
+end;
+
 procedure TStringList.Sort;
 begin
   if not Sorted and (FMap.Count > 1) then
@@ -1930,5 +1966,15 @@ begin
   end;
 end;
 
+procedure TStringList.Sort(SortingAlgorithm: PSortingAlgorithm);
+begin
+  if not Sorted and (FMap.Count > 1) then
+  begin
+    Changing;
+    FMap.Sort(SortingAlgorithm);
+    Changed;
+  end;
+end;
+
 {$endif}