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

fpspreadsheet: Fix arithmetic overflow in ooxml writer in case of empty worksheet but existing row records. Use try-finally blocks around test cases to make sure that memory is released and temp file is deleted in case of exceptions due to failed tests. Fix memory leak in rpn formula calculation (spreadtestgui, however, still reports a lot of memory leaks).

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3431 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2014-08-05 21:42:34 +00:00
parent d63dd1b715
commit 7e599ebd07
12 changed files with 525 additions and 435 deletions
Download Patch File Download Diff File Expand all files Collapse all files

17
components/fpspreadsheet/fpsfunc.pas
View File

@ -17,6 +17,19 @@ type
TsArgNumberArray = array of double;
TsArgStringArray = array of string;
TsArgument = record
IsMissing: Boolean;
Worksheet: TsWorksheet;
ArgumentType: TsArgumentType;
Cell: PCell;
FirstRow, FirstCol, LastRow, LastCol: Cardinal;
NumberValue: Double;
StringValue: String;
BoolValue: Boolean;
ErrorValue: TsErrorValue;
end;
{
TsArgument = record
IsMissing: Boolean;
Worksheet: TsWorksheet;
@ -28,6 +41,7 @@ type
atBool : (BoolValue: Boolean);
atError : (ErrorValue: TsErrorValue);
end;
}
PsArgument = ^TsArgument;
TsArgumentStack = class(TFPList)
@ -191,6 +205,7 @@ uses
function CreateArgument: TsArgument;
begin
Result.StringValue := '';
FillChar(Result, SizeOf(Result), 0);
end;
@ -419,7 +434,7 @@ var
begin
P := PsArgument(Items[AIndex]);
P^.StringValue := '';
FreeMem(P, SizeOf(P));
FreeMem(P, SizeOf(P^));
inherited Delete(AIndex);
end;

6
components/fpspreadsheet/fpspreadsheet.pas
View File

@ -4540,7 +4540,6 @@ end;
}
procedure TsWorksheet.InsertRow(ARow: Cardinal);
var
cell: PCell;
row: PRow;
cellnode: TAVLTreeNode;
i: Integer;
@ -4817,7 +4816,6 @@ procedure TsWorkbook.GetLastRowColIndex(out ALastRow, ALastCol: Cardinal);
var
i: Integer;
sheet: TsWorksheet;
r1,r2, c1,c2: Cardinal;
begin
if (boVirtualMode in Options) then begin
ALastRow := FVirtualRowCount - 1;
@ -6555,9 +6553,11 @@ end;
}
procedure DisposeRPNItem(AItem: PRPNItem);
begin
if AItem <> nil then
if AItem <> nil then begin
AItem.FE.StringValue := '';;
FreeMem(AItem, SizeOf(TRPNItem));
end;
end;
{@@
Creates a boolean value entry in the RPN array.

14
components/fpspreadsheet/tests/colortests.pas
View File

@ -120,6 +120,7 @@ begin
TempFile:=GetTempFileName;
MyWorkbook := TsWorkbook.Create;
try
MyWorkSheet:= MyWorkBook.AddWorksheet(ColorsSheet);
// Define palette
@ -156,10 +157,13 @@ begin
inc(row);
end;
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
@ -177,10 +181,11 @@ begin
CheckEquals(expectedRGB, currentRGB,
'Test saved background color, cell '+CellNotation(MyWorksheet,Row,Col));
end;
finally
MyWorkbook.Free;
DeleteFile(TempFile);
end;
end;
procedure TSpreadWriteReadColorTests.TestWriteReadFontColors(AFormat: TsSpreadsheetFormat;
WhichPalette: Integer);
@ -204,6 +209,7 @@ begin
TempFile:=GetTempFileName;
MyWorkbook := TsWorkbook.Create;
try
MyWorkSheet:= MyWorkBook.AddWorksheet(ColorsSheet);
// Define palette
@ -241,10 +247,13 @@ begin
inc(row);
end;
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
@ -263,10 +272,11 @@ begin
CheckEquals(expectedRGB, currentRGB,
'Test saved font color, cell '+CellNotation(MyWorksheet,Row,Col));
end;
finally
MyWorkbook.Free;
DeleteFile(TempFile);
end;
end;
{ Tests for BIFF2 file format }
{ BIFF2 supports only a fixed palette, and no background color --> test only

8
components/fpspreadsheet/tests/datetests.pas
View File

@ -389,6 +389,7 @@ begin
}
// Write out all test values
MyWorkbook := TsWorkbook.Create;
try
MyWorkSheet:=MyWorkBook.AddWorksheet(DatesSheet);
for Row := Low(SollDates) to High(SollDates) do
begin
@ -399,10 +400,13 @@ begin
CheckEquals(SollDates[Row],ActualDateTime,'Test date/time value mismatch cell '+CellNotation(MyWorksheet,Row));
end;
MyWorkBook.WriteToFile(TempFile, AFormat, true);
finally
MyWorkbook.Free;
end;
// Open the spreadsheet, as biff8
MyWorkbook := TsWorkbook.Create;
try
MyWorkbook.ReadFromFile(TempFile, AFormat);
if AFormat = sfExcel2 then
MyWorksheet := MyWorkbook.GetFirstWorksheet
@ -418,11 +422,11 @@ begin
Fail('Could not read date time for cell '+CellNotation(MyWorkSheet,Row));
CheckEquals(SollDates[Row],ActualDateTime,'Test date/time value mismatch cell '+CellNotation(MyWorkSheet,Row));
end;
// Finalization
finally
MyWorkbook.Free;
DeleteFile(TempFile);
end;
end;
procedure TSpreadWriteReadDateTests.TestWriteReadDates_BIFF2;
begin

19
components/fpspreadsheet/tests/emptycelltests.pas
View File

@ -155,15 +155,16 @@ var
begin
TempFile := GetTempFileName;
MyWorkbook := TsWorkbook.Create;
MyWorkSheet:= MyWorkBook.AddWorksheet(EmptyCellsSheet);
L := TStringList.Create;
try
L.Delimiter := '|';
L.StrictDelimiter := true;
L.DelimitedText := SollLayoutStrings[ALayout];
MyWorkbook := TsWorkbook.Create;
try
MyWorkSheet:= MyWorkBook.AddWorksheet(EmptyCellsSheet);
// Write out cells
for row := 0 to L.Count-1 do begin
s := L[row];
@ -176,10 +177,13 @@ begin
end;
end;
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
@ -205,12 +209,13 @@ begin
'Test empty cell layout mismatch, cell '+CellNotation(MyWorksheet, Row, Col));
end;
finally
L.Free;
MyWorkbook.Free;
DeleteFile(TempFile);
end;
MyWorkbook.Free;
DeleteFile(TempFile);
finally
L.Free;
end;
end;
{ BIFF2 tests }

