trunk/testsuite/Test05.pas

(*
 *  IBX Test suite. This program is used to test the IBX non-visual
 *  components and provides a semi-automated pass/fail check for each test.
 *
 *  The contents of this file are subject to the Initial Developer's
 *  Public License Version 1.0 (the "License"); you may not use this
 *  file except in compliance with the License. You may obtain a copy
 *  of the License here:
 *
 *    http://www.firebirdsql.org/index.php?op=doc&id=idpl
 *
 *  Software distributed under the License is distributed on an "AS
 *  IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
 *  implied. See the License for the specific language governing rights
 *  and limitations under the License.
 *
 *  The Initial Developer of the Original Code is Tony Whyman.
 *
 *  The Original Code is (C) 2021 Tony Whyman, MWA Software
 *  (http://www.mwasoftware.co.uk).
 *
 *  All Rights Reserved.
 *
 *  Contributor(s): ______________________________________.
 *
*)      
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:	380
Committed:	Mon Jan 10 10:13:17 2022 UTC (2 years, 10 months ago) by tony
Content type:	text/x-pascal
File size:	6649 byte(s)
Log Message:	propset for eol-style
#	User	Rev	Content
1	tony	323	(*
2			* IBX Test suite. This program is used to test the IBX non-visual
3			* components and provides a semi-automated pass/fail check for each test.
4			*
5			* The contents of this file are subject to the Initial Developer's
6			* Public License Version 1.0 (the "License"); you may not use this
7			* file except in compliance with the License. You may obtain a copy
8			* of the License here:
9			*
10			* http://www.firebirdsql.org/index.php?op=doc&id=idpl
11			*
12			* Software distributed under the License is distributed on an "AS
13			* IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
14			* implied. See the License for the specific language governing rights
15			* and limitations under the License.
16			*
17			* The Initial Developer of the Original Code is Tony Whyman.
18			*
19			* The Original Code is (C) 2021 Tony Whyman, MWA Software
20			* (http://www.mwasoftware.co.uk).
21			*
22			* All Rights Reserved.
23			*
24			* Contributor(s): ______________________________________.
25			*
26			*)
27	tony	315	unit Test05;
28
29			{$mode objfpc}{$H+}
30
31			{Test 5: Firebird 4 Data Types}
32
33			interface
34
35			uses
36			Classes, SysUtils, TestApplication, IBXTestBase, DB, IB, IBCustomDataSet,
37			IBDatabase, IBExtract;
38
39			const
40			aTestID = '05';
41			aTestTitle = 'Firebird 4 Data Types';
42
43			type
44
45			{ TTest05 }
46
47			TTest05 = class(TIBXTestBase)
48			private
49			FDataSet: TIBDataSet;
50			FExtract: TIBExtract;
51			procedure HandleExtractLine(Sender: TObject; start, count: integer);
52			procedure HandleAfterInsert(DataSet: TDataSet);
53			protected
54			procedure CreateObjects(Application: TTestApplication); override;
55			function GetTestID: AnsiString; override;
56			function GetTestTitle: AnsiString; override;
57			procedure InitTest; override;
58			procedure InitialiseDatabase(aDatabase: TIBDatabase) override;
59			function SkipTest: boolean; override;
60			public
61			procedure RunTest(CharSet: AnsiString; SQLDialect: integer); override;
62			end;
63
64
65			implementation
66
67			uses FmtBCD, IBUtils;
68
69			{ TTest05 }
70
71			procedure TTest05.HandleExtractLine(Sender: TObject; start, count: integer);
72			var i: integer;
73			begin
74			for i := 0 to count - 1 do
75			writeln(OutFile,FExtract.Items[start + i]);
76			end;
77
78			procedure TTest05.HandleAfterInsert(DataSet: TDataSet);
79			begin
80			with DataSet do
81			begin
82			(FieldByName('F1') as TIBDateTimeField).SetAsDateTimeTZ(EncodeDate(1918,11,11) + FBEncodeTime(0,11,0,1111),'CET'); ;
83			(FieldByName('f2') as TIBTimeField).SetAsDateTimeTZ(EncodeTime(22,02,10,5),'America/Los_Angeles');
84			FieldByName('F3').AsCurrency := 12345678912.12;
85			FieldByName('f4').AsBCD := StrToBCD('64100000000.011');
86			FieldByName('F5').AsBCD := StrToBCD('123456123456123456123456.123456');
87	tony	319	FieldByName('F6').AsBCD := StrToBCD('123456789123456789');
88	tony	315	end;
89			end;
90
91			procedure TTest05.CreateObjects(Application: TTestApplication);
92			begin
93			inherited CreateObjects(Application);
94			FDataSet := TIBDataSet.Create(Application);
95			with FDataSet do
96			begin
97			Database := IBDatabase;
98			SelectSQL.Text := 'Select * From IBXTEST A';
99			InsertSQL.Text :=
100	tony	319	'Insert Into IBXTEST(TABLEKEY, F1, F2, F3, F4, F5, F6) Values(:TABLEKEY, :F1, :F2, :F3, :F4, :F5, :F6)';
101	tony	315	RefreshSQL.Text :=
102			'Select * From IBXTEST A '+
103			'Where A.TABLEKEY = :TABLEKEY';
104			ModifySQL.Text :=
105			'Update IBXTEST A Set ' +
106			' A.F1 = :F1,' +
107			' A.F2 = :F2,' +
108			' A.F3 = :F3,' +
109			' A.F4 = :F4,' +
110	tony	319	' A.F5 = :F5,' +
111			' A.F6 = :F6 ' +
112	tony	315	'Where A.TABLEKEY = :OLD_TABLEKEY';
113			DeleteSQL.Text :=
114			'Delete From IBXTEST A '+
115			'Where A.TABLEKEY = :OLD_TABLEKEY';
116			DataSetCloseAction := dcSaveChanges;
117			AutoCommit := acCommitRetaining;
118			GeneratorField.Generator := 'IBXGEN';
119			GeneratorField.Field := 'TABLEKEY';
120			GeneratorField.ApplyOnEvent := gaeOnNewRecord;
121			AfterInsert := @HandleAfterInsert;
122			end;
123			FExtract := TIBExtract.Create(Application);
124			FExtract.Database := IBDatabase;
125			FExtract.Transaction := IBTransaction;
126			FExtract.OnExtractLines := @HandleExtractLine;
127			end;
128
129			function TTest05.GetTestID: AnsiString;
130			begin
131			Result := aTestID;
132			end;
133
134			function TTest05.GetTestTitle: AnsiString;
135			begin
136			Result := aTestTitle;
137			end;
138
139			procedure TTest05.InitTest;
140			begin
141			IBDatabase.DatabaseName := Owner.GetNewDatabaseName;
142			IBDatabase.CreateIfNotExists := true;
143			ReadWriteTransaction;
144			end;
145
146			procedure TTest05.InitialiseDatabase(aDatabase: TIBDatabase);
147			begin
148			if aDatabase.attachment.GetODSMajorVersion < 13 then
149			begin
150			aDatabase.DropDatabase;
151			raise ESkipException.Create('This test requires Firebird 4');
152			end;
153			inherited InitialiseDatabase(aDatabase);
154			end;
155
156			function TTest05.SkipTest: boolean;
157			begin
158			Result := FirebirdAPI.GetClientMajor < 4;
159			if Result then
160			writeln(OutFile,'Skipping ',TestTitle);
161			end;
162
163			procedure TTest05.RunTest(CharSet: AnsiString; SQLDialect: integer);
164			var OldDefaultFormatSettings: TFormatSettings;
165			begin
166			OldDefaultFormatSettings := DefaultFormatSettings;
167			IBDatabase.Connected := true;
168			try
169			DefaultFormatSettings.LongTimeFormat := 'HH:MM:SS.zzzz';
170			IBTransaction.Active := true;
171			FDataSet.Active := true;
172			writeln(OutFile,'Extracting Database Schema');
173			FExtract.ExtractObject(eoDatabase,'',[etGrantsToUser]);
174			writeln(OutFile);
175			writeln(OutFile,'Add a record');
176			FDataSet.Append;
177			FDataSet.Post;
178			PrintDataSet(FDataSet);
179			writeln(OutFile,'F1 in UTC Time = ', DateTimeToStr((FDataSet.FieldByName('F1') as TIBDateTimeField).GetAsUTCDateTime));
180			writeln(OutFile,'F2 in UTC Time = ', FBFormatDateTime('HH:MM:SS.zzzz',(FDataSet.FieldByName('F2') as TIBDateTimeField).GetAsUTCDateTime));
181			writeln(Outfile,'TZ Text Option = GMT');
182			FDataset.TZTextOption := tzGMT;
183			PrintDataSet(FDataSet);
184			writeln(Outfile,'TZ Text Option = Original format');
185			FDataset.TZTextOption := tzOriginalID;
186			PrintDataSet(FDataSet);
187			writeln(Outfile,'TZ Text Option = offset with Default time zone date of 2020/7/1');
188			FDataset.Active := false;
189			FDataset.TZTextOption := tzOffset;
190			FDataset.DefaultTZDate := EncodeDate(2020,7,1);
191			FDataset.Active := true;
192			PrintDataSet(FDataSet);
193			writeln(Outfile,'Update a record with a non default time zone date');
194			FDataset.Edit;
195			(FDataSet.FieldByName('F2') as TIBDateTimeField).SetAsDateTimeTZ(EncodeTime(11,02,10,15),'America/New_York');
196			FDataSet.Post;
197			PrintDataSet(FDataSet);
198			writeln(Outfile,'Restore original default time zone date');
199			FDataset.Active := false;
200			FDataset.DefaultTZDate := EncodeDate(2020,1,1);
201			FDataset.Active := true;
202			PrintDataSet(FDataSet);
203			finally
204			DefaultFormatSettings := OldDefaultFormatSettings;
205			IBDatabase.DropDatabase;
206			end;
207			end;
208
209			initialization
210			RegisterTest(TTest05);
211
212			end.
213