fpc/packages/fcl-report/test/tcbasereport.pp

{
    This file is part of the Free Pascal run time library.
    Copyright (c) 1999-2022 by Michael van Canneyt and other members of the
    Free Pascal development team

    base report tests 

    See the file COPYING.FPC, included in this distribution,
    for details about the copyright.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.

 **********************************************************************}
unit tcbasereport;

{$mode objfpc}{$H+}

{.$define gdebug}

interface

uses
  Classes,
  SysUtils,
  fpcunit,
  testregistry,
  fpexprpars,
  fpCanvas,
  fpReport;

type

  TMyFPReportComponent = class(TFPReportComponent)
  public
    procedure StartLayout; override;
    procedure EndLayout; override;
    procedure StartRender; override;
    procedure EndRender; override;
  end;


  TMyFPReportElement = class(TFPReportElement)
  private
    FChangedCalled: integer;
  public
    procedure CallChange;
    procedure ResetChanged;
    procedure DoChanged; override;
    property ChangedCalled: integer read FChangedCalled;
  end;


  TMyFPReportElementWithChildren = class(TFPReportElementWithChildren)
  private
    FChangedCalled: integer;
  public
    procedure CallChange;
    procedure ResetChanged;
    procedure DoChanged; override;
    property ChangedCalled: integer read FChangedCalled;
  end;


  TMyFPReportPageSize = class(TFPReportPageSize)
  private
    FChangedCalled: integer;
  public
    procedure ResetChanged;
    procedure Changed; override;
    property ChangedCalled: integer read FChangedCalled;
  end;


  TMyFPReportPage = class(TFPReportPage)
  private
    FChangedCalled: integer;
    FPrepareObjectsCalled: integer;
    procedure SetupPage;
  protected
    procedure PrepareObjects(aRTParent: TFPReportElement); override;
  public
    constructor Create(AOwner: TComponent); override;
    procedure ResetChanged;
    procedure DoChanged; override;
    property ChangedCalled: integer read FChangedCalled;
  end;


  TMyReportTitleBand = class(TFPReportCustomTitleBand)
  private
    FPrepareObjectsCalled: integer;
  protected
    procedure PrepareObjects(aRTParent: TFPReportElement); override;
  public
    constructor Create(AOwner: TComponent); override;
  end;


  TMyDataBand = class(TFPReportDataBand)
  private
    FPrepareObjectsCalled: integer;
  protected
    procedure PrepareObjects(aRTParent: TFPReportElement); override;
  public
    constructor Create(AOwner: TComponent); override;
  end;


  TMyCustomReport = class(TFPReport)
  end;


  TMyFPReportData = class(TFPReportData)
  private
    FCC: integer;
    FDFC: integer;
    FEC: integer;
    FFC: integer;
    FNC: integer;
    FOC: integer;
    FOE: boolean;
    FReportEOF: boolean;
  public
    procedure ResetCounts;
    procedure DoInitDataFields; override;
    procedure DoOpen; override;
    procedure DoFirst; override;
    procedure DoNext; override;
    procedure DoClose; override;
    function DoEOF: boolean; override;
    property InitDataFieldsCount: integer read FDFC;
    property OpenCount: integer read FOC;
    property FirstCount: integer read FFC;
    property NextCount: integer read FNC;
    property CloseCount: integer read FCC;
    property EOFCount: integer read FEC;
    property ReportEOF: boolean read FReportEOF write FReportEOF;
    property OldEOF: boolean read FOE;
    property Datafields;
  end;


  TTestFPPageSize = class(TTestCase)
  published
    procedure TestCreate;
  end;


  TTestFPPapers = class(TTestCase)
  protected
    FM: TFPReportPaperManager;
    procedure Setup; override;
    procedure TearDown; override;
    procedure RegisterPapers(ACount: integer; Local: boolean = True);
  end;


  TTestFPPaperManager = class(TTestFPPapers)
  private
    FAccess: integer;
    procedure TestAccess;
  protected
    procedure Setup; override;
  published
    procedure TestCreate;
    procedure TestRegister1;
    procedure TestRegister2;
    procedure TestRegister3;
    procedure TestRegisterDuplicate;
    procedure TestClear;
    procedure TestFind1;
    procedure TestFind2;
    procedure TestFind3;
    procedure IllegalAccess1;
    procedure IllegalAccess2;
    procedure IllegalAccess3;
    procedure IllegalAccess4;
    procedure IllegalAccess5;
    procedure IllegalAccess6;
    procedure IllegalAccess7;
    procedure IllegalAccess8;
    procedure TestWidth;
    procedure TestHeight;
  end;


  TTestFPReportPageSize = class(TTestFPPapers)
  private
    FP: TMyFPReportPageSize;
  protected
    procedure Setup; override;
    procedure TearDown; override;
  published
    procedure TestCreate;
    procedure TestCreateWithPage;
    procedure TestCreateByPage;
    procedure TestChanged1;
    procedure TestChanged2;
    procedure TestChanged3;
    procedure TestPaperName1;
    procedure TestPaperName2;
    procedure TestAssign;
  end;


  TBaseReportComponentTest = class(TTestCase)
  private
    FC: TMyFPReportComponent;
    procedure ExpectState(const aExpected: TFPReportState);
  protected
    procedure AssertEquals(Msg: string; const aExpected, AActual: TFPReportState); overload;
    procedure SetUp; override;
    procedure TearDown; override;
  end;


  TTestReportComponent = class(TBaseReportComponentTest)
  published
    procedure TestCreate;
    procedure TestLayoutState;
    procedure TestRenderState;
  end;


  TBaseReportElementTest = class(TTestCase)
  private
    FC: TMyFPReportElement;
  protected
    procedure SetUp; override;
    procedure TearDown; override;
  end;


  TReportElementTest = class(TBaseReportElementTest)
  published
    procedure TestCreate;
    procedure TestDoChange;
    procedure TestChangeCount;
    procedure TestChangeCountNested;
    procedure TestChangeCountNested2;
    procedure TestVisibleChanges;
    procedure TestLayoutChanges;
    procedure TestFrameChanges;
    procedure TestAssign;
    procedure TestEquals1;
    procedure TestEquals2;
    procedure TestEquals3;
    procedure TestEquals4;
    procedure TestEquals5;
  end;


  TTestReportChildren = class(TTestCase)
  private
    FC, FC2: TMyFPReportElementWithChildren;
    FChild: TFPReportElement;
  protected
    procedure SetUp; override;
    procedure TearDown; override;
    procedure WrongParent;
  published
    procedure TestCreate;
    procedure TestSetParent1;
    procedure TestSetParent2;
    procedure TestSetParent3;
    procedure TestSetParent4;
    procedure TestSetParent5;
    procedure TestSetParent6;
  end;


  TTestReportFrame = class(TBaseReportElementTest)
  published
    procedure TestCreate;
    procedure TestWidthChange;
    procedure TestColorChange;
    procedure TestPenStyleChange;
    procedure TestShapeChange;
    procedure TestLinesChange;
    procedure TestAssign;
    procedure TestEquals1;
    procedure TestEquals2;
    procedure TestEquals3;
    procedure TestEquals4;
    procedure TestEquals5;
    procedure TestEquals6;
    procedure TestEquals7;
  end;


  TTestReportLayout = class(TBaseReportElementTest)
  published
    procedure TestCreate;
    procedure TestTopChange;
    procedure TestLeftChange;
    procedure TestWidthChange;
    procedure TestHeightChange;
    procedure TestAssign;
    procedure TestEquals1;
    procedure TestEquals2;
    procedure TestEquals3;
    procedure TestEquals4;
    procedure TestEquals5;
    procedure TestEquals6;
  end;


  TTestCaseWithData = class(TTestCase)
  private
    FData: TFPReportUserData;
    FSL: TStringList;
    procedure InitializeData(const ACount: integer);
    procedure SetReportData(const ADataCount: Byte);
    procedure DoGetDataValue(Sender: TObject; const AValueName: string; var AValue: variant);
    procedure DoGetDataEOF(Sender: TObject; var IsEOF: boolean);
  protected
    procedure SetUp; override;
    procedure TearDown; override;
  public
    property Data: TFPReportUserData read FData write FData;
  end;


  TTestCaseWithDataAndReport = class(TTestCaseWithData)
  private
    FReport: TMyCustomReport;
  protected
    procedure SetUp; override;
    procedure TearDown; override;
  public
    property Report: TMyCustomReport read FReport write FReport;
  end;


  TTestReportPage = class(TTestCase)
  private
    FP: TMyFPReportPage;
  protected
    procedure Setup; override;
    procedure TearDown; override;
  published
    procedure TestCreate1;
    procedure TestCreate2;
    procedure TestCreate3;
    procedure TestPageSize1;
    procedure TestPageSize2;
    procedure TestPageSize3;
    procedure TestBand1;
    procedure TestBand2;
    procedure TestData;
    procedure TestAssign;
    procedure TestFindBand;
  end;


  TTestReportData = class(TTestCase)
  private
    FD: TMyFPReportData;
    FHandler: boolean;
    procedure AssertField(Prefix: string; F: TFPReportDataField; AFieldName: string;
      AFieldKind: TFPReportFieldKind; ADisplayWidth: integer = 0);
  protected
    procedure DoOpen(Sender: TObject);
    procedure DoNext(Sender: TObject);
    procedure Setup; override;
    procedure TearDown; override;
    procedure CreateFields;
    procedure DoFieldByName;
  published
    procedure TestCreate;
    procedure TestOpen1;
    procedure TestNext;
    procedure TestInitFieldDefs;
    procedure TestInitFieldDefs_OnlyAllowedOnce;
    procedure TestEOF1;
    procedure TestAddDatafield;
    procedure TestDatafieldAdd;
    procedure TestCreateFields;
    procedure TestDatafieldIndexOf1;
    procedure TestDatafieldIndexOf2;
    procedure TestFindField1;
    procedure TestFindField2;
    procedure TestFindByName1;
    procedure TestFindByName2;
    procedure TestFieldAssign;
    procedure TestGetValue;
    procedure TestEasyAccessProperties;
  end;


  { Testing UserData by pulling data from a DataField }
  TTestUserReportData = class(TTestCase)
  private
    FD: TFPReportUserData;
    FExpectName: string;
    FReturnValue: variant;
    procedure DoValue(Sender: TObject; const AValueName: string; var AValue: variant);
  protected
    procedure Setup; override;
    procedure TearDown; override;
  published
    procedure TestGetValue;
  end;


  { Testing UserData by pulling data from a StringList }
  TTestUserReportData2 = class(TTestCase)
  private
    FData: TFPReportUserData;
    FSL: TStringList;
    procedure DoGetValue(Sender: TObject; const AValueName: string; var AValue: variant);
    procedure DoGetEOF(Sender: TObject; var IsEOF: boolean);
  protected
    procedure Setup; override;
    procedure TearDown; override;
  published
    procedure TestGetValue;
    procedure TestOnGetEOF1;
    procedure TestOnGetEOF2;
  end;


  TTestDataBand = class(TTestCaseWithDataAndReport)
  private
    FDataBand: TFPReportDataBand;
  protected
    procedure Setup; override;
    procedure TearDown; override;
  published
    procedure TestData;
    procedure TestDataPropertyAutoSet;
  end;


  TTestCustomReport = class(TTestCase)
  private
    FRpt: TMyCustomReport;
    FBeginReportCount: integer;
    FEndReportCount: integer;
    FSL: TStringList;
    FData: TFPReportUserData;
    procedure HandleOnBeginReport;
    procedure HandleOnEndReport;
    procedure InitializeData(const ACount: integer);
    procedure SetReportData(const ADataCount: Byte);
    procedure DoGetDataValue(Sender: TObject; const AValueName: string; var AValue: variant);
    procedure DoGetDataEOF(Sender: TObject; var IsEOF: boolean);
    procedure DoGetDataFieldNames(Sender: TObject; List: TStrings);
  protected
    procedure Setup; override;
    procedure TearDown; override;
  public
    property Data: TFPReportUserData read FData;
    property Report: TMyCustomReport read FRpt write FRpt;
  published
    procedure TestBeginReportEvent;
    procedure TestEndReportEvent;
    procedure TestPagePrepareObjects;
    procedure TestBandPrepareObjects;
    procedure TestRTObjects1;
    procedure TestRTObjects2;
    procedure TestRTObjects3;
    procedure TestRTObjects4_OneDataItem;
    procedure TestRTObjects5_TwoDataItems;
    procedure TestInternalFunction_Page;
    procedure TestInternalFunction_Page_with_text;
    procedure TestInternalFunction_RecNo;
    procedure TestInternalFunction_Today;
    procedure TestInternalFunction_Today_with_text;
    procedure TestInternalFunction_Author;
    procedure TestInternalFunction_Author_with_text;
    procedure TestInternalFunction_Title;
    procedure TestInternalFunction_Title_with_text;
  end;


  { TTestReportMemo }

  TTestReportMemo = class(TTestCase)
  private
    FMemo: TFPReportMemo;
    procedure CauseFontNotFoundException;
  protected
    procedure SetUp; override;
    procedure TearDown; override;
  published
    procedure TestCreate;
    procedure TestPrepareTextBlocks;
    procedure TestPrepareTextBlocks_multiline_data;
    procedure TestPrepareTextBlocks_multiline_wraptext;
    procedure TestPrepareTextBlocks_multiline_wraptext_oneword;
    procedure TestPrepareTextBlocks_multiline_wraptext_oneword_overflow;
    procedure TestPrepareTextBlocks_multiline_wraptext_oneword_split;
    procedure TestRGBToReportColor;
    procedure TestHTMLColorToReportColor_length7;
    procedure TestHTMLColorToReportColor_length6;
    procedure TestHTMLColorToReportColor_length3;
    procedure TestCreateTestBlock;
    procedure TestCreateTestBlock_IsURL;
    procedure TestSubStr;
    procedure TestTokenCount;
    procedure TestToken;
  end;


  TTestBandList = class(TTestCase)
  private
    FList: TBandList;
    b1: TFPReportPageHeaderBand;
    b2: TFPReportTitleBand;
    b3: TFPReportDataBand;
    procedure CreateBands;
    procedure AddAllBandsToList;
  protected
    procedure SetUp; override;
    procedure TearDown; override;
  published
    procedure TestAdd;
    procedure TestItems;
    procedure TestClear;
    procedure TestDelete;
    procedure TestFind1;
    procedure TestFind2;
  end;

  { TTestVariableBase }

  TTestVariableBase = Class(TTestCase)
  Public
    Class procedure AssertEquals(Const Msg : String; AExpected,AActual : TResultType); overload;
  end;

  { TTestVariable }

  TTestVariable = Class(TTestVariableBase)
  private
    FVar: TFPReportVariable;
  Protected
    Procedure SetUp; override;
    Procedure TearDown; override;
    Property Variable : TFPReportVariable Read FVar;
  Published
    Procedure TestEmpty;
    Procedure TestName;
    Procedure TestBoolean;
    Procedure TestInteger;
    Procedure TestDateTime;
    Procedure TestFloat;
    Procedure TestString;
    Procedure TestExpressionResult;
  end;

  { TTestVariables }

  TTestVariables  = Class(TTestVariableBase)
  private
    FVar: TFPReportVariables;
    FV : Array[0..2] of TFPReportVariable;
    procedure AddThree;
  Protected
    Procedure SetUp; override;
    Procedure TearDown; override;
    Property Variables : TFPReportVariables Read FVar;
  Published
    Procedure TestEmpty;
    Procedure TestAdd;
    Procedure TestIndexOf;
    Procedure TestFind;
  end;

implementation

uses
  TypInfo,
  DateUtils,
  fpTTF;

type
  TMemoFriend = class(TFPReportMemo);

{ TTestVariables }

procedure TTestVariables.SetUp;
begin
  inherited SetUp;
  FVar:=TFPReportVariables.Create(Nil,TFPReportVariable);
end;

procedure TTestVariables.TearDown;
begin
  FreeAndNil(FVar);
  inherited TearDown;
end;

procedure TTestVariables.TestEmpty;
begin
  AssertNotNull('Have variables',Variables);
  AssertEquals('Variable count',0,Variables.Count);
  AssertTrue('Variable class',Variables.ItemClass.InheritsFrom(TFPReportVariable));
