lazarus-ccr/components/fpspreadsheet/unit-tests/common/ssttests.pas

{ 
  Test related to BIFF8 shared string table
  This unit tests are writing out to and reading back from files.
}

unit ssttests;

{$mode objfpc}{$H+}

interface

uses
  // Not using Lazarus package as the user may be working with multiple versions
  // Instead, add .. to unit search path
  Classes, SysUtils, fpcunit, testregistry,
  fpstypes, fpspreadsheet, xlsbiff8 {and a project requirement for lclbase for utf8 handling},
  testsutility;

type
  { TSpreadWriteReadColorTests }
  //Write to xls/xml file and read back
  TSpreadWriteReadSSTTests = class(TTestCase)
  private
  protected
    // Set up expected values:
    procedure SetUp; override;
    procedure TearDown; override;
    // General test procedure
    procedure TestWriteRead_SST_General(ATestCase: Integer);

  published
    { 1 ASCII string in SST, entirely in SST record }
    procedure TestWriteRead_SST_1ASCII;
    { 1 ASCII wide in SST, entirely in SST record }
    procedure TestWriteRead_SST_1Wide;
    { 3 string in SST, all entirely in SST record }
    procedure TestWriteRead_SST_3ASCII;
    { 3 string in SST, widestring case, all entirely in SST record }
    procedure TestWriteRead_SST_3Wide;
    { 1 long ASCII string in SST, fills SST record completely, no CONTINUE record needed }
    procedure TestWriteRead_SST_1LongASCII;
    { 1 long wide string in SST, fills SST record completely, no CONTINUE record needed }
    procedure TestWriteRead_SST_1LongWide;
    { ASCII string 2 character longer than SST record max --> CONTINUE record needed }
    procedure TestWriteRead_SST_1CONTINUE_1ASCII;
    { wide string 2 character longer than SST record max --> CONTINUE record needed }
    procedure TestWriteRead_SST_1CONTINUE_1Wide;
    { short ASCII string, then long ASCII string, 1 CONTINUE record needed }
    procedure TestWriteRead_SST_1CONTINUE_ShortASCII_LongASCII;
    { short widestring, then long widestring, 1 CONTINUE record needed }
    procedure TestWriteRead_SST_1CONTINUE_ShortWide_LongWide;
    { long ASCII string, then short ASCII string, 1 CONTINUE record needed }
    procedure TestWriteRead_SST_1CONTINUE_LongASCII_ShortASCII;
    { long widestring, then short wide string into CONTINUE record }
    procedure TestWriteRead_SST_1CONTINUE_LongWide_ShortWide;
    { very long ASCII string needing two CONTINUE records }
    procedure TestWriteRead_SST_2CONTINUE_VeryLongASCII;
    { very long widestring needing two CONTINUE records }
    procedure TestWriteRead_SST_2CONTINUE_VeryLongWide;
    { three long ASCII strings needing two CONTINUE records }
    procedure TestWriteRead_SST_2CONTINUE_3LongASCII;
    { three long widestrings needing two CONTINUE records }
    procedure TestWriteRead_SST_2CONTINUE_3LongWide;
    { 1 ASCII string in SST, entirely in SST record, font alternating from char to char }
    procedure TestWriteRead_SST_1ASCII_RichText;
    { 1 widestring in SST, entirely in SST record, font alternating from char to char }
    procedure TestWriteRead_SST_1Wide_RichText;
    { long ASCII string which reaches beyond SST into CONTINUE. Short Rich-Text
      staying within the same CONTINUE record}
    procedure TestWriteRead_SST_CONTINUE_LongASCII_ShortRichText;
    { long widestring which reaches beyond SST into CONTINUE. Short Rich-Text
      staying within the same CONTINUE record}
    procedure TestWriteRead_SST_CONTINUE_LongWide_ShortRichText;
    { long ASCII string with rich-text formatting. The string stays within SST
      but rich-text parameters reach into CONTINUE record. }
    procedure TestWriteRead_SST_CONTINUE_ShortASCII_LongRichText;
    { long widestring with rich-text formatting. The string stays within SST
      but rich-text parameters reach into CONTINUE record. }
    procedure TestWriteRead_SST_CONTINUE_ShortWide_LongRichText;
    { long ASCII string with rich-text formatting. The string stays within SST
      but long rich-text parameters flow into 2 CONTINUE records. }
    procedure TestWriteRead_SST_2CONTINUE_ASCII_LongRichText;
    { long widestring with rich-text formatting. The string stays within SST
      but long rich-text parameters flow into 2 CONTINUE records. }
    procedure TestWriteRead_SST_2CONTINUE_Wide_LongRichText;
  end;