14
components/fpspreadsheet/tests/fonttests.pas
View File

@ -143,6 +143,7 @@ begin
DeleteFile(TempFile);
}
MyWorkbook := TsWorkbook.Create;
try
MyWorkSheet:= MyWorkBook.AddWorksheet(FontSheet);
// Write out a cell without "bold" formatting style
@ -167,10 +168,13 @@ begin
TempFile:=NewTempFile;
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 // only 1 sheet for BIFF2
@ -195,10 +199,11 @@ begin
fail('Error in test code. Failed to get cell.');
CheckEquals(uffBold in MyCell^.UsedFormattingFields, true,
'Test saved bold attribute, cell '+CellNotation(MyWorksheet,row,col));
finally
MyWorkbook.Free;
DeleteFile(TempFile);
end;
end;
procedure TSpreadWriteReadFontTests.TestWriteReadFont(AFormat: TsSpreadsheetFormat;
AFontName: String);
@ -220,6 +225,7 @@ begin
DeleteFile(TempFile);
}
MyWorkbook := TsWorkbook.Create;
try
MyWorkSheet:= MyWorkBook.AddWorksheet(FontSheet);
// Write out all font styles at various sizes
@ -245,10 +251,13 @@ begin
end;
TempFile:=NewTempFile;
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 // only 1 sheet for BIFF2
@ -275,10 +284,11 @@ begin
'Test unsaved font style, cell ' + CellNotation(MyWorksheet,0,0));
inc(counter);
end;
finally
MyWorkbook.Free;
DeleteFile(TempFile);
end;
end;
{ BIFF2 }

8
components/fpspreadsheet/tests/numberstests.pas
View File