end;

procedure TTestVariables.TestAdd;

Var
  V : TFPReportVariable;

begin
  V:=Variables.addVariable('aName');
  AssertNotNull('Have result',V);
  AssertEquals('Correct name','aName',V.Name);
  AssertEquals('Correct type',rtString,V.DataType);
  AssertEquals('Correct value','',V.AsString);
  AssertEquals('Added to collection',1,Variables.Count);
  AssertSame('In array',V,Variables[0]);
  ExpectException('Cannot add twice',EReportError);
  V:=Variables.addVariable('aName');
end;

procedure TTestVariables.AddThree;

Var
  I: integer;

begin
  For I:=0 to 2 do
    FV[I]:=Variables.Addvariable('aName'+IntToStr(i+1));
end;

procedure TTestVariables.TestIndexOf;
begin
  AddThree;
  AssertEquals('First',0,Variables.IndexOfVariable('aName1'));
  AssertEquals('Second',1,Variables.IndexOfVariable('aName2'));
  AssertEquals('Third',2,Variables.IndexOfVariable('aName3'));
  AssertEquals('NonExisting',-1,Variables.IndexOfVariable('aName4'));
end;

procedure TTestVariables.TestFind;
begin
  AddThree;
  AssertSame('First',FV[0],Variables.FindVariable('aName1'));
  AssertSame('Second',FV[1],Variables.FindVariable('aName2'));
  AssertSame('Third',FV[2],Variables.FindVariable('aName3'));
  AssertNull('NonExisting',Variables.FindVariable('aName4'));
end;

{ TTestVariableBase }

class procedure TTestVariableBase.AssertEquals(const Msg: String; AExpected,
  AActual: TResultType);
begin
  AssertEquals(Msg,GetEnumName(TypeInfo(TResultType),Ord(AExpected)),GetEnumName(TypeInfo(TResultType),Ord(AActual)))
end;

{ TTestVariable }

procedure TTestVariable.SetUp;
begin
  inherited SetUp;
  FVar:=TFPReportVariable.Create(Nil);
end;

procedure TTestVariable.TearDown;
begin
  FreeandNil(FVar);
  inherited TearDown;
end;

procedure TTestVariable.TestEmpty;
begin
  AssertNotNull('Have variable', Variable);
  AssertEquals('Boolean type',rtBoolean,Variable.DataType);
  AssertFalse('Boolean default value',Variable.AsBoolean);
end;

procedure TTestVariable.TestName;
begin
  Variable.Name:='me'; // OK
  Variable.Name:='me.me'; // OK
  ExpectException('Name must be identifier',EReportError);
  Variable.Name:='me me'; // not OK
end;

procedure TTestVariable.TestBoolean;

Var
  R : TFPExpressionResult;

begin
  Variable.DataType:=rtBoolean;
  AssertEquals('Boolean type remains',rtBoolean,Variable.DataType);
  AssertFalse('Boolean default value',Variable.AsBoolean);
  AssertEquals('Boolean as string','False',Variable.Value);
  Variable.DataType:=rtFloat;
  Variable.AsBoolean:=true;
  AssertEquals('Boolean type remains',rtBoolean,Variable.DataType);
  AssertEquals('Boolean as string','True',Variable.Value);
  AssertTrue('Boolean value',Variable.AsBoolean);
  R:=Variable.AsExpressionResult;
  AssertEquals('Correct result',rtBoolean,r.resulttype);
  AssertEquals('Correct value',True,r.resBoolean);
  ExpectException('Cannot fetch as other type',EConvertError);
  Variable.AsString;
end;

procedure TTestVariable.TestInteger;

Var
  R : TFPExpressionResult;

begin
  Variable.DataType:=rtInteger;
  AssertEquals('Integer type remains',rtInteger,Variable.DataType);
  AssertEquals('Integer default value',0,Variable.AsInteger);
  AssertEquals('Integer as string','0',Variable.Value);
  Variable.DataType:=rtFloat;
  Variable.AsInteger:=123;
  AssertEquals('Integer type remains',rtInteger,Variable.DataType);
  AssertEquals('Integer as string','123',Variable.Value);
  AssertEquals('Integer value',123,Variable.AsInteger);
  R:=Variable.AsExpressionResult;
  AssertEquals('Correct result',rtInteger,r.resulttype);
  AssertEquals('Correct value',123,r.resInteger);
  ExpectException('Cannot fetch as other type',EConvertError);
  Variable.AsString;
end;

procedure TTestVariable.TestDateTime;

Var
  R : TFPExpressionResult;

begin
  Variable.DataType:=rtDateTime;
  AssertEquals('DateTime type remains',rtDateTime,Variable.DataType);
  AssertEquals('DateTime default value',0.0,Variable.AsDateTime);
  AssertEquals('DateTime as string','00000000T000000',Variable.Value);
  Variable.DataType:=rtDateTime;
  Variable.AsDateTime:=Date;
  AssertEquals('DateTime type remains',rtDateTime,Variable.DataType);
  AssertEquals('DateTime as string',FormatDateTime('yyyymmdd"T"000000',Date),Variable.Value);
  AssertEquals('DateTime value',Date,Variable.AsDateTime);
  R:=Variable.AsExpressionResult;
  AssertEquals('Correct result',rtDateTime,r.resulttype);
  AssertEquals('Correct value',Date,r.resDateTime);
  ExpectException('Cannot fetch as other type',EConvertError);
  Variable.AsString;
end;

procedure TTestVariable.TestFloat;

Var
  R : TFPExpressionResult;

begin
  Variable.DataType:=rtFloat;
  AssertEquals('Float type remains',rtFloat,Variable.DataType);
  AssertEquals('Float default value',0.0,Variable.AsFloat);
  AssertEquals('Float as string',' 0.0000000000000000E+000',Variable.Value);
  Variable.DataType:=rtBoolean;
  Variable.AsFloat:=1.23;
  AssertEquals('Float type remains',rtFloat,Variable.DataType);
  AssertEquals('Float as string',' 1.2300000000000000E+000',Variable.Value);
  AssertEquals('Float value',1.23,Variable.AsFloat);
  R:=Variable.AsExpressionResult;
  AssertEquals('Correct result',rtFloat,r.resulttype);
  AssertEquals('Correct value',1.23,r.resFloat);
  ExpectException('Cannot fetch as other type',EConvertError);
  Variable.AsString;
end;

procedure TTestVariable.TestString;

Var
  R : TFPExpressionResult;

begin
  Variable.DataType:=rtString;
  AssertEquals('String type remains',rtString,Variable.DataType);
  AssertEquals('String default value','',Variable.AsString);
  AssertEquals('String as string','',Variable.Value);
  Variable.DataType:=rtBoolean;
  Variable.AsString:='abc';
  AssertEquals('String type remains',rtString,Variable.DataType);
  AssertEquals('String as string','abc',Variable.Value);
  AssertEquals('String value','abc',Variable.AsString);
  R:=Variable.AsExpressionResult;
  AssertEquals('Correct result',rtString,r.resulttype);
  AssertEquals('Correct value','abc',r.resString);
  ExpectException('Cannot fetch as other type',EConvertError);
  Variable.AsFloat;
end;

procedure TTestVariable.TestExpressionResult;

Var
  R : TFPExpressionResult;

begin
  R.ResultType:=rtFloat;
  R.ResFloat:=1.23;
  Variable.AsExpressionResult:=R;
  AssertEquals('Correct type ',rtFloat,Variable.DataType);
  AssertEquals('Correct value',1.23,Variable.AsFloat);
  R.ResultType:=rtBoolean;
  R.ResBoolean:=True;
  Variable.AsExpressionResult:=R;
  AssertEquals('Correct type ',rtBoolean,Variable.DataType);
  AssertEquals('Correct value',True,Variable.AsBoolean);
  R.ResultType:=rtString;
  R.ResString:='me';
  Variable.AsExpressionResult:=R;
  AssertEquals('Correct type ',rtString,Variable.DataType);
  AssertEquals('Correct value','me',Variable.AsString);
  R.ResultType:=rtDateTime;
  R.ResDateTime:=Date;
  Variable.AsExpressionResult:=R;
  AssertEquals('Correct type ',rtDateTime,Variable.DataType);
  AssertEquals('Correct value',Date,Variable.AsDateTime);
  R.ResultType:=rtinteger;
  R.ResInteger:=1234;
  Variable.AsExpressionResult:=R;
  AssertEquals('Correct type ',rtinteger,Variable.DataType);
  AssertEquals('Correct value',1234,Variable.AsInteger);
end;

{ TTestCaseWithData }

procedure TTestCaseWithData.InitializeData(const ACount: Integer);
var
  i: integer;
begin
  // data is coming from the stringlist this time
  FSL := TStringList.Create;
  if ACount < 1 then
    Exit;
  for i := 1 to ACount do
    FSL.Add('Item ' + IntToStr(i));
end;

procedure TTestCaseWithData.SetReportData(const ADataCount: Byte);
begin
  if ADataCount < 1 then
    Exit;
  InitializeData(ADataCount);
  FData := TFPReportUserData.Create(nil);
  FData.OnGetValue := @DoGetDataValue;
  FData.OnGetEOF := @DoGetDataEOF;
end;

procedure TTestCaseWithData.DoGetDataValue(Sender: TObject; const AValueName: string; var AValue: variant);
begin
  if AValueName = 'element' then
    AValue := FSL[FData.RecNo - 1];
end;

procedure TTestCaseWithData.DoGetDataEOF(Sender: TObject; var IsEOF: boolean);
begin
  if FData.RecNo > FSL.Count then
    IsEOF := True
  else
    IsEOF := False;
end;

procedure TTestCaseWithData.SetUp;
begin
  inherited SetUp;
end;

procedure TTestCaseWithData.TearDown;
begin
  FreeAndNil(FData);
  FreeAndNil(FSL);
  inherited TearDown;
end;

{ TTestCaseWithDataAndReport }

procedure TTestCaseWithDataAndReport.SetUp;
begin
  inherited SetUp;
  FReport := TMyCustomReport.Create(nil);
end;

procedure TTestCaseWithDataAndReport.TearDown;
begin
  inherited TearDown;
  FreeAndNil(FReport);
end;

{ TBaseReportComponentTest }

procedure TBaseReportComponentTest.ExpectState(const aExpected: TFPReportState);
begin
  AssertEquals('ReportComponent.ReportState: ', AExpected, FC.ReportState);
end;

procedure TBaseReportComponentTest.AssertEquals(Msg: string; const aExpected, AActual: TFPReportState);
begin
  AssertEquals(Msg, GetEnumName(TypeInfo(TFPReportState), Ord(AExpected)),
    GetEnumName(TypeInfo(TFPReportState), Ord(AActual)));
end;

procedure TBaseReportComponentTest.SetUp;
begin
  FC := TMyFPReportComponent.Create(nil);
end;

procedure TBaseReportComponentTest.TearDown;
begin
  FreeAndNil(FC);
end;

{ TTestReportComponent }

procedure TTestReportComponent.TestCreate;
begin
  ExpectState(rsDesign);
end;

procedure TTestReportComponent.TestLayoutState;
begin
  FC.StartLayout;
  ExpectState(rsLayout);
  FC.EndLayout;
  ExpectState(rsDesign);
end;

procedure TTestReportComponent.TestRenderState;
begin
  FC.StartRender;
  ExpectState(rsRender);
  FC.EndRender;
  ExpectState(rsDesign);
end;

{ TMyFPReportComponent }

procedure TMyFPReportComponent.StartLayout;
begin
  inherited StartLayout;
end;

procedure TMyFPReportComponent.EndLayout;
begin
  inherited EndLayout;
end;

procedure TMyFPReportComponent.StartRender;
begin
  inherited StartRender;
end;

procedure TMyFPReportComponent.EndRender;
begin
  inherited EndRender;
end;

{ TMyFPReportElement }

procedure TMyFPReportElement.CallChange;
begin
  Changed;
end;

procedure TMyFPReportElement.ResetChanged;
begin
  FChangedCalled := 0;
end;

procedure TMyFPReportElement.DoChanged;
begin
  inherited DoChanged;
  Inc(FChangedCalled);
end;

{ TBaseReportElementTest }

procedure TBaseReportElementTest.SetUp;
begin
  inherited SetUp;
  FC := TMyFPReportElement.Create(nil);
end;

procedure TBaseReportElementTest.TearDown;
begin
  FreeAndNil(FC);
  inherited TearDown;
end;

{ TReportElementTest }

procedure TReportElementTest.TestCreate;
begin
  AssertEquals('Create does not invoke changed', 0, FC.ChangedCalled);
  AssertNotNull('Create creates frame', FC.Frame);
  AssertEquals('Create creates frame of correct class', TFPReportFrame, FC.Frame.Classtype);
  AssertNotNull('Create creates layout', FC.Layout);
  AssertEquals('Create creates layout of correct class ', TFPReportLayout, FC.Layout.Classtype);
  AssertEquals('Created element is visible', True, FC.Visible);
  AssertNull('No parent at create', FC.Parent);
end;

procedure TReportElementTest.TestDoChange;
begin
  FC.CallChange;
  AssertEquals('Change calls dochange', 1, FC.ChangedCalled);
end;

procedure TReportElementTest.TestChangeCount;
begin
  FC.BeginUpdate;
  try
    FC.CallChange;
    AssertEquals('First Change does notcall dochange', 0, FC.ChangedCalled);
    FC.CallChange;
    AssertEquals('Second Change does not call dochange', 0, FC.ChangedCalled);
  finally
    FC.EndUpdate;
  end;
  AssertEquals('EndUpdate calls dochange once', 1, FC.ChangedCalled);
end;

procedure TReportElementTest.TestChangeCountNested;
begin
  FC.BeginUpdate;
  try
    FC.CallChange;
    AssertEquals('First Change does notcall dochange', 0, FC.ChangedCalled);
    FC.BeginUpdate;
    try
      FC.CallChange;
      AssertEquals('Second Change does not call dochange', 0, FC.ChangedCalled);
    finally
      FC.EndUpdate;
      AssertEquals('First endupdate does not call dochange', 0, FC.ChangedCalled);
    end;
  finally
    FC.EndUpdate;
  end;
  AssertEquals('Second EndUpdate calls dochange once', 1, FC.ChangedCalled);
end;

procedure TReportElementTest.TestChangeCountNested2;
begin
  FC.BeginUpdate;
  try
    FC.CallChange;
    AssertEquals('First Change does notcall dochange', 0, FC.ChangedCalled);
    FC.BeginUpdate;
    try
      FC.CallChange;
      AssertEquals('Second Change does not call dochange', 0, FC.ChangedCalled);
      FC.CallChange;
      AssertEquals('Third Change does not call dochange', 0, FC.ChangedCalled);
    finally
      FC.EndUpdate;
      AssertEquals('First endupdate does not call dochange', 0, FC.ChangedCalled);
    end;
  finally
    FC.EndUpdate;
  end;
  AssertEquals('Second EndUpdate calls dochange once', 1, FC.ChangedCalled);
end;

procedure TReportElementTest.TestVisibleChanges;
begin
  FC.ResetChanged;
  FC.Visible := False;
  AssertEquals('Setting visible calls change', 1, FC.ChangedCalled);
end;

procedure TReportElementTest.TestLayoutChanges;
var
  L: TFPreportLayout;
begin
  L := TFPreportLayout.Create(nil);
  try
    FC.Layout := L;
    AssertEquals('Setting layout calls change', 1, FC.ChangedCalled);
  finally
    L.Free;
  end;
end;

procedure TReportElementTest.TestFrameChanges;
var
  F: TFPreportFrame;
begin
  F := TFPreportFrame.Create(nil);
  try
    FC.Frame := F;
    AssertEquals('Setting frame calls change', 1, FC.ChangedCalled);
  finally
    F.Free;
  end;
end;

procedure TReportElementTest.TestAssign;
var
  E: TFPReportElement;
