You've already forked lazarus-ccr
* Tests part of patch referenced issue 25718 (actual patch on forum) for RPN formulas. Thanks wp.
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@2929 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
@ -20,7 +20,7 @@ interface
|
|||||||
uses
|
uses
|
||||||
// Not using lazarus package as the user may be working with multiple versions
|
// Not using lazarus package as the user may be working with multiple versions
|
||||||
// Instead, add .. to unit search path
|
// Instead, add .. to unit search path
|
||||||
Classes, SysUtils, fpcunit, testutils, testregistry,
|
Classes, SysUtils, fpcunit, testutils, testregistry, testdecorator,
|
||||||
fpsallformats, fpspreadsheet, xlsbiff8 {and a project requirement for lclbase for utf8 handling},
|
fpsallformats, fpspreadsheet, xlsbiff8 {and a project requirement for lclbase for utf8 handling},
|
||||||
testsutility;
|
testsutility;
|
||||||
|
|
||||||
@ -33,6 +33,13 @@ var
|
|||||||
procedure InitSollColors;
|
procedure InitSollColors;
|
||||||
|
|
||||||
type
|
type
|
||||||
|
{ TSpreadManualSetup }
|
||||||
|
TSpreadManualSetup= class(TTestSetup)
|
||||||
|
protected
|
||||||
|
//procedure OneTimeSetup; override;
|
||||||
|
procedure OneTimeTearDown; override;
|
||||||
|
end;
|
||||||
|
|
||||||
{ TSpreadManualTests }
|
{ TSpreadManualTests }
|
||||||
// Writes to file and let humans figure out if the correct output was generated
|
// Writes to file and let humans figure out if the correct output was generated
|
||||||
TSpreadManualTests= class(TTestCase)
|
TSpreadManualTests= class(TTestCase)
|
||||||
@ -42,12 +49,25 @@ type
|
|||||||
procedure SetUp; override;
|
procedure SetUp; override;
|
||||||
procedure TearDown; override;
|
procedure TearDown; override;
|
||||||
published
|
published
|
||||||
|
// Writes all rpn formulas. Use Excel or Open/LibreOffice to check validity.
|
||||||
|
procedure TestRPNFormula;
|
||||||
// Writes all background colors in A1..A16
|
// Writes all background colors in A1..A16
|
||||||
procedure TestBiff8CellBackgroundColor;
|
procedure TestBiff8CellBackgroundColor;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
implementation
|
implementation
|
||||||
|
|
||||||
|
uses
|
||||||
|
Math, StrUtils,
|
||||||
|
fpsUtils;
|
||||||
|
|
||||||
|
const
|
||||||
|
OUTPUT_FORMAT = sfExcel8;
|
||||||
|
FALSE_TRUE: array[Boolean] of String = ('FALSE', 'TRUE');
|
||||||
|
|
||||||
|
var
|
||||||
|
Workbook: TsWorkbook = nil;
|
||||||
|
|
||||||
// Initialize array with variables that represent the values
|
// Initialize array with variables that represent the values
|
||||||
// we expect to be in the test spreadsheet files.
|
// we expect to be in the test spreadsheet files.
|
||||||
//
|
//
|
||||||
@ -107,6 +127,16 @@ begin
|
|||||||
SollColorNames[22]:='scWheat';
|
SollColorNames[22]:='scWheat';
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
{ TSpreadManualSetup }
|
||||||
|
|
||||||
|
procedure TSpreadManualSetup.OneTimeTearDown;
|
||||||
|
begin
|
||||||
|
if Workbook <> nil then begin
|
||||||
|
Workbook.WriteToFile(TestFileManual, OUTPUT_FORMAT, TRUE);
|
||||||
|
Workbook.Free;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
{ TSpreadManualTests }
|
{ TSpreadManualTests }
|
||||||
procedure TSpreadManualTests.SetUp;
|
procedure TSpreadManualTests.SetUp;
|
||||||
begin
|
begin
|
||||||
@ -118,21 +148,24 @@ begin
|
|||||||
|
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
procedure TSpreadManualTests.TestBiff8CellBackgroundColor();
|
procedure TSpreadManualTests.TestBiff8CellBackgroundColor();
|
||||||
// source: forum post
|
// source: forum post
|
||||||
// http://forum.lazarus.freepascal.org/index.php/topic,19887.msg134114.html#msg134114
|
// http://forum.lazarus.freepascal.org/index.php/topic,19887.msg134114.html#msg134114
|
||||||
// possible fix for values there too
|
// possible fix for values there too
|
||||||
const
|
|
||||||
OUTPUT_FORMAT = sfExcel8;
|
|
||||||
var
|
var
|
||||||
Workbook: TsWorkbook;
|
|
||||||
Worksheet: TsWorksheet;
|
Worksheet: TsWorksheet;
|
||||||
Cell : PCell;
|
Cell : PCell;
|
||||||
i: cardinal;
|
i: cardinal;
|
||||||
RowOffset: cardinal;
|
RowOffset: cardinal;
|
||||||
begin
|
begin
|
||||||
Workbook := TsWorkbook.Create;
|
// No worksheets in BIFF2. Since main interest is here in formulas we just jump
|
||||||
|
// off here - need to change this in the future...
|
||||||
|
if OUTPUT_FORMAT = sfExcel2 then
|
||||||
|
Ignore('BIFF2 does not support worksheets. Ignoring manual tests for now');
|
||||||
|
|
||||||
|
if Workbook = nil then
|
||||||
|
Workbook := TsWorkbook.Create;
|
||||||
|
|
||||||
Worksheet := Workbook.AddWorksheet('colorsheet');
|
Worksheet := Workbook.AddWorksheet('colorsheet');
|
||||||
WorkSheet.WriteUTF8Text(0,1,'TSpreadManualTests.TestBiff8CellBackgroundColor');
|
WorkSheet.WriteUTF8Text(0,1,'TSpreadManualTests.TestBiff8CellBackgroundColor');
|
||||||
RowOffset:=1;
|
RowOffset:=1;
|
||||||
@ -145,18 +178,17 @@ begin
|
|||||||
include (Cell^.UsedFormattingFields,uffBackgroundColor);
|
include (Cell^.UsedFormattingFields,uffBackgroundColor);
|
||||||
WorkSheet.WriteUTF8Text(i+RowOffset,1,'Cell to the left should be tsColor value '+SollColorNames[i]+'. Please check.');
|
WorkSheet.WriteUTF8Text(i+RowOffset,1,'Cell to the left should be tsColor value '+SollColorNames[i]+'. Please check.');
|
||||||
end;
|
end;
|
||||||
// todo: move to a shared workbook object, write at tests suite finish
|
|
||||||
// http://wiki.lazarus.freepascal.org/fpcunit#Test_decorator:_OneTimeSetup_and_OneTimeTearDown
|
|
||||||
Workbook.WriteToFile(TestFileManual, OUTPUT_FORMAT, TRUE);
|
|
||||||
Workbook.Free;
|
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
procedure TSpreadManualTests.TestRPNFormula;
|
||||||
|
{$I rpntests.inc}
|
||||||
|
|
||||||
initialization
|
initialization
|
||||||
// Register so these tests are included in a full run
|
// Register so these tests are included in a full run
|
||||||
RegisterTest(TSpreadManualTests);
|
RegisterTest(TSpreadManualTests);
|
||||||
// Initialize the norm variables in case other units want to use it:
|
// Initialize the norm variables in case other units want to use it:
|
||||||
InitSollColors;
|
InitSollColors;
|
||||||
|
|
||||||
end.
|
end.
|
||||||
|
|
||||||
|
|
||||||
|
1944
components/fpspreadsheet/tests/rpntests.inc
Normal file
1944
components/fpspreadsheet/tests/rpntests.inc
Normal file
File diff suppressed because it is too large
Load Diff
Reference in New Issue
Block a user