@ -201,6 +201,7 @@ begin
}
// Write out all test values
MyWorkbook := TsWorkbook.Create;
try
MyWorkSheet := MyWorkBook.AddWorksheet(NumbersSheet);
for Row := Low(SollNumbers) to High(SollNumbers) do
begin
@ -211,10 +212,13 @@ begin
end;
TempFile:=NewTempFile;
MyWorkBook.WriteToFile(TempFile, AFormat, true);
finally
MyWorkbook.Free;
end;
// Open the spreadsheet, as biff8
MyWorkbook := TsWorkbook.Create;
try
MyWorkbook.ReadFromFile(TempFile, AFormat);
if AFormat = sfExcel2 then
MyWorksheet := MyWorkbook.GetFirstWorksheet
@ -229,11 +233,11 @@ begin
ActualNumber:=MyWorkSheet.ReadAsNumber(Row,0);
CheckEquals(SollNumbers[Row],ActualNumber,'Test value mismatch cell '+CellNotation(MyWorkSheet,Row));
end;
// Finalization
finally
MyWorkbook.Free;
DeleteFile(TempFile);
end;
end;
procedure TSpreadWriteReadNumberTests.TestWriteReadNumbers_BIFF2;
begin

14
components/fpspreadsheet/tests/optiontests.pas
View File

@ -116,6 +116,7 @@ begin
// Write out show/hide grid lines/sheet headers
MyWorkbook := TsWorkbook.Create;
try
MyWorkSheet:= MyWorkBook.AddWorksheet(OptionsSheet);
if AShowGridLines then
MyWorksheet.Options := MyWorksheet.Options + [soShowGridLines]
@ -127,10 +128,13 @@ begin
MyWorksheet.Options := MyWorksheet.Options - [soShowHeaders];
MyWorkBook.WriteToFile(TempFile, AFormat, true);
finally
MyWorkbook.Free;
end;
// Read back presence of grid lines/sheet headers
MyWorkbook := TsWorkbook.Create;
try
MyWorkbook.ReadFromFile(TempFile, AFormat);
if AFormat = sfExcel2 then
MyWorksheet := MyWorkbook.GetFirstWorksheet
@ -142,10 +146,11 @@ begin
'Test saved show grid lines mismatch');
CheckEquals(soShowHeaders in MyWorksheet.Options, AShowHeaders,
'Test saved show headers mismatch');
finally
MyWorkbook.Free;
DeleteFile(TempFile);
end;
end;
{ Tests for BIFF2 grid lines and/or headers }
procedure TSpreadWriteReadOptionsTests.TestWriteRead_BIFF2_ShowGridLines_ShowHeaders;
@ -270,15 +275,19 @@ begin
// Write out pane sizes
MyWorkbook := TsWorkbook.Create;
try
MyWorkSheet:= MyWorkBook.AddWorksheet(OptionsSheet);
MyWorksheet.LeftPaneWidth := ALeftPaneWidth;
MyWorksheet.TopPaneHeight := ATopPaneHeight;
MyWorksheet.Options := MyWorksheet.Options + [soHasFrozenPanes];
MyWorkBook.WriteToFile(TempFile, AFormat, true);
finally
MyWorkbook.Free;
end;
// Read back pane sizes
MyWorkbook := TsWorkbook.Create;
try
MyWorkbook.ReadFromFile(TempFile, AFormat);
if AFormat = sfExcel2 then
MyWorksheet := MyWorkbook.GetFirstWorksheet
@ -295,10 +304,11 @@ begin
'Test saved left pane width mismatch');
CheckEquals(ATopPaneHeight, MyWorksheet.TopPaneHeight,
'Test save top pane height mismatch');
finally
MyWorkbook.Free;
DeleteFile(TempFile);
end;
end;
{ Tests for BIFF5 frozen panes }
procedure TSpreadWriteReadOptionsTests.TestWriteRead_BIFF5_Panes_HorVert;

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

@ -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"/>
@ -81,18 +83,22 @@
<Unit8>
<Filename Value="colortests.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="colortests"/>
</Unit8>
<Unit9>
<Filename Value="fonttests.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="fonttests"/>
</Unit9>
<Unit10>
<Filename Value="optiontests.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="optiontests"/>
</Unit10>
<Unit11>
<Filename Value="numformatparsertests.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="numformatparsertests"/>
</Unit11>
<Unit12>
<Filename Value="rpnformulaunit.pas"/>
@ -127,6 +133,9 @@
<DebugInfoType Value="dsDwarf2Set"/>
</Debugging>
</Linking>
<Other>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions>
<Debugging>
<Exceptions Count="6">

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