begin
  E := TMyFPReportElement.Create(nil);
  try
    FC.Layout.Top := 1;
    FC.Frame.Width := 2;
    E.Assign(FC);
    AssertEquals('Assigned frame equal', True, FC.Frame.Equals(E.Frame));
    AssertEquals('Assigned layout equal', True, FC.Layout.Equals(FC.Layout));
  finally
    E.Free;
  end;
end;

procedure TReportElementTest.TestEquals1;
begin
  AssertEquals('Self always returns equal', True, FC.Equals(FC));
end;

procedure TReportElementTest.TestEquals2;
var
  E: TFPReportElement;
begin
  E := TMyFPReportElement.Create(nil);
  try
    E.Assign(FC);
    AssertEquals('Assigned element returns equal', True, FC.Equals(E));
    AssertEquals('Assigned element returns equal', True, E.Equals(FC));
  finally
    E.Free;
  end;
end;

procedure TReportElementTest.TestEquals3;
var
  E: TFPReportElement;
begin
  E := TFPReportElement.Create(nil);
  try
    E.Assign(FC);
    AssertEquals('Different class makes unequal', True, FC.Equals(E));
    AssertEquals('Different class makes unequal', True, E.Equals(FC));
  finally
    E.Free;
  end;
end;

procedure TReportElementTest.TestEquals4;
var
  E: TFPReportElement;
begin
  E := TMyFPReportElement.Create(nil);
  try
    FC.Layout.Top := 1;
    E.Assign(FC);
    E.Layout.Top := 2;
    AssertEquals('Changed layout makes unequal', False, FC.Equals(E));
    AssertEquals('Changed layout makes unequal', False, E.Equals(FC));
  finally
    E.Free;
  end;
end;

procedure TReportElementTest.TestEquals5;
var
  E: TFPReportElement;
begin
  E := TMyFPReportElement.Create(nil);
  try
    FC.Layout.Top := 1;
    E.Assign(FC);
    E.Frame.Lines := [flLeft];
    AssertEquals('Changed frame makes unequal', False, FC.Equals(E));
    AssertEquals('Changed frame makes unequal', False, E.Equals(FC));
  finally
    E.Free;
  end;
end;

{ TTestReportFrame }

procedure TTestReportFrame.TestCreate;
begin
  AssertEquals('Failed on 1', 1, FC.Frame.Width);
  AssertEquals('Failed on 2',
    GetEnumName(TYpeInfo(TFPPenStyle), Ord(psSolid)),
    GetEnumName(TYpeInfo(TFPPenStyle), Ord(FC.Frame.Pen)));
  if not (FC.Frame.Lines = []) then
    Fail('Failed on 3');
  AssertEquals('Failed on 4',
    GetEnumName(TypeInfo(TFPReportFrameShape), Ord(fsNone)),
    GetEnumName(TypeInfo(TFPReportFrameShape), Ord(FC.Frame.Shape)));
end;

procedure TTestReportFrame.TestWidthChange;
begin
  FC.Frame.Width := 2;
  AssertEquals('Setting Width calls onChange', 1, FC.ChangedCalled);
end;

procedure TTestReportFrame.TestColorChange;
begin
  FC.Frame.Color := 3;
  AssertEquals('Setting Solor calls onChange', 1, FC.ChangedCalled);
end;

procedure TTestReportFrame.TestPenStyleChange;
begin
  FC.Frame.Pen := psDot;
  AssertEquals('Setting pen calls onChange', 1, FC.ChangedCalled);
end;

procedure TTestReportFrame.TestShapeChange;
begin
  FC.Frame.Shape := fsRoundedRect;
  AssertEquals('Setting pen calls onChange', 1, FC.ChangedCalled);
end;

procedure TTestReportFrame.TestLinesChange;
begin
  FC.Frame.Lines := [flBottom];
  AssertEquals('Setting pen calls onChange', 1, FC.ChangedCalled);
end;

procedure TTestReportFrame.TestAssign;
var
  F: TFPReportFrame;
begin
  F := TFPReportFrame.Create(nil);
  try
    F.Width := 3;
    F.Lines := [flBottom, flTop];
    F.Color := 4;
    F.Pen := psDot;
    F.Shape := fsRoundedRect;
    FC.Frame.Assign(F);
    AssertSame('ReportElement not copied', FC, FC.Frame.ReportElement);
    AssertEquals('Assert calls changed', 1, FC.ChangedCalled);
    AssertEquals('Frame width equals 3', F.Width, FC.Frame.Width);
    AssertEquals('Frame penstyle equals psDot',
      GetEnumName(TYpeInfo(TFPPenStyle), Ord(F.Pen)),
      GetEnumName(TYpeInfo(TFPPenStyle), Ord(FC.Frame.Pen)));
    if not (FC.Frame.Lines = F.Lines) then
      Fail('Frame lines not copied correctly');
    AssertEquals('Frame shape correctly copied',
      GetEnumName(TypeInfo(TFPReportFrameShape), Ord(F.Shape)),
      GetEnumName(TypeInfo(TFPReportFrameShape), Ord(FC.Frame.Shape)));
  finally
    F.Free;
  end;
end;

procedure TTestReportFrame.TestEquals1;
var
  F: TFPReportFrame;
begin
  F := TFPReportFrame.Create(nil);
  try
    FC.Frame.Width := 3;
    FC.Frame.Lines := [flBottom, flTop];
    FC.Frame.Color := 4;
    FC.Frame.Pen := psDot;
    FC.Frame.Shape := fsRoundedRect;
    F.Assign(FC.Frame);
    F.Width := 2;
    AssertEquals('Width changed makes unequal', False, FC.Frame.Equals(F));
    AssertEquals('Width changed makes unequal', False, F.Equals(FC.Frame));
  finally
    F.Free;
  end;
end;

procedure TTestReportFrame.TestEquals2;
var
  F: TFPReportFrame;
begin
  F := TFPReportFrame.Create(nil);
  try
    FC.Frame.Width := 3;
    FC.Frame.Lines := [flBottom, flTop];
    FC.Frame.Color := 4;
    FC.Frame.Pen := psDot;
    FC.Frame.Shape := fsRoundedRect;
    F.Assign(FC.Frame);
    F.Color := 2;
    AssertEquals('Color changed makes unequal', False, FC.Frame.Equals(F));
    AssertEquals('Color changed makes unequal', False, F.Equals(FC.Frame));
  finally
    F.Free;
  end;
end;

procedure TTestReportFrame.TestEquals3;
var
  F: TFPReportFrame;
begin
  F := TFPReportFrame.Create(nil);
  try
    FC.Frame.Width := 3;
    FC.Frame.Lines := [flBottom, flTop];
    FC.Frame.Color := 4;
    FC.Frame.Pen := psDot;
    FC.Frame.Shape := fsRoundedRect;
    F.Assign(FC.Frame);
    F.Pen := psDash;
    AssertEquals('Pen changed makes unequal', False, FC.Frame.Equals(F));
    AssertEquals('Pen changed makes unequal', False, F.Equals(FC.Frame));
  finally
    F.Free;
  end;
end;

procedure TTestReportFrame.TestEquals4;
var
  F: TFPReportFrame;
begin
  F := TFPReportFrame.Create(nil);
  try
    FC.Frame.Width := 3;
    FC.Frame.Lines := [flBottom, flTop];
    FC.Frame.Color := 4;
    FC.Frame.Pen := psDot;
    FC.Frame.Shape := fsRoundedRect;
    F.Assign(FC.Frame);
    F.Shape := fsShadow;
    AssertEquals('Shape changed makes unequal', False, FC.Frame.Equals(F));
    AssertEquals('Shape changed makes unequal', False, F.Equals(FC.Frame));
  finally
    F.Free;
  end;
end;

procedure TTestReportFrame.TestEquals5;
var
  F: TFPReportFrame;
begin
  F := TFPReportFrame.Create(nil);
  try
    FC.Frame.Width := 3;
    FC.Frame.Lines := [flBottom, flTop];
    FC.Frame.Color := 4;
    FC.Frame.Pen := psDot;
    FC.Frame.Shape := fsRoundedRect;
    F.Assign(FC.Frame);
    F.Lines := [flLeft, flRight];
    AssertEquals('Lines changed makes unequal', False, FC.Frame.Equals(F));
    AssertEquals('Lines changed makes unequal', False, F.Equals(FC.Frame));
  finally
    F.Free;
  end;
end;

procedure TTestReportFrame.TestEquals6;
begin
  AssertEquals('Same frame always equals', True, FC.Frame.Equals(FC.Frame));
end;

procedure TTestReportFrame.TestEquals7;
var
  F: TFPReportFrame;
begin
  F := TFPReportFrame.Create(nil);
  try
    FC.Frame.Width := 3;
    FC.Frame.Lines := [flBottom, flTop];
    FC.Frame.Color := 4;
    FC.Frame.Pen := psDot;
    FC.Frame.Shape := fsRoundedRect;
    F.Assign(FC.Frame);
    AssertEquals('Equals after assign', True, FC.Frame.Equals(F));
    AssertEquals('Equals after assign', True, F.Equals(FC.Frame));
  finally
    F.Free;
  end;
end;


{ TTestReportLayout }

procedure TTestReportLayout.TestCreate;
begin
  AssertEquals('Top is zero', 0, FC.Layout.top);
  AssertEquals('Left is zero', 0, FC.Layout.Left);
  AssertEquals('Width is zero', 0, FC.Layout.Width);
  AssertEquals('Height is zero', 0, FC.Layout.Width);
end;

procedure TTestReportLayout.TestTopChange;
begin
  FC.Layout.Top := 2;
  AssertEquals('Setting top calls onChange', 1, FC.ChangedCalled);
end;

procedure TTestReportLayout.TestLeftChange;
begin
  FC.Layout.Left := 2;
  AssertEquals('Setting left calls onChange', 1, FC.ChangedCalled);
end;

procedure TTestReportLayout.TestWidthChange;
begin
  FC.Layout.Width := 2;
  AssertEquals('Setting width calls onChange', 1, FC.ChangedCalled);
end;

procedure TTestReportLayout.TestHeightChange;
begin
  FC.Layout.Height := 2;
  AssertEquals('Setting Height calls onChange', 1, FC.ChangedCalled);
end;

procedure TTestReportLayout.TestAssign;
var
  L: TFPReportLayout;
begin
  L := TFPReportlayout.Create(nil);
  try
    FC.Layout.Top := 1;
    FC.Layout.Left := 1;
    FC.Layout.Width := 10;
    FC.Layout.Height := 10;
    L.Assign(FC.Layout);
    AssertEquals('Top correct', FC.Layout.Top, L.Top);
    AssertEquals('Left correct', FC.Layout.Left, L.Left);
    AssertEquals('Width correct', FC.Layout.Width, L.Width);
    AssertEquals('Height correct', FC.Layout.Height, L.Height);
  finally
    L.Free;
  end;
end;

procedure TTestReportLayout.TestEquals1;
var
  L: TFPReportLayout;
begin
  L := TFPReportlayout.Create(nil);
  try
    FC.Layout.Top := 1;
    FC.Layout.Left := 1;
    FC.Layout.Width := 10;
    FC.Layout.Height := 10;
    L.Assign(FC.Layout);
    FC.Layout.Top := 2;
    AssertEquals('Top changed makes unequal', False, FC.Layout.Equals(L));
    AssertEquals('Top changed makes unequal', False, L.Equals(FC.Layout));
  finally
    L.Free;
  end;
end;

procedure TTestReportLayout.TestEquals2;
var
  L: TFPReportLayout;
begin
  L := TFPReportlayout.Create(nil);
  try
    FC.Layout.Top := 1;
    FC.Layout.Left := 1;
    FC.Layout.Width := 10;
    FC.Layout.Height := 10;
    L.Assign(FC.Layout);
    FC.Layout.Left := 2;
    AssertEquals('Left changed makes unequal', False, FC.Layout.Equals(L));
    AssertEquals('Left changed makes unequal', False, L.Equals(FC.Layout));
  finally
    L.Free;
  end;
end;

procedure TTestReportLayout.TestEquals3;
var
  L: TFPReportLayout;
begin
  L := TFPReportlayout.Create(nil);
  try
    FC.Layout.Top := 1;
    FC.Layout.Left := 1;
    FC.Layout.Width := 10;
    FC.Layout.Height := 10;
    L.Assign(FC.Layout);
    FC.Layout.Width := 2;
    AssertEquals('Width changed makes unequal', False, FC.Layout.Equals(L));
    AssertEquals('Width changed makes unequal', False, L.Equals(FC.Layout));
  finally
    L.Free;
  end;
end;

procedure TTestReportLayout.TestEquals4;
var
  L: TFPReportLayout;
begin
  L := TFPReportlayout.Create(nil);
  try
    FC.Layout.Top := 1;
    FC.Layout.Left := 1;
    FC.Layout.Width := 10;
    FC.Layout.Height := 10;
    L.Assign(FC.Layout);
    FC.Layout.Height := 2;
    AssertEquals('Height changed makes unequal', False, FC.Layout.Equals(L));
    AssertEquals('Height changed makes unequal', False, L.Equals(FC.Layout));
  finally
    L.Free;
  end;
end;

procedure TTestReportLayout.TestEquals5;
var
  L: TFPReportLayout;
begin
  L := TFPReportlayout.Create(nil);
  try
    FC.Layout.Top := 1;
    FC.Layout.Left := 1;
    FC.Layout.Width := 10;
    FC.Layout.Height := 10;
    L.Assign(FC.Layout);
    AssertEquals('Assign results in equal', True, FC.Layout.Equals(L));
    AssertEquals('Assign results in equal', True, L.Equals(FC.Layout));
  finally
    L.Free;
  end;
end;

procedure TTestReportLayout.TestEquals6;
begin
  AssertEquals('Assign results in equal', True, FC.Layout.Equals(FC.Layout));
end;

{ TTestReportChildren }

procedure TTestReportChildren.SetUp;
begin
  FC := TMyFPReportElementWithChildren.Create(nil);
  FC2 := TMyFPReportElementWithChildren.Create(nil);
  FChild := TFPReportElement.Create(nil);
end;

procedure TTestReportChildren.TearDown;
begin
  FreeAndNil(FChild);
  FreeAndNil(FC);
  FreeAndNil(FC2);
end;

procedure TTestReportChildren.WrongParent;
begin
  FC.Parent := FChild;
end;

procedure TTestReportChildren.TestCreate;
begin
  AssertEquals('No children at create', 0, FC.ChildCount);
end;

procedure TTestReportChildren.TestSetParent1;
begin
  AssertException('Cannot set TReportElement as parent', EReportError, @WrongParent);
end;

procedure TTestReportChildren.TestSetParent2;
begin
  FChild.parent := FC;
  AssertSame('Parent was saved', FC, FChild.parent);
  AssertEquals('Changed was called', 1, FC.ChangedCalled);
  AssertEquals('Parent childcount is 1', 1, FC.ChildCount);
  AssertSame('Parent first child is OK', FChild, FC.Child[0]);
end;

procedure TTestReportChildren.TestSetParent3;
var
  E: TFPReportElementWithChildren;
begin
  FChild.parent := FC;
  AssertSame('Parent was saved', FC, FChild.parent);
  AssertEquals('Parent childcount is 1', 1, FC.ChildCount);
  AssertSame('Parent first child is OK', FChild, FC.Child[0]);
  FC.ResetChanged;
  FChild.Parent := FC2;
  AssertSame('Parent was saved', FC2, FChild.parent);
  AssertEquals('Changed was called', 1, FC.ChangedCalled);
  AssertEquals('Old Parent childcount is 0', 0, FC.ChildCount);
  AssertEquals('Parent childcount is 1', 1, FC2.ChildCount);
  AssertSame('Parent first child is OK', FChild, FC2.Child[0]);
end;

procedure TTestReportChildren.TestSetParent4;
begin
  FChild.parent := FC;
  AssertSame('Parent was saved', FC, FChild.parent);
  AssertEquals('Parent childcount is 1', 1, FC.ChildCount);
  AssertSame('Parent first child is OK', FChild, FC.Child[0]);
  FreeAndNil(FC);
  //FChild is freed due to free of parent
  //AssertNull('Child parent was removed when parent is freed', FChild.Parent);
  FChild := Nil;
end;

