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, 8 months ago) by tony
Content type:	text/x-pascal
File size:	5692 byte(s)
Log Message:	Merge into public 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	tony	319	FieldByName('F6').AsBCD := StrToBCD('123456789123456789');
62	tony	315	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	tony	319	'Insert Into IBXTEST(TABLEKEY, F1, F2, F3, F4, F5, F6) Values(:TABLEKEY, :F1, :F2, :F3, :F4, :F5, :F6)';
75	tony	315	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	tony	319	' A.F5 = :F5,' +
85			' A.F6 = :F6 ' +
86	tony	315	'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