trunk/testsuite/Test05.pas

unit Test05;

{$mode objfpc}{$H+}

{Test 5: Firebird 4 Data Types}

interface

uses
  Classes, SysUtils,   TestApplication, IBXTestBase, DB, IB, IBCustomDataSet,
  IBDatabase, IBExtract;

const
  aTestID    = '05';
  aTestTitle = 'Firebird 4 Data Types';

type

{ TTest05 }

  TTest05 = class(TIBXTestBase)
  private
    FDataSet: TIBDataSet;
    FExtract: TIBExtract;
    procedure HandleExtractLine(Sender: TObject; start, count: integer);
    procedure HandleAfterInsert(DataSet: TDataSet);
  protected
    procedure CreateObjects(Application: TTestApplication); override;
    function GetTestID: AnsiString; override;
    function GetTestTitle: AnsiString; override;
    procedure InitTest; override;
    procedure InitialiseDatabase(aDatabase: TIBDatabase) override;
    function SkipTest: boolean; override;
  public
    procedure RunTest(CharSet: AnsiString; SQLDialect: integer); override;
  end;


implementation

uses FmtBCD, IBUtils;

{ TTest05 }

procedure TTest05.HandleExtractLine(Sender: TObject; start, count: integer);
var i: integer;
begin
  for i := 0 to count - 1 do
    writeln(OutFile,FExtract.Items[start + i]);
end;

procedure TTest05.HandleAfterInsert(DataSet: TDataSet);
begin
  with DataSet do
  begin
    (FieldByName('F1') as TIBDateTimeField).SetAsDateTimeTZ(EncodeDate(1918,11,11) + FBEncodeTime(0,11,0,1111),'CET'); ;
    (FieldByName('f2') as TIBTimeField).SetAsDateTimeTZ(EncodeTime(22,02,10,5),'America/Los_Angeles');
    FieldByName('F3').AsCurrency := 12345678912.12;
    FieldByName('f4').AsBCD := StrToBCD('64100000000.011');
    FieldByName('F5').AsBCD := StrToBCD('123456123456123456123456.123456');
  end;
end;

procedure TTest05.CreateObjects(Application: TTestApplication);
begin
  inherited CreateObjects(Application);
  FDataSet := TIBDataSet.Create(Application);
  with FDataSet do
  begin
    Database := IBDatabase;
    SelectSQL.Text := 'Select * From IBXTEST A';
    InsertSQL.Text :=
      'Insert Into IBXTEST(TABLEKEY, F1, F2, F3, F4, F5) Values(:TABLEKEY, :F1, :F2, :F3, :F4, :F5)';
    RefreshSQL.Text :=
      'Select * From IBXTEST A '+
      'Where A.TABLEKEY = :TABLEKEY';
    ModifySQL.Text :=
        'Update IBXTEST A Set ' +
        '  A.F1 = :F1,' +
        '  A.F2 = :F2,' +
        '  A.F3 = :F3,' +
        '  A.F4 = :F4,' +
        '  A.F5 = :F5 ' +
        'Where A.TABLEKEY = :OLD_TABLEKEY';
    DeleteSQL.Text :=
      'Delete From IBXTEST A '+
      'Where A.TABLEKEY = :OLD_TABLEKEY';
    DataSetCloseAction := dcSaveChanges;
    AutoCommit := acCommitRetaining;
    GeneratorField.Generator := 'IBXGEN';
    GeneratorField.Field := 'TABLEKEY';
    GeneratorField.ApplyOnEvent := gaeOnNewRecord;
    AfterInsert := @HandleAfterInsert;
  end;
  FExtract := TIBExtract.Create(Application);
  FExtract.Database := IBDatabase;
  FExtract.Transaction := IBTransaction;
  FExtract.OnExtractLines := @HandleExtractLine;
end;

function TTest05.GetTestID: AnsiString;
begin
  Result := aTestID;
end;

function TTest05.GetTestTitle: AnsiString;
begin
  Result := aTestTitle;
end;

procedure TTest05.InitTest;
begin
  IBDatabase.DatabaseName := Owner.GetNewDatabaseName;
  IBDatabase.CreateIfNotExists := true;
  ReadWriteTransaction;
end;

procedure TTest05.InitialiseDatabase(aDatabase: TIBDatabase);
begin
  if aDatabase.attachment.GetODSMajorVersion < 13 then
  begin
    aDatabase.DropDatabase;
    raise ESkipException.Create('This test requires Firebird 4');
  end;
  inherited InitialiseDatabase(aDatabase);
end;

function TTest05.SkipTest: boolean;
begin
  Result := FirebirdAPI.GetClientMajor < 4;
  if Result then
    writeln(OutFile,'Skipping ',TestTitle);
end;