procedure TTestReportChildren.TestSetParent6;
begin
  FChild.parent := FC;
  AssertSame('Parent was saved', FC, FChild.parent);
  AssertEquals('Parent childcount is 1', 1, FC.ChildCount);
  AssertSame('Parent first child is OK', FChild, FC.Child[0]);
  FChild.parent := nil;
  AssertNull('Child parent was removed when parent is freed', FChild.Parent);
end;

procedure TTestReportChildren.TestSetParent5;
begin
  FChild.parent := FC;
  AssertSame('Parent was saved', FC, FChild.parent);
  AssertEquals('Parent childcount is 1', 1, FC.ChildCount);
  AssertSame('Parent first child is OK', FChild, FC.Child[0]);
  FreeAndNil(FChild);
  AssertEquals('Child removed when freed', 0, FC.ChildCount);
end;

{ TMyFPReportElementWithChildren }

procedure TMyFPReportElementWithChildren.CallChange;
begin
  Changed;
end;

procedure TMyFPReportElementWithChildren.ResetChanged;
begin
  FChangedCalled := 0;
end;

procedure TMyFPReportElementWithChildren.DoChanged;
begin
  inherited DoChanged;
  Inc(FChangedCalled);
end;

{ TTestFPPageSize }

procedure TTestFPPageSize.TestCreate;
var
  F: TFPReportPaperSize;
begin
  F := TFPReportPaperSize.Create(1.23, 3.45);
  try
    AssertEquals('Width stored correctly', 1.23, F.Width, 0.001);
    AssertEquals('Height stored correctly', 3.45, F.Height, 0.001);
  finally
    F.Free;
  end;
end;

{ TTestFPPaperManager }

procedure TTestFPPapers.Setup;
begin
  FM := TFPReportPaperManager.Create(nil);
  AssertNotNull(FM);
end;

procedure TTestFPPapers.TearDown;
begin
  FreeAndNil(FM);
end;

procedure TTestFPPapers.RegisterPapers(ACount: integer; Local: boolean = True);
var
  F: TFPReportPaperManager;
begin
  if local then
    F := FM
  else
    F := PaperManager;
  if (ACount >= 1) then
    F.RegisterPaper('P3', 1.0, 2.0);
  if (ACount >= 2) then
    F.RegisterPaper('P2', 4.0, 8.0);
  if (ACount >= 3) then
    F.RegisterPaper('P1', 16.0, 32.0);
end;

procedure TTestFPPaperManager.TestAccess;
begin
  case FAccess of
    0: FM.PaperNames[-1];
    1: FM.PaperNames[FM.PaperCount];
    2: FM.PaperHeight[-1];
    3: FM.PaperHeight[FM.PaperCount];
    4: FM.PaperWidth[-1];
    5: FM.PaperWidth[FM.PaperCount];
    6: FM.WidthByName['NoPaper'];
    7: FM.HeightByName['NoPaper'];
  end;
end;

procedure TTestFPPaperManager.Setup;
begin
  inherited Setup;
  FAccess := -1;
end;

procedure TTestFPPaperManager.TestCreate;
begin
  AssertEquals('No registered papers', 0, FM.PaperCount);
end;

procedure TTestFPPaperManager.TestRegister1;
begin
  RegisterPapers(1);
  AssertEquals('1 registered paper', 1, FM.PaperCount);
  AssertEquals('Correct name', 'P3', FM.PaperNames[0]);
end;

procedure TTestFPPaperManager.TestRegister2;
begin
  RegisterPapers(2);
  AssertEquals('2 registered papers', 2, FM.PaperCount);
  AssertEquals('Correct name paper 1', 'P2', FM.PaperNames[0]);
  AssertEquals('Correct name paper 2', 'P3', FM.PaperNames[1]);
end;

procedure TTestFPPaperManager.TestRegister3;
begin
  RegisterPapers(3);
  AssertEquals('3 registered papers', 3, FM.PaperCount);
  AssertEquals('Correct name paper 1', 'P1', FM.PaperNames[0]);
  AssertEquals('Correct name paper 2', 'P2', FM.PaperNames[1]);
  AssertEquals('Correct name paper 3', 'P3', FM.PaperNames[2]);
end;

procedure TTestFPPaperManager.TestRegisterDuplicate;
begin
  RegisterPapers(2);
  AssertEquals('2 registered papers', 2, FM.PaperCount);
  AssertEquals('Correct name paper 1', 'P2', FM.PaperNames[0]);
  AssertEquals('Correct name paper 2', 'P3', FM.PaperNames[1]);
  try
    FM.RegisterPaper('P3', 10.0, 20.0);
    Fail('We expected an exception to be raised.');
  except
    on E: Exception do
      begin
        AssertEquals('Exception class', 'EReportError', E.ClassName);
        AssertEquals('Exception message', 'Paper name P3 already exists', E.Message);
      end;
  end;
end;

procedure TTestFPPaperManager.TestClear;
begin
  RegisterPapers(2);
  AssertEquals('2 registered papers', 2, FM.PaperCount);
  AssertEquals('Correct name paper 1', 'P2', FM.PaperNames[0]);
  AssertEquals('Correct name paper 2', 'P3', FM.PaperNames[1]);
  FM.Clear;
  AssertEquals('0 registered papers', 0, FM.PaperCount);
end;

procedure TTestFPPaperManager.TestFind1;
begin
  AssertEquals('No paper registered', -1, FM.IndexOfPaper('P1'));
end;

procedure TTestFPPaperManager.TestFind2;
begin
  RegisterPapers(3);
  AssertEquals('No paper registered', -1, FM.IndexOfPaper('PA1'));
end;

procedure TTestFPPaperManager.TestFind3;
begin
  RegisterPapers(3);
  AssertEquals('3 registered papers', 3, FM.PaperCount);
  AssertEquals('Find P1 OK', 0, FM.IndexOfPaper('P1'));
  AssertEquals('Find P2 OK', 1, FM.IndexOfPaper('P2'));
  AssertEquals('Find P3 OK', 2, FM.IndexOfPaper('P3'));
end;

procedure TTestFPPaperManager.IllegalAccess1;
begin
  RegisterPapers(3);
  FAccess := 0;
  AssertException('Papername[-1]', EStringListError, @TestAccess);
end;

procedure TTestFPPaperManager.IllegalAccess2;
begin
  RegisterPapers(3);
  FAccess := 1;
  AssertException('Papername[3]', EStringListError, @TestAccess);
end;

procedure TTestFPPaperManager.IllegalAccess3;
begin
  RegisterPapers(3);
  FAccess := 2;
  AssertException('PaperHeight[-1]', EStringListError, @TestAccess);
end;

procedure TTestFPPaperManager.IllegalAccess4;
begin
  RegisterPapers(3);
  FAccess := 3;
  AssertException('PaperHeight[3]', EStringListError, @TestAccess);
end;

procedure TTestFPPaperManager.IllegalAccess5;
begin
  RegisterPapers(3);
  FAccess := 4;
  AssertException('PaperWidth[-1]', EStringListError, @TestAccess);
end;

procedure TTestFPPaperManager.IllegalAccess6;
begin
  RegisterPapers(3);
  FAccess := 5;
  AssertException('PaperWidth[3]', EStringListError, @TestAccess);
end;

procedure TTestFPPaperManager.IllegalAccess7;
begin
  RegisterPapers(3);
  FAccess := 6;
  AssertException('WidthByName[NoPaper]', EReportError, @TestAccess);
end;

procedure TTestFPPaperManager.IllegalAccess8;
begin
  RegisterPapers(3);
  FAccess := 7;
  AssertException('WidthByName[NoPaper]', EReportError, @TestAccess);
end;

procedure TTestFPPaperManager.TestWidth;
begin
  RegisterPapers(3);
  AssertEquals('Paper width 0', 16.0, FM.PaperWidth[0]);
  AssertEquals('Paper width 1', 4.0, FM.PaperWidth[1]);
  AssertEquals('Paper width 2', 1.0, FM.PaperWidth[2]);
  AssertEquals('Width[P1]', 16.0, FM.WidthByName['P1']);
  AssertEquals('Width[P2]', 4.0, FM.WidthByName['P2']);
  AssertEquals('Width[P3]', 1, FM.WidthByName['P3']);
end;

procedure TTestFPPaperManager.TestHeight;
begin
  RegisterPapers(3);
  AssertEquals('Paper height 0', 32.0, FM.PaperHeight[0]);
  AssertEquals('Paper height 1', 8.0, FM.PaperHeight[1]);
  AssertEquals('Paper height 2', 2.0, FM.PaperHeight[2]);
  AssertEquals('Height[P1]', 32.0, FM.HeightByName['P1']);
  AssertEquals('Height[P2]', 8.0, FM.HeightByName['P2']);
  AssertEquals('Height[P3]', 2, FM.HeightByName['P3']);
end;

{ TMyFPReportPageSize }

procedure TMyFPReportPageSize.ResetChanged;
begin
  FChangedCalled := 0;
end;

procedure TMyFPReportPageSize.Changed;
begin
  Inc(FChangedCalled);
  inherited Changed;
end;

{ TTestFPReportPageSize }

procedure TTestFPReportPageSize.Setup;
begin
  inherited Setup;
  FP := TMyFPReportPageSize.Create(nil);
end;

procedure TTestFPReportPageSize.TearDown;
begin
  FreeAndNil(FP);
  inherited TearDown;
end;

procedure TTestFPReportPageSize.TestCreate;
begin
  AssertNull('No page', FP.Page);
  AssertEquals('Zero width at create', 0.0, FP.Width);
  AssertEquals('Zero height at create', 0.0, FP.Height);
  AssertEquals('No paper name', '', FP.PaperName);
end;

procedure TTestFPReportPageSize.TestCreateWithPage;
var
  P: TFPReportPage;
  F: TFPReportPageSize;
begin
  P := TFPReportPage.Create(nil);
  try
    F := TFPReportPageSize.Create(P);
    try
      AssertSame('Pagesize created with page has page as page', P, F.Page);
    finally
      F.Free;
    end;
  finally
    P.Free
  end;
end;

procedure TTestFPReportPageSize.TestCreateByPage;
var
  P: TFPReportPage;
begin
  P := TFPReportPage.Create(nil);
  try
    AssertSame('Pagesize created with page has page as page', P, P.PageSize.Page);
  finally
    P.Free
  end;
end;

procedure TTestFPReportPageSize.TestChanged1;
begin
  FP.Width := 1.23;
  AssertEquals('Setting width triggers change', 1, FP.ChangedCalled);
end;

procedure TTestFPReportPageSize.TestChanged2;
begin
  FP.Height := 1.23;
  AssertEquals('Setting height triggers change', 1, FP.ChangedCalled);
end;

procedure TTestFPReportPageSize.TestChanged3;
begin
  FP.PaperName := 'ABC';
  AssertEquals('Setting paper name without associated paper does not trigger change', 0, FP.ChangedCalled);
end;

procedure TTestFPReportPageSize.TestPaperName1;
var
  F: TFPReportPaperManager;
begin
  F := PaperManager;
  if F.PaperCount = 0 then
    Registerpapers(3, False);
  FP.PaperName := F.PaperNames[0];
  AssertEquals('Setting papername sets width', F.PaperWidth[0], FP.Width);
  AssertEquals('Setting papername sets height', F.PaperHeight[0], FP.Height);
  AssertEquals('Setting papername calls changed once', 1, FP.ChangedCalled);
end;

procedure TTestFPReportPageSize.TestPaperName2;
var
  F: TFPReportPaperManager;
begin
  F := PaperManager;
  if F.PaperCount = 0 then
    Registerpapers(3, False);
  FP.PaperName := F.PaperNames[0];
  AssertEquals('Setting papername sets width', F.PaperWidth[0], FP.Width);
  AssertEquals('Setting papername sets height', F.PaperHeight[0], FP.Height);
  FP.ResetChanged;
  FP.PaperName := 'aloha'; // Non existing
  AssertEquals('Setting non-existing papername leaves width', F.PaperWidth[0], FP.Width);
  AssertEquals('Setting non-existing papername leaves height', F.PaperHeight[0], FP.Height);
  AssertEquals('Setting non-existing papername does not call changed', 0, FP.ChangedCalled);
end;

procedure TTestFPReportPageSize.TestAssign;
var
  F: TMyFPreportPageSize;
begin
  F := TMyFPreportPageSize.Create(nil);
  try
    FP.PaperName := 'me';
    FP.Width := 1.23;
    FP.Height := 4.56;
    F.Assign(FP);
    AssertEquals('Assign assigns Width', FP.Width, F.Width);
    AssertEquals('Assign assigns height', FP.Height, F.Height);
    AssertEquals('Assign assigns papername', FP.PaperName, F.PaperName);
    AssertEquals('Assign calls Changed once', 1, F.ChangedCalled);
  finally
    F.Free;
  end;
end;

{ TMyFPReportPage }

procedure TMyFPReportPage.SetupPage;
begin
  Orientation := poPortrait;
  { paper size }
  PageSize.PaperName := 'A4';
  { page margins }
  Margins.Left := 30;
  Margins.Top := 20;
  Margins.Right := 30;
  Margins.Bottom := 20;
end;

procedure TMyFPReportPage.PrepareObjects(aRTParent: TFPReportElement);

begin
  Inc(FPrepareObjectsCalled);
  inherited PrepareObjects(aRTParent);
end;

constructor TMyFPReportPage.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Font.Name := 'LiberationSerif';
end;

procedure TMyFPReportPage.ResetChanged;
begin
  FChangedCalled := 0;
end;

procedure TMyFPReportPage.DoChanged;
begin
  Inc(FChangedCalled);
  inherited DoChanged;
end;

{ TMyReportTitleBand }

procedure TMyReportTitleBand.PrepareObjects(aRTParent: TFPReportElement);

begin
  Inc(FPrepareObjectsCalled);
  inherited PrepareObjects(aRTParent);
end;

constructor TMyReportTitleBand.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Layout.Height := 20;
end;

{ TMyDataBand }

procedure TMyDataBand.PrepareObjects(aRTParent: TFPReportElement);

begin
  Inc(FPrepareObjectsCalled);
  inherited PrepareObjects(aRTParent);
end;

constructor TMyDataBand.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Layout.Height := 10;
end;

{ TTestReportPage }

procedure TTestReportPage.Setup;
begin
  inherited Setup;
  FP := TMyFPReportPage.Create(nil);
end;

procedure TTestReportPage.TearDown;
begin
  FreeAndNil(FP);
  inherited TearDown;
end;

procedure TTestReportPage.TestCreate1;
begin
  AssertNull('Created page without parent has no report', FP.Report);
  AssertNotNull('Created page has margins', FP.Margins);
  AssertNotNull('Created page has pagesize', FP.PageSize);
  AssertEquals('Orientation is portrait', Ord(poPortrait), Ord(FP.Orientation));
  AssertEquals('No bands', 0, FP.BandCount);
end;

procedure TTestReportPage.TestCreate2;
var
  R: TFPReport;
  P: TMyFPReportPage;
begin
  R := TFPReport.Create(nil);
  try
    P := TMyFPReportPage.Create(nil);
    try
      P.Report := R;
      AssertSame('Page owner is report when created', R, P.Report);
      AssertEquals('Report has one page', 1, R.PageCount);
      AssertSame('Page added to pages', P, R.Pages[0]);
    finally
      R.Free;
    end;
    AssertNull('Report has notified page', P.Report);
  finally
    P.Free;
  end;
end;

procedure TTestReportPage.TestCreate3;
var
  R: TFPReport;
  P: TMyFPReportPage;
begin
  R := TFPReport.Create(nil);
  P := TMyFPReportPage.Create(R); // Lets try passing Report as the AOwner in constructor
  try
    AssertSame('Page report is set', R, P.Report);
    AssertSame('Page added to pages', P, R.Pages[0]);
    P.Report := nil;
    AssertEquals('No more pages', 0, R.PageCount);
  finally
    // This will free P as well, because R was set as the owner
    R.Free;
  end;
end;

