pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

fpspreadsheet: Mode test cases on sorting (two-column sort test not yet working correctly)

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3677 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2014-10-22 15:57:07 +00:00
parent 233c735db6
commit 2f6bc3c183
4 changed files with 304 additions and 121 deletions
Download Patch File Download Diff File Expand all files Collapse all files

52
components/fpspreadsheet/fpspreadsheet.pas
View File

@ -445,6 +445,9 @@ type
{@@ Sort order }
TsSortOrder = (ssoAscending, ssoDescending);
{@@ Sort priority }
TsSortPriority = (spNumAlpha, spAlphaNum); // NumAlph = "number < alpha"
{@@ Sort key: sorted column or row index and sort direction }
TsSortKey = record
ColRowIndex: Integer;
@ -456,9 +459,11 @@ type
{@@ Complete set of sorting parameters
@param SortByCols If true sorting is top-down, otherwise left-right
@param Priority Determines whether numbers are before or after text.
@param SortKeys Array of sorting indexes and sorting directions }
TsSortParams = record
SortByCols: Boolean;
Priority: TsSortPriority;
Keys: TsSortKeys;
end;
@ -508,6 +513,7 @@ type
FLastColIndex: Cardinal;
FDefaultColWidth: Single; // in "characters". Excel uses the width of char "0" in 1st font
FDefaultRowHeight: Single; // in "character heights", i.e. line count
FSortParams: TsSortParams; // Parameters of the current sorting operation
FOnChangeCell: TsCellEvent;
FOnChangeFont: TsCellEvent;
FOnCompareCells: TsCellCompareEvent;
@ -3205,14 +3211,16 @@ end;
to their number value
Label cells are sorted like UTF8 strings.
In case of different cell content types used in the comparison:
Empty cells are "smallest", Label cells are next, Numeric cells
are "largest"
In case of mixed cell content types the order is determined by
the parameter Priority of the SortParams.
Empty cells are always at the end (in both ascending and descending
order)
-------------------------------------------------------------------------------}
function TsWorksheet.DoCompareCells(ACell1, ACell2: PCell;
ASortOrder: TsSortOrder): Integer;
// Sort priority in Excel:
// blank < alpha < number, dates are sorted according to their number value
// numbers < alpha < blank (ascending)
// alpha < numbers < blank (descending)
var
number1, number2: Double;
begin
@ -3224,25 +3232,32 @@ begin
if (ACell1 = nil) and (ACell2 = nil) then
Result := 0
else
if (ACell1 = nil) then
Result := -1
else
if (ACell2 = nil) then
Result := +1
else
if (ACell1 = nil) or (ACell2 = nil) then
begin
Result := +1; // Empty cells go to the end
exit; // Avoid SortOrder to bring the empty cell to the top!
end else
if (ACell1^.ContentType = cctEmpty) and (ACell2^.ContentType = cctEmpty) then
Result := 0
else if (ACell1^.ContentType = cctEmpty) then
Result := -1
else if (ACell2^.ContentType = cctEmpty) then
Result := +1
else if (ACell1^.ContentType = cctUTF8String) and (ACell2^.ContentType = cctUTF8String) then
else if (ACell1^.ContentType = cctEmpty) or (ACell2^.ContentType = cctEmpty) then
begin
Result := +1; // Empty cells go to the end
exit; // Avoid SortOrder to bring the empty cell back to the top
end else
if (ACell1^.ContentType = cctUTF8String) and (ACell2^.ContentType = cctUTF8String) then
Result := CompareText(ACell1^.UTF8StringValue, ACell2^.UTF8StringValue)
else if (ACell1^.ContentType = cctUTF8String) and (ACell2^.ContentType <> cctUTF8String) then
Result := -1
else
if (ACell1^.ContentType = cctUTF8String) and (ACell2^.ContentType <> cctUTF8String) then
case FSortParams.Priority of
spNumAlpha: Result := +1; // numbers before text
spAlphaNum: Result := -1; // text before numbers
end
else
if (ACell1^.ContentType <> cctUTF8String) and (ACell2^.ContentType = cctUTF8String) then
Result := +1
case FSortParams.Priority of
spNumAlpha: Result := -1;
spAlphaNum: Result := +1;
end
else
begin
ReadNumericValue(ACell1, number1);
@ -3422,6 +3437,7 @@ procedure TsWorksheet.Sort(const ASortParams: TsSortParams;
end;
begin
FSortParams := ASortParams;
if ASortParams.SortByCols then
QuickSort(ARowFrom, ARowTo)
else

34
components/fpspreadsheet/fpsutils.pas
View File

@ -151,6 +151,9 @@ function HighContrastColor(AColorValue: TsColorValue): TsColor;
function AnalyzeCompareStr(AString: String; out ACompareOp: TsCompareOperation): String;
function InitSortParams(ASortByCols: Boolean = true; ANumSortKeys: Integer = 1;
ASortPriority: TsSortPriority = spNumAlpha): TsSortParams;
procedure AppendToStream(AStream: TStream; const AString: String); inline; overload;
procedure AppendToStream(AStream: TStream; const AString1, AString2: String); inline; overload;
procedure AppendToStream(AStream: TStream; const AString1, AString2, AString3: String); inline; overload;
@ -2360,6 +2363,37 @@ begin
RemoveChars(0, coEqual);
end;
{@@ ----------------------------------------------------------------------------
Initializes a Sortparams record. This record sets paramaters used when cells
are sorted.
@param ASortByCols If true sorting occurs along columns, i.e. the
ColRowIndex of the sorting keys refer to column indexes.
If False, sorting occurs along rows, and the
ColRowIndexes refer to row indexes
Default: true
@param ANumSortKeys Determines how many columns or rows are used as sorting
keys. (Default: 1)
@param ASortPriority Determines the order or text and numeric data in
mixed content type cell ranges.
Default: spNumAlpha, i.e. numbers before text (in
ascending sort)
@return The initializaed TsSortParams record
-------------------------------------------------------------------------------}
function InitSortParams(ASortByCols: Boolean = true; ANumSortKeys: Integer = 1;
ASortPriority: TsSortPriority = spNumAlpha): TsSortParams;
var
i: Integer;
begin
Result.SortByCols := ASortByCols;
Result.Priority := spNumAlpha; // numbers before text, like in Excel
SetLength(Result.Keys, ANumSortKeys);
for i:=0 to High(Result.Keys) do begin
Result.Keys[i].ColRowIndex := 0;
Result.Keys[i].Order := ssoAscending;
end;
end;
procedure AppendToStream(AStream: TStream; const AString: string);
begin
if Length(AString) > 0 then

328
components/fpspreadsheet/tests/sortingtests.pas
View File

@ -24,35 +24,47 @@ type
{ TSpreadSortingTests }
TSpreadSortingTests = class(TTestCase)
private
protected
// Set up expected values:
procedure SetUp; override;
procedure TearDown; override;
procedure Test_Sorting(
procedure Test_Sorting_1( // one column or row
ASortByCols: Boolean;
AMode: Integer // AMode = 0: number, 1: strings, 2: mixed
);
procedure Test_Sorting_2( // two columns/rows, primary keys equal
ASortByCols: Boolean
);
published
procedure Test_SortingByCols_Numbers;
procedure Test_SortingByCols_Strings;
procedure Test_SortingByCols_Mixed;
{
procedure Test_SortingByRows_Numbers;
procedure Test_SortingByRows_Strings;
procedure Test_SortingByRows_Mixed;
}
procedure Test_SortingByCols1_Numbers;
procedure Test_SortingByCols1_Strings;
procedure Test_SortingByCols1_NumbersStrings;
procedure Test_SortingByRows1_Numbers;
procedure Test_SortingByRows1_Strings;
procedure Test_SortingByRows1_NumbersStrings;
procedure Test_SortingByCols2;
procedure Test_SortingByRows2;
end;
implementation
uses
fpsutils;
const
SortingTestSheet = 'Sorting';
procedure InitUnsortedData;
// When sorted the value is equal to the index
// The logics of the detection requires equal count of numbers and strings.
begin
SollSortNumbers[0] := 9; // Equal count of numbers and strings needed
// When sorted the value is equal to the index
SollSortNumbers[0] := 9;
SollSortNumbers[1] := 8;
SollSortNumbers[2] := 5;
SollSortNumbers[3] := 2;
@ -63,6 +75,7 @@ begin
SollSortNumbers[8] := 4;
SollSortNumbers[9] := 0;
// When sorted the value is equal to 'A' + index
SollSortStrings[0] := 'C';
SollSortStrings[1] := 'G';
SollSortStrings[2] := 'F';
@ -89,14 +102,14 @@ begin
inherited TearDown;
end;
procedure TSpreadSortingTests.Test_Sorting(ASortByCols: Boolean;
procedure TSpreadSortingTests.Test_Sorting_1(ASortByCols: Boolean;
AMode: Integer);
const
AFormat = sfExcel8;
var
MyWorksheet: TsWorksheet;
MyWorkbook: TsWorkbook;
i, row, col: Integer;
i, ilast, n, row, col: Integer;
MyCell: PCell;
TempFile: string; //write xls/xml to this file and read back from it
L: TStringList;
@ -110,6 +123,8 @@ var
expectedString: String;
begin
sortParams := InitSortParams(ASortByCols, 1);
TempFile := GetTempFileName;
MyWorkbook := TsWorkbook.Create;
@ -118,14 +133,7 @@ begin
col := 0;
row := 0;
SetLength(sortParams.Keys, 1);
sortparams.Keys[0].ColRowIndex := 0;
if ASortByCols then begin
sortParams.SortByCols := true;
r1 := 0;
r2 := High(SollSortNumbers);
c1 := 0;
c2 := 0;
case AMode of
0: for i :=0 to High(SollSortNumbers) do
MyWorksheet.WriteNumber(i, col, SollSortNumbers[i]);
@ -140,11 +148,6 @@ begin
end
end
else begin
sortParams.SortByCols := false;
r1 := 0;
r2 := 0;
c1 := 0;
c2 := High(SollSortNumbers);
case AMode of
0: for i := 0 to High(SollSortNumbers) do
MyWorksheet.WriteNumber(row, i, SollSortNumbers[i]);
@ -168,6 +171,7 @@ begin
begin
MyWorkbook := TsWorkbook.Create;
try
// Read spreadsheet file...
MyWorkbook.ReadFromFile(TempFile, AFormat);
if AFormat = sfExcel2 then
MyWorksheet := MyWorkbook.GetFirstWorksheet
@ -176,82 +180,68 @@ begin
if MyWorksheet = nil then
fail('Error in test code. Failed to get named worksheet');
// ... and sort it.
case AMode of
0: iLast:= High(SollSortNumbers);
1: iLast := High(SollSortStrings);
2: iLast := Length(SollSortNumbers) + Length(SollSortStrings) - 1;
end;
r1 := 0;
r2 := 0;
c1 := 0;
c2 := 0;
if ASortByCols then
r2 := iLast
else
c2 := iLast;
sortParams.Keys[0].Order := sortDir;
MyWorksheet.Sort(sortParams, r1,c1, r2, c2);
// for debugging, to see the sorted data
// MyWorkbook.WriteToFile('sorted.xls', AFormat, true);
row := 0;
col := 0;
for i:=0 to iLast do
begin
if ASortByCols then
case AMode of
0: for i:=0 to MyWorksheet.GetLastColIndex do
begin
actualNumber := MyWorksheet.ReadAsNumber(i, col);
if sortDir = ssoAscending then expectedNumber := i
else expectedNumber := High(SollSortNumbers)-i;
CheckEquals(actualnumber, expectedNumber,
'Sorted number cells mismatch, cell '+CellNotation(MyWorksheet, i, col));
end;
1: for i:=0 to Myworksheet.GetLastColIndex do
begin
actualString := MyWorksheet.ReadAsUTF8Text(i, col);
if sortDir = ssoAscending then expectedString := char(ord('A') + i)
else expectedString := char(ord('A') + High(SollSortStrings)-i);
CheckEquals(actualString, expectedString,
'Sorted string cells mismatch, cell '+CellNotation(MyWorksheet, i, col));
end;
2: begin (* to be done...
for i:=0 to High(SollNumbers) do
begin
actualNumber := MyWorkbook.ReadAsNumber(i*2, col);
if sortdir =ssoAscending then
expectedNumber := i
CheckEquals(actualnumber, expectedNumber,
'Sorted number cells mismatch, cell '+CellNotation(MyWorksheet, i*2, col));
end;
for i:=0 to High(SollStrings) do
begin
actualString := MyWorkbook.ReadAsUTF8String(i*2+1, col);
expectedString := SollStrings[i];
CheckEquals(actualString, expectedString,
'Sorted string cells mismatch, cell '+CellNotation(MyWorksheet, i*2+1, col));
end;
*)
end;
end // case
case sortDir of
ssoAscending : row := i;
ssoDescending: row := iLast - i;
end
else
case sortDir of
ssoAscending : col := i;
ssoDescending: col := iLast - i;
end;
case AMode of
0: for i:=0 to MyWorksheet.GetLastColIndex do
begin
actualNumber := MyWorksheet.ReadAsNumber(row, i);
if sortDir = ssoAscending then expectedNumber := i
else expectedNumber := High(SollSortNumbers)-i;
CheckEquals(actualnumber, expectedNumber,
'Sorted number cells mismatch, cell '+CellNotation(MyWorksheet, row, i));
0: begin
actualNumber := MyWorksheet.ReadAsNumber(row, col);
expectedNumber := i;
CheckEquals(expectednumber, actualnumber,
'Sorted cell number mismatch, cell '+CellNotation(MyWorksheet, row, col));
end;
1: for i:=0 to MyWorksheet.GetLastColIndex do
begin
actualString := MyWorksheet.ReadAsUTF8Text(row, i);
if sortDir = ssoAscending then expectedString := char(ord('A')+i)
else expectedString := char(ord('A') + High(SollSortStrings)-i);
CheckEquals(actualString, expectedString,
'Sorted string cells mismatch, cell '+CellNotation(MyWorksheet, row, i));
1: begin
actualString := MyWorksheet.ReadAsUTF8Text(row, col);
expectedString := char(ord('A') + i);
CheckEquals(expectedstring, actualstring,
'Sorted cell string mismatch, cell '+CellNotation(MyWorksheet, row, col));
end;
2: begin // with increasing i, we see first the numbers, then the strings
if i <= High(SollSortNumbers) then begin
actualnumber := MyWorksheet.ReadAsNumber(row, col);
expectedNumber := i;
CheckEquals(expectednumber, actualnumber,
'Sorted cell number mismatch, cell '+CellNotation(MyWorksheet, row, col));
end else begin
actualstring := MyWorksheet.ReadAsUTF8Text(row, col);
expectedstring := char(ord('A') + i - Length(SollSortNumbers));
CheckEquals(expectedstring, actualstring,
'Sorted cell string mismatch, cell '+CellNotation(MyWorksheet, row, col));
end;
2: begin{
for i:=0 to High(SollNumbers) do
begin
actualNumber := MyWorkbook.ReadAsNumber(row, i*2);
expectedNumber := SollNumbers[i];
CheckEquals(actualnumber, expectedNumber,
'Sorted number cells mismatch, cell '+CellNotation(MyWorksheet, row, i*2));
end;
for i:=0 to High(SollStrings) do
begin
actualString := MyWorkbook.ReadAsUTF8String(row, i*2+1);
expectedString := SollStrings[i];
CheckEquals(actualString, expectedString,
'Sorted string cells mismatch, cell '+CellNotation(MyWorksheet, row, i*2+1));
end;
}
end;
end; // case
finally
MyWorkbook.Free;
@ -261,20 +251,166 @@ begin
DeleteFile(TempFile);
end;
procedure TSpreadSortingTests.Test_Sorting_2(ASortByCols: Boolean);
const
AFormat = sfExcel8;
var
MyWorksheet: TsWorksheet;
MyWorkbook: TsWorkbook;
i, ilast, n, row, col: Integer;
MyCell: PCell;
TempFile: string; //write xls/xml to this file and read back from it
L: TStringList;
s: String;
sortParams: TsSortParams;
sortDir: TsSortOrder;
r1,r2,c1,c2: Cardinal;
actualNumber: Double;
actualString: String;
expectedNumber: Double;
expectedString: String;
procedure TSpreadSortingTests.Test_SortingByCols_Numbers;
begin
Test_Sorting(true, 0);
sortParams := InitSortParams(ASortByCols, 2);
sortParams.Keys[0].ColRowIndex := 0;
sortParams.Keys[1].ColRowIndex := 1;
TempFile := GetTempFileName;
MyWorkbook := TsWorkbook.Create;
try
MyWorkSheet:= MyWorkBook.AddWorksheet(SortingTestSheet);
col := 0;
row := 0;
if ASortByCols then
begin
// Always 2 numbers in the first column are equal
for i:=0 to High(SollSortNumbers) do
MyWorksheet.WriteNumber(i, col, SollSortNumbers[(i mod 2)*2]);
// All strings in the second column are distinct
for i:=0 to High(SollSortStrings) do
MyWorksheet.WriteUTF8Text(i, col+1, SollSortStrings[i]);
end else
begin
for i:=0 to High(SollSortNumbers) do
MyWorksheet.WriteNumber(row, i, SollSortNumbers[(i mod 2)*2]);
for i:=0 to High(SollSortStrings) do
MyWorksheet.WriteUTF8Text(row+1, i, SollSortStrings[i]);
end;
MyWorkBook.WriteToFile(TempFile, AFormat, true);
finally
MyWorkbook.Free;
end;
// Test ascending and descending sort orders
for sortDir in TsSortOrder do
begin
MyWorkbook := TsWorkbook.Create;
try
// Read spreadsheet file...
MyWorkbook.ReadFromFile(TempFile, AFormat);
if AFormat = sfExcel2 then
MyWorksheet := MyWorkbook.GetFirstWorksheet
else
MyWorksheet := GetWorksheetByName(MyWorkBook, SortingTestSheet);
if MyWorksheet = nil then
fail('Error in test code. Failed to get named worksheet');
// ... and sort it.
iLast := High(SollSortNumbers); //must be the same as for SollSortStrings
r1 := 0; c1 := 0;
if ASortByCols then begin
c2 := 1;
r2 := iLast;
end else
begin
c2 := iLast;
r2 := 1;
end;
sortParams.Keys[0].Order := sortDir;
sortParams.Keys[1].Order := sortDir;
MyWorksheet.Sort(sortParams, r1,c1, r2, c2);
// for debugging, to see the sorted data
MyWorkbook.WriteToFile('sorted.xls', AFormat, true);
for i:=0 to iLast do
begin
row := 0;
col := 0;
if ASortByCols then
case sortDir of
ssoAscending : row := i;
ssoDescending: row := iLast - i;
end
else
case sortDir of
ssoAscending : col := i;
ssoDescending: col := iLast - i;
end;
actualNumber := MyWorksheet.ReadAsNumber(row, col);
expectedNumber := (i mod 2) * 2;
CheckEquals(expectednumber, actualnumber,
'Sorted cell number mismatch, cell '+CellNotation(MyWorksheet, row, col));
if ASortByCols then
inc(col)
else
inc(row);
actualString := MyWorksheet.ReadAsUTF8Text(row, col);
expectedString := char(ord('A') + i);
CheckEquals(expectedstring, actualstring,
'Sorted cell string mismatch, cell '+CellNotation(MyWorksheet, row, col));
end;
finally
MyWorkbook.Free;
end;
end; // for sortDir
DeleteFile(TempFile);
end;
procedure TSpreadSortingTests.Test_SortingByCols_Strings;
procedure TSpreadSortingTests.Test_SortingByCols1_Numbers;
begin
Test_Sorting(true, 1);
Test_Sorting_1(true, 0);
end;
procedure TSpreadSortingTests.Test_SortingByCols_Mixed;
procedure TSpreadSortingTests.Test_SortingByCols1_Strings;
begin
//Test_Sorting(true, 2);
Test_Sorting_1(true, 1);
end;
procedure TSpreadSortingTests.Test_SortingByCols1_NumbersStrings;
begin
Test_Sorting_1(true, 2);
end;
procedure TSpreadSortingTests.Test_SortingByRows1_Numbers;
begin
Test_Sorting_1(false, 0);
end;
procedure TSpreadSortingTests.Test_SortingByRows1_Strings;
begin
Test_Sorting_1(false, 1);
end;
procedure TSpreadSortingTests.Test_SortingByRows1_NumbersStrings;
begin
Test_Sorting_1(false, 2);
end;
procedure TSpreadSortingTests.Test_SortingByCols2;
begin
Test_Sorting_2(true);
end;
procedure TSpreadSortingTests.Test_SortingByRows2;
begin
Test_Sorting_2(false);
end;
initialization

5
components/fpspreadsheet/tests/spreadtestgui.lpi
View File

@ -48,6 +48,7 @@
<Unit1>
<Filename Value="datetests.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="datetests"/>
</Unit1>
<Unit2>
<Filename Value="stringtests.pas"/>
@ -75,7 +76,6 @@
<Unit7>
<Filename Value="formattests.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="formattests"/>
</Unit7>
<Unit8>
<Filename Value="colortests.pas"/>
@ -84,7 +84,6 @@
<Unit9>
<Filename Value="fonttests.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="fonttests"/>
</Unit9>
<Unit10>
<Filename Value="optiontests.pas"/>
@ -97,7 +96,6 @@
<Unit12>
<Filename Value="rpnformulaunit.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="rpnFormulaUnit"/>
</Unit12>
<Unit13>
<Filename Value="formulatests.pas"/>
@ -107,7 +105,6 @@
<Unit14>
<Filename Value="emptycelltests.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="emptycelltests"/>
</Unit14>
<Unit15>
<Filename Value="errortests.pas"/>