implementation

uses
  LazUTF8;

const
  SST_Sheet = 'SST';
  MAX_BYTES_PER_RECORD = 8224;

{ TSpreadWriteReadSSTTests }

procedure TSpreadWriteReadSSTTests.SetUp;
begin
  inherited SetUp;
end;

procedure TSpreadWriteReadSSTTests.TearDown;
begin
  inherited TearDown;
end;

procedure TSpreadWriteReadSSTTests.TestWriteRead_SST_General(ATestCase: Integer);
const
  // Every record can contain 8224 data bytes (without BIFF header).
  // The SST record needs 2x4 bytes for the string counts.
  // The rest (8224-8) is for the string wbich has a header of 3 bytes (2 bytes
  // string length + 1 byte flags). fpspreadsheet writes string as widestring,
  // i.2. 2 bytes per character.
  maxLenSST = MAX_BYTES_PER_RECORD - 3 - 8;
  maxLenCONTINUE = MAX_BYTES_PER_RECORD - 1;
var
  MyWorksheet: TsWorksheet;
  MyWorkbook: TsWorkbook;
  MyCell: PCell;
  TempFile: string; //write xls/xml to this file and read back from it
  currentText: string;
  currentRtParams: TsRichTextParams;
  currentFont: TsFont;
  expectedText: array of string = nil;
  expectedRtParams: array of TsRichTextParams = nil;
  expectedFont: Array[0..1] of TsFont;
  expectedFontIndex: Array[0..1] of Integer;
  i, j: Integer;
  col, row: Cardinal;

  function CreateString(ALen: Integer): String;
  var
    i: Integer;
  begin
    Result := '';
    SetLength(Result, ALen);
    for i:=1 to ALen do
      Result[i] := char((i-1) mod 26 + ord('A'));
  end;

  function AlternatingFont(AStrLen: Integer): TsRichTextParams;
  var
    i: Integer;
  begin
    Result := nil;
    SetLength(Result, AStrLen div 2);
    for i := 0 to High(Result) do begin
      Result[i].FirstIndex := i*2 + 1;
        // character index is 1-based in fps
      Result[i].FontIndex := expectedFontIndex[i mod 2];
       // Avoid using the default font here, it makes counting too complex.
    end;
  end;

