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.
+