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

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3431 8e941d3f-bd1b-0410-a28a-d453659cc2b4

components/fpspreadsheet/fpsfunc.pas

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

components/fpspreadsheet/fpspreadsheet.pas

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

components/fpspreadsheet/tests/colortests.pas

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

components/fpspreadsheet/tests/datetests.pas

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

components/fpspreadsheet/tests/emptycelltests.pas

@@ -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;
+  finally
-
+    L.Free;
-  DeleteFile(TempFile);
+  end;
 end;
 
 { BIFF2 tests }

components/fpspreadsheet/tests/fonttests.pas

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

components/fpspreadsheet/tests/numberstests.pas

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

components/fpspreadsheet/tests/optiontests.pas

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

components/fpspreadsheet/tests/spreadtestgui.lpi

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

components/fpspreadsheet/tests/spreadtestgui.lpr

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

components/fpspreadsheet/tests/stringtests.pas

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

components/fpspreadsheet/xlsxooxml.pas

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