fpspreadsheet: Add test cases for cell comments. Fix some bugs related to comments.

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3937 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2015-02-08 18:26:47 +00:00
parent 8dc16503cd
commit 47cb730370
6 changed files with 315 additions and 8 deletions

View File

@ -3460,6 +3460,10 @@ begin
'<table:table-cell table:style-name="ce%d" %s>', [ACell^.FormatIndex, spannedStr]),
comment,
'</table:table-cell>')
else
if comment <> '' then
AppendToStream(AStream,
'<table:table-cell ' + spannedStr + '>' + comment + '</table:table-cell>')
else
AppendToStream(AStream,
'<table:table-cell ' + spannedStr + '/>');
@ -4049,10 +4053,15 @@ begin
formula, valuetype, value, lStyle, spannedStr
]))
else
begin
AppendToStream(AStream, Format(
'<table:table-cell table:formula="=%s" %s %s/>', [
formula, lStyle, spannedStr
]));
'<table:table-cell table:formula="=%s" %s %s', [
formula, lStyle, spannedStr]));
if comment <> '' then
AppendToStream(AStream, '>' + comment + '</table:table-cell>')
else
AppendToStream(AStream, '/>');
end;
end;

View File

@ -0,0 +1,290 @@
unit commenttests;
{$mode objfpc}{$H+}
interface
{ Color tests
This unit tests writing out to and reading back from files.
}
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, xlsbiff2, xlsbiff5, xlsbiff8 {and a project requirement for lclbase for utf8 handling},
testsutility;
type
{ TSpreadWriteReadCommemtTests }
//Write to xls/xml file and read back
TSpreadWriteReadCommentTests = class(TTestCase)
private
protected
// Set up expected values:
procedure SetUp; override;
procedure TearDown; override;
procedure TestWriteRead_Comment(AFormat: TsSpreadsheetFormat;
const ACommentText: String);
published
// Writes out comments & reads back.
{ BIFF2 comment tests }
procedure TestWriteRead_BIFF2_Standard_Comment;
procedure TestWriteRead_BIFF2_NonAscii_Comment;
procedure TestWriteRead_BIFF2_NonXMLChar_Comment;
procedure TestWriteRead_BIFF2_VeryLong_Standard_Comment;
procedure TestWriteRead_BIFF2_VeryLong_NonAscii_Comment;
{ BIFF5 comment tests }
procedure TestWriteRead_BIFF5_Standard_Comment;
procedure TestWriteRead_BIFF5_NonAscii_Comment;
procedure TestWriteRead_BIFF5_NonXMLChar_Comment;
procedure TestWriteRead_BIFF5_VeryLong_Standard_Comment;
procedure TestWriteRead_BIFF5_VeryLong_NonAscii_Comment;
{ BIFF8 comment tests }
// writing is currently not supported
//procedure TestWriteRead_BIFF8_Standard_Comment;
//procedure TestWriteRead_BIFF8_NonAscii_Comment;
//procedure TestWriteRead_BIFF8_NonXMLChar_Comment;
{ OpenDocument comment tests }
procedure TestWriteRead_ODS_Standard_Comment;
procedure TestWriteRead_ODS_NonAscii_Comment;
procedure TestWriteRead_ODS_NonXMLChar_Comment;
procedure TestWriteRead_ODS_VeryLong_Comment;
{ OOXML comment tests }
procedure TestWriteRead_OOXML_Standard_Comment;
procedure TestWriteRead_OOXML_NonAscii_Comment;
procedure TestWriteRead_OOXML_NonXMLChar_Comment;
procedure TestWriteRead_OOXML_VeryLong_Comment;
end;
implementation
const
CommentSheet = 'Comments';
STANDARD_COMMENT = 'This is a comment';
COMMENT_UTF8 = 'Comment with non-standard characters: ÄÖÜß café au lait'; // водка wódka';
COMMENT_XML = 'Comment with characters not allowed by XML: <, >';
var
VERY_LONG_COMMENT: String;
VERY_LONG_NONASCII_COMMENT: String;
{ TSpreadWriteReadCommentTests }
procedure TSpreadWriteReadCommentTests.SetUp;
var
i: Integer;
begin
inherited SetUp;
// In BIFF2-5, comments longer than 2048 characters are split into several
// NOTE records.
VERY_LONG_COMMENT := '';
repeat
VERY_LONG_COMMENT := VERY_LONG_COMMENT + '1234567890 ';
until Length(VERY_LONG_COMMENT) > 3000;
VERY_LONG_NONASCII_COMMENT := '';
repeat
VERY_LONG_NONASCII_COMMENT := VERY_LONG_NONASCII_COMMENT + 'ÄÖÜäöü ';
until Length(VERY_LONG_NONASCII_COMMENT) > 3000;
end;
procedure TSpreadWriteReadCommentTests.TearDown;
begin
inherited TearDown;
end;
procedure TSpreadWriteReadCommentTests.TestWriteRead_Comment(
AFormat: TsSpreadsheetFormat; const ACommentText: String);
var
MyWorksheet: TsWorksheet;
MyWorkbook: TsWorkbook;
row, col, lastCol: Integer;
expected, actual: String;
MyCell: PCell;
TempFile: string; //write xls/xml to this file and read back from it
begin
TempFile := GetTempFileName;
MyWorkbook := TsWorkbook.Create;
try
MyWorkSheet:= MyWorkBook.AddWorksheet(CommentSheet);
// Comment in empty cell
row := 0;
col := 0;
Myworksheet.WriteComment(row, col, ACommentText);
// Comment in label cell
col := 1;
MyWorksheet.WriteUTF8Text(row, col, 'Cell with comment');
Myworksheet.WriteComment(row, col, ACommentText);
// Comment in number cell
col := 2;
MyWorksheet.WriteNumber(row, col, 123.456);
Myworksheet.WriteComment(row, col, ACommentText);
// Comment in formula cell
col := 3;
Myworksheet.WriteFormula(row, col, '1+1');
Myworksheet.WriteComment(row, col, ACommentText);
// Comment in boolean cell
col := 4;
MyWorksheet.WriteBoolValue(row, col, true);
Myworksheet.WriteComment(row, col, ACommentText);
// Comment in error cell
// Error cell must be the last cell because ODS does not support error cell
// and the test is to be omitted.
col := 5;
Myworksheet.WriteErrorValue(row, col, errWrongType);
Myworksheet.WriteComment(row, col, ACommentText);
MyWorkBook.WriteToFile(TempFile, AFormat, true);
finally
MyWorkbook.Free;
end;
// Open the spreadsheet
MyWorkbook := TsWorkbook.Create;
try
MyWorkbook.ReadFromFile(TempFile, AFormat);
if AFormat = sfExcel2 then
MyWorksheet := MyWorkbook.GetFirstWorksheet
else
MyWorksheet := GetWorksheetByName(MyWorkBook, CommentSheet);
if MyWorksheet=nil then
fail('Error in test code. Failed to get named worksheet');
row := 0;
lastCol := MyWorksheet.GetLastColIndex;
if AFormat = sfOpenDocument then dec(lastCol); // No error cells supported in ODS --> skip the last test which is for error cells
for col := 0 to lastCol do
begin
MyCell := MyWorksheet.FindCell(row, col);
if MyCell = nil then
fail('Failure to find cell ' + CellNotation(MyWorksheet, row, col));
actual := MyWorksheet.ReadComment(MyCell);
expected := ACommentText;
CheckEquals(expected, actual,
'Test saved comment mismatch, cell '+CellNotation(MyWorksheet, row, col));
end;
finally
MyWorkbook.Free;
DeleteFile(TempFile);
end;
end;
{ Tests for BIFF2 file format }
procedure TSpreadWriteReadCommentTests.TestWriteRead_BIFF2_Standard_Comment;
begin
TestWriteRead_Comment(sfExcel2, STANDARD_COMMENT);
end;
procedure TSpreadWriteReadCommentTests.TestWriteRead_BIFF2_NonAscii_Comment;
begin
TestWriteRead_Comment(sfExcel2, COMMENT_UTF8);
end;
procedure TSpreadWriteReadCommentTests.TestWriteRead_BIFF2_NonXMLChar_Comment;
begin
TestWriteRead_Comment(sfExcel2, COMMENT_XML);
end;
procedure TSpreadWriteReadCommentTests.TestWriteRead_BIFF2_VeryLong_Standard_Comment;
begin
TestWriteRead_Comment(sfExcel2, VERY_LONG_COMMENT);
end;
procedure TSpreadWriteReadCommentTests.TestWriteRead_BIFF2_VeryLong_NonAscii_Comment;
begin
TestWriteRead_Comment(sfExcel2, VERY_LONG_NONASCII_COMMENT);
end;
{ Tests for BIFF5 file format }
procedure TSpreadWriteReadCommentTests.TestWriteRead_BIFF5_Standard_Comment;
begin
TestWriteRead_Comment(sfExcel5, STANDARD_COMMENT);
end;
procedure TSpreadWriteReadCommentTests.TestWriteRead_BIFF5_NonAscii_Comment;
begin
TestWriteRead_Comment(sfExcel5, COMMENT_UTF8);
end;
procedure TSpreadWriteReadCommentTests.TestWriteRead_BIFF5_NonXMLChar_Comment;
begin
TestWriteRead_Comment(sfExcel5, COMMENT_XML);
end;
procedure TSpreadWriteReadCommentTests.TestWriteRead_BIFF5_VeryLong_Standard_Comment;
begin
TestWriteRead_Comment(sfExcel5, VERY_LONG_COMMENT);
end;
procedure TSpreadWriteReadCommentTests.TestWriteRead_BIFF5_VeryLong_NonAscii_Comment;
begin
TestWriteRead_Comment(sfExcel5, VERY_LONG_NONASCII_COMMENT);
end;
{ Tests for BIFF8 file format }
{ Writing is currently not support --> the test does not make sense! }
{ Tests for Open Document file format }
procedure TSpreadWriteReadCommentTests.TestWriteRead_ODS_Standard_Comment;
begin
TestWriteRead_Comment(sfOpenDocument, STANDARD_COMMENT);
end;
procedure TSpreadWriteReadCommentTests.TestWriteRead_ODS_NonAscii_Comment;
begin
TestWriteRead_Comment(sfOpenDocument, COMMENT_UTF8);
end;
procedure TSpreadWriteReadCommentTests.TestWriteRead_ODS_NonXMLChar_Comment;
begin
TestWriteRead_Comment(sfOpenDocument, COMMENT_XML);
end;
procedure TSpreadWriteReadCommentTests.TestWriteRead_ODS_VeryLong_Comment;
begin
TestWriteRead_Comment(sfOpenDocument, VERY_LONG_COMMENT);
end;
{ Tests for OOXML file format }
procedure TSpreadWriteReadCommentTests.TestWriteRead_OOXML_Standard_Comment;
begin
TestWriteRead_Comment(sfOOXML, STANDARD_COMMENT);
end;
procedure TSpreadWriteReadCommentTests.TestWriteRead_OOXML_NonAscii_Comment;
begin
TestWriteRead_Comment(sfOOXML, COMMENT_UTF8);
end;
procedure TSpreadWriteReadCommentTests.TestWriteRead_OOXML_NonXMLChar_Comment;
begin
TestWriteRead_Comment(sfOOXML, COMMENT_XML);
end;
procedure TSpreadWriteReadCommentTests.TestWriteRead_OOXML_VeryLong_Comment;
begin
TestWriteRead_Comment(sfOOXML, VERY_LONG_COMMENT);
end;
initialization
RegisterTest(TSpreadWriteReadCommentTests);
end.

