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');
    FieldByName('F6').AsBCD := StrToBCD('123456789123456789');
  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, F6) Values(:TABLEKEY, :F1, :F2, :F3, :F4, :F5, :F6)';
    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,' +
        '  A.F6 = :F6 ' +
        '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:	319
Committed:	Thu Feb 25 12:05:40 2021 UTC (3 years, 1 month ago) by tony
Content type:	text/x-pascal
File size:	5692 byte(s)
Log Message:	Merge into public release
#	Content
1	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	FieldByName('F6').AsBCD := StrToBCD('123456789123456789');
62	end;
63	end;
64
65	procedure TTest05.CreateObjects(Application: TTestApplication);
66	begin
67	inherited CreateObjects(Application);
68	FDataSet := TIBDataSet.Create(Application);
69	with FDataSet do
70	begin
71	Database := IBDatabase;
72	SelectSQL.Text := 'Select * From IBXTEST A';
73	InsertSQL.Text :=
74	'Insert Into IBXTEST(TABLEKEY, F1, F2, F3, F4, F5, F6) Values(:TABLEKEY, :F1, :F2, :F3, :F4, :F5, :F6)';
75	RefreshSQL.Text :=
76	'Select * From IBXTEST A '+
77	'Where A.TABLEKEY = :TABLEKEY';
78	ModifySQL.Text :=
79	'Update IBXTEST A Set ' +
80	' A.F1 = :F1,' +
81	' A.F2 = :F2,' +
82	' A.F3 = :F3,' +
83	' A.F4 = :F4,' +
84	' A.F5 = :F5,' +
85	' A.F6 = :F6 ' +
86	'Where A.TABLEKEY = :OLD_TABLEKEY';
87	DeleteSQL.Text :=
88	'Delete From IBXTEST A '+
89	'Where A.TABLEKEY = :OLD_TABLEKEY';
90	DataSetCloseAction := dcSaveChanges;
91	AutoCommit := acCommitRetaining;
92	GeneratorField.Generator := 'IBXGEN';
93	GeneratorField.Field := 'TABLEKEY';
94	GeneratorField.ApplyOnEvent := gaeOnNewRecord;
95	AfterInsert := @HandleAfterInsert;
96	end;
97	FExtract := TIBExtract.Create(Application);
98	FExtract.Database := IBDatabase;
99	FExtract.Transaction := IBTransaction;
100	FExtract.OnExtractLines := @HandleExtractLine;
101	end;
102
103	function TTest05.GetTestID: AnsiString;
104	begin
105	Result := aTestID;
106	end;
107
108	function TTest05.GetTestTitle: AnsiString;
109	begin
110	Result := aTestTitle;
111	end;
112
113	procedure TTest05.InitTest;
114	begin
115	IBDatabase.DatabaseName := Owner.GetNewDatabaseName;
116	IBDatabase.CreateIfNotExists := true;
117	ReadWriteTransaction;
118	end;
119
120	procedure TTest05.InitialiseDatabase(aDatabase: TIBDatabase);
121	begin
122	if aDatabase.attachment.GetODSMajorVersion < 13 then
123	begin
124	aDatabase.DropDatabase;
125	raise ESkipException.Create('This test requires Firebird 4');
126	end;
127	inherited InitialiseDatabase(aDatabase);
128	end;
129
130	function TTest05.SkipTest: boolean;
131	begin
132	Result := FirebirdAPI.GetClientMajor < 4;
133	if Result then
134	writeln(OutFile,'Skipping ',TestTitle);
135	end;
136
137	procedure TTest05.RunTest(CharSet: AnsiString; SQLDialect: integer);
138	var OldDefaultFormatSettings: TFormatSettings;
139	begin
140	OldDefaultFormatSettings := DefaultFormatSettings;
141	IBDatabase.Connected := true;
142	try
143	DefaultFormatSettings.LongTimeFormat := 'HH:MM:SS.zzzz';
144	IBTransaction.Active := true;
145	FDataSet.Active := true;
146	writeln(OutFile,'Extracting Database Schema');
147	FExtract.ExtractObject(eoDatabase,'',[etGrantsToUser]);
148	writeln(OutFile);
149	writeln(OutFile,'Add a record');
150	FDataSet.Append;
151	FDataSet.Post;
152	PrintDataSet(FDataSet);
153	writeln(OutFile,'F1 in UTC Time = ', DateTimeToStr((FDataSet.FieldByName('F1') as TIBDateTimeField).GetAsUTCDateTime));
154	writeln(OutFile,'F2 in UTC Time = ', FBFormatDateTime('HH:MM:SS.zzzz',(FDataSet.FieldByName('F2') as TIBDateTimeField).GetAsUTCDateTime));
155	writeln(Outfile,'TZ Text Option = GMT');
156	FDataset.TZTextOption := tzGMT;
157	PrintDataSet(FDataSet);
158	writeln(Outfile,'TZ Text Option = Original format');
159	FDataset.TZTextOption := tzOriginalID;
160	PrintDataSet(FDataSet);
161	writeln(Outfile,'TZ Text Option = offset with Default time zone date of 2020/7/1');
162	FDataset.Active := false;
163	FDataset.TZTextOption := tzOffset;
164	FDataset.DefaultTZDate := EncodeDate(2020,7,1);
165	FDataset.Active := true;
166	PrintDataSet(FDataSet);
167	writeln(Outfile,'Update a record with a non default time zone date');
168	FDataset.Edit;
169	(FDataSet.FieldByName('F2') as TIBDateTimeField).SetAsDateTimeTZ(EncodeTime(11,02,10,15),'America/New_York');
170	FDataSet.Post;
171	PrintDataSet(FDataSet);
172	writeln(Outfile,'Restore original default time zone date');
173	FDataset.Active := false;
174	FDataset.DefaultTZDate := EncodeDate(2020,1,1);
175	FDataset.Active := true;
176	PrintDataSet(FDataSet);
177	finally
178	DefaultFormatSettings := OldDefaultFormatSettings;
179	IBDatabase.DropDatabase;
180	end;
181	end;
182
183	initialization
184	RegisterTest(TTest05);
185
186	end.
187