procedure TTestReportPage.TestPageSize1;
begin
  FP.ResetChanged;
  FP.BeginUpdate;
  try
    FP.PageSize.Width := 10;
    FP.PageSize.Height := 20;
  finally
    FP.EndUpdate;
  end;
  AssertEquals('Changed called', 1, FP.ChangedCalled);
  AssertEquals('Top is zero', 0, FP.Layout.Top);
  AssertEquals('Left is zero', 0, FP.Layout.Left);
  AssertEquals('Width is pagewidth', FP.PageSize.Width, FP.Layout.Width);
  AssertEquals('Height is pageheight', FP.PageSize.Height, FP.Layout.Height);
end;

procedure TTestReportPage.TestPageSize2;
begin
  FP.ResetChanged;
  FP.BeginUpdate;
  try
    FP.PageSize.Width := 10;
    FP.PageSize.Height := 20;
    FP.Margins.Left := 1;
    FP.Margins.Right := 2;
    FP.Margins.Top := 3;
    FP.Margins.Bottom := 4;
  finally
    FP.EndUpdate;
  end;
  AssertEquals('Changed called', 1, FP.ChangedCalled);
  AssertEquals('Top is top margin', 3, FP.Layout.Top);
  AssertEquals('Left is left margin', 1, FP.Layout.Left);
  AssertEquals('Width is pagewidth-rightmargin-leftmargin', 7, FP.Layout.Width);
  AssertEquals('Height is pageheight-topmargin-bottommargin', 13, FP.Layout.Height);
end;

procedure TTestReportPage.TestPageSize3;
begin
  FP.ResetChanged;
  FP.BeginUpdate;
  try
    FP.Orientation := poLandScape;
    FP.PageSize.Width := 10;
    FP.PageSize.Height := 20;
    FP.Margins.Left := 1;
    FP.Margins.Right := 2;
    FP.Margins.Top := 3;
    FP.Margins.Bottom := 4;
  finally
    FP.EndUpdate;
  end;
  AssertEquals('Changed called', 1, FP.ChangedCalled);
  AssertEquals('Top is top margin', 3, FP.Layout.Top);
  AssertEquals('Left is left margin', 1, FP.Layout.Left);
  AssertEquals('Width is pageheight-rightmargin-leftmargin', 17, FP.Layout.Width);
  AssertEquals('Height is pagewidth-topmargin-bottommargin', 3, FP.Layout.Height);
end;

procedure TTestReportPage.TestBand1;
var
  B: TFPReportCustomBand;
begin
  B := TFPReportCustomBand.Create(nil);
  try
    FP.ResetChanged;
    B.Parent := FP;
    AssertEquals('Changed called', 1, FP.ChangedCalled);
    AssertSame('Parent stored correctly', FP, B.Page);
    AssertEquals('Bandcount correct', 1, FP.BandCount);
    AssertSame('Bands[0] correct', B, FP.Bands[0]);
  finally
    B.Free;
  end;
  AssertEquals('Bandcount correct', 0, FP.BandCount);
end;

procedure TTestReportPage.TestBand2;
var
  B: TFPReportCustomBand;
  P: TMyFPReportPage;
begin
  P := TMyFPReportPage.Create(nil);
  try
    B := TFPReportCustomBand.Create(nil);
    try
      B.Parent := P;
      AssertSame('Parent stored correctly', P, B.Page);
      AssertEquals('Bandcount correct', 1, P.BandCount);
      AssertSame('Bands[0] correct', B, P.Bands[0]);
    finally
      B.Free;
    end;
    AssertEquals('Page notified that Band is gone', 0, P.BandCount);
  finally
    P.Free;
  end;
end;

procedure TTestReportPage.TestData;
var
  FData: TFPReportData;
begin
  FData := TFPReportData.Create(nil);
  try
    FP.Data := FData;
  finally
    FData.Free;
  end;
  AssertNull('Data is cleared', FP.Data);
end;

procedure TTestReportPage.TestAssign;
var
  E: TFPReportPage;
begin
  E := TFPReportPage.Create(nil);
  try
    FP.Layout.Top := 1;
    FP.Frame.Width := 2;
    E.Assign(FP);
    AssertEquals('Failed on 1', True, FP.Frame.Equals(E.Frame));
    AssertEquals('Failed on 2', True, FP.Layout.Equals(E.Layout));
    AssertEquals('Failed on 3', Ord(E.Orientation), Ord(FP.Orientation));
    AssertEquals('Failed on 4', True, FP.Margins.Equals(E.Margins));
  finally
    E.Free;
  end;
end;

procedure TTestReportPage.TestFindBand;
var
  t: TFPReportTitleBand;
  h: TFPReportPageHeaderBand;
  f: TFPReportPageFooterBand;
  d: TFPReportDataBand;
begin
  t := TFPReportTitleBand.Create(FP);
  h := TFPReportPageHeaderBand.Create(FP);
  f := TFPReportPageFooterBand.Create(FP);
  d := TFPReportDataBand.Create(FP);
  AssertTrue('failed on 1', h = FP.FindBand(TFPReportPageHeaderBand));
  AssertTrue('failed on 2', t <> FP.FindBand(TFPReportPageHeaderBand));
  AssertTrue('failed on 3', t = FP.FindBand(TFPReportTitleBand));
  AssertTrue('failed on 4', f = FP.FindBand(TFPReportPageFooterBand));
  AssertTrue('failed on 5', d = FP.FindBand(TFPReportDataBand));
  AssertTrue('failed on 6', FP.FindBand(TFPReportChildBand) = nil);
end;

{ TMyFPReportData }

procedure TMyFPReportData.ResetCounts;
begin
  FCC := 0;
  FDFC := 0;
  FEC := 0;
  FFC := 0;
  FNC := 0;
  FOC := 0;
end;

procedure TMyFPReportData.DoInitDataFields;
begin
  inherited DoInitDataFields;
  Inc(FDFC);
end;

procedure TMyFPReportData.DoOpen;
begin
  inherited DoOpen;
  Inc(FOC);
end;

procedure TMyFPReportData.DoFirst;
begin
  inherited DoFirst;
  Inc(FFC);
end;

procedure TMyFPReportData.DoNext;
begin
  inherited DoNext;
  Inc(FNC);
end;

procedure TMyFPReportData.DoClose;
begin
  inherited DoClose;
  Inc(FCC);
end;

function TMyFPReportData.DoEOF: boolean;
begin
  FOE := inherited DoEOF;
  Inc(FEC);
  Result := FReportEOF;
end;

{ TTestReportData }

procedure TTestReportData.DoOpen(Sender: TObject);
begin
  FHandler := True;
  AssertEquals('OnOpen called before DoOpen', 0, FD.OpenCount);
  AssertEquals('OnOpen called before InitFieldDefs', 0, FD.InitDataFieldsCount);
end;

procedure TTestReportData.DoNext(Sender: TObject);
begin
  FHandler := True;
  AssertEquals('DoNext not yet called in handler', 0, FD.NextCount);
  AssertEquals('Recno is already 2 in donext', 2, FD.RecNo);
end;

procedure TTestReportData.Setup;
begin
  inherited Setup;
  FD := TMyFPReportData.Create(nil);
  FHandler := False;
end;

procedure TTestReportData.TearDown;
begin
  FreeAndNil(FD);
  inherited TearDown;
end;

procedure TTestReportData.CreateFields;
begin
  FD.DataFields.AddField('string', rfkString).DisplayWidth := 10;
  FD.DataFields.AddField('boolean', rfkBoolean).DisplayWidth := 20;
  FD.DataFields.AddField('integer', rfkInteger).DisplayWidth := 30;
  FD.DataFields.AddField('float', rfkFloat).DisplayWidth := 40;
  FD.DataFields.AddField('datetime', rfkDateTime).DisplayWidth := 50;
  FD.Datafields.AddField('stream', rfkStream).DisplayWidth := 60;
end;

procedure TTestReportData.DoFieldByName;
var
  F: TFPReportDataField;
begin
  F := FD.Datafields.FieldByName('ohlala');
end;

procedure TTestReportData.TestCreate;
begin
  AssertEquals('Closed recno is 0', 0, FD.RecNo);
  AssertNotNull('DataFields created', FD.DataFields);
  AssertEquals('Closed fieldcount is 0', 0, FD.DataFields.Count);
  AssertSame('Datafields reportdata is self', FD, FD.DataFields.ReportData);
end;

procedure TTestReportData.TestOpen1;
begin
  FD.OnOpen := @DoOpen;
  FD.Open;
  AssertEquals('OnOpen Handler called', True, FHandler);
  AssertEquals('DoOpen called once', 1, FD.OpenCount);
  AssertEquals('InitFieldDefs called once', 1, FD.InitDataFieldsCount);
  AssertEquals('Recno is 1', 1, FD.RecNo);
end;

procedure TTestReportData.TestNext;
begin
  FD.OnNext := @DoNext;
  FD.Open;
  FHandler := False;
  FD.Next;
  AssertEquals('OnNext Handler called', True, FHandler);
  AssertEquals('DoNext Called once', 1, FD.NextCount);
  AssertEquals('Recno is 2 after next', 2, FD.RecNo);
end;

procedure TTestReportData.TestInitFieldDefs;
begin
  FD.InitFieldDefs;
  AssertEquals('InitFieldDefs called once', 1, FD.InitDataFieldsCount);
end;

procedure TTestReportData.TestInitFieldDefs_OnlyAllowedOnce;
begin
  FD.Open;
  AssertEquals('Failed on 1', 1, FD.InitDataFieldsCount);
  try
    FD.InitFieldDefs;
    Fail('Failed on 2. - we should not have reached here.');
  except
    on E: Exception do
    begin
      AssertEquals('Failed on 3', E.ClassName, 'EReportError');
    end;
  end;
  AssertEquals('Failed on 4', 1, FD.InitDataFieldsCount);
end;

procedure TTestReportData.TestEOF1;
begin
  FD.ReportEOF := True;
  AssertEquals('ReportEOF works correctly', True, FD.EOF);
  AssertEquals('Inherited EOF returns false', False, FD.OldEOF);
end;

procedure TTestReportData.TestAddDatafield;
var
  F: TFPReportDataField;
begin
  F := FD.DataFields.AddField('test', rfkBoolean);
  AssertEquals('Boolean field Added', Ord(rfkBoolean), Ord(F.FieldKind));
  AssertEquals('test field name Added', 'test', F.fieldname);
  AssertEquals('0 width field Added', 0, F.DisplayWidth);
end;

procedure TTestReportData.TestDatafieldAdd;
var
  I: TCollectionItem;
  F: TFPReportDataField;
begin
  I := FD.Datafields.Add;
  AssertEquals('add creates TFPReportDataField', TFPReportDataField, I.ClassType);
  F := I as TFPReportDataField;
  AssertEquals('Default field of string kind', Ord(rfkString), Ord(F.FieldKind));
  AssertEquals('Default field name empty', '', F.FieldName);
  AssertEquals('Default field with 0', 0, F.DisplayWidth);
end;

procedure TTestReportData.AssertField(Prefix: string; F: TFPReportDataField; AFieldName: string;
  AFieldKind: TFPReportFieldKind; ADisplayWidth: integer = 0);
var
  S1, S2: string;
begin
  AssertEquals(Prefix + ' has correct field name', AfieldName, F.FieldName);
  S1 := GetEnumName(TypeInfo(TFPReportFieldKind), Ord(AFieldKind));
  S2 := GetEnumName(TypeInfo(TFPReportFieldKind), Ord(F.FieldKind));
  AssertEquals(Prefix + ' has corrrect fieldkind', S1, S2);
  AssertEquals(Prefix + ' has correct fieldwidth', ADisplayWidth, F.DisplayWidth);
end;

procedure TTestReportData.TestCreateFields;
begin
  CreateFields;
  AssertEquals('Correct field count', 6, FD.FieldCount);
  AssertField('Field 0', FD.DataFields[0], 'string', rfkString, 10);
  AssertField('Field 1', FD.DataFields[1], 'boolean', rfkBoolean, 20);
  AssertField('Field 2', FD.DataFields[2], 'integer', rfkInteger, 30);
  AssertField('Field 3', FD.DataFields[3], 'float', rfkFloat, 40);
  AssertField('Field 4', FD.DataFields[4], 'datetime', rfkDateTime, 50);
  AssertField('Field 5', FD.DataFields[5], 'stream', rfkStream, 60);
end;

procedure TTestReportData.TestDatafieldIndexOf1;
begin
  CreateFields;
  AssertEquals('Finds field at pos 0', 0, FD.DataFields.IndexOfField('string'));
  AssertEquals('Finds field at pos 3', 3, FD.DataFields.IndexOfField('float'));
  AssertEquals('Finds field at pos 5', 5, FD.DataFields.IndexOfField('stream'));
  AssertEquals('Finds field (casing) at pos 3', 3, FD.DataFields.IndexOfField('Float'));
end;

procedure TTestReportData.TestDatafieldIndexOf2;
begin
  AssertEquals('No fields returns -1', -1, FD.DataFields.IndexOfField('string'));
  CreateFields;
  AssertEquals('Non-existing field returns -1', -1, FD.DataFields.IndexOfField('stringlslsl'));
end;

procedure TTestReportData.TestFindField1;
begin
  AssertNull('No fields returns Nil', FD.DataFields.FindField('string'));
  CreateFields;
  AssertNull('Non-existing fields returns Nil', FD.DataFields.FindField('stringsss'));
end;

procedure TTestReportData.TestFindField2;
begin
  CreateFields;
  AssertSame('FindField returns correct field', FD.DataFields[0], FD.DataFields.FindField('string'));
  AssertSame('FindField returns correct field', FD.DataFields[3], FD.DataFields.FindField('float'));
  AssertSame('FindField returns correct field (case insensitive)', FD.DataFields[3], FD.DataFields.FindField('floaT'));
end;

procedure TTestReportData.TestFindByName1;
begin
  CreateFields;
  AssertSame('FieldByName returns correct field', FD.DataFields[0], FD.DataFields.FieldByName('string'));
end;

procedure TTestReportData.TestFindByName2;
begin
  CreateFields;
  AssertException('FieldByName (non-existent) raises exception', EReportError, @DoFieldByName);
end;

procedure TTestReportData.TestFieldAssign;
var
  F1, F2: TFPReportDataField;
begin
  F1 := TFPReportDataField.Create(nil);
  try
    f2 := TFPReportDataField.Create(nil);
    try
      F1.FieldKind := rfkBoolean;
      F1.FieldName := 'bool';
      F1.DisplayWidth := 12;
      F2.Assign(F1);
      AssertField('Assigned ', F2, 'bool', rfkBoolean, 12);
    finally
      F2.Free;
    end;
  finally
    F1.Free;
  end;
end;

procedure TTestReportData.TestGetValue;
var
  v: variant;
begin
  CreateFields;
  v := FD.Datafields[0].GetValue;
  AssertTrue('Failed on 1', V = Null);
end;

procedure TTestReportData.TestEasyAccessProperties;
var
  I: integer;
begin
  CreateFields;
  for I := 0 to FD.FieldCount - 1 do
    AssertEquals('FieldNames array OK', FD.DataFields[0].FieldName, FD.FieldNames[0]);
  for I := 0 to FD.FieldCount - 1 do
    AssertEquals('FieldWidth array OK', FD.DataFields[0].DisplayWidth, FD.FieldWidths[FD.FieldNames[0]]);
  for I := 0 to FD.FieldCount - 1 do
    AssertEquals('FieldTypes array OK', Ord(FD.DataFields[0].FieldKind), Ord(FD.FieldTypes[FD.FieldNames[0]]));
end;

{ TTestUserReportData }

procedure TTestUserReportData.Setup;
begin
  FD := TFPReportUserData.Create(nil);
  FD.DataFields.AddField('string', rfkString);
  FD.OnGetValue := @DoValue;
  inherited;
end;

procedure TTestUserReportData.TearDown;
begin
  FreeAndNil(FD);
  inherited TearDown;
end;

procedure TTestUserReportData.DoValue(Sender: TObject; const AValueName: string; var AValue: variant);
begin
  AssertSame('DoValue Sender is reportdata', FD, Sender);
  AssertEquals('DoValue gets correct value name', FExpectName, AValueName);
  AValue := FReturnValue;
end;

