mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-06-06 11:38:25 +02:00
395 lines
10 KiB
ObjectPascal
395 lines
10 KiB
ObjectPascal
{
|
|
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.
|
|
|