begin
  TempFile := GetTempFileName;

  MyWorkbook := TsWorkbook.Create;
  try
    expectedFontIndex[0] := 1;
    expectedFontIndex[1] := 2;
    for j:=0 to 1 do
      expectedFont[j] := MyWorkbook.GetFont(expectedFontIndex[j]);

    case ATestCase of
      0: begin
           // 1 short ASCII string, easily fits within SST record
           SetLength(expectedtext, 1);
           expectedText[0] := 'ABC';
         end;
      1: begin
           // 1 short wide string, easily fits within SST record
           SetLength(expectedtext, 1);
           expectedText[0] := 'äöü';
         end;
      2: begin
           // 3 short ASCII strings, easily fit within SST record
           SetLength(expectedtext, 3);
           expectedText[0] := 'ABC';
           expectedText[1] := 'DEF';
           expectedText[2] := 'GHI';
         end;
      3: begin
           // 3 short strings, widestring case, easily fit within SST record
           SetLength(expectedtext, 3);
           expectedText[0] := 'äöü';
           expectedText[1] := 'DEF';
           expectedText[2] := 'GHI';
         end;
      4: begin
           // 1 long ASCII string, max length for SST record
           SetLength(expectedtext, 1);
           expectedText[0] := CreateString(maxLenSST);
         end;
      5: begin
           // 1 long widestring, max length for SST record
           SetLength(expectedtext, 1);
           expectedText[0] := 'ä' + CreateString(maxLenSST div 2 - 1);
         end;
      6: begin
           // 1 long ASCII string, 2 characters more than max SST length --> CONTINUE needed
           SetLength(expectedtext, 1);
           expectedText[0] := CreateString(maxLenSST + 2);
         end;
      7: begin
           // 1 long widestring, 2 characters more than max SST length --> CONTINUE needed
           SetLength(expectedtext, 1);
           expectedText[0] := 'ä' + CreateString(maxLenSST div 2 + 1);
         end;
      8: begin
           // a short ASCII string, plus 1 long ASCII string reaching into CONTINUE record
           SetLength(expectedtext, 2);
           expectedText[0] := 'ABC';
           expectedText[1] := CreateString(maxLenSST);
         end;
      9: begin
           // a short widestring, plus 1 long widestring reaching into CONTINUE record
           SetLength(expectedtext, 2);
           expectedText[0] := 'äöü';
           expectedText[1] := 'äöü' + CreateString(maxLenSST div 2);
         end;
     10: begin
           // 1 long ASCII string staying inside SST, 1 short ASCII string into CONTINUE
           // The header of the short string does no longer fit in the SST record.
           // The short string must bo into CONTINUE completely.
           SetLength(expectedtext, 2);
           expectedText[0] := CreateString(maxLenSST-2);
           expectedText[1] := 'ABCDEF';
         end;
     11: begin
           // 1 long widestring staying inside SST, 1 short widestring into CONTINUE
           SetLength(expectedtext, 2);
           expectedText[0] := 'ä' + CreateString(maxLenSST div 2 - 2);
           expectedText[1] := 'ÄÖÜabc';
         end;
     12: begin
           // a very long ASCII string needing two CONTINUE records
           SetLength(expectedtext, 1);
           expectedText[0] := CreateString(maxLenSST + maxLenCONTINUE + 3);
         end;
     13: begin
           // a very long wide string needing two CONTINUE records
           SetLength(expectedtext, 1);
           expectedText[0] := 'äöü' + CreateString(maxLenSST div 2  + maxLenCONTINUE div 2);
         end;
     14: begin
           // three long ASCII strings needing two CONTINUE records
           SetLength(expectedtext, 3);
           expectedText[0] := CreateString(maxLenSST - 3);
           expectedText[1] := CreateString(maxLenSST - 3 + maxLenCONTINUE - 3);
           expectedText[2] := CreateString(maxLenSST - 3 + maxLenCONTINUE - 3);
         end;
     15: begin
           // three long wide strings needing two CONTINUE records
           SetLength(expectedtext, 3);
           expectedText[0] := CreateString(maxLenSST div 2 - 3);
           expectedText[1] := CreateString(maxLenSST div 2 - 3 + maxLenCONTINUE div 2 - 3);
           expectedText[2] := CreateString(maxLenSST div 2 - 3 + maxLenCONTINUE div 2 - 3);
         end;
     16: begin
           // 1 short ASCII string, easily fits within SST record, with Rich-Text
           SetLength(expectedtext, 1);
           expectedText[0] := 'ABCD';
           SetLength(expectedRtParams, 1);
           expectedRtParams[0] := AlternatingFont(Length(expectedText[0]));
         end;
     17: begin
           // 1 short widestring, easily fits within SST record, with Rich-Text
           SetLength(expectedtext, 1);
           expectedText[0] := 'äöüa';
           SetLength(expectedRtParams, 1);
           expectedRtParams[0] := AlternatingFont(4);
         end;
     18: begin
           // 1 long ASCII string, reaches into CONTINUE record, short Rich-Text
           SetLength(expectedtext, 1);
           expectedText[0] := CreateString(maxLenSST+5);
           SetLength(expectedRtParams, 1);
           expectedRtParams[0] := AlternatingFont(10);
         end;
     19: begin
           // 1 long wide string, reaches into CONTINUE record, short Rich-Text
           SetLength(expectedtext, 1);
           expectedText[0] := 'äöü' + CreateString(maxLenSST div 2 + 5);
           SetLength(expectedRtParams, 1);
           expectedRtParams[0] := AlternatingFont(10);
         end;
     20: begin
           // ASCII string staying within SST. But has Rich-Text parameters
           // overflowing into the CONTINUE record
           SetLength(expectedtext, 1);
           expectedText[0] := CreateString(maxLenSST - 10);
           SetLength(expectedRtParams, 1);
           expectedRtParams[0] := AlternatingFont(100);
         end;
     21: begin
           // wide string staying within SST. But has Rich-Text parameters
           // overflowing into the CONTINUE record
           SetLength(expectedtext, 1);
           expectedText[0] := 'äöü' + CreateString(maxLenSST div 2 - 13);
           SetLength(expectedRtParams, 1);
           expectedRtParams[0] := AlternatingFont(100);
         end;
     22: begin
           // Long ASCII string staying within SST. But has long Rich-Text
           // parameters overflowing into two CONTINUE records
           SetLength(expectedtext, 1);
           expectedText[0] := CreateString(maxLenSST - 10);
           SetLength(expectedRtParams, 1);
           expectedRtParams[0] := AlternatingFont(Length(expectedText[0]));
         end;
     23: begin
           // Long widestring staying within SST. But has long Rich-Text
           // parameters overflowing into two CONTINUE records
           SetLength(expectedtext, 1);
           expectedText[0] := 'äöü' + CreateString(maxLenSST div 2 - 13);
           SetLength(expectedRtParams, 1);
           expectedRtParams[0] := AlternatingFont(UTF8Length(expectedText[0]) div 2);
         end;
    end;

    { Create spreadsheet and write to file }
    MyWorkSheet:= MyWorkBook.AddWorksheet(SST_Sheet);
    col := 0;
    for row := 0 to High(expectedText) do
      if row < Length(expectedRtParams) then
        MyCell := MyWorksheet.WriteText(row, col, expectedText[row], expectedRtParams[row])
      else
        MyCell := MyWorksheet.WriteText(row, col, expectedText[row]);
    MyWorkBook.WriteToFile(TempFile, sfExcel8, true);
  finally
    MyWorkbook.Free;
  end;

  { Read the spreadsheet }
  MyWorkbook := TsWorkbook.Create;
  try
    MyWorkbook.ReadFromFile(TempFile, sfExcel8);
    MyWorksheet := MyWorkbook.GetWorksheetByIndex(0);
    col := 0;
    for row := 0 to High(expectedText) do begin
      myCell := MyWorksheet.FindCell(row, col);
      if MyCell = nil then
        fail('Error in test code. Failed to get cell.');

      currentText := MyWorksheet.ReadAsText(MyCell);
      CheckEquals(expectedText[row], currentText,
        'Saved cell text mismatch, cell '+CellNotation(MyWorksheet, row, col));

      if row < Length(expectedRtParams) then
      begin
        currentRtParams := MyCell^.RichTextParams;
        CheckEquals(Length(expectedRtParams[row]), Length(currentRtParams),
          'Number of rich-text parameters mismatch, cell '+CellNotation(MyWorksheet, row, col));

        for i:=0 to High(currentRtParams) do
        begin
          CheckEquals(expectedRtParams[row][i].FirstIndex, currentRtParams[i].FirstIndex,
            'Character index mismatch in rich-text parameter #' + IntToStr(i) +
            ', cell ' + CellNotation(MyWorksheet, row, col));

          currentFont := MyWorkbook.GetFont(currentRtParams[i].FontIndex);
          CheckEquals(currentFont.Fontname, expectedFont[i mod 2].FontName,
            'Font name mismatch in rich-text parameter #' + IntToStr(i) +
            ', cell ' + CellNotation(MyWorksheet, row, col));
          CheckEquals(currentFont.Size, expectedFont[i mod 2].Size,
            'Font size mismatch in rich-text parameter #' + IntToStr(i) +
            ', cell ' + CellNotation(MyWorksheet, row, col));
          CheckEquals(integer(currentFont.Style), integer(expectedFont[i mod 2].Style),
            'Font style mismatch in rich-text parameter #' + IntToStr(i) +
            ', cell ' + CellNotation(MyWorksheet, row, col));
          CheckEquals(currentFont.Color, expectedFont[i mod 2].Color,
            'Font color mismatch in rich-text parameter #' + IntToStr(i) +
            ', cell ' + CellNotation(MyWorksheet, row, col));
        end;
      end;
    end;
  finally
    MyWorkbook.Free;
    DeleteFile(TempFile);
  end;
