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

* Allow context when sorting lists (patch from Ondrej Pokorny, bug ID #0035962)

Browse Source 
git-svn-id: trunk@42798 -
This commit is contained in:
michael 2019-08-24 10:46:51 +00:00
parent c1e3c61af3
commit 91ba1214d2
2 changed files with 26 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -256,6 +256,8 @@ Type
procedure Pack; procedure Pack;
procedure Sort(Compare: TListSortCompare); procedure Sort(Compare: TListSortCompare);
procedure Sort(Compare: TListSortCompare; SortingAlgorithm: PSortingAlgorithm); procedure Sort(Compare: TListSortCompare; SortingAlgorithm: PSortingAlgorithm);
procedure Sort(Compare: TListSortComparer_Context; Context: Pointer);
procedure Sort(Compare: TListSortComparer_Context; Context: Pointer; SortingAlgorithm: PSortingAlgorithm);
procedure ForEachCall(proc2call:TListCallback;arg:pointer); procedure ForEachCall(proc2call:TListCallback;arg:pointer);
procedure ForEachCall(proc2call:TListStaticCallback;arg:pointer); procedure ForEachCall(proc2call:TListStaticCallback;arg:pointer);
property Capacity: Integer read FCapacity write SetCapacity; property Capacity: Integer read FCapacity write SetCapacity;
@ -342,6 +344,8 @@ Type
procedure Pack; procedure Pack;
procedure Sort(Compare: TListSortCompare); procedure Sort(Compare: TListSortCompare);
procedure Sort(Compare: TListSortCompare; SortingAlgorithm: PSortingAlgorithm); procedure Sort(Compare: TListSortCompare; SortingAlgorithm: PSortingAlgorithm);
procedure Sort(Compare: TListSortComparer_Context; Context: Pointer);
procedure Sort(Compare: TListSortComparer_Context; Context: Pointer; SortingAlgorithm: PSortingAlgorithm);
property Capacity: Integer read GetCapacity write SetCapacity; property Capacity: Integer read GetCapacity write SetCapacity;
property Count: Integer read GetCount write SetCount; property Count: Integer read GetCount write SetCount;
property Items[Index: Integer]: Pointer read Get write Put; default; property Items[Index: Integer]: Pointer read Get write Put; default;

22
rtl/objpas/classes/lists.inc
View File

@ -312,6 +312,18 @@ begin
end; end;
procedure TFPList.Sort(Compare: TListSortComparer_Context; Context: Pointer);
begin
Sort(Compare, Context, SortBase.DefaultSortingAlgorithm);
end;
procedure TFPList.Sort(Compare: TListSortComparer_Context; Context: Pointer; SortingAlgorithm: PSortingAlgorithm);
begin
SortingAlgorithm^.PtrListSorter_ContextComparer(PPointer(FList), FCount, Compare, Context);
end;
procedure TFPList.ForEachCall(proc2call:TListCallback;arg:pointer); procedure TFPList.ForEachCall(proc2call:TListCallback;arg:pointer);
var var
i : integer; i : integer;
@ -784,6 +796,16 @@ begin
FList.Sort(Compare, SortingAlgorithm); FList.Sort(Compare, SortingAlgorithm);
end; end;
procedure TList.Sort(Compare: TListSortComparer_Context; Context: Pointer);
begin
FList.Sort(Compare, Context);
end;
procedure TList.Sort(Compare: TListSortComparer_Context; Context: Pointer; SortingAlgorithm: PSortingAlgorithm);
begin
FList.Sort(Compare, Context, SortingAlgorithm);
end;
procedure TList.CopyMove (aList : TList); procedure TList.CopyMove (aList : TList);
var r : integer; var r : integer;
begin begin