@ -2,13 +2,27 @@ program spreadtestgui;
{$mode objfpc}{$H+}
{.$DEFINE HEAPTRC} // Instead of using -gh activate this to write the heap trace to file
uses
{$IFDEF HEAPTRC}
HeapTrc, SysUtils,
{$ENDIF}
Interfaces, Forms, GuiTestRunner, datetests, stringtests, numberstests,
manualtests, testsutility, internaltests, formattests, colortests, fonttests,
optiontests, numformatparsertests, formulatests, rpnFormulaUnit,
emptycelltests;
begin
{$IFDEF HEAPTRC}
// Assuming your build mode sets -dDEBUG in Project Options/Other when defining -gh
// This avoids interference when running a production/default build without -gh
if FileExists('heap.trc') then
DeleteFile('heap.trc');
SetHeapTraceOutput('heap.trc');
{$ENDIF HEAPTRC}
Application.Initialize;
Application.CreateForm(TGuiTestRunner, TestRunner);
Application.Run;

16
components/fpspreadsheet/tests/stringtests.pas
View File

@ -172,6 +172,7 @@ begin
}
// Write out all test values
MyWorkbook := TsWorkbook.Create;
try
MyWorkSheet:=MyWorkBook.AddWorksheet(StringsSheet);
for Row := Low(SollStrings) to High(SollStrings) do
begin
@ -182,10 +183,13 @@ begin
end;
TempFile:=NewTempFile;
MyWorkBook.WriteToFile(TempFile,sfExcel8,true);
finally
MyWorkbook.Free;
end;
// Open the spreadsheet, as biff8
MyWorkbook := TsWorkbook.Create;
try
MyWorkbook.ReadFromFile(TempFile, sfExcel8);
MyWorksheet:=GetWorksheetByName(MyWorkBook,StringsSheet);
if MyWorksheet=nil then
@ -197,11 +201,11 @@ begin
ActualString:=MyWorkSheet.ReadAsUTF8Text(Row,0);
CheckEquals(SollStrings[Row],ActualString,'Test value mismatch, cell '+CellNotation(MyWorkSheet,Row));
end;
// Finalization
finally
MyWorkbook.Free;
DeleteFile(TempFile);
end;
end;
procedure TSpreadWriteReadStringTests.TestWriteReadStringsLimits;
const
@ -227,6 +231,7 @@ begin
}
// Write out all test values
MyWorkbook := TsWorkbook.Create;
try
MyWorkSheet:=MyWorkBook.AddWorksheet(StringsSheet);
for Row := Low(LocalNormStrings) to High(LocalNormStrings) do
@ -279,10 +284,13 @@ begin
end;
// Notify user of exception if it happened where we didn't expect it:
CheckTrue(TestResult,'Exception: '+ExceptionMessage);
finally
MyWorkbook.Free;
end;
// Open the spreadsheet, as biff8
MyWorkbook := TsWorkbook.Create;
try
MyWorkbook.ReadFromFile(TempFile, sfExcel8);
MyWorksheet:=GetWorksheetByName(MyWorkBook,StringsSheet);
if MyWorksheet=nil then
@ -302,11 +310,11 @@ begin
'Test value mismatch cell '+CellNotation(MyWorkSheet,Row)+
' for string length.');
end;
// Finalization
finally
MyWorkbook.Free;
DeleteFile(TempFile);
end;
end;
{ TSpreadReadStringTests }

5
components/fpspreadsheet/xlsxooxml.pas
View File

@ -1677,6 +1677,9 @@ begin
end else
begin
// The cells need to be written in order, row by row, cell by cell
c1 := AWorksheet.GetFirstColIndex;
c2 := AWorksheet.GetLastColIndex;
if (c1 = $FFFFFFFF) and (c2 = 0) then c1 := 0; // avoid arithmetic overflow in case of empty worksheet
for r := 0 to AWorksheet.GetLastRowIndex do begin
// If the row has a custom height add this value to the <row> specification
row := AWorksheet.FindRow(r);
@ -1685,8 +1688,6 @@ begin
(row^.Height + ROW_HEIGHT_CORRECTION)*h0])
else
rh := '';
c1 := AWorksheet.GetFirstColIndex;
c2 := AWorksheet.GetLastColIndex;
AppendToStream(AStream, Format(
'<row r="%d" spans="%d:%d"%s>', [r+1, c1+1, c2+1, rh]));
// Write cells belonging to this row.