procedure TTestUserReportData.TestGetValue;
begin
  FExpectName := 'string';
  FReturnValue := 10;
  AssertEquals('Return value correct', 10, FD.DataFields[0].GetValue);
  AssertEquals('FieldValues array value correct', 10, FD.FieldValues['string']);
end;

{ TTestUserReportData2 }

procedure TTestUserReportData2.DoGetValue(Sender: TObject; const AValueName: string; var AValue: variant);
begin
  if AValueName = 'element' then
    AValue := FSL[FData.RecNo - 1];
end;

procedure TTestUserReportData2.DoGetEOF(Sender: TObject; var IsEOF: boolean);
begin
  if FData.RecNo > FSL.Count then
    IsEOF := True
  else
    IsEOF := False;
end;

procedure TTestUserReportData2.Setup;
begin
  inherited Setup;
  FData := TFPReportUserData.Create(nil);
  FData.OnGetValue := @DoGetValue;
  // data is coming from the stringlist this time
  FSL := TStringList.Create;
  FSL.Add('Item 1');
  FSL.Add('Item 2');
  FSL.Add('Item 3');
  FSL.Add('Item 4');
end;

procedure TTestUserReportData2.TearDown;
begin
  FData.Free;
  FSL.Free;
  inherited TearDown;
end;

procedure TTestUserReportData2.TestGetValue;
begin
  FData.First;
  AssertEquals('Failed on 1', 'Item 1', FData.FieldValues['element']);
  FData.Next;
  AssertEquals('Failed on 2', 'Item 2', FData.FieldValues['element']);
  FData.Next;
  AssertEquals('Failed on 3', 'Item 3', FData.FieldValues['element']);
  FData.Next;
  AssertEquals('Failed on 4', 'Item 4', FData.FieldValues['element']);
  FData.Next;
end;

procedure TTestUserReportData2.TestOnGetEOF1;
var
  i: integer;
begin
  FData.First;
  for i := 1 to FSL.Count do
    FData.Next;
  // Should be False, because we haven't assigned OnGetEOF event handler
  AssertTrue('Failed on 1', FData.EOF = False);
end;

procedure TTestUserReportData2.TestOnGetEOF2;
var
  i: integer;
begin
  FData.OnGetEOF := @DoGetEOF;
  FData.First;
  for i := 1 to FSL.Count do
    FData.Next;
  AssertTrue('Failed on 1', FData.EOF = True);
end;

{ TTestDataBand }

procedure TTestDataBand.Setup;
begin
  FDataBand := TFPReportDataBand.Create(nil);
  inherited Setup;
end;

procedure TTestDataBand.TearDown;
begin
  FreeAndNil(FDataBand);
  inherited TearDown;
end;

procedure TTestDataBand.TestData;
var
  D: TFPReportData;
begin
  D := TFPReportData.Create(nil);
  try
    FDataBand.Data := D;
    AssertSame('Assigned data OK', D, FDataBand.Data)
  finally
    D.Free;
  end;
  AssertNull('Free notification of Data', FDataBand.Data);
end;

procedure TTestDataBand.TestDataPropertyAutoSet;
var
  p: TMyFPReportPage;
  DataBand: TMyDataBand;
  D: TFPReportData;
begin
  SetReportData(2);

  p := TMyFPReportPage.Create(Report);
  p.SetupPage;
  p.Name := 'Page1';
  p.Data := Data;

  DataBand := TMyDataBand.Create(p);
  // DataBand should have been assigned p.Data automatically
  AssertSame('Failed on 1', TFPReportData(Data), DataBand.Data);
  D := TFPReportData.Create(nil);
  try
    DataBand.Data := D;
    AssertTrue('Failed on 2', p.Data <> DataBand.Data);
  finally
    D.Free;
  end;
end;

{ TTestCustomReport }

procedure TTestCustomReport.HandleOnBeginReport;
begin
  Inc(FBeginReportCount);
end;

procedure TTestCustomReport.HandleOnEndReport;
begin
  Inc(FEndReportCount);
end;

procedure TTestCustomReport.InitializeData(const ACount: integer);
var
  i: integer;
begin
  // data is coming from the stringlist this time
  FSL := TStringList.Create;
  if ACount < 1 then
    Exit;
  for i := 1 to ACount do
    FSL.Add('Item ' + IntToStr(i));
end;

procedure TTestCustomReport.SetReportData(const ADataCount: Byte);
begin
  if ADataCount < 1 then
    Exit;
  InitializeData(ADataCount);
  FData := TFPReportUserData.Create(nil);
  FData.OnGetValue := @DoGetDataValue;
  FData.OnGetEOF := @DoGetDataEOF;
  FData.OnGetNames := @DoGetDataFieldNames;
end;

procedure TTestCustomReport.DoGetDataValue(Sender: TObject; const AValueName: string; var AValue: variant);
begin
  if AValueName = 'element' then
    AValue := FSL[FData.RecNo - 1];
end;

procedure TTestCustomReport.DoGetDataEOF(Sender: TObject; var IsEOF: boolean);
begin
  if FData.RecNo > FSL.Count then
    IsEOF := True
  else
    IsEOF := False;
end;

procedure TTestCustomReport.Setup;
begin
  inherited Setup;
  PaperManager.Clear;
  PaperManager.RegisterStandardSizes;
  Report := TMyCustomReport.Create(nil);
  FBeginReportCount := 0;
  FEndReportCount := 0;

  gTTFontCache.Clear;
  gTTFontCache.SearchPath.Text := 'fonts';
  gTTFontCache.BuildFontCache;
end;

procedure TTestCustomReport.TearDown;
begin
  FreeAndNil(FRpt);
  FreeAndNil(FData);
  FreeAndNil(FSL);
  inherited TearDown;
end;

procedure TTestCustomReport.DoGetDataFieldNames(Sender: TObject; List: TStrings);
begin
  List.Add('element');
end;

procedure TTestCustomReport.TestBeginReportEvent;
begin
  TMyFPReportPage.Create(Report); // add at least one page
  Report.OnBeginReport := @HandleOnBeginReport;
  AssertEquals('Failed on 1', 0, FBeginReportCount);
  Report.RunReport;
  AssertEquals('Failed on 2', 1, FBeginReportCount);
  AssertEquals('Failed on 3', 0, FEndReportCount);
end;

procedure TTestCustomReport.TestEndReportEvent;
begin
  TMyFPReportPage.Create(Report); // add at least one page
  Report.OnEndReport := @HandleOnEndReport;
  AssertEquals('Failed on 1', 0, FEndReportCount);
  Report.RunReport;
  AssertEquals('Failed on 2', 1, FEndReportCount);
  AssertEquals('Failed on 3', 0, FBeginReportCount);
end;

procedure TTestCustomReport.TestPagePrepareObjects;
var
  p: TMyFPReportPage;
begin
  SetReportData(2);

  p := TMyFPReportPage.Create(Report);
  p.Name := 'Page1';
  p.Data := Data;

  p := TMyFPReportPage.Create(Report);
  p.Name := 'Page2';
  p.Data := Data;

  p := TMyFPReportPage.Create(Report);
  p.Name := 'Page3';
  p.Data := Data;

  AssertEquals('Failed on 1', 0, TMyFPReportPage(Report.Pages[0]).FPrepareObjectsCalled);
  AssertEquals('Failed on 2', 0, TMyFPReportPage(Report.Pages[1]).FPrepareObjectsCalled);
  AssertEquals('Failed on 3', 0, TMyFPReportPage(Report.Pages[2]).FPrepareObjectsCalled);

  Report.RunReport;
  // due to Re-interpret of Page.Data, page is prepared per record (r38906)
  AssertEquals('Failed on 4', 2, TMyFPReportPage(Report.Pages[0]).FPrepareObjectsCalled);
  AssertEquals('Failed on 5', 2, TMyFPReportPage(Report.Pages[1]).FPrepareObjectsCalled);
  AssertEquals('Failed on 6', 2, TMyFPReportPage(Report.Pages[2]).FPrepareObjectsCalled);
end;

procedure TTestCustomReport.TestBandPrepareObjects;
var
  p: TMyFPReportPage;
  TitleBand: TMyReportTitleBand;
  DataBand: TMyDataBand;
begin
  SetReportData(2);

  p := TMyFPReportPage.Create(Report);
  p.SetupPage;
  p.Name := 'Page1';
  p.Data := Data;

  TitleBand := TMyReportTitleBand.Create(p);
  DataBand := TMyDataBand.Create(p);
  DataBand.Data := FData;

  AssertEquals('Failed on 1', 0, p.FPrepareObjectsCalled);
  AssertEquals('Failed on 2', 0, TitleBand.FPrepareObjectsCalled);
  AssertEquals('Failed on 3', 0, DataBand.FPrepareObjectsCalled);

  Report.RunReport;
  AssertEquals('Failed on 4', 1, p.FPrepareObjectsCalled);
  AssertEquals('Failed on 5', 1, TitleBand.FPrepareObjectsCalled);
  AssertEquals('Failed on 6', 2, DataBand.FPrepareObjectsCalled);
end;

procedure TTestCustomReport.TestRTObjects1;
var
  p: TMyFPReportPage;
begin
  SetReportData(2);

  p := TMyFPReportPage.Create(Report);
  p.SetupPage;
  p.Name := 'Page1';
  p.Data := Data;

  p := TMyFPReportPage.Create(Report);
  p.SetupPage;
  p.Name := 'Page2';
  p.Data := Data;

  p := TMyFPReportPage.Create(Report);
  p.SetupPage;
  p.Name := 'Page3';
  p.Data := Data;

  AssertEquals('Failed on 1', 0, Report.RTObjects.Count);

  Report.RunReport;
  // due to Re-interpret of Page.Data, page is prepared per record (r38906)
  AssertEquals('Failed on 2', 6, Report.RTObjects.Count);
end;

procedure TTestCustomReport.TestRTObjects2;
var
  p: TMyFPReportPage;
  TitleBand: TMyReportTitleBand;
  Memo: TFPReportMemo;
  rtPage: TFPReportCustomPage;
begin
  SetReportData(2);

  p := TMyFPReportPage.Create(Report);
  p.SetupPage;
  p.Name := 'Page1';
  p.Data := Data;

  TitleBand := TMyReportTitleBand.Create(p);
  Memo := TFPReportMemo.Create(TitleBand);
  Memo.Text := 'THE REPORT TITLE';
  Memo.Layout.Top := 5;
  Memo.Layout.Left := 10;

  AssertEquals('Failed on 1', 0, Report.RTObjects.Count);
  Report.RunReport;
  // due to Re-interpret of Page.Data, page is prepared per record (r38906)
  AssertEquals('Failed on 2', 2, Report.RTObjects.Count); // runtime objects adhere to same hierarchy as design time
  AssertEquals('Failed on 3', 'TFPReportCustomPage', TObject(Report.RTObjects[0]).ClassName);
  rtPage := TFPReportCustomPage(Report.RTObjects[0]);
  AssertEquals('Failed on 4', 1, rtPage.ChildCount);
  AssertEquals('Failed on 5', 1, rtPage.BandCount);
  AssertEquals('Failed on 6', 1, rtPage.Bands[0].ChildCount);

  {$IFDEF gdebug}
//  writeln(Report.DebugPreparedPageAsJSON(0));
  {$ENDIF}
end;

procedure TTestCustomReport.TestRTObjects3;
var
  p: TMyFPReportPage;
  DataBand: TMyDataBand;
  Memo: TFPReportMemo;
  rtPage: TFPReportCustomPage;
begin
  SetReportData(2);

  p := TMyFPReportPage.Create(Report);
  p.SetupPage;
  p.Name := 'Page1';
  p.Data := Data;

  DataBand := TMyDataBand.Create(p);
  Memo := TFPReportMemo.Create(DataBand);
  Memo.Layout.Top := 5;
  Memo.Layout.Left := 10;
  Memo.Text := '[element]';

  AssertEquals('Failed on 1', 0, Report.RTObjects.Count);
  Report.RunReport;
  AssertEquals('Failed on 2', 1, Report.RTObjects.Count); // runtime objects adhere to same hierarchy as design time
  AssertEquals('Failed on 3', 'TFPReportCustomPage', TObject(Report.RTObjects[0]).ClassName);
  rtPage := TFPReportCustomPage(Report.RTObjects[0]);
  AssertEquals('Failed on 4', 2, rtPage.ChildCount);
  AssertEquals('Failed on 5', 2, rtPage.BandCount);

  {$IFDEF gdebug}
//  writeln(Report.DebugPreparedPageAsJSON(0));
  {$ENDIF}
end;

procedure TTestCustomReport.TestRTObjects4_OneDataItem;
var
  p: TMyFPReportPage;
  DataBand: TMyDataBand;
  Memo: TFPReportMemo;
  rtPage: TFPReportCustomPage;
begin
  SetReportData(1);

  p := TMyFPReportPage.Create(Report);
  p.SetupPage;
  p.Name := 'Page1';
  p.SetupPage;
  p.Data := Data;

  DataBand := TMyDataBand.Create(p);
  DataBand.Layout.Height := 23;

  Memo := TFPReportMemo.Create(DataBand);
  Memo.Layout.Top := 5;
  Memo.Layout.Left := 10;
  Memo.Text := '[element]';

  AssertEquals('Failed on 1', 0, Report.RTObjects.Count);
  Report.RunReport;
  AssertEquals('Failed on 2', 1, Report.RTObjects.Count); // runtime objects adhere to same hierarchy as design time
  AssertEquals('Failed on 3', 'TFPReportCustomPage', TObject(Report.RTObjects[0]).ClassName);
  rtPage := TFPReportCustomPage(Report.RTObjects[0]);
  AssertEquals('Failed on 4', 1, rtPage.ChildCount);
  AssertEquals('Failed on 5', 1, rtPage.BandCount);
  AssertEquals('Failed on 6', 1, rtPage.Bands[0].ChildCount);

  {$IFDEF gdebug}
//    writeln(Report.DebugPreparedPageAsJSON(0));
  {$ENDIF}
end;

procedure TTestCustomReport.TestRTObjects5_TwoDataItems;
var
  p: TMyFPReportPage;
  DataBand: TMyDataBand;
  Memo: TFPReportMemo;
  rtPage: TFPReportCustomPage;
begin
  SetReportData(2);

  p := TMyFPReportPage.Create(Report);
  p.Name := 'Page1';
  p.SetupPage;
  p.Data := Data;

  DataBand := TMyDataBand.Create(p);
  DataBand.Layout.Top := 0;
  DataBand.Layout.Height := 23;

  Memo := TFPReportMemo.Create(DataBand);
  Memo.Layout.Top := 5;
  Memo.Layout.Left := 10;
  Memo.Text := '[element]';

  AssertEquals('Failed on 1', 0, Report.RTObjects.Count);
  Report.RunReport;
  AssertEquals('Failed on 2', 1, Report.RTObjects.Count); // runtime objects adhere to same hierarchy as design time
  AssertEquals('Failed on 3', 'TFPReportCustomPage', TObject(Report.RTObjects[0]).ClassName);
  rtPage := TFPReportCustomPage(Report.RTObjects[0]);
  AssertEquals('Failed on 4', 2, rtPage.ChildCount);
  AssertEquals('Failed on 5', 2, rtPage.BandCount); { each data row has its own data band }
  AssertEquals('Failed on 6', 1, rtPage.Bands[0].ChildCount);
  AssertEquals('Failed on 7', 1, rtPage.Bands[1].ChildCount);

  {$IFDEF gdebug}
//    writeln(Report.DebugPreparedPageAsJSON(0));
  {$ENDIF}
end;

procedure TTestCustomReport.TestInternalFunction_Page;
var
  p: TMyFPReportPage;
  DataBand: TMyDataBand;
  Memo: TFPReportMemo;
  rtPage: TFPReportCustomPage;
