lazarus-ccr/components/fpspreadsheet/unit-tests/common/manualtests.pas

unit manualtests;

{
 Tests that can be run but need a human to check results.
 Examples are color output, rotation, bold etc
 Of course, you could write Excel macros to do this for you; patches welcome ;)
}

{$mode objfpc}{$H+}

{
Adding tests/test data:
1. Increase Soll* array size
2. Add desired normative value InitNormVariables so you can test against it
3. Add your write test(s) including instructions for the humans check the resulting file
}

interface

uses
  // Not using lazarus package as the user may be working with multiple versions
  // Instead, add .. to unit search path
  Classes, SysUtils, testregistry, testdecorator, fpcunit,
  {%H-}fpsallformats, fpspreadsheet, {%H-}fpscell,
  xlsbiff8 {and a project requirement for lclbase for utf8 handling},
  testsutility;

{
var
  // Norm to test against - list of dates/times that should occur in spreadsheet
  SollColors: array[0..16] of tsColor; //"Soll" is a German word in Dutch accountancy jargon meaning "normative value to check against". There ;)
  SollColorNames: array[0..16] of string; //matching names for SollColors
  // Initializes Soll*/normative variables.
  // Useful in test setup procedures to make sure the norm is correct.
  procedure InitSollColors;
 }

type
  { TSpreadManualSetup }
  TSpreadManualSetup= class(TTestSetup)
  protected
    procedure OneTimeSetup; override;
    procedure OneTimeTearDown; override;
  end;

  { TSpreadManualTests }
  // Writes to file and let humans figure out if the correct output was generated
  TSpreadManualTests= class(TTestCase)
  private
  protected
    // Set up expected values:
    procedure SetUp; override;
    procedure TearDown; override;
  published
    // Current fpspreadsheet does not yet have support for new RPN formulas
    {$DEFINE FPSPREAD_HAS_NEWRPNSUPPORT}
    {$IFDEF FPSPREAD_HAS_NEWRPNSUPPORT}
    // As described in bug 25718: Feature request & patch: Implementation of writing more functions
    // Writes all rpn formulas. Use Excel or Open/LibreOffice to check validity.
    procedure TestRPNFormula;
    // Dto, but writes string formulas.
//    procedure TestStringFormula;
    {$ENDIF}
    // For BIFF8 format, writes all background colors in A1..A16
    procedure TestBiff8CellBackgroundColor;

    procedure TestNumberFormats;
  end;

implementation

uses
  fpstypes, fpsUtils, fpsPalette, rpnFormulaUnit;

const
  COLORSHEETNAME='color_sheet'; //for background color tests
  RPNSHEETNAME='rpn_formula_sheet'; //for rpn formula tests
  NUMBERFORMATSHEETNAME='number format sheet';  // for number format tests
  OUTPUT_FORMAT = sfExcel8; //change manually if you want to test different formats. To do: automatically output all formats

var
  Workbook: TsWorkbook = nil;
 (*
// Initialize array with variables that represent the values
// we expect to be in the test spreadsheet files.
//
// When adding tests, add values to this array
// and increase array size in variable declaration
procedure InitSollColors;
begin
  // Set up norm - MUST match spreadsheet cells exactly
  // Follows fpspreadsheet.TsColor, except custom colors
  SollColors[0]:=scBlack;
  SollColors[1]:=scWhite;
  SollColors[2]:=scRed;
  SollColors[3]:=scGREEN;
  SollColors[4]:=scBLUE;
  SollColors[5]:=scYELLOW;
  SollColors[6]:=scMAGENTA;
  SollColors[7]:=scCYAN;
  SollColors[8]:=scDarkRed;
  SollColors[9]:=scDarkGreen;
  SollColors[10]:=scDarkBlue;
  SollColors[11]:=scOLIVE;
  SollColors[12]:=scPURPLE;
  SollColors[13]:=scTEAL;
  SollColors[14]:=scSilver;
  SollColors[15]:=scGrey;
  SollColors[16]:=scOrange;
  {
  SollColors[16]:=scGrey10pct;
  SollColors[17]:=scGrey20pct;
  SollColors[18]:=scOrange;
  SollColors[19]:=scDarkBrown;
  SollColors[20]:=scBrown;
  SollColors[21]:=scBeige;
  SollColors[22]:=scWheat;
   }
  // Corresponding names for display in cells:
  SollColorNames[0]:='scBlack';
  SollColorNames[1]:='scWhite';
  SollColorNames[2]:='scRed';
  SollColorNames[3]:='scGREEN';
  SollColorNames[4]:='scBLUE';
  SollColorNames[5]:='scYELLOW';
  SollColorNames[6]:='scMAGENTA';
  SollColorNames[7]:='scCYAN';
  SollColorNames[8]:='scDarkRed';
  SollColorNames[9]:='scDarkGreen';
  SollColorNames[10]:='scDarkBlue';
  SollColorNames[11]:='scOLIVE';
  SollColorNames[12]:='scPURPLE';
  SollColorNames[13]:='scTEAL';
  SollColorNames[14]:='scSilver';
  SollColorNames[15]:='scGrey';
  SollColorNames[16]:='scOrange';
  {
  SollColorNames[16]:='scGrey10pct';
  SollColorNames[17]:='scGrey20pct';
  SollColorNames[18]:='scOrange';
  SollColorNames[19]:='scDarkBrown';
  SollColorNames[20]:='scBrown';
  SollColorNames[21]:='scBeige';
  SollColorNames[22]:='scWheat';
  }
end;
   *)

