path: root/fpcsrc/packages/fcl-db/tests/testdddiff.pp

{
    This file is part of the Free Pascal run time library.
    Copyright (c) 2008 by the Free Pascal development team

    FPCUnit fpdddiff test.

    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 testdddiff;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, testregistry, fpcunit, fpdddiff, fpdatadict;

type

  { TMyDiff }

  TMyDiff = class (TCustomDDDiffer)
  private
    FMsg: TStringlist;
    function GetIndexName (ID : TDDIndexDef) : string;
    function GetFieldName (FD : TDDFieldDef) : string;
  protected
    procedure TableDifference (DiffType: TDifferenceType; SourceTable, TargetTable: TDDTableDef); override;
    procedure IndexDifference (DiffType: TDifferenceType; SourceIndex, TargetIndex: TDDIndexDef); override;
    procedure FieldDifference (DiffType: TDifferenceType; SourceField, TargetField: TDDFieldDef); override;
  public
    Constructor create;
    destructor destroy; override;
  public
    property Messages : TStringlist read FMsg;
  end;
  
  { TTestDDDiff }

  TTestDDDiff = class (TTestcase)
  private
    Differ : TMyDiff;
    SourceDD, TargetDD : TFPDataDictionary;
    procedure SetupSourceDD;
    procedure SetupTargetDD;
    function CreateTable (DD: TFPDataDictionary; tablename:string) : TDDTableDef;
    procedure AssertMessageCount (ACount: integer);
    procedure AssertMessage (AMessage: string);
  protected
    procedure SetUp; override;
    procedure TearDown; override;
  published
    procedure TestEquals;
    procedure TestSourceTable;
    procedure TestTargetTable;
    procedure TestSourceField;
    procedure TestTargetField;
    procedure TestSourceIndex;
    procedure TestTargetIndex;
    procedure TestFieldType;
    procedure TestFieldSize;
    procedure TestFieldPrecision;
    procedure TestFieldDefExpression;
    procedure TestFieldRequired;
    procedure TestIndexOptions;
    procedure TestIndexExpression;
    procedure TestIndexFields;
    procedure TestIndexDescFields;
    procedure TestIndexCaseInsFields;
  end;
  
  
implementation

uses db;

{ TMyDiff }

function TMyDiff.GetIndexName(ID: TDDIndexDef): string;
begin
  result := TDDIndexdefs(ID.Collection).TableName + '.' + ID.IndexName;
end;

function TMyDiff.GetFieldName(FD: TDDFieldDef): string;
begin
  result := TDDFielddefs(FD.Collection).TableName + '.' + FD.FieldName;
end;

procedure TMyDiff.TableDifference(DiffType: TDifferenceType; SourceTable,
  TargetTable: TDDTableDef);
begin
  case DiffType of
    dtMissing: FMsg.Add (format('ST %s', [SourceTable.TableName]));
    dtSurplus: FMsg.Add (format('TT %s', [TargetTable.TableName]));
    dtDifferent: FMsg.Add (format('DT', [TargetTable.TableName]));
  end;
end;

procedure TMyDiff.IndexDifference(DiffType: TDifferenceType; SourceIndex,
  TargetIndex: TDDIndexDef);
begin
  case DiffType of
    dtMissing: FMsg.Add (format('SI %s', [getindexname(SourceIndex)]));
    dtSurplus: FMsg.Add (format('TI %s', [getindexname(TargetIndex)]));
    dtDifferent: FMsg.Add (format('DI %s', [getindexname(TargetIndex)]));
  end;
end;

procedure TMyDiff.FieldDifference(DiffType: TDifferenceType; SourceField,
  TargetField: TDDFieldDef);
begin
  case DiffType of
    dtMissing: FMsg.Add (format('SF %s', [getfieldname(SourceField)]));
    dtSurplus: FMsg.Add (format('TF %s', [getfieldname(TargetField)]));
    dtDifferent: FMsg.Add (format('DF %s', [getfieldname(TargetField)]));
  end;
end;

constructor TMyDiff.create;
begin
  inherited;
  FMsg := TStringlist.Create;
end;

destructor TMyDiff.destroy;
begin
  FMsg.Free;
  inherited destroy;
end;

{ TTestDDDiff }

procedure TTestDDDiff.SetupSourceDD;
begin
  SourceDD := TFPDataDictionary.Create;
  CreateTable (SourceDD, 'EERSTE');
  CreateTable (SourceDD, 'TWEEDE');
end;

procedure TTestDDDiff.SetupTargetDD;
begin
  TargetDD := TFPDataDictionary.Create;
  CreateTable (TargetDD, 'EERSTE');
  CreateTable (TargetDD, 'TWEEDE');
end;

function TTestDDDiff.CreateTable(DD: TFPDataDictionary; tablename: string): TDDTableDef;
begin
  result := dd.Tables.AddTable(tablename);
  with result.Fields.AddField('ID') do
    begin
    FieldType := ftLargeint;
    Required:=True;
    end;
  with result.Fields.AddField('eerste') do
    begin
    FieldType := ftString;
    Required:=True;
    Size := 25;
    end;
  with result.Fields.AddField('Tweede') do
    begin
    FieldType := ftFloat;
    Required:=False;
    Size := 12;
    Precision := 4;
    end;
  with result.Fields.AddField('Extralang') do
    begin
    FieldType := ftString;
    Required:=false;
    Size := 1024;
    end;
  with result.Indexes.AddDDIndexDef('Primary') do
    begin
    Fields:='ID';
    options := [ixPrimary];
    end;
  with result.Indexes.AddDDIndexDef('UniqueEerste') do
    begin
    Fields:='eerste,tweede';
    DescFields:='eerste';
    options := [ixUnique];
    end;
end;

procedure TTestDDDiff.AssertMessageCount(ACount: integer);
begin
  AssertEquals('Number of differences', ACount, Differ.Messages.count);
end;

procedure TTestDDDiff.AssertMessage(AMessage: string);
begin
  if Differ.Messages.count > 1 then
    Fail ('More differences then expected: expected '+AMessage+', got '+differ.Messages.Commatext)
  else if Differ.messages.count = 0 then
    Fail ('No differences found, expected 1: '+AMessage);
  AssertEquals ('Difference detected,', AMessage, Differ.Messages[0])
end;

procedure TTestDDDiff.SetUp;
begin
  inherited SetUp;
  SetupSourceDD;
  SetupTargetDD;
  Differ := TMyDiff.Create;
  Differ.SourceDD := SourceDD;
  Differ.TargetDD := TargetDD;
end;

procedure TTestDDDiff.TearDown;
begin
  Differ.Free;
  FreeAndNil(SourceDD);
  FreeAndNil(TargetDD);
  inherited TearDown;
end;

procedure TTestDDDiff.TestEquals;
begin
  Differ.Compare(diffAll);
  AssertMessageCount (0);
end;

procedure TTestDDDiff.TestSourceTable;
begin
  SourceDD.Tables.AddTable ('eentabel');
  Differ.Compare(diffAll);
  AssertMessageCount (1);
  AssertMessage ('ST eentabel');
end;

procedure TTestDDDiff.TestTargetTable;
begin
  TargetDD.Tables.AddTable ('eentabel');
  Differ.Compare(diffAll);
  AssertMessageCount (1);
  AssertMessage ('TT eentabel');
end;

procedure TTestDDDiff.TestSourceField;
begin
  with SourceDD.Tables.TableByName('TWEEDE').AddField ('extra') do
    begin
    FieldType := ftCurrency;
    size := 12;
    precision := 2;
    required := true;
    end;
  Differ.Compare(diffAll);
  AssertMessageCount (1);
  AssertMessage ('SF TWEEDE.extra');
end;

procedure TTestDDDiff.TestTargetField;
begin
  with TargetDD.Tables.TableByName('TWEEDE').AddField ('extra') do
    begin
    FieldType := ftCurrency;
    size := 12;
    precision := 2;
    required := true;
    end;
  Differ.Compare(diffAll);
  AssertMessageCount (1);
  AssertMessage ('TF TWEEDE.extra');
end;

procedure TTestDDDiff.TestSourceIndex;
begin
  with SourceDD.Tables.TableByName('TWEEDE').Indexes.AddIndex ('extra') do
    begin
    Fields := 'Tweede';
    Options := [ixUnique];
    end;
  Differ.Compare(diffAll);
  AssertMessageCount (1);
  AssertMessage ('SI TWEEDE.extra');
end;

procedure TTestDDDiff.TestTargetIndex;
begin
  with TargetDD.Tables.TableByName('TWEEDE').Indexes.AddIndex ('extra') do
    begin
    Fields := 'Tweede';
    Options := [ixUnique];
    end;
  Differ.Compare(diffAll);
  AssertMessageCount (1);
  AssertMessage ('TI TWEEDE.extra');
end;

procedure TTestDDDiff.TestFieldType;
begin
  with SourceDD.Tables.TableByName('TWEEDE').Fields.FieldByName ('tweede') do
    FieldType := ftCurrency;
  Differ.Compare(diffAll);
  AssertMessageCount (1);
  AssertMessage ('DF TWEEDE.Tweede');
end;

procedure TTestDDDiff.TestFieldSize;
begin
  with SourceDD.Tables.TableByName('TWEEDE').Fields.FieldByName ('tweede') do
    Size := 16;
  Differ.Compare(diffAll);
  AssertMessageCount (1);
  AssertMessage ('DF TWEEDE.Tweede');
end;

procedure TTestDDDiff.TestFieldPrecision;
begin
  with SourceDD.Tables.TableByName('TWEEDE').Fields.FieldByName ('tweede') do
    Precision := 0;
  Differ.Compare(diffAll);
  AssertMessageCount (1);
  AssertMessage ('DF TWEEDE.Tweede');
end;

procedure TTestDDDiff.TestFieldDefExpression;
begin
  with SourceDD.Tables.TableByName('TWEEDE').Fields.FieldByName ('tweede') do
    DefaultExpression := '258.2345';
  Differ.Compare(diffAll);
  AssertMessageCount (1);
  AssertMessage ('DF TWEEDE.Tweede');
end;

procedure TTestDDDiff.TestFieldRequired;
begin
  with SourceDD.Tables.TableByName('TWEEDE').Fields.FieldByName ('tweede') do
    Required := true;
  Differ.Compare(diffAll);
  AssertMessageCount (1);
  AssertMessage ('DF TWEEDE.Tweede');
end;

procedure TTestDDDiff.TestIndexOptions;
begin
  with SourceDD.Tables.TableByName('TWEEDE').Indexes.IndexByName('UniqueEerste') do
    Options := [ixUnique, ixDescending];
  Differ.Compare(diffAll);
  AssertMessageCount (1);
  AssertMessage ('DI TWEEDE.UniqueEerste');
end;

procedure TTestDDDiff.TestIndexExpression;
begin
  with SourceDD.Tables.TableByName('TWEEDE').Indexes.IndexByName('UniqueEerste') do
    Expression := 'Eerste+Tweede';
  Differ.Compare(diffAll);
  AssertMessageCount (1);
  AssertMessage ('DI TWEEDE.UniqueEerste');
end;

procedure TTestDDDiff.TestIndexFields;
begin
  with SourceDD.Tables.TableByName('TWEEDE').Indexes.IndexByName('UniqueEerste') do
    Fields := 'Eerste';
  Differ.Compare(diffAll);
  AssertMessageCount (1);
  AssertMessage ('DI TWEEDE.UniqueEerste');
end;

procedure TTestDDDiff.TestIndexDescFields;
begin
  with SourceDD.Tables.TableByName('TWEEDE').Indexes.IndexByName('UniqueEerste') do
    DescFields := 'Tweede';
  Differ.Compare(diffAll);
  AssertMessageCount (1);
  AssertMessage ('DI TWEEDE.UniqueEerste');
end;

procedure TTestDDDiff.TestIndexCaseInsFields;
begin
  with SourceDD.Tables.TableByName('TWEEDE').Indexes.IndexByName('UniqueEerste') do
    CaseInsFields := 'Eesrte';
  Differ.Compare(diffAll);
  AssertMessageCount (1);
  AssertMessage ('DI TWEEDE.UniqueEerste');
end;

initialization

  RegisterTest (TTestDDDiff);
  
end.