end;

{ Writes/reads one string ASCII only. The string fits in the SST record }
procedure TSpreadWriteReadSSTTests.TestWriteRead_SST_1ASCII;
begin
  TestWriteRead_SST_General(0);
end;

{ Writes/reads one wide string only. The string fits in the SST record }
procedure TSpreadWriteReadSSTTests.TestWriteRead_SST_1Wide;
begin
  TestWriteRead_SST_General(1);
end;

{ Writes/reads 3 strings, all entirely in SST record }
procedure TSpreadWriteReadSSTTests.TestWriteRead_SST_3ASCII;
begin
  TestWriteRead_SST_General(2);
end;

{ Writes/reads 3 strings, widestring case, all entirely in SST record }
procedure TSpreadWriteReadSSTTests.TestWriteRead_SST_3Wide;
begin
  TestWriteRead_SST_General(3);
end;

{ 1 long ASCII string in SST, fills SST record exactly, no CONTINUE record needed }
procedure TSpreadWriteReadSSTTests.TestWriteRead_SST_1LongASCII;
begin
  TestWriteRead_SST_General(4);
end;

{ 1 long widestring in SST, fills SST record exactly, no CONTINUE record needed }
procedure TSpreadWriteReadSSTTests.TestWriteRead_SST_1LongWide;
begin
  TestWriteRead_SST_General(5);