procedure TTest05.RunTest(CharSet: AnsiString; SQLDialect: integer);
var OldDefaultFormatSettings: TFormatSettings;
begin
  OldDefaultFormatSettings := DefaultFormatSettings;
  IBDatabase.Connected := true;
  try
    DefaultFormatSettings.LongTimeFormat := 'HH:MM:SS.zzzz';
    IBTransaction.Active := true;
    FDataSet.Active := true;
    writeln(OutFile,'Extracting Database Schema');
    FExtract.ExtractObject(eoDatabase,'',[etGrantsToUser]);
    writeln(OutFile);
    writeln(OutFile,'Add a record');
    FDataSet.Append;
    FDataSet.Post;
    PrintDataSet(FDataSet);
    writeln(OutFile,'F1 in UTC Time = ', DateTimeToStr((FDataSet.FieldByName('F1') as TIBDateTimeField).GetAsUTCDateTime));
    writeln(OutFile,'F2 in UTC Time = ', FBFormatDateTime('HH:MM:SS.zzzz',(FDataSet.FieldByName('F2') as TIBDateTimeField).GetAsUTCDateTime));
    writeln(Outfile,'TZ Text Option = GMT');
    FDataset.TZTextOption := tzGMT;
    PrintDataSet(FDataSet);
    writeln(Outfile,'TZ Text Option = Original format');
    FDataset.TZTextOption := tzOriginalID;
    PrintDataSet(FDataSet);
    writeln(Outfile,'TZ Text Option = offset with Default time zone date of 2020/7/1');
    FDataset.Active := false;
    FDataset.TZTextOption := tzOffset;
    FDataset.DefaultTZDate := EncodeDate(2020,7,1);
    FDataset.Active := true;
    PrintDataSet(FDataSet);
    writeln(Outfile,'Update a record with a non default time zone date');
    FDataset.Edit;
    (FDataSet.FieldByName('F2') as TIBDateTimeField).SetAsDateTimeTZ(EncodeTime(11,02,10,15),'America/New_York');
    FDataSet.Post;
    PrintDataSet(FDataSet);
    writeln(Outfile,'Restore original default time zone date');
    FDataset.Active := false;
    FDataset.DefaultTZDate := EncodeDate(2020,1,1);
    FDataset.Active := true;
    PrintDataSet(FDataSet);
  finally
    DefaultFormatSettings := OldDefaultFormatSettings;
    IBDatabase.DropDatabase;
  end;
end;

initialization
  RegisterTest(TTest05);

end.

