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

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3677 8e941d3f-bd1b-0410-a28a-d453659cc2b4

components/fpspreadsheet/fpspreadsheet.pas

@@ -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:
+            In case of mixed cell content types the order is determined by
-            Empty cells are "smallest", Label cells are next, Numeric cells
+            the parameter Priority of the SortParams.
-            are "largest"
+            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
+    if (ACell1 = nil) or (ACell2 = nil) then
-      Result := -1
+    begin
-    else
+      Result := +1;  // Empty cells go to the end
-    if (ACell2 = nil) then
+      exit;          // Avoid SortOrder to bring the empty cell to the top!
-      Result := +1
+    end else
-    else
     if (ACell1^.ContentType = cctEmpty) and (ACell2^.ContentType = cctEmpty) then
       Result := 0
-    else if (ACell1^.ContentType = cctEmpty) then
+    else if (ACell1^.ContentType = cctEmpty) or (ACell2^.ContentType = cctEmpty) then
-      Result := -1
+    begin
-    else if (ACell2^.ContentType = cctEmpty) then
+      Result := +1;  // Empty cells go to the end
-      Result := +1
+      exit;          // Avoid SortOrder to bring the empty cell back to the top
-    else if (ACell1^.ContentType = cctUTF8String) and (ACell2^.ContentType = cctUTF8String) then
+    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
+    else
-      Result := -1
+    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

components/fpspreadsheet/fpsutils.pas

@@ -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

components/fpspreadsheet/tests/sortingtests.pas

@@ -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_SortingByCols1_Numbers;
-    procedure Test_SortingByCols_Strings;
+    procedure Test_SortingByCols1_Strings;
-    procedure Test_SortingByCols_Mixed;
+    procedure Test_SortingByCols1_NumbersStrings;
-              {
+
-    procedure Test_SortingByRows_Numbers;
+    procedure Test_SortingByRows1_Numbers;
-    procedure Test_SortingByRows_Strings;
+    procedure Test_SortingByRows1_Strings;
-    procedure Test_SortingByRows_Mixed;
+    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
+          case sortDir of
-          0: for i:=0 to MyWorksheet.GetLastColIndex do
+            ssoAscending : row := i;
-             begin
+            ssoDescending: row := iLast - i;
-               actualNumber := MyWorksheet.ReadAsNumber(i, col);
+          end
-               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
         else
+          case sortDir of
+            ssoAscending : col := i;
+            ssoDescending: col := iLast - i;
+          end;
         case AMode of
-          0: for i:=0 to MyWorksheet.GetLastColIndex do
+          0: begin
-             begin
+               actualNumber := MyWorksheet.ReadAsNumber(row, col);
-               actualNumber := MyWorksheet.ReadAsNumber(row, i);
+               expectedNumber := i;
-               if sortDir = ssoAscending then expectedNumber := i
+               CheckEquals(expectednumber, actualnumber,
-                 else expectedNumber := High(SollSortNumbers)-i;
+                 'Sorted cell number mismatch, cell '+CellNotation(MyWorksheet, row, col));
-               CheckEquals(actualnumber, expectedNumber,
-                 'Sorted number cells mismatch, cell '+CellNotation(MyWorksheet, row, i));
              end;
-        1: for i:=0 to MyWorksheet.GetLastColIndex do
+          1: begin
-           begin
+               actualString := MyWorksheet.ReadAsUTF8Text(row, col);
-             actualString := MyWorksheet.ReadAsUTF8Text(row, i);
+               expectedString := char(ord('A') + i);
-             if sortDir = ssoAscending then expectedString := char(ord('A')+i)
+               CheckEquals(expectedstring, actualstring,
-               else expectedString := char(ord('A') + High(SollSortStrings)-i);
+                 'Sorted cell string mismatch, cell '+CellNotation(MyWorksheet, row, col));
-             CheckEquals(actualString, expectedString,
+             end;
-               'Sorted string cells mismatch, cell '+CellNotation(MyWorksheet, row, i));
+          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

components/fpspreadsheet/tests/spreadtestgui.lpi

@@ -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"/>