begin
  SetReportData(1);

  p := TMyFPReportPage.Create(Report);
  p.Name := 'Page1';
  p.SetupPage;
  p.Data := Data;

  DataBand := TMyDataBand.Create(p);
  DataBand.Layout.Height := 23;

  Memo := TFPReportMemo.Create(DataBand);
  Memo.Layout.Top := 5;
  Memo.Layout.Left := 10;
  Memo.Text := '[PageNo]';

  AssertEquals('Failed on 1', 0, Report.RTObjects.Count);
  Report.RunReport;
  AssertEquals('Failed on 2', 1, Report.RTObjects.Count); // runtime objects adhere to same hierarchy as design time
  AssertEquals('Failed on 3', 'TFPReportCustomPage', TObject(Report.RTObjects[0]).ClassName);
  rtPage := TFPReportCustomPage(Report.RTObjects[0]);
  AssertEquals('Failed on 4', 1, rtPage.ChildCount);
  AssertEquals('Failed on 5', 1, rtPage.BandCount);
  AssertEquals('Failed on 6', 1, rtPage.Bands[0].ChildCount);
  Memo := TFPReportMemo(rtPage.Bands[0].Child[0]);
  AssertEquals('Failed on 7', '1', Memo.Text);
end;

procedure TTestCustomReport.TestInternalFunction_Page_with_text;
var
  p: TMyFPReportPage;
  DataBand: TMyDataBand;
  Memo: TFPReportMemo;
  rtPage: TFPReportCustomPage;
begin
  SetReportData(1);

  p := TMyFPReportPage.Create(Report);
  p.Name := 'Page1';
  p.SetupPage;
  p.Data := Data;

  DataBand := TMyDataBand.Create(p);
  DataBand.Layout.Height := 23;

  Memo := TFPReportMemo.Create(DataBand);
  Memo.Layout.Top := 5;
  Memo.Layout.Left := 10;
  Memo.Text := 'Page [PageNo]';

  AssertEquals('Failed on 1', 0, Report.RTObjects.Count);
  Report.RunReport;
  AssertEquals('Failed on 2', 1, Report.RTObjects.Count); // runtime objects adhere to same hierarchy as design time
  AssertEquals('Failed on 3', 'TFPReportCustomPage', TObject(Report.RTObjects[0]).ClassName);
  rtPage := TFPReportCustomPage(Report.RTObjects[0]);
  AssertEquals('Failed on 4', 1, rtPage.ChildCount);
  AssertEquals('Failed on 5', 1, rtPage.BandCount);
  AssertEquals('Failed on 6', 1, rtPage.Bands[0].ChildCount);
  Memo := TFPReportMemo(rtPage.Bands[0].Child[0]);
  AssertEquals('Failed on 7', 'Page 1', Memo.Text);
end;

procedure TTestCustomReport.TestInternalFunction_RecNo;
var
  p: TMyFPReportPage;
  DataBand: TMyDataBand;
  Memo: TFPReportMemo;
  rtPage: TFPReportCustomPage;
  i: integer;
