From 7e599ebd072cbab1d90639bdaaf6d715f7cc29be Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Tue, 5 Aug 2014 21:42:34 +0000 Subject: [PATCH] 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 +- components/fpspreadsheet/fpspreadsheet.pas | 6 +- components/fpspreadsheet/tests/colortests.pas | 230 +++++++++--------- components/fpspreadsheet/tests/datetests.pas | 58 +++-- .../fpspreadsheet/tests/emptycelltests.pas | 85 ++++--- components/fpspreadsheet/tests/fonttests.pas | 206 ++++++++-------- .../fpspreadsheet/tests/numberstests.pas | 58 +++-- .../fpspreadsheet/tests/optiontests.pas | 110 +++++---- .../fpspreadsheet/tests/spreadtestgui.lpi | 9 + .../fpspreadsheet/tests/spreadtestgui.lpr | 14 ++ .../fpspreadsheet/tests/stringtests.pas | 162 ++++++------ components/fpspreadsheet/xlsxooxml.pas | 5 +- 12 files changed, 525 insertions(+), 435 deletions(-) diff --git a/components/fpspreadsheet/fpsfunc.pas b/components/fpspreadsheet/fpsfunc.pas index 46fdd11db..cb8d0112b 100644 --- a/components/fpspreadsheet/fpsfunc.pas +++ b/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; diff --git a/components/fpspreadsheet/fpspreadsheet.pas b/components/fpspreadsheet/fpspreadsheet.pas index e4a65e42e..65bf5b789 100755 --- a/components/fpspreadsheet/fpspreadsheet.pas +++ b/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,8 +6553,10 @@ end; } procedure DisposeRPNItem(AItem: PRPNItem); begin - if AItem <> nil then + if AItem <> nil then begin + AItem.FE.StringValue := '';; FreeMem(AItem, SizeOf(TRPNItem)); + end; end; {@@ diff --git a/components/fpspreadsheet/tests/colortests.pas b/components/fpspreadsheet/tests/colortests.pas index 60d250e47..867749749 100644 --- a/components/fpspreadsheet/tests/colortests.pas +++ b/components/fpspreadsheet/tests/colortests.pas @@ -120,66 +120,71 @@ begin TempFile:=GetTempFileName; MyWorkbook := TsWorkbook.Create; - MyWorkSheet:= MyWorkBook.AddWorksheet(ColorsSheet); + try + MyWorkSheet:= MyWorkBook.AddWorksheet(ColorsSheet); - // Define palette - case whichPalette of - 5: MyWorkbook.UsePalette(@PALETTE_BIFF5, Length(PALETTE_BIFF5)); - 8: MyWorkbook.UsePalette(@PALETTE_BIFF8, Length(PALETTE_BIFF8)); - 999: begin // Random palette: testing of color replacement - MyWorkbook.UsePalette(@PALETTE_BIFF8, Length(PALETTE_BIFF8)); - for i:=8 to 63 do // first 8 colors cannot be changed - MyWorkbook.SetPaletteColor(i, random(256) + random(256) shr 8 + random(256) shr 16); - end; - // else use default palette + // Define palette + case whichPalette of + 5: MyWorkbook.UsePalette(@PALETTE_BIFF5, Length(PALETTE_BIFF5)); + 8: MyWorkbook.UsePalette(@PALETTE_BIFF8, Length(PALETTE_BIFF8)); + 999: begin // Random palette: testing of color replacement + MyWorkbook.UsePalette(@PALETTE_BIFF8, Length(PALETTE_BIFF8)); + for i:=8 to 63 do // first 8 colors cannot be changed + MyWorkbook.SetPaletteColor(i, random(256) + random(256) shr 8 + random(256) shr 16); + end; + // else use default palette + end; + + // Remember all colors because ODS does not have a palette in the file; therefore + // we do not know which colors to expect. + SetLength(pal, MyWorkbook.GetPaletteSize); + for i:=0 to High(pal) do + pal[i] := MyWorkbook.GetPaletteColor(i); + + // Write out all colors + row := 0; + col := 0; + for color := 0 to MyWorkbook.GetPaletteSize-1 do begin + MyWorksheet.WriteUTF8Text(row, col, CELLTEXT); + MyWorksheet.WriteBackgroundColor(row, col, color); + MyCell := MyWorksheet.FindCell(row, col); + if MyCell = nil then + fail('Error in test code. Failed to get cell.'); + currentRGB := MyWorkbook.GetPaletteColor(MyCell^.BackgroundColor); + expectedRGB := MyWorkbook.GetPaletteColor(color); + CheckEquals(expectedRGB, currentRGB, + 'Test unsaved background color, cell ' + CellNotation(MyWorksheet,0,0)); + inc(row); + end; + MyWorkBook.WriteToFile(TempFile, AFormat, true); + finally + MyWorkbook.Free; end; - // Remember all colors because ODS does not have a palette in the file; therefore - // we do not know which colors to expect. - SetLength(pal, MyWorkbook.GetPaletteSize); - for i:=0 to High(pal) do - pal[i] := MyWorkbook.GetPaletteColor(i); - - // Write out all colors - row := 0; - col := 0; - for color := 0 to MyWorkbook.GetPaletteSize-1 do begin - MyWorksheet.WriteUTF8Text(row, col, CELLTEXT); - MyWorksheet.WriteBackgroundColor(row, col, color); - MyCell := MyWorksheet.FindCell(row, col); - if MyCell = nil then - fail('Error in test code. Failed to get cell.'); - currentRGB := MyWorkbook.GetPaletteColor(MyCell^.BackgroundColor); - expectedRGB := MyWorkbook.GetPaletteColor(color); - CheckEquals(expectedRGB, currentRGB, - 'Test unsaved background color, cell ' + CellNotation(MyWorksheet,0,0)); - inc(row); - end; - MyWorkBook.WriteToFile(TempFile, AFormat, true); - MyWorkbook.Free; - // Open the spreadsheet MyWorkbook := TsWorkbook.Create; - MyWorkbook.ReadFromFile(TempFile, AFormat); - if AFormat = sfExcel2 then - MyWorksheet := MyWorkbook.GetFirstWorksheet - else - MyWorksheet := GetWorksheetByName(MyWorkBook, ColorsSheet); - if MyWorksheet=nil then - fail('Error in test code. Failed to get named worksheet'); - for row := 0 to MyWorksheet.GetLastRowIndex do begin - MyCell := MyWorksheet.FindCell(row, col); - if MyCell = nil then - fail('Error in test code. Failed to get cell.'); - color := TsColor(row); - currentRGB := MyWorkbook.GetPaletteColor(MyCell^.BackgroundColor); - expectedRGB := pal[color]; - CheckEquals(expectedRGB, currentRGB, - 'Test saved background color, cell '+CellNotation(MyWorksheet,Row,Col)); + try + MyWorkbook.ReadFromFile(TempFile, AFormat); + if AFormat = sfExcel2 then + MyWorksheet := MyWorkbook.GetFirstWorksheet + else + MyWorksheet := GetWorksheetByName(MyWorkBook, ColorsSheet); + if MyWorksheet=nil then + fail('Error in test code. Failed to get named worksheet'); + for row := 0 to MyWorksheet.GetLastRowIndex do begin + MyCell := MyWorksheet.FindCell(row, col); + if MyCell = nil then + fail('Error in test code. Failed to get cell.'); + color := TsColor(row); + currentRGB := MyWorkbook.GetPaletteColor(MyCell^.BackgroundColor); + expectedRGB := pal[color]; + CheckEquals(expectedRGB, currentRGB, + 'Test saved background color, cell '+CellNotation(MyWorksheet,Row,Col)); + end; + finally + MyWorkbook.Free; + DeleteFile(TempFile); end; - MyWorkbook.Free; - - DeleteFile(TempFile); end; procedure TSpreadWriteReadColorTests.TestWriteReadFontColors(AFormat: TsSpreadsheetFormat; @@ -204,68 +209,73 @@ begin TempFile:=GetTempFileName; MyWorkbook := TsWorkbook.Create; - MyWorkSheet:= MyWorkBook.AddWorksheet(ColorsSheet); + try + MyWorkSheet:= MyWorkBook.AddWorksheet(ColorsSheet); - // Define palette - case whichPalette of - 5: MyWorkbook.UsePalette(@PALETTE_BIFF5, High(PALETTE_BIFF5)+1); - 8: MyWorkbook.UsePalette(@PALETTE_BIFF8, High(PALETTE_BIFF8)+1); - 999: begin // Random palette: testing of color replacement - MyWorkbook.UsePalette(@PALETTE_BIFF8, Length(PALETTE_BIFF8)); - for i:=8 to 63 do // first 8 colors cannot be changed - MyWorkbook.SetPaletteColor(i, random(256) + random(256) shr 8 + random(256) shr 16); - end; - // else use default palette + // Define palette + case whichPalette of + 5: MyWorkbook.UsePalette(@PALETTE_BIFF5, High(PALETTE_BIFF5)+1); + 8: MyWorkbook.UsePalette(@PALETTE_BIFF8, High(PALETTE_BIFF8)+1); + 999: begin // Random palette: testing of color replacement + MyWorkbook.UsePalette(@PALETTE_BIFF8, Length(PALETTE_BIFF8)); + for i:=8 to 63 do // first 8 colors cannot be changed + MyWorkbook.SetPaletteColor(i, random(256) + random(256) shr 8 + random(256) shr 16); + end; + // else use default palette + end; + + // Remember all colors because ODS does not have a palette in the file; + // therefore we do not know which colors to expect. + SetLength(pal, MyWorkbook.GetPaletteSize); + for color:=0 to High(pal) do + pal[color] := MyWorkbook.GetPaletteColor(color); + + // Write out all colors + row := 0; + col := 0; + for color := 0 to MyWorkbook.GetPaletteSize-1 do begin + MyWorksheet.WriteUTF8Text(row, col, CELLTEXT); + MyWorksheet.WriteFontColor(row, col, color); + MyCell := MyWorksheet.FindCell(row, col); + if MyCell = nil then + fail('Error in test code. Failed to get cell.'); + colorInFile := MyWorkbook.GetFont(MyCell^.FontIndex).Color; + currentRGB := MyWorkbook.GetPaletteColor(colorInFile); + expectedRGB := MyWorkbook.GetPaletteColor(color); + CheckEquals(expectedRGB, currentRGB, + 'Test unsaved font color, cell ' + CellNotation(MyWorksheet,row, col)); + inc(row); + end; + MyWorkBook.WriteToFile(TempFile, AFormat, true); + finally + MyWorkbook.Free; end; - // Remember all colors because ODS does not have a palette in the file; - // therefore we do not know which colors to expect. - SetLength(pal, MyWorkbook.GetPaletteSize); - for color:=0 to High(pal) do - pal[color] := MyWorkbook.GetPaletteColor(color); - - // Write out all colors - row := 0; - col := 0; - for color := 0 to MyWorkbook.GetPaletteSize-1 do begin - MyWorksheet.WriteUTF8Text(row, col, CELLTEXT); - MyWorksheet.WriteFontColor(row, col, color); - MyCell := MyWorksheet.FindCell(row, col); - if MyCell = nil then - fail('Error in test code. Failed to get cell.'); - colorInFile := MyWorkbook.GetFont(MyCell^.FontIndex).Color; - currentRGB := MyWorkbook.GetPaletteColor(colorInFile); - expectedRGB := MyWorkbook.GetPaletteColor(color); - CheckEquals(expectedRGB, currentRGB, - 'Test unsaved font color, cell ' + CellNotation(MyWorksheet,row, col)); - inc(row); - end; - MyWorkBook.WriteToFile(TempFile, AFormat, true); - MyWorkbook.Free; - // Open the spreadsheet MyWorkbook := TsWorkbook.Create; - MyWorkbook.ReadFromFile(TempFile, AFormat); - if AFormat = sfExcel2 then - MyWorksheet := MyWorkbook.GetFirstWorksheet - else - MyWorksheet := GetWorksheetByName(MyWorkBook, ColorsSheet); - if MyWorksheet=nil then - fail('Error in test code. Failed to get named worksheet'); - for row := 0 to MyWorksheet.GetLastRowIndex do begin - MyCell := MyWorksheet.FindCell(row, col); - if MyCell = nil then - fail('Error in test code. Failed to get cell.'); - color := TsColor(row); - colorInFile := MyWorkbook.GetFont(MyCell^.FontIndex).Color; - currentRGB := MyWorkbook.GetPaletteColor(colorInFile); - expectedRGB := pal[color]; //MyWorkbook.GetPaletteColor(color); - CheckEquals(expectedRGB, currentRGB, - 'Test saved font color, cell '+CellNotation(MyWorksheet,Row,Col)); + try + MyWorkbook.ReadFromFile(TempFile, AFormat); + if AFormat = sfExcel2 then + MyWorksheet := MyWorkbook.GetFirstWorksheet + else + MyWorksheet := GetWorksheetByName(MyWorkBook, ColorsSheet); + if MyWorksheet=nil then + fail('Error in test code. Failed to get named worksheet'); + for row := 0 to MyWorksheet.GetLastRowIndex do begin + MyCell := MyWorksheet.FindCell(row, col); + if MyCell = nil then + fail('Error in test code. Failed to get cell.'); + color := TsColor(row); + colorInFile := MyWorkbook.GetFont(MyCell^.FontIndex).Color; + currentRGB := MyWorkbook.GetPaletteColor(colorInFile); + expectedRGB := pal[color]; //MyWorkbook.GetPaletteColor(color); + CheckEquals(expectedRGB, currentRGB, + 'Test saved font color, cell '+CellNotation(MyWorksheet,Row,Col)); + end; + finally + MyWorkbook.Free; + DeleteFile(TempFile); end; - MyWorkbook.Free; - - DeleteFile(TempFile); end; { Tests for BIFF2 file format } diff --git a/components/fpspreadsheet/tests/datetests.pas b/components/fpspreadsheet/tests/datetests.pas index 995f8ee6d..7b64f7103 100644 --- a/components/fpspreadsheet/tests/datetests.pas +++ b/components/fpspreadsheet/tests/datetests.pas @@ -389,39 +389,43 @@ begin } // Write out all test values MyWorkbook := TsWorkbook.Create; - MyWorkSheet:=MyWorkBook.AddWorksheet(DatesSheet); - for Row := Low(SollDates) to High(SollDates) do - begin - MyWorkSheet.WriteDateTime(Row, 0, SollDates[Row], nfShortDateTime); - // Some checks inside worksheet itself - if not(MyWorkSheet.ReadAsDateTime(Row,0,ActualDateTime)) then - Fail('Failed writing date time for cell '+CellNotation(MyWorkSheet,Row)); - CheckEquals(SollDates[Row],ActualDateTime,'Test date/time value mismatch cell '+CellNotation(MyWorksheet,Row)); + try + MyWorkSheet:=MyWorkBook.AddWorksheet(DatesSheet); + for Row := Low(SollDates) to High(SollDates) do + begin + MyWorkSheet.WriteDateTime(Row, 0, SollDates[Row], nfShortDateTime); + // Some checks inside worksheet itself + if not(MyWorkSheet.ReadAsDateTime(Row,0,ActualDateTime)) then + Fail('Failed writing date time for cell '+CellNotation(MyWorkSheet,Row)); + CheckEquals(SollDates[Row],ActualDateTime,'Test date/time value mismatch cell '+CellNotation(MyWorksheet,Row)); + end; + MyWorkBook.WriteToFile(TempFile, AFormat, true); + finally + MyWorkbook.Free; end; - MyWorkBook.WriteToFile(TempFile, AFormat, true); - MyWorkbook.Free; // Open the spreadsheet, as biff8 MyWorkbook := TsWorkbook.Create; - MyWorkbook.ReadFromFile(TempFile, AFormat); - if AFormat = sfExcel2 then - MyWorksheet := MyWorkbook.GetFirstWorksheet - else - MyWorksheet := GetWorksheetByName(MyWorkBook,DatesSheet); - if MyWorksheet=nil then - fail('Error in test code. Failed to get named worksheet'); + try + MyWorkbook.ReadFromFile(TempFile, AFormat); + if AFormat = sfExcel2 then + MyWorksheet := MyWorkbook.GetFirstWorksheet + else + MyWorksheet := GetWorksheetByName(MyWorkBook,DatesSheet); + if MyWorksheet=nil then + fail('Error in test code. Failed to get named worksheet'); - // Read test data from A column & compare if written=original - for Row := Low(SollDates) to High(SollDates) do - begin - if not(MyWorkSheet.ReadAsDateTime(Row,0,ActualDateTime)) then - Fail('Could not read date time for cell '+CellNotation(MyWorkSheet,Row)); - CheckEquals(SollDates[Row],ActualDateTime,'Test date/time value mismatch cell '+CellNotation(MyWorkSheet,Row)); + // Read test data from A column & compare if written=original + for Row := Low(SollDates) to High(SollDates) do + begin + if not(MyWorkSheet.ReadAsDateTime(Row,0,ActualDateTime)) then + 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; + finally + MyWorkbook.Free; + DeleteFile(TempFile); end; - // Finalization - MyWorkbook.Free; - - DeleteFile(TempFile); end; procedure TSpreadWriteReadDateTests.TestWriteReadDates_BIFF2; diff --git a/components/fpspreadsheet/tests/emptycelltests.pas b/components/fpspreadsheet/tests/emptycelltests.pas index 25a9aa262..220103aa1 100644 --- a/components/fpspreadsheet/tests/emptycelltests.pas +++ b/components/fpspreadsheet/tests/emptycelltests.pas @@ -155,62 +155,67 @@ var begin TempFile := GetTempFileName; - MyWorkbook := TsWorkbook.Create; - MyWorkSheet:= MyWorkBook.AddWorksheet(EmptyCellsSheet); - L := TStringList.Create; try L.Delimiter := '|'; L.StrictDelimiter := true; L.DelimitedText := SollLayoutStrings[ALayout]; - // Write out cells - for row := 0 to L.Count-1 do begin - s := L[row]; - for col := 0 to Length(s)-1 do begin - if AInverted then begin - if s[col+1] = ' ' then s[col+1] := 'x' else s[col+1] := ' '; + MyWorkbook := TsWorkbook.Create; + try + MyWorkSheet:= MyWorkBook.AddWorksheet(EmptyCellsSheet); + + // Write out cells + for row := 0 to L.Count-1 do begin + s := L[row]; + for col := 0 to Length(s)-1 do begin + if AInverted then begin + if s[col+1] = ' ' then s[col+1] := 'x' else s[col+1] := ' '; + end; + if s[col+1] = 'x' then + MyWorksheet.WriteUTF8Text(row, col, CELLTEXT); + end; end; - if s[col+1] = 'x' then - MyWorksheet.WriteUTF8Text(row, col, CELLTEXT); + MyWorkBook.WriteToFile(TempFile, AFormat, true); + finally + MyWorkbook.Free; end; - end; - MyWorkBook.WriteToFile(TempFile, AFormat, true); - MyWorkbook.Free; // Open the spreadsheet MyWorkbook := TsWorkbook.Create; - MyWorkbook.ReadFromFile(TempFile, AFormat); - if AFormat = sfExcel2 then - MyWorksheet := MyWorkbook.GetFirstWorksheet - else - MyWorksheet := GetWorksheetByName(MyWorkBook, EmptyCellsSheet); - if MyWorksheet=nil then - fail('Error in test code. Failed to get named worksheet'); - - for row := 0 to MyWorksheet.GetLastRowIndex do begin - SetLength(s, MyWorksheet.GetLastColIndex + 1); - for col := 0 to MyWorksheet.GetLastColIndex do begin - MyCell := MyWorksheet.FindCell(row, col); - if MyCell = nil then s[col+1] := ' ' else s[col+1] := 'x'; - if AInverted then begin - if s[col+1] = ' ' then s[col+1] := 'x' else s[col+1] := ' '; - end; - end; - if AInverted then - while Length(s) < Length(L[row]) do s := s + 'x' + try + MyWorkbook.ReadFromFile(TempFile, AFormat); + if AFormat = sfExcel2 then + MyWorksheet := MyWorkbook.GetFirstWorksheet else - while Length(s) < Length(L[row]) do s := s + ' '; - CheckEquals(L[row], s, - 'Test empty cell layout mismatch, cell '+CellNotation(MyWorksheet, Row, Col)); + MyWorksheet := GetWorksheetByName(MyWorkBook, EmptyCellsSheet); + if MyWorksheet=nil then + fail('Error in test code. Failed to get named worksheet'); + + for row := 0 to MyWorksheet.GetLastRowIndex do begin + SetLength(s, MyWorksheet.GetLastColIndex + 1); + for col := 0 to MyWorksheet.GetLastColIndex do begin + MyCell := MyWorksheet.FindCell(row, col); + if MyCell = nil then s[col+1] := ' ' else s[col+1] := 'x'; + if AInverted then begin + if s[col+1] = ' ' then s[col+1] := 'x' else s[col+1] := ' '; + end; + end; + if AInverted then + while Length(s) < Length(L[row]) do s := s + 'x' + else + while Length(s) < Length(L[row]) do s := s + ' '; + CheckEquals(L[row], s, + 'Test empty cell layout mismatch, cell '+CellNotation(MyWorksheet, Row, Col)); + end; + finally + MyWorkbook.Free; + DeleteFile(TempFile); end; + finally L.Free; end; - - MyWorkbook.Free; - - DeleteFile(TempFile); end; { BIFF2 tests } diff --git a/components/fpspreadsheet/tests/fonttests.pas b/components/fpspreadsheet/tests/fonttests.pas index d79342e54..40f786c8d 100644 --- a/components/fpspreadsheet/tests/fonttests.pas +++ b/components/fpspreadsheet/tests/fonttests.pas @@ -143,61 +143,66 @@ begin DeleteFile(TempFile); } MyWorkbook := TsWorkbook.Create; - MyWorkSheet:= MyWorkBook.AddWorksheet(FontSheet); + try + MyWorkSheet:= MyWorkBook.AddWorksheet(FontSheet); - // Write out a cell without "bold" formatting style - row := 0; - col := 0; - MyWorksheet.WriteUTF8Text(row, col, 'not bold'); - MyCell := MyWorksheet.FindCell(row, col); - if MyCell = nil then - fail('Error in test code. Failed to get cell.'); - CheckEquals(uffBold in MyCell^.UsedFormattingFields, false, - 'Test unsaved bold attribute, cell '+CellNotation(MyWorksheet,Row,Col)); + // Write out a cell without "bold" formatting style + row := 0; + col := 0; + MyWorksheet.WriteUTF8Text(row, col, 'not bold'); + MyCell := MyWorksheet.FindCell(row, col); + if MyCell = nil then + fail('Error in test code. Failed to get cell.'); + CheckEquals(uffBold in MyCell^.UsedFormattingFields, false, + 'Test unsaved bold attribute, cell '+CellNotation(MyWorksheet,Row,Col)); - // Write out a cell with "bold" formatting style - inc(row); - MyWorksheet.WriteUTF8Text(row, col, 'bold'); - MyWorksheet.WriteUsedFormatting(row, col, [uffBold]); - MyCell := MyWorksheet.FindCell(row, col); - if MyCell = nil then - fail('Error in test code. Failded to get cell.'); - CheckEquals(uffBold in MyCell^.UsedFormattingFields, true, - 'Test unsaved bold attribute, cell '+CellNotation(MyWorksheet,Row, Col)); + // Write out a cell with "bold" formatting style + inc(row); + MyWorksheet.WriteUTF8Text(row, col, 'bold'); + MyWorksheet.WriteUsedFormatting(row, col, [uffBold]); + MyCell := MyWorksheet.FindCell(row, col); + if MyCell = nil then + fail('Error in test code. Failded to get cell.'); + CheckEquals(uffBold in MyCell^.UsedFormattingFields, true, + 'Test unsaved bold attribute, cell '+CellNotation(MyWorksheet,Row, Col)); - TempFile:=NewTempFile; - MyWorkBook.WriteToFile(TempFile, AFormat, true); - MyWorkbook.Free; + TempFile:=NewTempFile; + MyWorkBook.WriteToFile(TempFile, AFormat, true); + finally + MyWorkbook.Free; + end; // Open the spreadsheet MyWorkbook := TsWorkbook.Create; - MyWorkbook.ReadFromFile(TempFile, AFormat); - if AFormat = sfExcel2 then - MyWorksheet := MyWorkbook.GetFirstWorksheet // only 1 sheet for BIFF2 - else - MyWorksheet := GetWorksheetByName(MyWorkBook, FontSheet); - if MyWorksheet=nil then - fail('Error in test code. Failed to get named worksheet'); + try + MyWorkbook.ReadFromFile(TempFile, AFormat); + if AFormat = sfExcel2 then + MyWorksheet := MyWorkbook.GetFirstWorksheet // only 1 sheet for BIFF2 + else + MyWorksheet := GetWorksheetByName(MyWorkBook, FontSheet); + if MyWorksheet=nil then + fail('Error in test code. Failed to get named worksheet'); - // Try to read cell without "bold" - row := 0; - col := 0; - MyCell := MyWorksheet.FindCell(row, col); - if MyCell = nil then - fail('Error in test code. Failed to get cell.'); - CheckEquals(uffBold in MyCell^.UsedFormattingFields, false, - 'Test saved bold attribute, cell '+CellNotation(MyWorksheet,row,col)); + // Try to read cell without "bold" + row := 0; + col := 0; + MyCell := MyWorksheet.FindCell(row, col); + if MyCell = nil then + fail('Error in test code. Failed to get cell.'); + CheckEquals(uffBold in MyCell^.UsedFormattingFields, false, + 'Test saved bold attribute, cell '+CellNotation(MyWorksheet,row,col)); - // Try to read cell with "bold" - inc(row); - MyCell := MyWorksheet.FindCell(row, col); - if MyCell = nil then - fail('Error in test code. Failed to get cell.'); - CheckEquals(uffBold in MyCell^.UsedFormattingFields, true, - 'Test saved bold attribute, cell '+CellNotation(MyWorksheet,row,col)); - - MyWorkbook.Free; - DeleteFile(TempFile); + // Try to read cell with "bold" + inc(row); + MyCell := MyWorksheet.FindCell(row, col); + if MyCell = nil then + 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; @@ -220,64 +225,69 @@ begin DeleteFile(TempFile); } MyWorkbook := TsWorkbook.Create; - MyWorkSheet:= MyWorkBook.AddWorksheet(FontSheet); + try + MyWorkSheet:= MyWorkBook.AddWorksheet(FontSheet); - // Write out all font styles at various sizes - for row := 0 to High(SollSizes) do - begin - for col := 0 to High(SollStyles) do - begin - cellText := Format('%s, %.1f-pt', [AFontName, SollSizes[row]]); - MyWorksheet.WriteUTF8Text(row, col, celltext); - MyWorksheet.WriteFont(row, col, AFontName, SollSizes[row], SollStyles[col], scBlack); + // Write out all font styles at various sizes + for row := 0 to High(SollSizes) do + begin + for col := 0 to High(SollStyles) do + begin + cellText := Format('%s, %.1f-pt', [AFontName, SollSizes[row]]); + MyWorksheet.WriteUTF8Text(row, col, celltext); + MyWorksheet.WriteFont(row, col, AFontName, SollSizes[row], SollStyles[col], scBlack); - MyCell := MyWorksheet.FindCell(row, col); - if MyCell = nil then - fail('Error in test code. Failed to get cell.'); - font := MyWorkbook.GetFont(MyCell^.FontIndex); - CheckEquals(SollSizes[row], font.Size, - 'Test unsaved font size, cell ' + CellNotation(MyWorksheet,0,0)); - currValue := GetEnumName(TypeInfo(TsFontStyles), byte(font.Style)); - expectedValue := GetEnumName(TypeInfo(TsFontStyles), byte(SollStyles[col])); - CheckEquals(currValue, expectedValue, - 'Test unsaved font style, cell ' + CellNotation(MyWorksheet,0,0)); + MyCell := MyWorksheet.FindCell(row, col); + if MyCell = nil then + fail('Error in test code. Failed to get cell.'); + font := MyWorkbook.GetFont(MyCell^.FontIndex); + CheckEquals(SollSizes[row], font.Size, + 'Test unsaved font size, cell ' + CellNotation(MyWorksheet,0,0)); + currValue := GetEnumName(TypeInfo(TsFontStyles), byte(font.Style)); + expectedValue := GetEnumName(TypeInfo(TsFontStyles), byte(SollStyles[col])); + CheckEquals(currValue, expectedValue, + 'Test unsaved font style, cell ' + CellNotation(MyWorksheet,0,0)); + end; end; + TempFile:=NewTempFile; + MyWorkBook.WriteToFile(TempFile, AFormat, true); + finally + MyWorkbook.Free; end; - TempFile:=NewTempFile; - MyWorkBook.WriteToFile(TempFile, AFormat, true); - MyWorkbook.Free; // Open the spreadsheet MyWorkbook := TsWorkbook.Create; - MyWorkbook.ReadFromFile(TempFile, AFormat); - if AFormat = sfExcel2 then - MyWorksheet := MyWorkbook.GetFirstWorksheet // only 1 sheet for BIFF2 - else - MyWorksheet := GetWorksheetByName(MyWorkBook, FontSheet); - if MyWorksheet=nil then - fail('Error in test code. Failed to get named worksheet'); - counter := 0; - for row := 0 to MyWorksheet.GetLastRowIndex do - for col := 0 to MyWorksheet.GetLastColIndex do - begin - if (AFormat = sfExcel2) and (counter = 4) then - break; // Excel 2 allows only 4 fonts - MyCell := MyWorksheet.FindCell(row, col); - if MyCell = nil then - fail('Error in test code. Failed to get cell.'); - font := MyWorkbook.GetFont(MyCell^.FontIndex); - if abs(SollSizes[row] - font.Size) > 1e-6 then // safe-guard against rounding errors - CheckEquals(SollSizes[row], font.Size, - 'Test saved font size, cell '+CellNotation(MyWorksheet,Row,Col)); - currValue := GetEnumName(TypeInfo(TsFontStyles), byte(font.Style)); - expectedValue := GetEnumName(TypeInfo(TsFontStyles), byte(SollStyles[col])); - CheckEquals(currValue, expectedValue, - 'Test unsaved font style, cell ' + CellNotation(MyWorksheet,0,0)); - inc(counter); - end; - MyWorkbook.Free; - - DeleteFile(TempFile); + try + MyWorkbook.ReadFromFile(TempFile, AFormat); + if AFormat = sfExcel2 then + MyWorksheet := MyWorkbook.GetFirstWorksheet // only 1 sheet for BIFF2 + else + MyWorksheet := GetWorksheetByName(MyWorkBook, FontSheet); + if MyWorksheet=nil then + fail('Error in test code. Failed to get named worksheet'); + counter := 0; + for row := 0 to MyWorksheet.GetLastRowIndex do + for col := 0 to MyWorksheet.GetLastColIndex do + begin + if (AFormat = sfExcel2) and (counter = 4) then + break; // Excel 2 allows only 4 fonts + MyCell := MyWorksheet.FindCell(row, col); + if MyCell = nil then + fail('Error in test code. Failed to get cell.'); + font := MyWorkbook.GetFont(MyCell^.FontIndex); + if abs(SollSizes[row] - font.Size) > 1e-6 then // safe-guard against rounding errors + CheckEquals(SollSizes[row], font.Size, + 'Test saved font size, cell '+CellNotation(MyWorksheet,Row,Col)); + currValue := GetEnumName(TypeInfo(TsFontStyles), byte(font.Style)); + expectedValue := GetEnumName(TypeInfo(TsFontStyles), byte(SollStyles[col])); + CheckEquals(currValue, expectedValue, + 'Test unsaved font style, cell ' + CellNotation(MyWorksheet,0,0)); + inc(counter); + end; + finally + MyWorkbook.Free; + DeleteFile(TempFile); + end; end; { BIFF2 } diff --git a/components/fpspreadsheet/tests/numberstests.pas b/components/fpspreadsheet/tests/numberstests.pas index 0166a7665..b8f5d967e 100644 --- a/components/fpspreadsheet/tests/numberstests.pas +++ b/components/fpspreadsheet/tests/numberstests.pas @@ -201,38 +201,42 @@ begin } // Write out all test values MyWorkbook := TsWorkbook.Create; - MyWorkSheet := MyWorkBook.AddWorksheet(NumbersSheet); - for Row := Low(SollNumbers) to High(SollNumbers) do - begin - MyWorkSheet.WriteNumber(Row,0,SollNumbers[Row]); - // Some checks inside worksheet itself - ActualNumber:=MyWorkSheet.ReadAsNumber(Row,0); - CheckEquals(SollNumbers[Row],ActualNumber,'Test value mismatch cell '+CellNotation(MyWorkSheet,Row)); + try + MyWorkSheet := MyWorkBook.AddWorksheet(NumbersSheet); + for Row := Low(SollNumbers) to High(SollNumbers) do + begin + MyWorkSheet.WriteNumber(Row,0,SollNumbers[Row]); + // Some checks inside worksheet itself + ActualNumber:=MyWorkSheet.ReadAsNumber(Row,0); + CheckEquals(SollNumbers[Row],ActualNumber,'Test value mismatch cell '+CellNotation(MyWorkSheet,Row)); + end; + TempFile:=NewTempFile; + MyWorkBook.WriteToFile(TempFile, AFormat, true); + finally + MyWorkbook.Free; end; - TempFile:=NewTempFile; - MyWorkBook.WriteToFile(TempFile, AFormat, true); - MyWorkbook.Free; // Open the spreadsheet, as biff8 MyWorkbook := TsWorkbook.Create; - MyWorkbook.ReadFromFile(TempFile, AFormat); - if AFormat = sfExcel2 then - MyWorksheet := MyWorkbook.GetFirstWorksheet - else - MyWorksheet := GetWorksheetByName(MyWorkBook,NumbersSheet); - if MyWorksheet=nil then - fail('Error in test code. Failed to get named worksheet'); + try + MyWorkbook.ReadFromFile(TempFile, AFormat); + if AFormat = sfExcel2 then + MyWorksheet := MyWorkbook.GetFirstWorksheet + else + MyWorksheet := GetWorksheetByName(MyWorkBook,NumbersSheet); + if MyWorksheet=nil then + fail('Error in test code. Failed to get named worksheet'); - // Read test data from A column & compare if written=original - for Row := Low(SollNumbers) to High(SollNumbers) do - begin - ActualNumber:=MyWorkSheet.ReadAsNumber(Row,0); - CheckEquals(SollNumbers[Row],ActualNumber,'Test value mismatch cell '+CellNotation(MyWorkSheet,Row)); + // Read test data from A column & compare if written=original + for Row := Low(SollNumbers) to High(SollNumbers) do + begin + ActualNumber:=MyWorkSheet.ReadAsNumber(Row,0); + CheckEquals(SollNumbers[Row],ActualNumber,'Test value mismatch cell '+CellNotation(MyWorkSheet,Row)); + end; + finally + MyWorkbook.Free; + DeleteFile(TempFile); end; - // Finalization - MyWorkbook.Free; - - DeleteFile(TempFile); end; procedure TSpreadWriteReadNumberTests.TestWriteReadNumbers_BIFF2; @@ -279,7 +283,7 @@ begin TestWorkbook := TsWorkbook.Create; case UpperCase(ExtractFileExt(FileName)) of '.XLSX': TestWorkbook.ReadFromFile(FileName, sfOOXML); - '.ODS': TestWorkbook.ReadFromFile(FileName, sfOpenDocument); + '.ODS' : TestWorkbook.ReadFromFile(FileName, sfOpenDocument); // Excel XLS/BIFF else TestWorkbook.ReadFromFile(FileName, sfExcel8); end; diff --git a/components/fpspreadsheet/tests/optiontests.pas b/components/fpspreadsheet/tests/optiontests.pas index 0e2b8da8b..68cfdab89 100644 --- a/components/fpspreadsheet/tests/optiontests.pas +++ b/components/fpspreadsheet/tests/optiontests.pas @@ -116,35 +116,40 @@ begin // Write out show/hide grid lines/sheet headers MyWorkbook := TsWorkbook.Create; - MyWorkSheet:= MyWorkBook.AddWorksheet(OptionsSheet); - if AShowGridLines then - MyWorksheet.Options := MyWorksheet.Options + [soShowGridLines] - else - MyWorksheet.Options := MyWorksheet.Options - [soShowGridLines]; - if AShowHeaders then - MyWorksheet.Options := MyWorksheet.Options + [soShowHeaders] - else - MyWorksheet.Options := MyWorksheet.Options - [soShowHeaders]; + try + MyWorkSheet:= MyWorkBook.AddWorksheet(OptionsSheet); + if AShowGridLines then + MyWorksheet.Options := MyWorksheet.Options + [soShowGridLines] + else + MyWorksheet.Options := MyWorksheet.Options - [soShowGridLines]; + if AShowHeaders then + MyWorksheet.Options := MyWorksheet.Options + [soShowHeaders] + else + MyWorksheet.Options := MyWorksheet.Options - [soShowHeaders]; - MyWorkBook.WriteToFile(TempFile, AFormat, true); - MyWorkbook.Free; + MyWorkBook.WriteToFile(TempFile, AFormat, true); + finally + MyWorkbook.Free; + end; // Read back presence of grid lines/sheet headers MyWorkbook := TsWorkbook.Create; - MyWorkbook.ReadFromFile(TempFile, AFormat); - if AFormat = sfExcel2 then - MyWorksheet := MyWorkbook.GetFirstWorksheet - else - MyWorksheet := GetWorksheetByName(MyWorkBook, OptionsSheet); - if MyWorksheet=nil then - fail('Error in test code. Failed to get named worksheet'); - CheckEquals(soShowGridLines in MyWorksheet.Options, AShowGridLines, - 'Test saved show grid lines mismatch'); - CheckEquals(soShowHeaders in MyWorksheet.Options, AShowHeaders, - 'Test saved show headers mismatch'); - MyWorkbook.Free; - - DeleteFile(TempFile); + try + MyWorkbook.ReadFromFile(TempFile, AFormat); + if AFormat = sfExcel2 then + MyWorksheet := MyWorkbook.GetFirstWorksheet + else + MyWorksheet := GetWorksheetByName(MyWorkBook, OptionsSheet); + if MyWorksheet=nil then + fail('Error in test code. Failed to get named worksheet'); + CheckEquals(soShowGridLines in MyWorksheet.Options, AShowGridLines, + '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 } @@ -270,34 +275,39 @@ begin // Write out pane sizes MyWorkbook := TsWorkbook.Create; - MyWorkSheet:= MyWorkBook.AddWorksheet(OptionsSheet); - MyWorksheet.LeftPaneWidth := ALeftPaneWidth; - MyWorksheet.TopPaneHeight := ATopPaneHeight; - MyWorksheet.Options := MyWorksheet.Options + [soHasFrozenPanes]; - MyWorkBook.WriteToFile(TempFile, AFormat, true); - MyWorkbook.Free; + 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; - MyWorkbook.ReadFromFile(TempFile, AFormat); - if AFormat = sfExcel2 then - MyWorksheet := MyWorkbook.GetFirstWorksheet - else - MyWorksheet := GetWorksheetByName(MyWorkBook, OptionsSheet); - if MyWorksheet=nil then - fail('Error in test code. Failed to get named worksheet'); - CheckEquals( - (AleftPaneWidth > 0) or (ATopPaneHeight > 0), - (soHasFrozenPanes in MyWorksheet.Options) - and ((MyWorksheet.LeftPaneWidth > 0) or (MyWorksheet.TopPaneHeight > 0)), - 'Test saved frozen panes mismatch'); - CheckEquals(ALeftPaneWidth, MyWorksheet.LeftPaneWidth, - 'Test saved left pane width mismatch'); - CheckEquals(ATopPaneHeight, MyWorksheet.TopPaneHeight, - 'Test save top pane height mismatch'); - MyWorkbook.Free; - - DeleteFile(TempFile); + try + MyWorkbook.ReadFromFile(TempFile, AFormat); + if AFormat = sfExcel2 then + MyWorksheet := MyWorkbook.GetFirstWorksheet + else + MyWorksheet := GetWorksheetByName(MyWorkBook, OptionsSheet); + if MyWorksheet=nil then + fail('Error in test code. Failed to get named worksheet'); + CheckEquals( + (AleftPaneWidth > 0) or (ATopPaneHeight > 0), + (soHasFrozenPanes in MyWorksheet.Options) + and ((MyWorksheet.LeftPaneWidth > 0) or (MyWorksheet.TopPaneHeight > 0)), + 'Test saved frozen panes mismatch'); + CheckEquals(ALeftPaneWidth, MyWorksheet.LeftPaneWidth, + '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 } diff --git a/components/fpspreadsheet/tests/spreadtestgui.lpi b/components/fpspreadsheet/tests/spreadtestgui.lpi index d798ee65c..e3a5d330a 100644 --- a/components/fpspreadsheet/tests/spreadtestgui.lpi +++ b/components/fpspreadsheet/tests/spreadtestgui.lpi @@ -48,10 +48,12 @@ + + @@ -81,18 +83,22 @@ + + + + @@ -127,6 +133,9 @@ + + + diff --git a/components/fpspreadsheet/tests/spreadtestgui.lpr b/components/fpspreadsheet/tests/spreadtestgui.lpr index ee867af5d..3b139c9b2 100644 --- a/components/fpspreadsheet/tests/spreadtestgui.lpr +++ b/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; diff --git a/components/fpspreadsheet/tests/stringtests.pas b/components/fpspreadsheet/tests/stringtests.pas index 29920dd7e..4f691b90e 100644 --- a/components/fpspreadsheet/tests/stringtests.pas +++ b/components/fpspreadsheet/tests/stringtests.pas @@ -172,35 +172,39 @@ begin } // Write out all test values MyWorkbook := TsWorkbook.Create; - MyWorkSheet:=MyWorkBook.AddWorksheet(StringsSheet); - for Row := Low(SollStrings) to High(SollStrings) do - begin - MyWorkSheet.WriteUTF8Text(Row,0,SollStrings[Row]); - // Some checks inside worksheet itself - ActualString:=MyWorkSheet.ReadAsUTF8Text(Row,0); - CheckEquals(SollStrings[Row],ActualString,'Test value mismatch cell '+CellNotation(MyWorkSheet,Row)); + try + MyWorkSheet:=MyWorkBook.AddWorksheet(StringsSheet); + for Row := Low(SollStrings) to High(SollStrings) do + begin + MyWorkSheet.WriteUTF8Text(Row,0,SollStrings[Row]); + // Some checks inside worksheet itself + ActualString:=MyWorkSheet.ReadAsUTF8Text(Row,0); + CheckEquals(SollStrings[Row],ActualString,'Test value mismatch cell '+CellNotation(MyWorkSheet,Row)); + end; + TempFile:=NewTempFile; + MyWorkBook.WriteToFile(TempFile,sfExcel8,true); + finally + MyWorkbook.Free; end; - TempFile:=NewTempFile; - MyWorkBook.WriteToFile(TempFile,sfExcel8,true); - MyWorkbook.Free; // Open the spreadsheet, as biff8 MyWorkbook := TsWorkbook.Create; - MyWorkbook.ReadFromFile(TempFile, sfExcel8); - MyWorksheet:=GetWorksheetByName(MyWorkBook,StringsSheet); - if MyWorksheet=nil then - fail('Error in test code. Failed to get named worksheet'); + try + MyWorkbook.ReadFromFile(TempFile, sfExcel8); + MyWorksheet:=GetWorksheetByName(MyWorkBook,StringsSheet); + if MyWorksheet=nil then + fail('Error in test code. Failed to get named worksheet'); - // Read test data from A column & compare if written=original - for Row := Low(SollStrings) to High(SollStrings) do - begin - ActualString:=MyWorkSheet.ReadAsUTF8Text(Row,0); - CheckEquals(SollStrings[Row],ActualString,'Test value mismatch, cell '+CellNotation(MyWorkSheet,Row)); + // Read test data from A column & compare if written=original + for Row := Low(SollStrings) to High(SollStrings) do + begin + ActualString:=MyWorkSheet.ReadAsUTF8Text(Row,0); + CheckEquals(SollStrings[Row],ActualString,'Test value mismatch, cell '+CellNotation(MyWorkSheet,Row)); + end; + finally + MyWorkbook.Free; + DeleteFile(TempFile); end; - // Finalization - MyWorkbook.Free; - - DeleteFile(TempFile); end; procedure TSpreadWriteReadStringTests.TestWriteReadStringsLimits; @@ -227,24 +231,45 @@ begin } // Write out all test values MyWorkbook := TsWorkbook.Create; - MyWorkSheet:=MyWorkBook.AddWorksheet(StringsSheet); + try + MyWorkSheet:=MyWorkBook.AddWorksheet(StringsSheet); - for Row := Low(LocalNormStrings) to High(LocalNormStrings) do - begin - // We could use CheckException but then you can't pass parameters + for Row := Low(LocalNormStrings) to High(LocalNormStrings) do + begin + // We could use CheckException but then you can't pass parameters + TestResult:=true; + try + MyWorkSheet.WriteUTF8Text(Row,0,LocalNormStrings[Row]); + // Some checks inside worksheet itself + ActualString:=MyWorkSheet.ReadAsUTF8Text(Row,0); + CheckEquals(length(LocalNormStrings[Row]),length(ActualString), + 'Test value mismatch cell '+CellNotation(MyWorkSheet,Row)+ + ' for string length.'); + except + { When over size limit we expect to hit this: + if TextTooLong then + Raise Exception.CreateFmt('Text value exceeds %d character limit in cell [%d,%d]. Text has been truncated.',[MaxBytes,ARow,ACol]); + } + //todo: rewrite when/if the fpspreadsheet exception class changes + on E: Exception do + begin + if Row=2 then + TestResult:=true + else + begin + TestResult:=false; + ExceptionMessage:=E.Message; + end; + end; + end; + // Notify user of exception if it happened where we didn't expect it: + CheckTrue(TestResult,'Exception: '+ExceptionMessage); + end; TestResult:=true; + TempFile:=NewTempFile; try - MyWorkSheet.WriteUTF8Text(Row,0,LocalNormStrings[Row]); - // Some checks inside worksheet itself - ActualString:=MyWorkSheet.ReadAsUTF8Text(Row,0); - CheckEquals(length(LocalNormStrings[Row]),length(ActualString), - 'Test value mismatch cell '+CellNotation(MyWorkSheet,Row)+ - ' for string length.'); + MyWorkBook.WriteToFile(TempFile,sfExcel8,true); except - { When over size limit we expect to hit this: - if TextTooLong then - Raise Exception.CreateFmt('Text value exceeds %d character limit in cell [%d,%d]. Text has been truncated.',[MaxBytes,ARow,ACol]); - } //todo: rewrite when/if the fpspreadsheet exception class changes on E: Exception do begin @@ -259,53 +284,36 @@ begin end; // Notify user of exception if it happened where we didn't expect it: CheckTrue(TestResult,'Exception: '+ExceptionMessage); + finally + MyWorkbook.Free; end; - TestResult:=true; - TempFile:=NewTempFile; - try - MyWorkBook.WriteToFile(TempFile,sfExcel8,true); - except - //todo: rewrite when/if the fpspreadsheet exception class changes - on E: Exception do - begin - if Row=2 then - TestResult:=true - else - begin - TestResult:=false; - ExceptionMessage:=E.Message; - end; - end; - end; - // Notify user of exception if it happened where we didn't expect it: - CheckTrue(TestResult,'Exception: '+ExceptionMessage); - MyWorkbook.Free; // Open the spreadsheet, as biff8 MyWorkbook := TsWorkbook.Create; - MyWorkbook.ReadFromFile(TempFile, sfExcel8); - MyWorksheet:=GetWorksheetByName(MyWorkBook,StringsSheet); - if MyWorksheet=nil then - fail('Error in test code. Failed to get named worksheet'); + try + MyWorkbook.ReadFromFile(TempFile, sfExcel8); + MyWorksheet:=GetWorksheetByName(MyWorkBook,StringsSheet); + if MyWorksheet=nil then + fail('Error in test code. Failed to get named worksheet'); - // Read test data from A column & compare if written=original - for Row := Low(LocalNormStrings) to High(LocalNormStrings) do - begin - ActualString:=MyWorkSheet.ReadAsUTF8Text(Row,0); - // Allow for truncation of excessive strings by fpspreadsheet - if length(LocalNormStrings[Row])>MaxBytesBIFF8 then - CheckEquals(MaxBytesBIFF8,length(ActualString), + // Read test data from A column & compare if written=original + for Row := Low(LocalNormStrings) to High(LocalNormStrings) do + begin + ActualString:=MyWorkSheet.ReadAsUTF8Text(Row,0); + // Allow for truncation of excessive strings by fpspreadsheet + if length(LocalNormStrings[Row])>MaxBytesBIFF8 then + CheckEquals(MaxBytesBIFF8,length(ActualString), + 'Test value mismatch cell '+CellNotation(MyWorkSheet,Row)+ + ' for string length.') + else + CheckEquals(length(LocalNormStrings[Row]),length(ActualString), 'Test value mismatch cell '+CellNotation(MyWorkSheet,Row)+ - ' for string length.') - else - CheckEquals(length(LocalNormStrings[Row]),length(ActualString), - 'Test value mismatch cell '+CellNotation(MyWorkSheet,Row)+ - ' for string length.'); + ' for string length.'); + end; + finally + MyWorkbook.Free; + DeleteFile(TempFile); end; - // Finalization - MyWorkbook.Free; - - DeleteFile(TempFile); end; diff --git a/components/fpspreadsheet/xlsxooxml.pas b/components/fpspreadsheet/xlsxooxml.pas index 305008acb..bc64d680c 100755 --- a/components/fpspreadsheet/xlsxooxml.pas +++ b/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 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( '', [r+1, c1+1, c2+1, rh])); // Write cells belonging to this row.