View File

@ -1450,8 +1450,8 @@ begin
MyWorkbook := TsWorkbook.Create;
try
MyWorksheet:= MyWorkBook.AddWorksheet(SHEETNAME);
for r := 0 to 7 do // change FontSize in each row
for c := 0 to 7 do // change FontColor in each column
for r := 0 to 7 do // each row has a different font size
for c := 0 to 7 do // each column has a different font color
begin
MyWorksheet.WriteNumber(r, c, 123);
MyWorksheet.WriteBackgroundColor(r, c, 0);

View File

@ -40,7 +40,7 @@
<PackageName Value="FCL"/>
</Item4>
</RequiredPackages>
<Units Count="21">
<Units Count="22">
<Unit0>
<Filename Value="spreadtestgui.lpr"/>
<IsPartOfProject Value="True"/>
@ -53,6 +53,7 @@
<Unit2>
<Filename Value="stringtests.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="stringtests"/>
</Unit2>
<Unit3>
<Filename Value="numberstests.pas"/>
@ -69,6 +70,7 @@
<Unit6>
<Filename Value="internaltests.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="internaltests"/>
</Unit6>
<Unit7>
<Filename Value="formattests.pas"/>
@ -130,6 +132,11 @@
<Filename Value="copytests.pas"/>
<IsPartOfProject Value="True"/>
</Unit20>
<Unit21>
<Filename Value="commenttests.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="commenttests"/>
</Unit21>
</Units>
</ProjectOptions>
<CompilerOptions>

View File

@ -12,7 +12,7 @@ uses
manualtests, testsutility, internaltests, formattests, colortests, fonttests,
optiontests, numformatparsertests, formulatests, rpnFormulaUnit,
emptycelltests, errortests, virtualmodetests, insertdeletetests,
celltypetests, sortingtests, copytests;
celltypetests, sortingtests, copytests, commenttests;
begin
{$IFDEF HEAPTRC}

View File

@ -918,6 +918,7 @@ begin
try
List.Text := s; // Fix line endings which are #10 in file
s := Copy(List.Text, 1, Length(List.Text) - Length(LineEnding));
s := ConvertEncoding(s, FCodePage, encodingUTF8);
FWorksheet.WriteComment(r, c, s);
finally
List.Free;
@ -2011,7 +2012,7 @@ begin
// have to be written.
rec.Row := $FFFF; // indicator that this will be a continuation record
rec.Col := 0;
p := CHUNK_SIZE;
p := CHUNK_SIZE + 1;
dec(L, CHUNK_SIZE);
while L > 0 do begin
rec.TextLen := Min(L, CHUNK_SIZE);