Revision:	315
Committed:	Thu Feb 25 11:56:36 2021 UTC (3 years, 9 months ago) by tony
Content type:	text/x-pascal
File size:	5594 byte(s)
Log Message:	Updated for IBX 4 release
#	User	Rev	Content
1	tony	315	unit Test05;
2
3			{$mode objfpc}{$H+}
4
5			{Test 5: Firebird 4 Data Types}
6
7			interface
8
9			uses
10			Classes, SysUtils, TestApplication, IBXTestBase, DB, IB, IBCustomDataSet,
11			IBDatabase, IBExtract;
12
13			const
14			aTestID = '05';
15			aTestTitle = 'Firebird 4 Data Types';
16
17			type
18
19			{ TTest05 }
20
21			TTest05 = class(TIBXTestBase)
22			private
23			FDataSet: TIBDataSet;
24			FExtract: TIBExtract;
25			procedure HandleExtractLine(Sender: TObject; start, count: integer);
26			procedure HandleAfterInsert(DataSet: TDataSet);
27			protected
28			procedure CreateObjects(Application: TTestApplication); override;
29			function GetTestID: AnsiString; override;
30			function GetTestTitle: AnsiString; override;
31			procedure InitTest; override;
32			procedure InitialiseDatabase(aDatabase: TIBDatabase) override;
33			function SkipTest: boolean; override;
34			public
35			procedure RunTest(CharSet: AnsiString; SQLDialect: integer); override;
36			end;
37
38
39			implementation
40
41			uses FmtBCD, IBUtils;
42
43			{ TTest05 }
44
45			procedure TTest05.HandleExtractLine(Sender: TObject; start, count: integer);
46			var i: integer;
47			begin
48			for i := 0 to count - 1 do
49			writeln(OutFile,FExtract.Items[start + i]);
50			end;
51
52			procedure TTest05.HandleAfterInsert(DataSet: TDataSet);
53			begin
54			with DataSet do
55			begin
56			(FieldByName('F1') as TIBDateTimeField).SetAsDateTimeTZ(EncodeDate(1918,11,11) + FBEncodeTime(0,11,0,1111),'CET'); ;
57			(FieldByName('f2') as TIBTimeField).SetAsDateTimeTZ(EncodeTime(22,02,10,5),'America/Los_Angeles');
58			FieldByName('F3').AsCurrency := 12345678912.12;
59			FieldByName('f4').AsBCD := StrToBCD('64100000000.011');
60			FieldByName('F5').AsBCD := StrToBCD('123456123456123456123456.123456');
61			end;
62			end;
63
64			procedure TTest05.CreateObjects(Application: TTestApplication);
65			begin
66			inherited CreateObjects(Application);
67			FDataSet := TIBDataSet.Create(Application);
68			with FDataSet do
69			begin
70			Database := IBDatabase;
71			SelectSQL.Text := 'Select * From IBXTEST A';
72			InsertSQL.Text :=
73			'Insert Into IBXTEST(TABLEKEY, F1, F2, F3, F4, F5) Values(:TABLEKEY, :F1, :F2, :F3, :F4, :F5)';
74			RefreshSQL.Text :=
75			'Select * From IBXTEST A '+
76			'Where A.TABLEKEY = :TABLEKEY';
77			ModifySQL.Text :=
78			'Update IBXTEST A Set ' +
79			' A.F1 = :F1,' +
80			' A.F2 = :F2,' +
81			' A.F3 = :F3,' +
82			' A.F4 = :F4,' +
83			' A.F5 = :F5 ' +
84			'Where A.TABLEKEY = :OLD_TABLEKEY';
85			DeleteSQL.Text :=
86			'Delete From IBXTEST A '+
87			'Where A.TABLEKEY = :OLD_TABLEKEY';
88			DataSetCloseAction := dcSaveChanges;
89			AutoCommit := acCommitRetaining;
90			GeneratorField.Generator := 'IBXGEN';
91			GeneratorField.Field := 'TABLEKEY';
92			GeneratorField.ApplyOnEvent := gaeOnNewRecord;
93			AfterInsert := @HandleAfterInsert;
94			end;
95			FExtract := TIBExtract.Create(Application);
96			FExtract.Database := IBDatabase;
97			FExtract.Transaction := IBTransaction;
98			FExtract.OnExtractLines := @HandleExtractLine;
99			end;
100
101			function TTest05.GetTestID: AnsiString;
102			begin
103			Result := aTestID;
104			end;
105
106			function TTest05.GetTestTitle: AnsiString;
107			begin
108			Result := aTestTitle;
109			end;
110
111			procedure TTest05.InitTest;
112			begin
113			IBDatabase.DatabaseName := Owner.GetNewDatabaseName;
114			IBDatabase.CreateIfNotExists := true;
115			ReadWriteTransaction;
116			end;
117
118			procedure TTest05.InitialiseDatabase(aDatabase: TIBDatabase);
119			begin
120			if aDatabase.attachment.GetODSMajorVersion < 13 then
121			begin
122			aDatabase.DropDatabase;
123			raise ESkipException.Create('This test requires Firebird 4');
124			end;
125			inherited InitialiseDatabase(aDatabase);
126			end;
127
128			function TTest05.SkipTest: boolean;
129			begin
130			Result := FirebirdAPI.GetClientMajor < 4;
131			if Result then
132			writeln(OutFile,'Skipping ',TestTitle);
133			end;
134
135			procedure TTest05.RunTest(CharSet: AnsiString; SQLDialect: integer);
136			var OldDefaultFormatSettings: TFormatSettings;
137			begin
138			OldDefaultFormatSettings := DefaultFormatSettings;
139			IBDatabase.Connected := true;
140			try
141			DefaultFormatSettings.LongTimeFormat := 'HH:MM:SS.zzzz';
142			IBTransaction.Active := true;
143			FDataSet.Active := true;
144			writeln(OutFile,'Extracting Database Schema');
145			FExtract.ExtractObject(eoDatabase,'',[etGrantsToUser]);
146			writeln(OutFile);
147			writeln(OutFile,'Add a record');
148			FDataSet.Append;
149			FDataSet.Post;
150			PrintDataSet(FDataSet);
151			writeln(OutFile,'F1 in UTC Time = ', DateTimeToStr((FDataSet.FieldByName('F1') as TIBDateTimeField).GetAsUTCDateTime));
152			writeln(OutFile,'F2 in UTC Time = ', FBFormatDateTime('HH:MM:SS.zzzz',(FDataSet.FieldByName('F2') as TIBDateTimeField).GetAsUTCDateTime));
153			writeln(Outfile,'TZ Text Option = GMT');
154			FDataset.TZTextOption := tzGMT;
155			PrintDataSet(FDataSet);
156			writeln(Outfile,'TZ Text Option = Original format');
157			FDataset.TZTextOption := tzOriginalID;
158			PrintDataSet(FDataSet);
159			writeln(Outfile,'TZ Text Option = offset with Default time zone date of 2020/7/1');
160			FDataset.Active := false;
161			FDataset.TZTextOption := tzOffset;
162			FDataset.DefaultTZDate := EncodeDate(2020,7,1);
163			FDataset.Active := true;
164			PrintDataSet(FDataSet);
165			writeln(Outfile,'Update a record with a non default time zone date');
166			FDataset.Edit;
167			(FDataSet.FieldByName('F2') as TIBDateTimeField).SetAsDateTimeTZ(EncodeTime(11,02,10,15),'America/New_York');
168			FDataSet.Post;
169			PrintDataSet(FDataSet);
170			writeln(Outfile,'Restore original default time zone date');
171			FDataset.Active := false;
172			FDataset.DefaultTZDate := EncodeDate(2020,1,1);
173			FDataset.Active := true;
174			PrintDataSet(FDataSet);
175			finally
176			DefaultFormatSettings := OldDefaultFormatSettings;
177			IBDatabase.DropDatabase;
178			end;
179			end;
180
181			initialization
182			RegisterTest(TTest05);
183
184			end.
185