{ TSpreadManualSetup }

procedure TSpreadManualSetup.OneTimeSetup;
begin
  // One time setup for entire suite: nothing needed here yet
end;

procedure TSpreadManualSetup.OneTimeTearDown;
begin
  if Workbook <> nil then begin
    // In Ubuntu explicit deletion of the existing file is needed.
    // Otherwise an error would occur and a defective file would be written }
    if FileExists(TestFileManual) then DeleteFile(TestFileManual);

    Workbook.WriteToFile(TestFileManual, OUTPUT_FORMAT, TRUE);
    Workbook.Free;
    Workbook := nil;
  end;
end;

{ TSpreadManualTests }
procedure TSpreadManualTests.SetUp;
begin
//  InitSollColors;
end;

procedure TSpreadManualTests.TearDown;
begin
  // nothing to do here, yet
end;

procedure TSpreadManualTests.TestBiff8CellBackgroundColor();
// source: forum post
// http://forum.lazarus.freepascal.org/index.php/topic,19887.msg134114.html#msg134114
// possible fix for values there too
var
  Worksheet: TsWorksheet;
  Cell : PCell;
  i: cardinal;
  RowOffset: cardinal;
  palette: TsPalette;
begin
  if OUTPUT_FORMAT <> sfExcel8 then
    {%H-}Ignore('This test only applies to BIFF8 XLS output format.');

  // 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
    {%H-}Ignore('BIFF2 does not support worksheets. Ignoring manual tests for now');

  if Workbook = nil then
    Workbook := TsWorkbook.Create;

  palette := TsPalette.Create;
  try
    palette.AddBuiltinColors;
    palette.AddExcelColors;

    Worksheet := Workbook.AddWorksheet(COLORSHEETNAME);
    WorkSheet.WriteText(0, 1, 'TSpreadManualTests.TestBiff8CellBackgroundColor');
    RowOffset := 1;
    for i:=0 to palette.Count-1 do begin
      cell := WorkSheet.WriteText(i+RowOffset,0,'BACKGROUND COLOR TEST');
      Worksheet.WriteBackgroundColor(Cell, palette[i]);
      Worksheet.WriteFontColor(cell, HighContrastColor(palette[i]));
      WorkSheet.WriteText(i+RowOffset,1,'Cell to the left should be '+GetColorName(palette[i])+'. Please check.');
    end;
    Worksheet.WriteColWidth(0, 30, suChars);
    Worksheet.WriteColWidth(1, 60, suChars);
  finally
    palette.Free;
  end;
end;

procedure TSpreadManualTests.TestNumberFormats();
// source: forum post
// http://forum.lazarus.freepascal.org/index.php/topic,19887.msg134114.html#msg134114
// possible fix for values there too
const
  Values: Array[0..4] of Double = (12000.34, -12000.34, 0.0001234, -0.0001234, 0.0);
  FormatStrings: array[0..24] of String = (
    'General',
    '0',     '0.00',     '0.0000',
    '#,##0', '#,##0.00', '#,##0.0000',
    '0%',    '0.00%',    '0.0000%',
    '0,',    '0.00,',    '0.0000,',
    '0E+00', '0.00E+00', '0.0000E+00',
    '0E-00', '0.00E-00', '0.0000E-00',
    '# ?/?', '# ??/??',  '# ????/????',
    '?/?',   '??/??',    '????/????'
  );
var
  Worksheet: TsWorksheet;
  r, c: Cardinal;
begin
  if OUTPUT_FORMAT <> sfExcel8 then
    {%H-}Ignore('This test only applies to BIFF8 XLS output format.');

  // 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
    {%H-}Ignore('BIFF2 does not support worksheets. Ignoring manual tests for now');

  if Workbook = nil then
    Workbook := TsWorkbook.Create;

  Worksheet := Workbook.AddWorksheet(NUMBERFORMATSHEETNAME);
  WorkSheet.WriteText(0, 1, 'Number format tests');

  for r:=0 to High(FormatStrings) do
  begin
    Worksheet.WriteText(r+2, 0, FormatStrings[r]);
    for c:=0 to High(Values) do
      Worksheet.WriteNumber(r+2, c+1, values[c], nfCustom, FormatStrings[r]);
  end;

  Worksheet.WriteColWidth(0, 20, suChars);
end;

{$IFDEF FPSPREAD_HAS_NEWRPNSUPPORT}
// As described in bug 25718: Feature request & patch: Implementation of writing more functions
procedure TSpreadManualTests.TestRPNFormula;
var
  Worksheet: TsWorksheet;
begin
  if Workbook = nil then
    Workbook := TsWorkbook.Create;

  Worksheet := Workbook.AddWorksheet(RPNSHEETNAME);
  WriteRPNFormulaSamples(Worksheet, OUTPUT_FORMAT, false);
end;
                                                               (*
procedure TSpreadManualTests.TestStringFormula;
var
  Worksheet: TsWorksheet;
begin
  if Workbook = nil then
    Workbook := TsWorkbook.Create;

  Worksheet := Workbook.AddWorksheet(FORMULASHEETNAME);
  WriteRPNFormulaSamples(Worksheet, OUTPUT_FORMAT, false, false);
end;
*)
{$ENDIF}

initialization
  // Register one time setup/teardown and associated test class to actually run the tests
  RegisterTestDecorator(TSpreadManualSetup,TSpreadManualTests);
  // Initialize the norm variables in case other units want to use it:
//  InitSollColors;

end.