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

fpspreadsheet: Re-add copytests to test suite (they had been dropped after modification of TCell structure).

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3899 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2015-01-25 18:25:57 +00:00
parent 22a7e50170
commit 9b0e720b37
4 changed files with 101 additions and 247 deletions
Download Patch File Download Diff File Expand all files Collapse all files

289
components/fpspreadsheet/tests/copytests.pas
View File

@@ -15,8 +15,20 @@ uses
fpstypes, fpspreadsheet, xlsbiff2, xlsbiff5, xlsbiff8, fpsopendocument, {and a project requirement for lclbase for utf8 handling}
testsutility;
type
PCellRecord = ^TCellRecord;
TCellRecord = record
ContentType: TCellContentType;
Numbervalue: Double;
UTF8StringValue: String;
FormulaValue: String;
UsedFormattingFields: TsUsedFormattingFields;
SharedFormulaBase: PCellRecord;
BackgroundColor: TsColor;
end;
var
SourceCells: Array[0..9] of TCell;
SourceCells: Array[0..8] of TCellRecord;
procedure InitCopyData;
@@ -51,41 +63,57 @@ uses
const
CopyTestSheet = 'Copy';
function InitNumber(ANumber: Double; ABkColor: TsColor): TCell;
begin (*
InitCell(Result);
procedure MyInitCellRecord(out ACell: TCellRecord);
begin
ACell.Contenttype := cctEmpty;
ACell.NumberValue := 0.0;
ACell.UTF8StringValue := '';
ACell.FormulaValue := '';
ACell.UsedformattingFields := [];
ACell.BackgroundColor := scTransparent;
ACell.SharedFormulaBase := nil;
end;
function MyHasFormula(ACell: PCellRecord): Boolean;
begin
Result := Assigned(ACell) and (
(ACell^.SharedFormulaBase <> nil) or (Length(ACell^.FormulaValue) > 0)
);
end;
function InitNumber(ANumber: Double; ABkColor: TsColor): TCellRecord;
begin
MyInitCellRecord(Result);
Result.ContentType := cctNumber;
Result.Numbervalue := ANumber;
if (ABkColor <> scNotDefined) and (ABkColor <> scTransparent) then
begin
Result.UsedFormattingFields := Result.UsedFormattingFields + [uffBackgroundColor];
if (ABkColor <> scTransparent) then begin
Result.UsedFormattingFields := Result.usedFormattingFields + [uffBackgroundColor];
Result.BackgroundColor := ABkColor;
end; *)
end;
end;
function InitString(AString: String; ABkColor: TsColor): TCell;
begin (*
InitCell(Result);
function InitString(AString: String; ABkColor: TsColor): TCellRecord;
begin
MyInitCellRecord(Result);
Result.ContentType := cctUTF8String;
Result.UTF8StringValue := AString;
if (ABkColor <> scNotDefined) and (ABkColor <> scTransparent) then
begin
Result.UsedFormattingFields := Result.UsedFormattingFields + [uffBackgroundColor];
if (ABkColor <> scTransparent) then begin
Result.UsedFormattingFields := Result.usedFormattingFields + [uffBackgroundColor];
Result.BackgroundColor := ABkColor;
end; *)
end;
end;
function InitFormula(AFormula: String; ANumberResult: Double; ABkColor: TsColor): TCell;
begin (*
InitCell(Result);
function InitFormula(AFormula: String; ANumberResult: Double;
ABkColor: TsColor): TCellRecord;
begin
MyInitCellRecord(Result);
Result.FormulaValue := AFormula;
Result.NumberValue := ANumberResult;
Result.ContentType := cctNumber;
if (ABkColor <> scNotDefined) and (ABkColor <> scTransparent) then
begin
Result.UsedFormattingFields := Result.UsedFormattingFields + [uffBackgroundColor];
if (ABkColor <> scTransparent) then begin
Result.UsedFormattingFields := Result.usedFormattingFields + [uffBackgroundColor];
Result.BackgroundColor := ABkColor;
end; *)
end;
end;
{ IMPORTANT: Carefully check the Test_Copy method if anything is changed here.
@@ -100,7 +128,7 @@ begin
SourceCells[5] := InitFormula('$A1+1', 2.0, scTransparent);
SourceCells[6] := InitFormula('A$1+1', 2.0, scTransparent);
SourceCells[7] := InitFormula('$A$1+1', 2.0, scGray);
InitCell(SourceCells[8]); // empty but existing
MyInitCellRecord(SourceCells[8]); // empty but existing
end;
@@ -172,7 +200,7 @@ begin
end;
if SourceCells[row].FormulaValue <> '' then
Myworksheet.WriteFormula(row+col, col, SourceCells[row].FormulaValue);
if (uffBackgroundColor in SourceCells[row].UsedFormattingFields) then
if SourceCells[row].BackgroundColor <> scTransparent then
MyWorksheet.WriteBackgroundColor(cell, SourceCells[row].BackgroundColor);
end;
@@ -216,12 +244,12 @@ begin
case ATestKind of
1, 2: // Copied values
if cell <> nil then
if (cell <> nil) and (row <= High(SourceCells)) then
begin
// Check formula results
if HasFormula(@SourceCells[row]) then
if MyHasFormula(@SourceCells[row]) then
CheckEquals(
SourceCells[0].NumberValue + 1,
SourceCells[0].NumberValue + 1, // +1 because that's what the formula does...
cell^.NumberValue,
'Result of copied formula mismatch, cell ' + CellNotation(MyWorksheet, row, col)
)
@@ -294,42 +322,49 @@ begin
1, 5:
CheckEquals(
true,
(cell = nil) or (cell^.UsedFormattingFields = []),
(cell = nil) or (MyWorksheet.ReadUsedFormatting(cell) = []),
'Default formatting mismatch, cell ' + CellNotation(MyWorksheet, row, col)
);
2, 6:
if (row = 0) then
CheckEquals(
true,
(cell = nil) or (cell^.UsedFormattingFields = []),
(cell = nil) or (MyWorksheet.ReadUsedFormatting(cell) = []),
'Default formatting mismatch, cell ' + CellNotation(MyWorksheet, row, col)
)
else
begin
CheckEquals(
true,
SourceCells[i+(col-2)].UsedFormattingFields = cell^.UsedFormattingFields,
SourceCells[i+(col-2)].UsedFormattingFields = MyWorksheet.ReadUsedFormatting(cell),
'Used formatting fields mismatch, cell ' + CellNotation(myWorksheet, row, col)
);
if (uffBackgroundColor in SourceCells[i].UsedFormattingFields) then
CheckEquals(
SourceCells[i+(col-2)].BackgroundColor,
cell^.BackgroundColor,
MyWorksheet.ReadBackgroundColor(cell),
'Background color mismatch, cell ' + CellNotation(Myworksheet, row, col)
);
end;
3, 4:
if cell <> nil then
if (i = Length(SourceCells)) and (ATestKind = 4) then
CheckEquals(
true,
(cell = nil) or (MyWorksheet.ReadUsedFormatting(cell) = []),
'Default formatting mismatch, cell ' + CellNotation(MyWorksheet, row, col)
)
else
if (cell <> nil) then
begin
CheckEquals(
true,
SourceCells[i].UsedFormattingFields = cell^.UsedFormattingFields,
SourceCells[i].UsedFormattingFields = MyWorksheet.ReadUsedFormatting(cell),
'Used formatting fields mismatch, cell ' + CellNotation(MyWorksheet, row, col)
);
if (uffBackgroundColor in SourceCells[i].UsedFormattingFields) then
CheckEquals(
SourceCells[i].BackgroundColor,
cell^.BackgroundColor,
MyWorksheet.ReadBackgroundColor(cell),
'Background color mismatch, cell ' + CellNotation(Myworksheet, row, col)
);
end;
@@ -393,192 +428,6 @@ begin
end;
end; // For
(*
case ATestKind of
1, 2:
// Copied VALUES in first colum to empty third column (ATestKind = 1) or
// occuopied second column (ATestKind = 2)
// The formula cell should contain the result of A1+1 (only value copied)
begin
if ATestKind = 1 then col := 2 else col := 1;
for row := 0 to Length(SourceCells) do
begin
cell := MyWorksheet.FindCell(row, col);
if row < Length(SourceCells) then
begin
// Check content type
if (SourceCells[row].ContentType in [cctNumber, cctUTF8String, cctEmpty]) then
CheckEquals(
GetEnumName(TypeInfo(TCellContentType), Integer(SourceCells[row].ContentType)),
GetEnumName(TypeInfo(TCellContentType), Integer(cell^.ContentType)),
'Content type mismatch, cell '+CellNotation(MyWorksheet, row, col)
);
// Check values
case SourceCells[row].ContentType of
cctNumber:
CheckEquals(
SourceCells[row].NumberValue,
cell^.NumberValue,
'Number value mismatch, cell ' + CellNotation(MyWorksheet, row, col)
);
cctUTF8String:
CheckEquals(
SourceCells[row].UTF8StringValue,
cell^.UTF8StringValue,
'String value mismatch, cell ' + CellNotation(MyWorksheet, row, col)
);
end;
// Check formula results
if HasFormula(@SourceCells[row]) then
CheckEquals(
SourceCells[0].NumberValue + 1,
cell^.NumberValue,
'Result of copied formula mismatch, cell ' + CellNotation(MyWorksheet, row, col)
);
end;
// Check format: it should not be changed when copying only values
case ATestKind of
1: // Copy to empty column --> no formatting
CheckEquals(
true, // true = "the cell has default formatting"
(cell = nil) or (cell^.UsedFormattingFields = []),
'Default format mismatch, cell ' + CellNotation(MyWorksheet, row,col)
);
2: // Copy to occupied column --> format like source, but shifted down 1 cvell
if row = 0 then // this cell should not be formatted
CheckEquals(
true,
cell^.UsedFormattingFields = [],
'Formatting fields mismatch, cell ' + CellNotation(MyWorksheet, row, col)
)
else
begin
CheckEquals(
true,
SourceCells[row-1].UsedFormattingFields = cell^.UsedFormattingFields,
'Formatting fields mismatch, cell ' + CellNotation(MyWorksheet, row, col)
);
if (uffBackgroundColor in cell^.UsedFormattingFields) then
CheckEquals(
SourceCells[row-1].BackgroundColor,
cell^.BackgroundColor,
'Background color mismatch, cell '+ CellNotation(MyWorksheet, row, col)
);
end;
end;
end;
end;
{ ------------------------------------------------ }
3: // FORMATs copied from first column to empty third column
begin
col := 2;
for row :=0 to Length(SourceCells)-1 do
begin
cell := MyWorksheet.FindCell(row, col);
// There should not be any content because the column was empty and
// we had copied only formats
CheckEquals(
true, // true = "the cell has no content"
(cell = nil) or (cell^.ContentType = cctEmpty),
'No content mismatch, cell ' + CellNotation(MyWorksheet, row,col)
);
// Check the format: it should be identical to that in column A
if cell <> nil then
begin
CheckEquals(
true,
SourceCells[row].UsedFormattingFields = cell^.UsedFormattingFields,
'Formatting fields mismatch, cell ' + CellNotation(MyWorksheet, row, col)
);
if (uffBackgroundColor in cell^.UsedFormattingFields) then
CheckEquals(
SourceCells[row].BackgroundColor,
cell^.BackgroundColor,
'Background color mismatch, cell '+ CellNotation(MyWorksheet, row, col)
);
end;
end;
end;
{ ---------------------------- }
4: // FORMATs copied from 1st to second column.
begin
col := 1;
// Check values: they should be unchanged, i.e. identical to column A,
// but there is a vertical offset by 1 cell
cell := MyWorksheet.FindCell(0, col);
CheckEquals(
true, // true = "the cell has no content"
(cell = nil) or (cell^.ContentType = cctEmpty),
'No content mismatch, cell ' + CellNotation(MyWorksheet, row,col)
);
for row := 1 to Length(SourceCells) do
begin
cell := MyWorksheet.FindCell(row, col);
// Check content type
if (SourceCells[row-1].ContentType in [cctNumber, cctUTF8String, cctEmpty]) then
CheckEquals(
GetEnumName(TypeInfo(TCellContentType), Integer(SourceCells[row-1].ContentType)),
GetEnumName(TypeInfo(TCellContentType), Integer(cell^.ContentType)),
'Content type mismatch, cell '+CellNotation(MyWorksheet, row, col)
);
// Check values
case SourceCells[row-1].ContentType of
cctNumber:
CheckEquals(
SourceCells[row-1].NumberValue,
cell^.NumberValue,
'Number value mismatch, cell ' + CellNotation(MyWorksheet, row, col)
);
cctUTF8String:
CheckEquals(
SourceCells[row-1].UTF8StringValue,
cell^.UTF8StringValue,
'String value mismatch, cell ' + CellNotation(MyWorksheet, row, col)
);
end;
// Check formula results
if HasFormula(@SourceCells[row-1]) then
CheckEquals(
SourceCells[0].NumberValue + 1,
cell^.NumberValue,
'Result of copied formula mismatch, cell ' + CellNotation(MyWorksheet, row, col)
);
end;
// Now check formatting - it should be equal to first column
for row := 0 to Length(SourceCells)-1 do
begin
cell := MyWorksheet.FindCell(row, col);
CheckEquals(
true,
SourceCells[row].UsedFormattingFields = cell^.UsedFormattingFields,
'Formatting fields mismatch, cell ' + CellNotation(MyWorksheet, row, col)
);
if (uffBackgroundColor in cell^.UsedFormattingFields) then
CheckEquals(
SourceCells[row].BackgroundColor,
cell^.BackgroundColor,
'Background color mismatch, cell '+ CellNotation(MyWorksheet, row, col)
);
end;
end;
end;
*)
finally
MyWorkbook.Free;
end;

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

@@ -40,7 +40,7 @@
<PackageName Value="FCL"/>
</Item4>
</RequiredPackages>
<Units Count="20">
<Units Count="21">
<Unit0>
<Filename Value="spreadtestgui.lpr"/>
<IsPartOfProject Value="True"/>
@@ -60,6 +60,7 @@
<Unit4>
<Filename Value="manualtests.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="manualtests"/>
</Unit4>
<Unit5>
<Filename Value="testsutility.pas"/>
@@ -81,6 +82,7 @@
<Unit9>
<Filename Value="fonttests.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="fonttests"/>
</Unit9>
<Unit10>
<Filename Value="optiontests.pas"/>
@@ -123,6 +125,11 @@
<Filename Value="sortingtests.pas"/>
<IsPartOfProject Value="True"/>
</Unit19>
<Unit20>
<Filename Value="copytests.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="copytests"/>
</Unit20>
</Units>
</ProjectOptions>
<CompilerOptions>

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

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

48
components/fpspreadsheet/xlsbiff5.pas
View File

@@ -387,29 +387,30 @@ begin
CurStreamPos := AStream.Position;
case RecordType of
INT_EXCEL_ID_BLANK : ReadBlank(AStream);
INT_EXCEL_ID_BOOLERROR : ReadBool(AStream);
INT_EXCEL_ID_MULBLANK : ReadMulBlank(AStream);
INT_EXCEL_ID_NUMBER : ReadNumber(AStream);
INT_EXCEL_ID_LABEL : ReadLabel(AStream);
INT_EXCEL_ID_RSTRING : ReadRichString(AStream); //(RSTRING) This record stores a formatted text cell (Rich-Text). In BIFF8 it is usually replaced by the LABELSST record. Excel still uses this record, if it copies formatted text cells to the clipboard.
INT_EXCEL_ID_RK : ReadRKValue(AStream); //(RK) This record represents a cell that contains an RK value (encoded integer or floating-point value). If a floating-point value cannot be encoded to an RK value, a NUMBER record will be written. This record replaces the record INTEGER written in BIFF2.
INT_EXCEL_ID_MULRK : ReadMulRKValues(AStream);
INT_EXCEL_ID_COLINFO : ReadColInfo(AStream);
INT_EXCEL_ID_STANDARDWIDTH : ReadStandardWidth(AStream, FWorksheet);
INT_EXCEL_ID_DEFCOLWIDTH : ReadDefColWidth(AStream);
INT_EXCEL_ID_ROW : ReadRowInfo(AStream);
INT_EXCEL_ID_FORMULA : ReadFormula(AStream);
INT_EXCEL_ID_SHAREDFMLA : ReadSharedFormula(AStream);
INT_EXCEL_ID_STRING : ReadStringRecord(AStream);
INT_EXCEL_ID_WINDOW2 : ReadWindow2(AStream);
INT_EXCEL_ID_PANE : ReadPane(AStream);
INT_EXCEL_ID_BOF : ;
INT_EXCEL_ID_EOF : SectionEOF := True;
{$IFDEF FPSPREADDEBUG} // Only write out if debugging
INT_EXCEL_ID_BLANK : ReadBlank(AStream);
INT_EXCEL_ID_BOOLERROR : ReadBool(AStream);
INT_EXCEL_ID_MULBLANK : ReadMulBlank(AStream);
INT_EXCEL_ID_NUMBER : ReadNumber(AStream);
INT_EXCEL_ID_LABEL : ReadLabel(AStream);
INT_EXCEL_ID_RSTRING : ReadRichString(AStream); //(RSTRING) This record stores a formatted text cell (Rich-Text). In BIFF8 it is usually replaced by the LABELSST record. Excel still uses this record, if it copies formatted text cells to the clipboard.
INT_EXCEL_ID_RK : ReadRKValue(AStream); //(RK) This record represents a cell that contains an RK value (encoded integer or floating-point value). If a floating-point value cannot be encoded to an RK value, a NUMBER record will be written. This record replaces the record INTEGER written in BIFF2.
INT_EXCEL_ID_MULRK : ReadMulRKValues(AStream);
INT_EXCEL_ID_COLINFO : ReadColInfo(AStream);
INT_EXCEL_ID_STANDARDWIDTH : ReadStandardWidth(AStream, FWorksheet);
INT_EXCEL_ID_DEFCOLWIDTH : ReadDefColWidth(AStream);
INT_EXCEL_ID_ROW : ReadRowInfo(AStream);
INT_EXCEL_ID_FORMULA : ReadFormula(AStream);
INT_EXCEL_ID_SHAREDFMLA : ReadSharedFormula(AStream);
INT_EXCEL_ID_STRING : ReadStringRecord(AStream);
INT_EXCEL_ID_WINDOW2 : ReadWindow2(AStream);
INT_EXCEL_ID_PANE : ReadPane(AStream);
INT_EXCEL_ID_BOF : ;
INT_EXCEL_ID_EOF : SectionEOF := True;
{$IFDEF FPSPREADDEBUG} // Only write out if debugging
else
// Show unsupported record types to console.
// Show unsupported record types to console.
case RecordType of
$000C: ; //(CALCCOUNT) This record is part of the Calculation Settings Block. It specifies the maximum number of times the formulas should be iteratively calculated. This is a fail-safe against mutually recursive formulas locking up a spreadsheet application.
$000D: ; //(CALCMODE) This record is part of the Calculation Settings Block. It specifies whether to calculate formulas manually, automatically or automatically except for multiple table operations.
@@ -444,7 +445,7 @@ begin
else
WriteLn(format('Record type: %.4X Record Size: %.4X',[RecordType,RecordSize]));
end;
{$ENDIF}
{$ENDIF}
end;
// Make sure we are in the right position for the next record
@@ -748,9 +749,6 @@ begin
// Final preparations
Inc(FCurrentWorksheet);
if FCurrentWorksheet = FWorksheetNames.Count then BIFF5EOF := True;
// It can happen in files written by Office97 that the OLE directory is
// at the end of the file.
end;
if not FPaletteFound then