end;

{ 1 ASCII string, 2 characters longer than in SST record max
  --> CONTINUE record needed }
procedure TSpreadWriteReadSSTTests.TestWriteRead_SST_1CONTINUE_1ASCII;
begin
  TestWriteRead_SST_General(6);
end;

{ 1 widestring, 2 characters longer than in SST record max
   --> CONTINUE record needed }
procedure TSpreadWriteReadSSTTests.TestWriteRead_SST_1CONTINUE_1Wide;
begin
  TestWriteRead_SST_General(7);
end;

{ short ASCII string, then long ASCII string, 1 CONTINUE record needed }
procedure TSpreadWriteReadSSTTests.TestWriteRead_SST_1CONTINUE_ShortASCII_LongASCII;
begin
  TestWriteRead_SST_General(8);
end;

{ short widestring, then long widestring, 1 CONTINUE record needed }
procedure TSpreadWriteReadSSTTests.TestWriteRead_SST_1CONTINUE_ShortWide_LongWide;
begin
  TestWriteRead_SST_General(9);
end;

{ long ASCII string, then short ACII string into CONTINUE record }
procedure TSpreadWriteReadSSTTests.TestWriteRead_SST_1CONTINUE_LongASCII_ShortASCII;
begin
  TestWriteRead_SST_General(10);