begin
  SetReportData(5);

  p := TMyFPReportPage.Create(Report);
  p.Name := 'Page1';
  p.SetupPage;
  p.Data := Data;

  DataBand := TMyDataBand.Create(p);
  DataBand.Layout.Height := 23;

  Memo := TFPReportMemo.Create(DataBand);
  Memo.Layout.Top := 5;
  Memo.Layout.Left := 10;
  Memo.Text := '[recno('''')]';

  AssertEquals('Failed on 1', 0, Report.RTObjects.Count);
  Report.RunReport;
  AssertEquals('Failed on 2', 1, Report.RTObjects.Count); // runtime objects adhere to same hierarchy as design time
  AssertEquals('Failed on 3', 'TFPReportCustomPage', TObject(Report.RTObjects[0]).ClassName);
  rtPage := TFPReportCustomPage(Report.RTObjects[0]);
  AssertEquals('Failed on 4', 5, rtPage.ChildCount);  // 5 rendered data bands because we have 5 data records
  AssertEquals('Failed on 5', 5, rtPage.BandCount);
  AssertEquals('Failed on 6', 1, rtPage.Bands[0].ChildCount);
  for i := 0 to 4 do
  begin
    Memo := TFPReportMemo(rtPage.Bands[i].Child[0]);
    AssertEquals('Failed on 7.'+IntToStr(i), IntToStr(i+1), Memo.Text); { recno is 1-based }
  end;
end;

procedure TTestCustomReport.TestInternalFunction_Today;
var
  p: TMyFPReportPage;
  DataBand: TMyDataBand;
  Memo: TFPReportMemo;
  rtPage: TFPReportCustomPage;
begin
  SetReportData(1);

  p := TMyFPReportPage.Create(Report);
  p.Name := 'Page1';
  p.SetupPage;
  p.Data := Data;

  DataBand := TMyDataBand.Create(p);
  DataBand.Layout.Height := 23;

  Memo := TFPReportMemo.Create(DataBand);
  Memo.Layout.Top := 5;
  Memo.Layout.Left := 10;
  Memo.Text := '[today]';

  AssertEquals('Failed on 1', 0, Report.RTObjects.Count);
  Report.RunReport;
  AssertEquals('Failed on 2', 1, Report.RTObjects.Count); // runtime objects adhere to same hierarchy as design time
  AssertEquals('Failed on 3', 'TFPReportCustomPage', TObject(Report.RTObjects[0]).ClassName);
  rtPage := TFPReportCustomPage(Report.RTObjects[0]);
  AssertEquals('Failed on 4', 1, rtPage.ChildCount); // 1 rendered data band because we have 1 data record
  AssertEquals('Failed on 5', 1, rtPage.BandCount);
  AssertEquals('Failed on 6', 1, rtPage.Bands[0].ChildCount);
  Memo := TFPReportMemo(rtPage.Bands[0].Child[0]);
  AssertEquals('Failed on 7', FormatDateTime('yyyy-mm-dd', Today), Memo.Text);
end;

procedure TTestCustomReport.TestInternalFunction_Today_with_text;
var
  p: TMyFPReportPage;
  DataBand: TMyDataBand;
  Memo: TFPReportMemo;
  rtPage: TFPReportCustomPage;
begin
  SetReportData(1);

  p := TMyFPReportPage.Create(Report);
  p.Name := 'Page1';
  p.SetupPage;
  p.Data := Data;

  DataBand := TMyDataBand.Create(p);
  DataBand.Layout.Height := 23;

  Memo := TFPReportMemo.Create(DataBand);
  Memo.Layout.Top := 5;
  Memo.Layout.Left := 10;
  Memo.Text := 'Today is [today]';

  AssertEquals('Failed on 1', 0, Report.RTObjects.Count);
  Report.RunReport;
  AssertEquals('Failed on 2', 1, Report.RTObjects.Count); // runtime objects adhere to same hierarchy as design time
  AssertEquals('Failed on 3', 'TFPReportCustomPage', TObject(Report.RTObjects[0]).ClassName);
  rtPage := TFPReportCustomPage(Report.RTObjects[0]);
  AssertEquals('Failed on 4', 1, rtPage.ChildCount); // 1 rendered data band because we have 1 data record
  AssertEquals('Failed on 5', 1, rtPage.BandCount);
  AssertEquals('Failed on 6', 1, rtPage.Bands[0].ChildCount);
  Memo := TFPReportMemo(rtPage.Bands[0].Child[0]);
  AssertEquals('Failed on 7', 'Today is ' + FormatDateTime('yyyy-mm-dd', Today), Memo.Text);
end;

procedure TTestCustomReport.TestInternalFunction_Author;
var
  p: TMyFPReportPage;
  DataBand: TMyDataBand;
  Memo: TFPReportMemo;
  rtPage: TFPReportCustomPage;
begin
  SetReportData(1);

  p := TMyFPReportPage.Create(Report);
  p.Name := 'Page1';
  p.SetupPage;
  p.Data := Data;

  DataBand := TMyDataBand.Create(p);
  DataBand.Layout.Height := 23;

  Memo := TFPReportMemo.Create(DataBand);
  Memo.Layout.Top := 5;
  Memo.Layout.Left := 10;
  Memo.Text := '[author]';

  AssertEquals('Failed on 1', 0, Report.RTObjects.Count);
  Report.RunReport;
  AssertEquals('Failed on 2', 1, Report.RTObjects.Count); // runtime objects adhere to same hierarchy as design time
  AssertEquals('Failed on 3', 'TFPReportCustomPage', TObject(Report.RTObjects[0]).ClassName);
  rtPage := TFPReportCustomPage(Report.RTObjects[0]);
  AssertEquals('Failed on 4', 1, rtPage.ChildCount); // 1 rendered data band because we have 1 data record
  AssertEquals('Failed on 5', 1, rtPage.BandCount);
  AssertEquals('Failed on 6', 1, rtPage.Bands[0].ChildCount);
  Memo := TFPReportMemo(rtPage.Bands[0].Child[0]);
  AssertEquals('Failed on 7', '', Memo.Text); // we never set Report.Author
end;

procedure TTestCustomReport.TestInternalFunction_Author_with_text;
var
  p: TMyFPReportPage;
  DataBand: TMyDataBand;
  Memo: TFPReportMemo;
  rtPage: TFPReportCustomPage;
begin
  SetReportData(1);

  Report.Author := 'Graeme Geldenhuys';
  p := TMyFPReportPage.Create(Report);
  p.Name := 'Page1';
  p.SetupPage;
  p.Data := Data;

  DataBand := TMyDataBand.Create(p);
  DataBand.Layout.Height := 23;

  Memo := TFPReportMemo.Create(DataBand);
  Memo.Layout.Top := 5;
  Memo.Layout.Left := 10;
  Memo.Text := 'The Author is [author].';

  AssertEquals('Failed on 1', 0, Report.RTObjects.Count);
  Report.RunReport;
  AssertEquals('Failed on 2', 1, Report.RTObjects.Count); // runtime objects adhere to same hierarchy as design time
  AssertEquals('Failed on 3', 'TFPReportCustomPage', TObject(Report.RTObjects[0]).ClassName);
  rtPage := TFPReportCustomPage(Report.RTObjects[0]);
  AssertEquals('Failed on 4', 1, rtPage.ChildCount); // 1 rendered data band because we have 1 data record
  AssertEquals('Failed on 5', 1, rtPage.BandCount);
  AssertEquals('Failed on 6', 1, rtPage.Bands[0].ChildCount);
  Memo := TFPReportMemo(rtPage.Bands[0].Child[0]);
  AssertEquals('Failed on 7', 'The Author is Graeme Geldenhuys.', Memo.Text);
end;

procedure TTestCustomReport.TestInternalFunction_Title;
var
  p: TMyFPReportPage;
  DataBand: TMyDataBand;
  Memo: TFPReportMemo;
  rtPage: TFPReportCustomPage;
begin
  SetReportData(1);

  p := TMyFPReportPage.Create(Report);
  p.Name := 'Page1';
  p.SetupPage;
  p.Data := Data;

  DataBand := TMyDataBand.Create(p);
  DataBand.Layout.Height := 23;

  Memo := TFPReportMemo.Create(DataBand);
  Memo.Layout.Top := 5;
  Memo.Layout.Left := 10;
  Memo.Text := '[title]';

  AssertEquals('Failed on 1', 0, Report.RTObjects.Count);
  Report.RunReport;
  AssertEquals('Failed on 2', 1, Report.RTObjects.Count); // runtime objects adhere to same hierarchy as design time
  AssertEquals('Failed on 3', 'TFPReportCustomPage', TObject(Report.RTObjects[0]).ClassName);
  rtPage := TFPReportCustomPage(Report.RTObjects[0]);
  AssertEquals('Failed on 4', 1, rtPage.ChildCount); // 1 rendered data band because we have 1 data record
  AssertEquals('Failed on 5', 1, rtPage.BandCount);
  AssertEquals('Failed on 6', 1, rtPage.Bands[0].ChildCount);
  Memo := TFPReportMemo(rtPage.Bands[0].Child[0]);
  AssertEquals('Failed on 7', '', Memo.Text); // we never set Report.Title
end;

procedure TTestCustomReport.TestInternalFunction_Title_with_text;
var
  p: TMyFPReportPage;
  DataBand: TMyDataBand;
  Memo: TFPReportMemo;
  rtPage: TFPReportCustomPage;
begin
  SetReportData(1);

  Report.Title := 'My Test Report';
  p := TMyFPReportPage.Create(Report);
  p.Name := 'Page1';
  p.SetupPage;
  p.Data := Data;

  DataBand := TMyDataBand.Create(p);
  DataBand.Layout.Height := 23;

  Memo := TFPReportMemo.Create(DataBand);
  Memo.Layout.Top := 5;
  Memo.Layout.Left := 10;
  Memo.Text := 'Report Title is "[title]".';

  AssertEquals('Failed on 1', 0, Report.RTObjects.Count);
  Report.RunReport;
  AssertEquals('Failed on 2', 1, Report.RTObjects.Count); // runtime objects adhere to same hierarchy as design time
  AssertEquals('Failed on 3', 'TFPReportCustomPage', TObject(Report.RTObjects[0]).ClassName);
  rtPage := TFPReportCustomPage(Report.RTObjects[0]);
  AssertEquals('Failed on 4', 1, rtPage.ChildCount); // 1 rendered data band because we have 1 data record
  AssertEquals('Failed on 5', 1, rtPage.BandCount);
  AssertEquals('Failed on 6', 1, rtPage.Bands[0].ChildCount);
  Memo := TFPReportMemo(rtPage.Bands[0].Child[0]);
  AssertEquals('Failed on 7', 'Report Title is "My Test Report".', Memo.Text);
end;

{ TTestReportMemo }


procedure TTestReportMemo.CauseFontNotFoundException;
begin
  TMemoFriend(FMemo).RecalcLayout;
end;

procedure TTestReportMemo.SetUp;
begin
  inherited SetUp;
  FMemo := TFPReportMemo.Create(nil);
  FMemo.Layout.SetPosition(0, 0, 60, 5);
end;

procedure TTestReportMemo.TearDown;
begin
  FMemo.Free;
  inherited TearDown;
end;

procedure TTestReportMemo.TestCreate;
var
  m: TFPReportMemo;
begin
  m := TFPReportMemo.Create(nil);
  try
    m.Text := 'abc 123';
    AssertTrue('Failed on 1', m <> nil);
  finally
    m.Free;
  end;
end;

procedure TTestReportMemo.TestPrepareTextBlocks;
begin
  gTTFontCache.Clear;
  gTTFontCache.SearchPath.Text := 'fonts';
  gTTFontCache.BuildFontCache;

  FMemo.Layout.Width := 100;
  FMemo.Text := 'abc 123';
  FMemo.UseParentFont := False;
  FMemo.Font.Name := 'Calibri';
  FMemo.StretchMode := smActualHeight;
  TMemoFriend(FMemo).CreateRTLayout;
  TMemoFriend(FMemo).RecalcLayout;
  AssertEquals('Failed on 2', 1, FMemo.TextLines.Count);
end;

procedure TTestReportMemo.TestPrepareTextBlocks_multiline_data;
begin
  gTTFontCache.Clear;
  gTTFontCache.SearchPath.Text := 'fonts';
  gTTFontCache.BuildFontCache;

  FMemo.Layout.Width := 100;
  FMemo.Text := 'abc'+LineEnding+'123';
  FMemo.UseParentFont := False;
  FMemo.Font.Name := 'Calibri';
  FMemo.StretchMode := smActualHeight;
  TMemoFriend(FMemo).CreateRTLayout;
  TMemoFriend(FMemo).RecalcLayout;
  AssertEquals('Failed on 2', 2, FMemo.TextLines.Count);
end;

procedure TTestReportMemo.TestPrepareTextBlocks_multiline_wraptext;
begin
  gTTFontCache.Clear;
  gTTFontCache.SearchPath.Text := 'fonts';
  gTTFontCache.BuildFontCache;

  FMemo.Layout.Width := 6;
  FMemo.Text := 'abc 123';
  FMemo.UseParentFont := False;
  FMemo.Font.Name := 'Calibri';
  FMemo.StretchMode := smActualHeight;
  FMemo.WordOverflow := woOverflow;
  TMemoFriend(FMemo).CreateRTLayout;
  TMemoFriend(FMemo).RecalcLayout;
  AssertEquals('Failed on 2', 2, FMemo.TextLines.Count);
end;

procedure TTestReportMemo.TestPrepareTextBlocks_multiline_wraptext_oneword;
begin
  gTTFontCache.Clear;
  gTTFontCache.SearchPath.Text := 'fonts';
  gTTFontCache.BuildFontCache;

  FMemo.Layout.Width := 10;
  FMemo.Text := 'abc123';
  FMemo.UseParentFont := False;
  FMemo.Font.Name := 'Calibri';
  FMemo.StretchMode := smActualHeight;
  TMemoFriend(FMemo).CreateRTLayout;
  TMemoFriend(FMemo).RecalcLayout;
  AssertEquals('Failed on 1', 1, FMemo.TextLines.Count);
  // The length of abc1 fits.
  AssertEquals('Failed on 1', 'abc1', FMemo.TextLines[0]);
end;

procedure TTestReportMemo.TestPrepareTextBlocks_multiline_wraptext_oneword_overflow;
begin
  gTTFontCache.Clear;
  gTTFontCache.SearchPath.Text := 'fonts';
  gTTFontCache.BuildFontCache;

  FMemo.Layout.Width := 10;
  FMemo.Text := 'abc123';
  FMemo.UseParentFont := False;
  FMemo.Font.Name := 'Calibri';
  FMemo.StretchMode := smActualHeight;
  TMemoFriend(FMemo).WordOverflow:=woOverflow;
  TMemoFriend(FMemo).CreateRTLayout;
  TMemoFriend(FMemo).RecalcLayout;
  AssertEquals('Failed on 1', 1, FMemo.TextLines.Count);
  AssertEquals('Failed on 1', 'abc123', FMemo.TextLines[0]);
end;

procedure TTestReportMemo.TestPrepareTextBlocks_multiline_wraptext_oneword_split;
begin
  gTTFontCache.Clear;
  gTTFontCache.SearchPath.Text := 'fonts';
  gTTFontCache.BuildFontCache;

  FMemo.Layout.Width := 10;
  FMemo.Text := 'abc123';
  FMemo.UseParentFont := False;
  FMemo.Font.Name := 'Calibri';
  FMemo.StretchMode := smActualHeight;
  TMemoFriend(FMemo).WordOverflow:=woSplit;
  TMemoFriend(FMemo).CreateRTLayout;
  TMemoFriend(FMemo).RecalcLayout;
  AssertEquals('Failed on 1', 2, FMemo.TextLines.Count);
  AssertEquals('Failed on 2', 'abc1', FMemo.TextLines[0]);
  AssertEquals('Failed on 3', '23', FMemo.TextLines[1]);
end;

procedure TTestReportMemo.TestRGBToReportColor;
var
  c: TFPReportColor;
begin
  c := RGBToReportColor(255, 0, 0);
  AssertEquals('failed on 1', IntToHex(clRed, 8), IntToHex(c, 8));
  c := RGBToReportColor(0, 128, 0);
  AssertEquals('failed on 2', IntToHex(clGreen, 8), IntToHex(c, 8));
  c := RGBToReportColor(0, 0, 255);
  AssertEquals('failed on 3', IntToHex(clBlue, 8), IntToHex(c, 8));
end;

procedure TTestReportMemo.TestHTMLColorToReportColor_length7;
var
  c: TFPReportColor;
begin
  c := TMemoFriend(FMemo).HtmlColorToFPReportColor('#FF0000', clBlack);
  AssertEquals('failed on 1', IntToHex(clRed, 8), IntToHex(c, 8));
  c := TMemoFriend(FMemo).HtmlColorToFPReportColor('#008000', clBlack);
  AssertEquals('failed on 2', IntToHex(clGreen, 8), IntToHex(c, 8));
  c := TMemoFriend(FMemo).HtmlColorToFPReportColor('#0000FF', clBlack);
  AssertEquals('failed on 3', IntToHex(clBlue, 8), IntToHex(c, 8));
  c := TMemoFriend(FMemo).HtmlColorToFPReportColor('A0000FF', clBlack);
  AssertEquals('failed on 4', IntToHex(clBlack, 8), IntToHex(c, 8));
end;

procedure TTestReportMemo.TestHTMLColorToReportColor_length6;
var
  c: TFPReportColor;
begin
  c := TMemoFriend(FMemo).HtmlColorToFPReportColor('FF0000', clBlack);
  AssertEquals('failed on 1', IntToHex(clRed, 8), IntToHex(c, 8));
  c := TMemoFriend(FMemo).HtmlColorToFPReportColor('008000', clBlack);
  AssertEquals('failed on 2', IntToHex(clGreen, 8), IntToHex(c, 8));
  c := TMemoFriend(FMemo).HtmlColorToFPReportColor('0000FF', clBlack);
  AssertEquals('failed on 3', IntToHex(clBlue, 8), IntToHex(c, 8));
  c := TMemoFriend(FMemo).HtmlColorToFPReportColor('A0000FF', clBlack);
  AssertEquals('failed on 4', IntToHex(clBlack, 8), IntToHex(c, 8));
end;

procedure TTestReportMemo.TestHTMLColorToReportColor_length3;
var
  c: TFPReportColor;
begin
  c := TMemoFriend(FMemo).HtmlColorToFPReportColor('F00', clBlack);
  AssertEquals('failed on 1', IntToHex(clRed, 8), IntToHex(c, 8));
  c := TMemoFriend(FMemo).HtmlColorToFPReportColor('080', clBlack);
  AssertEquals('failed on 2', IntToHex($008800, 8), IntToHex(c, 8));
  c := TMemoFriend(FMemo).HtmlColorToFPReportColor('00F', clBlack);
  AssertEquals('failed on 3', IntToHex(clBlue, 8), IntToHex(c, 8));
  c := TMemoFriend(FMemo).HtmlColorToFPReportColor('A00F', clDkGray);
  AssertEquals('failed on 4', IntToHex(clDkGray, 8), IntToHex(c, 8));

  c := TMemoFriend(FMemo).HtmlColorToFPReportColor('700', clBlack);
  AssertEquals('failed on 5', IntToHex($770000, 8), IntToHex(c, 8));
  c := TMemoFriend(FMemo).HtmlColorToFPReportColor('006', clBlack);
  AssertEquals('failed on 6', IntToHex($000066, 8), IntToHex(c, 8));
end;

procedure TTestReportMemo.TestCreateTestBlock;
var
  tb: TFPTextBlock;
begin
  tb := TMemoFriend(FMemo).CreateTextBlock(false);
  try
    AssertTrue('failed on 1', tb is TFPTextBlock);
    AssertFalse('failed on 2', tb is TFPHTTPTextBlock);
  finally
    tb.Free;
  end;
end;

procedure TTestReportMemo.TestCreateTestBlock_IsURL;
var
  tb: TFPTextBlock;
begin
  tb := TMemoFriend(FMemo).CreateTextBlock(true);
  try
    AssertTrue('failed on 1', tb is TFPTextBlock);
    AssertTrue('failed on 2', tb is TFPHTTPTextBlock);
  finally
    tb.Free;
  end;
end;

procedure TTestReportMemo.TestSubStr;
var
  m: TMemoFriend;
  lStartPos: integer;
begin
  m := TMemoFriend(FMemo);
  AssertEquals('failed on 1', '', m.SubStr('','','', 1, lStartPos));
  AssertEquals('failed on 1.1', -1, lStartPos);
  AssertEquals('failed on 2', 'abc', m.SubStr('xxxabcyyy','xxx','yyy', 1, lStartPos));
  AssertEquals('failed on 2.1', 4, lStartPos);
  AssertEquals('failed on 3', 'abc', m.SubStr('xxx,abc;xxx',',',';', 1, lStartPos));
  AssertEquals('failed on 3.1', 5, lStartPos);
  AssertEquals('failed on 4', 'abc', m.SubStr('<d>abc</d>','<d>','</d>', 1, lStartPos));
  AssertEquals('failed on 4.1', 4, lStartPos);
  AssertEquals('failed on 5', 'abc1', m.SubStr('<d>abc1</d> <d>abc2</d>','<d>','</d>', 1, lStartPos));
  AssertEquals('failed on 5.1', 4, lStartPos);
  AssertEquals('failed on 6', 'abc2', m.SubStr('<d>abc1</d> <d>abc2</d>','<d>','</d>', 2, lStartPos));
  AssertEquals('failed on 6.1', 16, lStartPos);
  AssertEquals('failed on 7', '', m.SubStr('<d>abc1</d> <d>abc2</d>','<d>','</d>', 3, lStartPos));
  AssertEquals('failed on 7.1', -1, lStartPos);
  AssertEquals('failed on 8', 'abc1', m.SubStr('<d>abc1</d> <d>abc2</d>','<d>','</d>', 0, lStartPos));
  AssertEquals('failed on 8.1', 4, lStartPos);
  AssertEquals('failed on 9', 'abc1', m.SubStr('<d>abc1</d> <d>abc2</d>','<d>','</d>', -1, lStartPos));
  AssertEquals('failed on 9.1', 4, lStartPos);
end;

procedure TTestReportMemo.TestTokenCount;
var
  m: TMemoFriend;
  lStartPos: integer;
begin
  m := TMemoFriend(FMemo);
  AssertEquals('failed on 1', '', m.SubStr('','','', 1, lStartPos));
  AssertEquals('failed on 1.1', -1, lStartPos);
  AssertEquals('failed on 2', 'abc', m.SubStr('xxxabcyyy','xxx','yyy', 1, lStartPos));
  AssertEquals('failed on 2.1', 4, lStartPos);

  AssertEquals('failed on 1', m.TokenCount('', ','), 0);
  AssertEquals('failed on 2', m.TokenCount('adf adf', ','), 1);
  AssertEquals('failed on 3', m.TokenCount('adf,', ','), 2);
  AssertEquals('failed on 4', m.TokenCount('adf,adf', ','), 2);
  AssertEquals('failed on 5', m.TokenCount('adf,adf,adf', ','), 3);
  AssertEquals('failed on 6', m.TokenCount('adf,adf,adf,', ','), 4);
  AssertEquals('failed on 6', m.TokenCount('0mm margin top and bottom.', ' '), 5);
  AssertEquals('failed on 6', m.TokenCount('0mm margin top and bottom. ', ' '), 6);
end;

procedure TTestReportMemo.TestToken;
var
  m: TMemoFriend;
  lStartPos: integer;
begin
  m := TMemoFriend(FMemo);
  AssertEquals('failed on 1', m.Token('', ',', 1), '');
  AssertEquals('failed on 2', m.Token('a,b,c', ',', 1), 'a');
  AssertEquals('failed on 3', m.Token('a,b,c', ',', 2), 'b');
  AssertEquals('failed on 4', m.Token('a,b,c', ',', 3), 'c');
  AssertEquals('failed on 5', m.Token('a,b,c', ',', 4), '');
  AssertEquals('failed on 6', m.Token('aa,bb,cc', ',', 1), 'aa');
  AssertEquals('failed on 7', m.Token('aa,bb,cc', ',', 2), 'bb');
  AssertEquals('failed on 8', m.Token('aa,bb,cc', ',', 3), 'cc');
  AssertEquals('failed on 9', m.Token('aa,bb,cc', ',', 4), '');
  AssertEquals('failed on 10', m.Token('aa,bb,cc,', ',', 4), '');
  AssertEquals('failed on 11', m.Token('0mm margin top and bottom.', ' ', 5), 'bottom.');
  AssertEquals('failed on 12', m.Token('0mm margin top and bottom. ', ' ', 5), 'bottom.');
  AssertEquals('failed on 13', m.Token('0mm margin top and bottom. ', ' ', 6), '');
end;

{ TTestBandList }

procedure TTestBandList.CreateBands;
begin
  b1 := TFPReportPageHeaderBand.Create(nil);
  b2 := TFPReportTitleBand.Create(nil);
  b3 := TFPReportDataBand.Create(nil);
end;

procedure TTestBandList.AddAllBandsToList;
begin
  FList.Add(b1);
  FList.Add(b2);
  FList.Add(b3);
end;

procedure TTestBandList.SetUp;
begin
  inherited SetUp;
  FList := TBandList.Create;
  CreateBands;
end;

procedure TTestBandList.TearDown;
begin
  FreeAndNil(FList);
  FreeAndNil(b3);
  FreeAndNil(b2);
  FreeAndNil(b1);
  inherited TearDown;
end;

procedure TTestBandList.TestAdd;
begin
  AssertEquals('Failed on 1', 0, FList.Count);
  AddAllBandsToList;
  AssertEquals('Failed on 2', 3, FList.Count);
end;

procedure TTestBandList.TestItems;
begin
  AssertEquals('Failed on 1', 0, FList.Count);
  AddAllBandsToList;
  AssertEquals('Failed on 2', 3, FList.Count);

  AssertTrue('failed on 3', FList.Items[0] = b1);
  AssertTrue('failed on 4', FList.Items[1] = b2);
  AssertTrue('failed on 5', FList.Items[1] <> b1);
  AssertTrue('failed on 6', FList.Items[2] = b3);
end;

procedure TTestBandList.TestClear;
begin
  AssertEquals('Failed on 1', 0, FList.Count);
  AddAllBandsToList;
  AssertEquals('Failed on 2', 3, FList.Count);

  FList.Clear;
  AssertEquals('Failed on 3', 0, FList.Count);
  AssertTrue('failed on 4', b1 <> nil); // List.Clear shouldn't free bands
end;

procedure TTestBandList.TestDelete;
begin
  AssertEquals('Failed on 1', 0, FList.Count);
  AddAllBandsToList;
  AssertEquals('Failed on 2', 3, FList.Count);

  FList.Delete(0);
  AssertEquals('Failed on 3', 2, FList.Count);
  AssertTrue('failed on 4', b1 <> nil); // List.Delete shouldn't free bands
  AssertTrue('failed on 5', FList.Items[0] = b2);
  AssertTrue('failed on 6', FList.Items[1] = b3);
end;

procedure TTestBandList.TestFind1;
var
  lBand: TFPReportCustomBand;
  lResult: integer;
begin
  AssertEquals('Failed on 1', 0, FList.Count);
  AddAllBandsToList;
  AssertEquals('Failed on 2', 3, FList.Count);

  AssertTrue('failed on 3', FList.Find(TFPReportPageHeaderBand) <> nil);
  AssertTrue('failed on 4', FList.Find(TFPReportPageHeaderBand) = b1);
  AssertTrue('failed on 5', FList.Find(TFPReportTitleBand) = b2);
  AssertTrue('failed on 6', FList.Find(TFPReportDataBand) = b3);

  FList.Clear;
  AssertTrue('failed on 7', FList.Find(TFPReportTitleBand) = nil);
end;

procedure TTestBandList.TestFind2;
var
  lBand: TFPReportCustomBand;
  lResult: integer;
begin
  AssertEquals('Failed on 1', 0, FList.Count);
  lResult := FList.Find(TFPReportPageHeaderBand, lBand);
  AssertEquals('failed on 2', -1, lResult);
  AssertTrue('failed on 3', lBand = nil);

  AddAllBandsToList;
  AssertEquals('Failed on 4', 3, FList.Count);

  lResult := FList.Find(TFPReportPageHeaderBand, lBand);
  AssertEquals('failed on 5', 0, lResult);
  AssertTrue('failed on 6', lBand <> nil);
  AssertTrue('failed on 7', lBand = b1);

  lResult := FList.Find(TFPReportTitleBand, lBand);
  AssertEquals('failed on 8', 1, lResult);
  AssertTrue('failed on 9', lBand = b2);

  lResult := FList.Find(TFPReportDataBand, lBand);
  AssertEquals('failed on 10', 2, lResult);
  AssertTrue('failed on 11', lBand = b3);

  FList.Clear;
  lResult := FList.Find(TFPReportTitleBand, lBand);
  AssertTrue('failed on 12', lBand = nil);
  AssertTrue('failed on 13', lResult = -1);
end;

initialization
  RegisterTests(
    [TTestReportComponent,
    TReportElementTest,
    TTestReportChildren,
    TTestReportFrame,
    TTestReportLayout,
    TTestFPPageSize,
    TTestFPPaperManager,
    TTestFPReportPageSize,
    TTestReportPage,
    TTestReportData,
    TTestUserReportData,
    TTestUserReportData2,
    TTestDataBand,
    TTestCustomReport,
    TTestReportMemo,
    TTestBandList,
    TTestVariable,
    TTestVariables
    ]);
end.