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

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

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3449 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2014-08-08 09:02:37 +00:00
parent ac22d2958d
commit 0029891176
6 changed files with 480 additions and 352 deletions
Download Patch File Download Diff File Expand all files Collapse all files

34
components/fpspreadsheet/fpsopendocument.pas
View File

@ -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;
// Look for empty rows with the same style, they need the "number-rows-repeated" element.
// 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(
'<table:table-row table:style-name="%s" %s>' +
'<table:table-cell %s/>' +
'</table:table-row>',
[styleName, rowsRepeatedStr, colsRepeatedStr]));
rowsRepeated := 1;
end
else
// Look for empty rows with the same style, they need the "number-rows-repeated" element.
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;

168
components/fpspreadsheet/tests/errortests.pas Normal file
View File

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

426
components/fpspreadsheet/tests/internaltests.pas
View File

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

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

@ -40,7 +40,7 @@
<PackageName Value="FCL"/>
</Item4>
</RequiredPackages>
<Units Count="15">
<Units Count="17">
<Unit0>
<Filename Value="spreadtestgui.lpr"/>
<IsPartOfProject Value="True"/>
@ -48,10 +48,12 @@
<Unit1>
<Filename Value="datetests.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="datetests"/>
</Unit1>
<Unit2>
<Filename Value="stringtests.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="stringtests"/>
</Unit2>
<Unit3>
<Filename Value="numberstests.pas"/>
@ -61,14 +63,17 @@
<Unit4>
<Filename Value="manualtests.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="manualtests"/>
</Unit4>
<Unit5>
<Filename Value="testsutility.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="testsutility"/>
</Unit5>
<Unit6>
<Filename Value="internaltests.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="internaltests"/>
</Unit6>
<Unit7>
<Filename Value="formattests.pas"/>
@ -86,6 +91,7 @@
<Unit10>
<Filename Value="optiontests.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="optiontests"/>
</Unit10>
<Unit11>
<Filename Value="numformatparsertests.pas"/>
@ -94,15 +100,28 @@
<Unit12>
<Filename Value="rpnformulaunit.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="rpnFormulaUnit"/>
</Unit12>
<Unit13>
<Filename Value="formulatests.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="formulatests"/>
</Unit13>
<Unit14>
<Filename Value="emptycelltests.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="emptycelltests"/>
</Unit14>
<Unit15>
<Filename Value="errortests.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="errortests"/>
</Unit15>
<Unit16>
<Filename Value="virtualmodetests.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="virtualmodetests"/>
</Unit16>
</Units>
</ProjectOptions>
<CompilerOptions>

2
components/fpspreadsheet/tests/spreadtestgui.lpr
View File

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

181
components/fpspreadsheet/tests/virtualmodetests.pas Normal file
View File

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