end;

{ long widestring, then short widestring into CONTINUE record }
procedure TSpreadWriteReadSSTTests.TestWriteRead_SST_1CONTINUE_LongWide_ShortWide;
begin
  TestWriteRead_SST_General(11);
end;

{ very long ASCII string, needing two CONTINUE records }
procedure TSpreadWriteReadSSTTests.TestWriteRead_SST_2CONTINUE_VeryLongASCII;
begin
  TestWriteRead_SST_General(12);
end;

{ very long widestring, needing two CONTINUE records }
procedure TSpreadWriteReadSSTTests.TestWriteRead_SST_2CONTINUE_VeryLongWide;
begin
  TestWriteRead_SST_General(13);
end;

{ three long ASCII strings, needing two CONTINUE records }
procedure TSpreadWriteReadSSTTests.TestWriteRead_SST_2CONTINUE_3LongASCII;
begin
  TestWriteRead_SST_General(14);
end;

{ three long widestrings, needing two CONTINUE records }
procedure TSpreadWriteReadSSTTests.TestWriteRead_SST_2CONTINUE_3LongWide;
begin
  TestWriteRead_SST_General(15);
end;

{ Writes/reads one ASCII string only. The string fits in the SST record.
  Uses rich-text formatting toggling font every second character. }
procedure TSpreadWriteReadSSTTests.TestWriteRead_SST_1ASCII_RichText;
begin
  TestWriteRead_SST_General(16);
end;

{ Writes/reads one wide string only. The string fits in the SST record.
  Uses rich-text formatting toggling font every second character. }
procedure TSpreadWriteReadSSTTests.TestWriteRead_SST_1Wide_RichText;
begin
  TestWriteRead_SST_General(17);
end;

{ Writes/reads one long ASCII string which reaches beyond SST into CONTINUE.
  Uses short rich-text formatting staying within this CONTINUE record. }
procedure TSpreadWriteReadSSTTests.TestWriteRead_SST_CONTINUE_LongASCII_ShortRichText;
begin
  TestWriteRead_SST_General(18);
end;

{ Writes/reads one long wide string which reaches beyond SST into CONTINUE.
Uses short rich-text formatting staying within this CONTINUE record. }
procedure TSpreadWriteReadSSTTests.TestWriteRead_SST_CONTINUE_LongWide_ShortRichText;
begin
  TestWriteRead_SST_General(19);
end;

{ Writes/reads one short ASCII string with rich-text formatting. The string
  stay within SST, but rich-text parameters reach into CONTINUE record. }
procedure TSpreadWriteReadSSTTests.TestWriteRead_SST_CONTINUE_ShortASCII_LongRichText;
begin
  TestWriteRead_SST_General(20);
end;

{ Writes/reads one long widestring with rich-text formatting. The string
  stay within SST, but rich-text parameters reach into CONTINUE record. }
procedure TSpreadWriteReadSSTTests.TestWriteRead_SST_CONTINUE_ShortWide_LongRichText;
begin
  TestWriteRead_SST_General(21);
end;

{ long ASCII string with rich-text formatting. The string stays within SST
  but long rich-text parameters flow into 2 CONTINUE records. }
procedure TSpreadWriteReadSSTTests.TestWriteRead_SST_2CONTINUE_ASCII_LongRichText;
begin
  TestWriteRead_SST_General(22);
end;

{ long widestring with rich-text formatting. The string stays within SST
  but long rich-text parameters flow into 2 CONTINUE records. }
procedure TSpreadWriteReadSSTTests.TestWriteRead_SST_2CONTINUE_Wide_LongRichText;
begin
  TestWriteRead_SST_General(23);
end;


initialization
  RegisterTest(TSpreadWriteReadSSTTests);

end.