From 0029891176e01393ae3d7761d797713e3206b5f2 Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Fri, 8 Aug 2014 09:02:37 +0000 Subject: [PATCH] fpspreadsheet: Fix ODS writer beginning to write rows/columns at first used row/column instead of 0. ODS error message test active now. Separate errortests and virtualmodetests from internaltests. All tests passed (Win32, Laz trunk, fpc 2.6.4). git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3449 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- components/fpspreadsheet/fpsopendocument.pas | 34 +- components/fpspreadsheet/tests/errortests.pas | 168 +++++++ .../fpspreadsheet/tests/internaltests.pas | 426 ++++-------------- .../fpspreadsheet/tests/spreadtestgui.lpi | 21 +- .../fpspreadsheet/tests/spreadtestgui.lpr | 2 +- .../fpspreadsheet/tests/virtualmodetests.pas | 181 ++++++++ 6 files changed, 480 insertions(+), 352 deletions(-) create mode 100644 components/fpspreadsheet/tests/errortests.pas create mode 100644 components/fpspreadsheet/tests/virtualmodetests.pas diff --git a/components/fpspreadsheet/fpsopendocument.pas b/components/fpspreadsheet/fpsopendocument.pas index 08a50b940..b7055fe75 100755 --- a/components/fpspreadsheet/fpsopendocument.pas +++ b/components/fpspreadsheet/fpsopendocument.pas @@ -2932,17 +2932,25 @@ var rowsRepeated: Integer; colsRepeatedStr: String; rowsRepeatedStr: String; - lastCol, lastRow: Cardinal; + firstCol, firstRow, lastCol, lastRow: Cardinal; rowStyleData: TRowStyleData; defFontSize: Single; + emptyRowsAbove: Boolean; begin // some abbreviations... + defFontSize := Workbook.GetFont(0).Size; + firstCol := ASheet.GetFirstColIndex; + firstRow := ASheet.GetFirstRowIndex; lastCol := ASheet.GetLastColIndex; lastRow := ASheet.GetLastRowIndex; - defFontSize := Workbook.GetFont(0).Size; + // avoid arithmetic overflow in case of empty worksheet + if (firstCol = $FFFFFFFF) and (lastCol = 0) then firstCol := 0; + if (FirstRow = $FFFFFFFF) and (lastRow = 0) then firstRow := 0; + emptyRowsAbove := firstRow > 0; // Now loop through all rows - r := 0; +// r := 0; + r := firstRow; while (r <= lastRow) do begin // Look for the row style of the current row (r) row := ASheet.FindRow(r); @@ -2965,8 +2973,23 @@ begin raise Exception.Create('Row style not found.'); end; + // Take care of empty rows above the first row + if (r = firstRow) and emptyRowsAbove then begin + rowsRepeated := r; + rowsRepeatedStr := IfThen(rowsRepeated = 1, '', + Format('table:number-rows-repeated="%d"', [rowsRepeated])); + colsRepeated := lastCol + 1; + colsRepeatedStr := IfThen(colsRepeated = 1, '', + Format('table:number-columns-repeated="%d"', [colsRepeated])); + AppendToStream(AStream, Format( + '' + + '' + + '', + [styleName, rowsRepeatedStr, colsRepeatedStr])); + rowsRepeated := 1; + end + else // Look for empty rows with the same style, they need the "number-rows-repeated" element. - rowsRepeated := 1; if (ASheet.GetFirstCellOfRow(r) = nil) then begin rr := r + 1; while (rr <= lastRow) do begin @@ -2981,7 +3004,7 @@ begin rowsRepeated := rr - r; rowsRepeatedStr := IfThen(rowsRepeated = 1, '', Format('table:number-rows-repeated="%d"', [rowsRepeated])); - colsRepeated := lastCol+1; + colsRepeated := lastCol - firstCol + 1; colsRepeatedStr := IfThen(colsRepeated = 1, '', Format('table:number-columns-repeated="%d"', [colsRepeated])); @@ -3030,6 +3053,7 @@ begin // Next row inc(r, rowsRepeated); + rowsRepeated := 1; end; end; diff --git a/components/fpspreadsheet/tests/errortests.pas b/components/fpspreadsheet/tests/errortests.pas new file mode 100644 index 000000000..2e5840251 --- /dev/null +++ b/components/fpspreadsheet/tests/errortests.pas @@ -0,0 +1,168 @@ +unit errortests; + +{$mode objfpc}{$H+} + +{ Tests for error logging by readers / writers } + +interface + +uses + // Not using lazarus package as the user may be working with multiple versions + // Instead, add .. to unit search path + Classes, SysUtils, fpcunit, testutils, testregistry, + fpsallformats, fpspreadsheet {and a project requirement for lclbase for utf8 handling}, + fpsutils, testsutility; + +type + { TSpreadErrorTests } + + TSpreadErrorTests= class(TTestCase) + protected + // Set up expected values: + procedure SetUp; override; + procedure TearDown; override; + procedure TestWriteErrorMessages(AFormat: TsSpreadsheetFormat); + + published + // Tests collection of error messages during writing + procedure TestWriteErrorMessages_BIFF2; + procedure TestWriteErrorMessages_BIFF5; + procedure TestWriteErrorMessages_BIFF8; + procedure TestWriteErrorMessages_ODS; + procedure TestWriteErrorMessages_OOXML; + + end; + +implementation + +uses + StrUtils; + +const + ERROR_SHEET = 'ErrorTest'; //worksheet name + +procedure TSpreadErrorTests.SetUp; +begin +end; + +procedure TSpreadErrorTests.TearDown; +begin +end; + +procedure TSpreadErrorTests.TestWriteErrorMessages(AFormat: TsSpreadsheetFormat); +type + TTestFormat = (sfExcel2, sfExcel5, sfExcel8, sfOOXML, sfOpenDocument); +const + MAX_ROW_COUNT: array[TTestFormat] of Cardinal = (65536, 65536, 65536, 1048576, 1048576); + MAX_COL_COUNT: array[TTestFormat] of Cardinal = (256, 256, 256, 16384, 1024); + MAX_CELL_LEN: array[TTestFormat] of Cardinal = (255, 255, 32767, cardinal(-1), Cardinal(-1)); +var + MyWorkbook: TsWorkbook; + MyWorksheet: TsWorksheet; + row, col: Cardinal; + row1, row2: Cardinal; + col1, col2: Cardinal; + s: String; + TempFile: String; + ErrList: TStringList; +begin + ErrList := TStringList.Create; + try + // Test 1: Too many rows + MyWorkbook := TsWorkbook.Create; + try + MyWorkSheet:= MyWorkBook.AddWorksheet(ERROR_SHEET); + row1 := MAX_ROW_COUNT[TTestFormat(AFormat)] - 5; + row2 := MAX_ROW_COUNT[TTestFormat(AFormat)] + 5; + for row :=row1 to row2 do begin + MyWorksheet.WriteBlank(row, 0); + MyWorksheet.WriteNumber(row, 1, 1.0); + MyWorksheet.WriteUTF8Text(row, 2, 'A'); + MyWorksheet.WriteRPNFormula(row, 3, CreateRPNFormula( + RPNCellValue('A1', nil))); + end; + TempFile:=NewTempFile; + MyWorkBook.WriteToFile(TempFile, AFormat, true); + ErrList.Text := MyWorkbook.ErrorMsg; + CheckEquals(1, ErrList.Count, 'Error count mismatch in test 1'); + finally + MyWorkbook.Free; + DeleteFile(TempFile); + end; + + // Test 2: Too many columns + MyWorkbook := TsWorkbook.Create; + try + MyWorkSheet:= MyWorkBook.AddWorksheet(ERROR_SHEET); + col1 := MAX_COL_COUNT[TTestFormat(AFormat)] - 5; + col2 := MAX_COL_COUNT[TTestFormat(AFormat)] + 5; + for col := col1 to col2 do begin + MyWorksheet.WriteBlank(row, 0); + MyWorksheet.WriteNumber(row, 1, 1.0); + MyWorksheet.WriteUTF8Text(row, 2, 'A'); + MyWorksheet.WriteRPNFormula(row, 3, CreateRPNFormula( + RPNCellValue('A1', nil))); + end; + TempFile:=NewTempFile; + MyWorkBook.WriteToFile(TempFile, AFormat, true); + ErrList.Text := MyWorkbook.ErrorMsg; + CheckEquals(1, ErrList.Count, 'Error count mismatch in test 2'); + finally + MyWorkbook.Free; + DeleteFile(TempFile); + end; + + // Test 3: Too long cell label + if MAX_CELL_LEN[TTestFormat(AFormat)] <> Cardinal(-1) then begin + s := DupeString('A', MAX_CELL_LEN[TTestFormat(AFormat)] + 10); + MyWorkbook := TsWorkbook.Create; + try + MyWorkSheet:= MyWorkBook.AddWorksheet(ERROR_SHEET); + MyWorksheet.WriteUTF8Text(0, 0, s); + TempFile:=NewTempFile; + MyWorkBook.WriteToFile(TempFile, AFormat, true); + ErrList.Text := MyWorkbook.ErrorMsg; + CheckEquals(1, ErrList.Count, 'Error count mismatch in test 3'); + finally + MyWorkbook.Free; + DeleteFile(TempFile); + end; + end; + + finally + ErrList.Free; + end; +end; + +procedure TSpreadErrorTests.TestWriteErrorMessages_BIFF2; +begin + TestWriteErrorMessages(sfExcel2); +end; + +procedure TSpreadErrorTests.TestWriteErrorMessages_BIFF5; +begin + TestWriteErrorMessages(sfExcel5); +end; + +procedure TSpreadErrorTests.TestWriteErrorMessages_BIFF8; +begin + TestWriteErrorMessages(sfExcel8); +end; + +procedure TSpreadErrorTests.TestWriteErrorMessages_ODS; +begin + TestWriteErrorMessages(sfOpenDocument); +end; + +procedure TSpreadErrorTests.TestWriteErrorMessages_OOXML; +begin + TestWriteErrorMessages(sfOOXML); +end; + + +initialization + // Register so these tests are included in a full run + RegisterTest(TSpreadErrorTests); + +end. + diff --git a/components/fpspreadsheet/tests/internaltests.pas b/components/fpspreadsheet/tests/internaltests.pas index fdec62d7f..ad55d1e35 100644 --- a/components/fpspreadsheet/tests/internaltests.pas +++ b/components/fpspreadsheet/tests/internaltests.pas @@ -1,7 +1,5 @@ unit internaltests; -{$DEFINE SKIP_TestWriteErrorMessages_ODS} - { Other units test file read/write capability. This unit tests functions, procedures and properties that fpspreadsheet provides. } @@ -29,15 +27,10 @@ type { TSpreadInternalTests } TSpreadInternalTests= class(TTestCase) - private - procedure WriteVirtualCellDataHandler(Sender: TObject; ARow, ACol: Cardinal; - var AValue:Variant; var AStyleCell: PCell); protected // Set up expected values: procedure SetUp; override; procedure TearDown; override; - procedure TestWriteErrorMessages(AFormat: TsSpreadsheetFormat); - procedure TestVirtualMode(AFormat: TsSpreadsheetFormat; ABufStreamMode: Boolean); published // Tests getting Excel style A1 cell locations from row/column based locations. @@ -53,37 +46,13 @@ type procedure OverwriteExistingFile; // Write out date cell and try to read as UTF8; verify if contents the same procedure ReadDateAsUTF8; - // Test buffered stream procedure TestReadBufStream; procedure TestWriteBufStream; - - // Tests collection of error messages during writing - procedure TestWriteErrorMessages_BIFF2; - procedure TestWriteErrorMessages_BIFF5; - procedure TestWriteErrorMessages_BIFF8; - procedure TestWriteErrorMessages_ODS; - procedure TestWriteErrorMessages_OOXML; - - // Virtual mode tests for all file formats - procedure TestVirtualMode_BIFF2; - procedure TestVirtualMode_BIFF5; - procedure TestVirtualMode_BIFF8; - procedure TestVirtualMode_ODS; - procedure TestVirtualMode_OOXML; - - procedure TestVirtualMode_BIFF2_BufStream; - procedure TestVirtualMode_BIFF5_BufStream; - procedure TestVirtualMode_BIFF8_BufStream; - procedure TestVirtualMode_ODS_BufStream; - procedure TestVirtualMode_OOXML_BufStream; end; implementation -uses - StrUtils, numberstests, stringtests; - const InternalSheet = 'Internal'; //worksheet name @@ -195,203 +164,6 @@ begin end; end; -procedure TSpreadInternalTests.TestWriteBufStream; -const - BUFSIZE = 1024; -var - stream: TBufStream; - readBuf, writeBuf1, writeBuf2: array of byte; - nRead, nWrite1, nWrite2: Integer; - i: Integer; -begin - stream := TBufStream.Create(BUFSIZE); - try - // Write 100 random bytes. They fit into the BUFSIZE of the memory buffer - nWrite1 := 100; - SetLength(writeBuf1, nWrite1); - for i:=0 to nWrite1-1 do writeBuf1[i] := Random(255); - stream.WriteBuffer(writeBuf1[0], nWrite1); - - // Check stream size - must be equal to nWrite - CheckEquals(nWrite1, stream.Size, 'Stream size mismatch (#1)'); - - // Check stream position must be equal to nWrite - CheckEquals(nWrite1, stream.Position, 'Stream position mismatch (#2)'); - - // Bring stream pointer back to start - stream.Position := 0; - CheckEquals(0, stream.Position, 'Stream position mismatch (#3)'); - - // Read the first 10 bytes just written and compare - nRead := 10; - SetLength(readBuf, nRead); - nRead := stream.Read(readBuf[0], nRead); - CheckEquals(10, nRead, 'Read/write size mismatch (#4)'); - for i:=0 to 9 do - CheckEquals(writeBuf1[i], readBuf[i], Format('Read/write mismatch at position %d (#5)', [i])); - - // Back to start, and read the entire stream - stream.Position := 0; - nRead := stream.Size; - Setlength(readBuf, nRead); - nRead := stream.Read(readBuf[0], stream.Size); - CheckEquals(nWrite1, nRead, 'Stream read size mismatch (#6)'); - for i:=0 to nWrite1-1 do - CheckEquals(writeBuf1[i], readBuf[i], Format('Read/write mismatch at position %d (#7)', [i])); - - // Now put stream pointer to end and write another 2000 bytes. This crosses - // the size of the memory buffer, and the stream must swap to file. - stream.Seek(0, soFromEnd); - CheckEquals(stream.Size, stream.Position, 'Stream position not at end (#8)'); - - nWrite2 := 2000; - SetLength(writeBuf2, nWrite2); - for i:=0 to nWrite2-1 do writeBuf2[i] := Random(255); - stream.WriteBuffer(writeBuf2[0], nWrite2); - - // The stream pointer must be at 100+2000, same for the size - CheckEquals(nWrite1+nWrite2, stream.Position, 'Stream position mismatch (#9)'); - CheckEquals(nWrite1+nWrite2, stream.Size, 'Stream size mismatch (#10)'); - - // Read the last 10 bytes and compare - Stream.Seek(10, soFromEnd); - SetLength(readBuf, 10); - Stream.ReadBuffer(readBuf[0], 10); - for i:=0 to 9 do - CheckEquals(writeBuf2[nWrite2-10+i], readBuf[i], Format('Read/write mismatch at position %d from end (#11)', [i])); - - // Now read all from beginning - Stream.Position := 0; - SetLength(readBuf, stream.Size); - nRead := Stream.Read(readBuf[0], stream.Size); - CheckEquals(nWrite1+nWrite2, nRead, 'Read/write size mismatch (#4)'); - for i:=0 to nRead-1 do - if i < nWrite1 then - CheckEquals(writeBuf1[i], readBuf[i], Format('Read/write mismatch at position %d (#11)', [i])) - else - CheckEquals(writeBuf2[i-nWrite1], readBuf[i], Format('Read/write mismatch at position %d (#11)', [i])); - - finally - stream.Free; - end; -end; - -procedure TSpreadInternalTests.TestWriteErrorMessages(AFormat: TsSpreadsheetFormat); -type - TTestFormat = (sfExcel2, sfExcel5, sfExcel8, sfOOXML, sfOpenDocument); -const - MAX_ROW_COUNT: array[TTestFormat] of Cardinal = (65536, 65536, 65536, 1048576, 1048576); - MAX_COL_COUNT: array[TTestFormat] of Cardinal = (256, 256, 256, 16384, 1024); - MAX_CELL_LEN: array[TTestFormat] of Cardinal = (255, 255, 32767, cardinal(-1), Cardinal(-1)); -var - MyWorkbook: TsWorkbook; - MyWorksheet: TsWorksheet; - row, col: Cardinal; - row1, row2: Cardinal; - col1, col2: Cardinal; - s: String; - TempFile: String; - ErrList: TStringList; -begin - ErrList := TStringList.Create; - try - // Test 1: Too many rows - MyWorkbook := TsWorkbook.Create; - try - MyWorkSheet:= MyWorkBook.AddWorksheet('Test'); - row1 := MAX_ROW_COUNT[TTestFormat(AFormat)] - 5; - row2 := MAX_ROW_COUNT[TTestFormat(AFormat)] + 5; - for row :=row1 to row2 do begin - MyWorksheet.WriteBlank(row, 0); - MyWorksheet.WriteNumber(row, 1, 1.0); - MyWorksheet.WriteUTF8Text(row, 2, 'A'); - MyWorksheet.WriteRPNFormula(row, 3, CreateRPNFormula( - RPNCellValue('A1', nil))); - end; - TempFile:=NewTempFile; - MyWorkBook.WriteToFile(TempFile, AFormat, true); - ErrList.Text := MyWorkbook.ErrorMsg; - CheckEquals(1, ErrList.Count, 'Error count mismatch in test 1'); - finally - MyWorkbook.Free; - DeleteFile(TempFile); - end; - - // Test 2: Too many columns - MyWorkbook := TsWorkbook.Create; - try - MyWorkSheet:= MyWorkBook.AddWorksheet('Test'); - col1 := MAX_COL_COUNT[TTestFormat(AFormat)] - 5; - col2 := MAX_COL_COUNT[TTestFormat(AFormat)] + 5; - for col := col1 to col2 do begin - MyWorksheet.WriteBlank(row, 0); - MyWorksheet.WriteNumber(row, 1, 1.0); - MyWorksheet.WriteUTF8Text(row, 2, 'A'); - MyWorksheet.WriteRPNFormula(row, 3, CreateRPNFormula( - RPNCellValue('A1', nil))); - end; - TempFile:=NewTempFile; - MyWorkBook.WriteToFile(TempFile, AFormat, true); - ErrList.Text := MyWorkbook.ErrorMsg; - CheckEquals(1, ErrList.Count, 'Error count mismatch in test 2'); - finally - MyWorkbook.Free; - DeleteFile(TempFile); - end; - - // Test 3: Too long cell label - if MAX_CELL_LEN[TTestFormat(AFormat)] <> Cardinal(-1) then begin - s := DupeString('A', MAX_CELL_LEN[TTestFormat(AFormat)] + 10); - MyWorkbook := TsWorkbook.Create; - try - MyWorkSheet:= MyWorkBook.AddWorksheet('Test'); - MyWorksheet.WriteUTF8Text(0, 0, s); - TempFile:=NewTempFile; - MyWorkBook.WriteToFile(TempFile, AFormat, true); - ErrList.Text := MyWorkbook.ErrorMsg; - CheckEquals(1, ErrList.Count, 'Error count mismatch in test 3'); - finally - MyWorkbook.Free; - DeleteFile(TempFile); - end; - end; - - finally - ErrList.Free; - end; -end; - -procedure TSpreadInternalTests.TestWriteErrorMessages_BIFF2; -begin - TestWriteErrorMessages(sfExcel2); -end; - -procedure TSpreadInternalTests.TestWriteErrorMessages_BIFF5; -begin - TestWriteErrorMessages(sfExcel5); -end; - -procedure TSpreadInternalTests.TestWriteErrorMessages_BIFF8; -begin - TestWriteErrorMessages(sfExcel8); -end; - -procedure TSpreadInternalTests.TestWriteErrorMessages_ODS; -begin - {$IFDEF SKIP_TestWriteErrorMessages_ODS} - //Ignore(TestWriteErrorMessages(sfOpenDocument)); - // How to do that? - {$ELSE} - TestWriteErrorMessages(sfOpenDocument); - {$ENDIF} -end; - -procedure TSpreadInternalTests.TestWriteErrorMessages_OOXML; -begin - TestWriteErrorMessages(sfOOXML); -end; - - procedure TSpreadInternalTests.TestReadBufStream; const BUF_SIZE = 1024; @@ -481,6 +253,87 @@ begin end; end; +procedure TSpreadInternalTests.TestWriteBufStream; +const + BUFSIZE = 1024; +var + stream: TBufStream; + readBuf, writeBuf1, writeBuf2: array of byte; + nRead, nWrite1, nWrite2: Integer; + i: Integer; +begin + stream := TBufStream.Create(BUFSIZE); + try + // Write 100 random bytes. They fit into the BUFSIZE of the memory buffer + nWrite1 := 100; + SetLength(writeBuf1, nWrite1); + for i:=0 to nWrite1-1 do writeBuf1[i] := Random(255); + stream.WriteBuffer(writeBuf1[0], nWrite1); + + // Check stream size - must be equal to nWrite + CheckEquals(nWrite1, stream.Size, 'Stream size mismatch (#1)'); + + // Check stream position must be equal to nWrite + CheckEquals(nWrite1, stream.Position, 'Stream position mismatch (#2)'); + + // Bring stream pointer back to start + stream.Position := 0; + CheckEquals(0, stream.Position, 'Stream position mismatch (#3)'); + + // Read the first 10 bytes just written and compare + nRead := 10; + SetLength(readBuf, nRead); + nRead := stream.Read(readBuf[0], nRead); + CheckEquals(10, nRead, 'Read/write size mismatch (#4)'); + for i:=0 to 9 do + CheckEquals(writeBuf1[i], readBuf[i], Format('Read/write mismatch at position %d (#5)', [i])); + + // Back to start, and read the entire stream + stream.Position := 0; + nRead := stream.Size; + Setlength(readBuf, nRead); + nRead := stream.Read(readBuf[0], stream.Size); + CheckEquals(nWrite1, nRead, 'Stream read size mismatch (#6)'); + for i:=0 to nWrite1-1 do + CheckEquals(writeBuf1[i], readBuf[i], Format('Read/write mismatch at position %d (#7)', [i])); + + // Now put stream pointer to end and write another 2000 bytes. This crosses + // the size of the memory buffer, and the stream must swap to file. + stream.Seek(0, soFromEnd); + CheckEquals(stream.Size, stream.Position, 'Stream position not at end (#8)'); + + nWrite2 := 2000; + SetLength(writeBuf2, nWrite2); + for i:=0 to nWrite2-1 do writeBuf2[i] := Random(255); + stream.WriteBuffer(writeBuf2[0], nWrite2); + + // The stream pointer must be at 100+2000, same for the size + CheckEquals(nWrite1+nWrite2, stream.Position, 'Stream position mismatch (#9)'); + CheckEquals(nWrite1+nWrite2, stream.Size, 'Stream size mismatch (#10)'); + + // Read the last 10 bytes and compare + Stream.Seek(10, soFromEnd); + SetLength(readBuf, 10); + Stream.ReadBuffer(readBuf[0], 10); + for i:=0 to 9 do + CheckEquals(writeBuf2[nWrite2-10+i], readBuf[i], Format('Read/write mismatch at position %d from end (#11)', [i])); + + // Now read all from beginning + Stream.Position := 0; + SetLength(readBuf, stream.Size); + nRead := Stream.Read(readBuf[0], stream.Size); + CheckEquals(nWrite1+nWrite2, nRead, 'Read/write size mismatch (#4)'); + for i:=0 to nRead-1 do + if i < nWrite1 then + CheckEquals(writeBuf1[i], readBuf[i], Format('Read/write mismatch at position %d (#11)', [i])) + else + CheckEquals(writeBuf2[i-nWrite1], readBuf[i], Format('Read/write mismatch at position %d (#11)', [i])); + + finally + stream.Free; + end; +end; + procedure TSpreadInternalTests.TestCellString; var r,c: Cardinal; @@ -512,123 +365,6 @@ begin end; -procedure TSpreadInternalTests.WriteVirtualCellDataHandler(Sender: TObject; - ARow, ACol: Cardinal; var AValue:Variant; var AStyleCell: PCell); -begin - // First read the SollNumbers, then the first 4 SollStrings - // See comment in TestVirtualMode(). - if ARow < Length(SollNumbers) then - AValue := SollNumbers[ARow] - else - AValue := SollStrings[ARow - Length(SollNumbers)]; -end; - -procedure TSpreadInternalTests.TestVirtualMode(AFormat: TsSpreadsheetFormat; - ABufStreamMode: Boolean); -var - tempFile: String; - workbook: TsWorkbook; - worksheet: TsWorksheet; - row, col: Integer; - value: Double; - s: String; -begin - try - workbook := TsWorkbook.Create; - try - worksheet := workbook.AddWorksheet('VirtualMode'); - workbook.Options := workbook.Options + [boVirtualMode]; - if ABufStreamMode then - workbook.Options := workbook.Options + [boBufStream]; - workbook.VirtualColCount := 1; - workbook.VirtualRowCount := Length(SollNumbers) + 4; - // We'll use only the first 4 SollStrings, the others cause trouble due to utf8 and formatting. - workbook.OnWriteCellData := @WriteVirtualCellDataHandler; - tempFile:=NewTempFile; - workbook.WriteToFile(tempfile, AFormat, true); - finally - workbook.Free; - end; - - workbook := TsWorkbook.Create; - try - workbook.ReadFromFile(tempFile, AFormat); - worksheet := workbook.GetWorksheetByIndex(0); - col := 0; - CheckEquals(Length(SollNumbers) + 4, worksheet.GetLastRowIndex+1, - 'Row count mismatch'); - for row := 0 to Length(SollNumbers)-1 do - begin - value := worksheet.ReadAsNumber(row, col); - CheckEquals(SollNumbers[row], value, - 'Test number value mismatch, cell '+CellNotation(workSheet, row, col)) - end; - for row := Length(SollNumbers) to worksheet.GetLastRowIndex do - begin - s := worksheet.ReadAsUTF8Text(row, col); - CheckEquals(SollStrings[row - Length(SollNumbers)], s, - 'Test string value mismatch, cell '+CellNotation(workSheet, row, col)); - end; - finally - workbook.Free; - end; - - finally - DeleteFile(tempFile); - end; -end; - -procedure TSpreadInternalTests.TestVirtualMode_BIFF2; -begin - TestVirtualMode(sfExcel2, false); -end; - -procedure TSpreadInternalTests.TestVirtualMode_BIFF5; -begin - TestVirtualMode(sfExcel5, false); -end; - -procedure TSpreadInternalTests.TestVirtualMode_BIFF8; -begin - TestVirtualMode(sfExcel8, false); -end; - -procedure TSpreadInternalTests.TestVirtualMode_ODS; -begin - TestVirtualMode(sfOpenDocument, false); -end; - -procedure TSpreadInternalTests.TestVirtualMode_OOXML; -begin - TestVirtualMode(sfOOXML, false); -end; - -procedure TSpreadInternalTests.TestVirtualMode_BIFF2_BufStream; -begin - TestVirtualMode(sfExcel2, True); -end; - -procedure TSpreadInternalTests.TestVirtualMode_BIFF5_BufStream; -begin - TestVirtualMode(sfExcel5, true); -end; - -procedure TSpreadInternalTests.TestVirtualMode_BIFF8_BufStream; -begin - TestVirtualMode(sfExcel8, true); -end; - -procedure TSpreadInternalTests.TestVirtualMode_ODS_BufStream; -begin - TestVirtualMode(sfOpenDocument, true); -end; - -procedure TSpreadInternalTests.TestVirtualMode_OOXML_BufStream; -begin - TestVirtualMode(sfOOXML, true); -end; - - initialization // Register so these tests are included in a full run RegisterTest(TSpreadInternalTests); diff --git a/components/fpspreadsheet/tests/spreadtestgui.lpi b/components/fpspreadsheet/tests/spreadtestgui.lpi index bd26fe4db..85297ef2b 100644 --- a/components/fpspreadsheet/tests/spreadtestgui.lpi +++ b/components/fpspreadsheet/tests/spreadtestgui.lpi @@ -40,7 +40,7 @@ - + @@ -48,10 +48,12 @@ + + @@ -61,14 +63,17 @@ + + + @@ -86,6 +91,7 @@ + @@ -94,15 +100,28 @@ + + + + + + + + + + + + + diff --git a/components/fpspreadsheet/tests/spreadtestgui.lpr b/components/fpspreadsheet/tests/spreadtestgui.lpr index 3b139c9b2..578b3935d 100644 --- a/components/fpspreadsheet/tests/spreadtestgui.lpr +++ b/components/fpspreadsheet/tests/spreadtestgui.lpr @@ -11,7 +11,7 @@ uses Interfaces, Forms, GuiTestRunner, datetests, stringtests, numberstests, manualtests, testsutility, internaltests, formattests, colortests, fonttests, optiontests, numformatparsertests, formulatests, rpnFormulaUnit, - emptycelltests; + emptycelltests, errortests, virtualmodetests; begin {$IFDEF HEAPTRC} diff --git a/components/fpspreadsheet/tests/virtualmodetests.pas b/components/fpspreadsheet/tests/virtualmodetests.pas new file mode 100644 index 000000000..1016dfd7a --- /dev/null +++ b/components/fpspreadsheet/tests/virtualmodetests.pas @@ -0,0 +1,181 @@ +unit virtualmodetests; +{ Tests for VirtualMode } + +{$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, testutils, testregistry, + fpsallformats, fpspreadsheet, xlsbiff8 {and a project requirement for lclbase for utf8 handling}, + fpsutils, testsutility; + +type + { TSpreadVirtualModeTests } + + TSpreadVirtualModeTests= class(TTestCase) + private + procedure WriteVirtualCellDataHandler(Sender: TObject; ARow, ACol: Cardinal; + var AValue:Variant; var AStyleCell: PCell); + protected + // Set up expected values: + procedure SetUp; override; + procedure TearDown; override; + procedure TestWriteVirtualMode(AFormat: TsSpreadsheetFormat; ABufStreamMode: Boolean); + + published + // Virtual mode tests for all file formats + procedure TestWriteVirtualMode_BIFF2; + procedure TestWriteVirtualMode_BIFF5; + procedure TestWriteVirtualMode_BIFF8; + procedure TestWriteVirtualMode_ODS; + procedure TestWriteVirtualMode_OOXML; + + procedure TestWriteVirtualMode_BIFF2_BufStream; + procedure TestWriteVirtualMode_BIFF5_BufStream; + procedure TestWriteVirtualMode_BIFF8_BufStream; + procedure TestWriteVirtualMode_ODS_BufStream; + procedure TestWriteVirtualMode_OOXML_BufStream; + end; + +implementation + +uses + numberstests, stringtests; + +const + VIRTUALMODE_SHEET = 'VirtualMode'; //worksheet name + +procedure TSpreadVirtualModeTests.SetUp; +begin +end; + +procedure TSpreadVirtualModeTests.TearDown; +begin +end; + +procedure TSpreadVirtualModeTests.WriteVirtualCellDataHandler(Sender: TObject; + ARow, ACol: Cardinal; var AValue:Variant; var AStyleCell: PCell); +begin + // First read the SollNumbers, then the first 4 SollStrings + // See comment in TestVirtualMode(). + if ARow < Length(SollNumbers) then + AValue := SollNumbers[ARow] + else + AValue := SollStrings[ARow - Length(SollNumbers)]; +end; + +procedure TSpreadVirtualModeTests.TestWriteVirtualMode(AFormat: TsSpreadsheetFormat; + ABufStreamMode: Boolean); +var + tempFile: String; + workbook: TsWorkbook; + worksheet: TsWorksheet; + row, col: Integer; + value: Double; + s: String; +begin + try + workbook := TsWorkbook.Create; + try + worksheet := workbook.AddWorksheet(VIRTUALMODE_SHEET); + workbook.Options := workbook.Options + [boVirtualMode]; + if ABufStreamMode then + workbook.Options := workbook.Options + [boBufStream]; + workbook.VirtualColCount := 1; + workbook.VirtualRowCount := Length(SollNumbers) + 4; + // We'll use only the first 4 SollStrings, the others cause trouble due to utf8 and formatting. + workbook.OnWriteCellData := @WriteVirtualCellDataHandler; + tempFile:=NewTempFile; + workbook.WriteToFile(tempfile, AFormat, true); + finally + workbook.Free; + end; + + workbook := TsWorkbook.Create; + try + workbook.ReadFromFile(tempFile, AFormat); + worksheet := workbook.GetWorksheetByIndex(0); + col := 0; + CheckEquals(Length(SollNumbers) + 4, worksheet.GetLastRowIndex+1, + 'Row count mismatch'); + for row := 0 to Length(SollNumbers)-1 do + begin + value := worksheet.ReadAsNumber(row, col); + CheckEquals(SollNumbers[row], value, + 'Test number value mismatch, cell '+CellNotation(workSheet, row, col)) + end; + for row := Length(SollNumbers) to worksheet.GetLastRowIndex do + begin + s := worksheet.ReadAsUTF8Text(row, col); + CheckEquals(SollStrings[row - Length(SollNumbers)], s, + 'Test string value mismatch, cell '+CellNotation(workSheet, row, col)); + end; + finally + workbook.Free; + end; + + finally + DeleteFile(tempFile); + end; +end; + +procedure TSpreadVirtualModeTests.TestWriteVirtualMode_BIFF2; +begin + TestWriteVirtualMode(sfExcel2, false); +end; + +procedure TSpreadVirtualModeTests.TestWriteVirtualMode_BIFF5; +begin + TestWriteVirtualMode(sfExcel5, false); +end; + +procedure TSpreadVirtualModeTests.TestWriteVirtualMode_BIFF8; +begin + TestWriteVirtualMode(sfExcel8, false); +end; + +procedure TSpreadVirtualModeTests.TestWriteVirtualMode_ODS; +begin + TestWriteVirtualMode(sfOpenDocument, false); +end; + +procedure TSpreadVirtualModeTests.TestWriteVirtualMode_OOXML; +begin + TestWriteVirtualMode(sfOOXML, false); +end; + +procedure TSpreadVirtualModeTests.TestWriteVirtualMode_BIFF2_BufStream; +begin + TestWriteVirtualMode(sfExcel2, True); +end; + +procedure TSpreadVirtualModeTests.TestWriteVirtualMode_BIFF5_BufStream; +begin + TestWriteVirtualMode(sfExcel5, true); +end; + +procedure TSpreadVirtualModeTests.TestWriteVirtualMode_BIFF8_BufStream; +begin + TestWriteVirtualMode(sfExcel8, true); +end; + +procedure TSpreadVirtualModeTests.TestWriteVirtualMode_ODS_BufStream; +begin + TestWriteVirtualMode(sfOpenDocument, true); +end; + +procedure TSpreadVirtualModeTests.TestWriteVirtualMode_OOXML_BufStream; +begin + TestWriteVirtualMode(sfOOXML, true); +end; + + +initialization + // Register so these tests are included in a full run + RegisterTest(TSpreadVirtualModeTests); + +end. +