fbintf/testsuite/Test18.pas

(*
 *  Firebird Interface (fbintf) Test suite. This program is used to
 *  test the Firebird Pascal Interface and provide 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) 2020 Tony Whyman, MWA Software
 *  (http://www.mwasoftware.co.uk).
 *
 *  All Rights Reserved.
 *
 *  Contributor(s): ______________________________________.
 *
*)

unit Test18;

{$IFDEF MSWINDOWS}
{$DEFINE WINDOWS}
{$ENDIF}

{$IFDEF FPC}
{$mode delphi}
{$codepage UTF8}
{$ENDIF}

{$DEFINE TESTINT128ARRAY}  {Depends on resolution of CORE-6302}

{Test 18: Firebird 4 extensions: DecFloat data types}

{
  This test provides  tests for the new DECFloat16 and DECFloat34 types. The test
  is skipped if not a Firebird 4 Client.

  1. A new temporary database is created and a single table added containing
     columns for each DecFloat data type.

  2. Data insert is performed for the various ways of setting the column values.

  3. A Select query is used to read back the rows, testing out the data read variations.

}

interface

uses
  Classes, SysUtils, TestApplication, FBTestApp, IB {$IFDEF WINDOWS},Windows{$ENDIF};

type

  { TTest18 }

  TTest18 = class(TFBTestBase)
  private
    procedure QueryDatabase4_DECFloat(Attachment: IAttachment);
    procedure UpdateDatabase4_DECFloat(Attachment: IAttachment);
    procedure ArrayTest(Attachment: IAttachment);
  public
    function TestTitle: AnsiString; override;
    procedure RunTest(CharSet: AnsiString; SQLDialect: integer); override;
  end;


implementation

uses IBUtils, FmtBCD;

const
    sqlCreateTable =
    'Create Table FB4TestData_DECFloat ('+
    'RowID Integer not null,'+
    'Float16 DecFloat(16),'+
    'Float34 DecFloat(34),'+
    'BigNumber NUMERIC(24,6),'+
    'BiggerNumber NUMERIC(34,4),'+
    'BigInteger INT128, '+
    'Primary Key(RowID)'+
    ')';

    sqlCreateTable2 =
    'Create Table FB4TestData_DECFloat_AR ('+
    'RowID Integer not null,'+
    'Float16 DecFloat(16) [0:16],'+
    'Float34 DecFloat(34) [0:16],'+
    'BigNumber NUMERIC(24,6) [0:16],'+
    'Primary Key(RowID)'+
    ')';

{ TTest18 }

procedure TTest18.UpdateDatabase4_DECFloat(Attachment: IAttachment);
var Transaction: ITransaction;
    Statement: IStatement;
    sqlInsert: AnsiString;
begin
  Transaction := Attachment.StartTransaction([isc_tpb_write,isc_tpb_nowait,isc_tpb_concurrency],taCommit);
  sqlInsert := 'Insert into FB4TestData_DECFLoat(RowID,Float16,Float34,BigNumber,BigInteger) ' +
               'Values(1,64000000000.01,123456789123456789.12345678,123456123456.123456,123456789123456789)';
  Attachment.ExecuteSQL(Transaction,sqlInsert,[]);
  sqlInsert := 'Insert into FB4TestData_DECFLoat(RowID,Float16,Float34,BigNumber) '+
               'Values(2,-64000000000.01,-123456789123456789.12345678,-123456123456.123456)';
  Attachment.ExecuteSQL(Transaction,sqlInsert,[]);


  Statement := Attachment.Prepare(Transaction,'Insert into FB4TestData_DECFLoat(RowID,Float16,Float34,BigNumber,BiggerNumber) VALUES (?,?,?,?,?)');

  Statement.SQLParams[0].AsInteger := 3;
  Statement.SQLParams[1].AsBCD := StrToBCD('64100000000.011');
  Statement.SQLParams[2].AsCurrency := 12345678912.12;
  Statement.SQLParams[3].AsString := '1234561234567.123456';
  Statement.SQLParams[4].AsBCD := StrToBCD('11123456123456123456123456123456.123456'); {last digit should be dropped}
  Statement.Execute;

  Statement.SQLParams[0].AsInteger := 4;
  Statement.SQLParams[1].AsBCD := StrToBCD('0');
  Statement.SQLParams[2].AsBCD := StrToBCD('-1');
  Statement.SQLParams[3].AsBCD := StrToBCD('0');
  Statement.SQLParams[4].AsBCD := StrToBCD('0');
  Statement.Execute;
end;

procedure TTest18.ArrayTest(Attachment: IAttachment);
var Transaction: ITransaction;
    Statement: IStatement;
    ResultSet: IResultSet;
    ar: IArray;
    value: tBCD;
    i: integer;
begin
  Attachment.ExecImmediate([isc_tpb_write,isc_tpb_wait,isc_tpb_consistency],sqlCreateTable2);
  Transaction := Attachment.StartTransaction([isc_tpb_write,isc_tpb_nowait,isc_tpb_concurrency],taCommit);
  Statement := Attachment.Prepare(Transaction,'Select * From FB4TestData_DECFloat_AR');
  Printmetadata(Statement.MetaData);
  Attachment.Prepare(Transaction,'Insert into FB4TestData_DECFloat_AR (RowID) Values(1)').Execute;

  {Float16}
  ar := Attachment.CreateArray(Transaction,'FB4TestData_DECFloat_AR','Float16');
  value := StrToBCD('64100000000.011');
  for i := 0 to 16 do
  begin
    ar.SetAsBcd(i,value);
    BcdAdd(value,IntegerToBCD(1),Value);
  end;

  Statement := Attachment.Prepare(Transaction,'Update FB4TestData_DECFloat_AR Set Float16 = ? Where RowID = 1');
  Statement.SQLParams[0].AsArray := ar;
  Statement.Execute;

  {Float 34}
  ar := Attachment.CreateArray(Transaction,'FB4TestData_DECFloat_AR','Float34');
  value := StrToBCD('123456789123456789.12345678');
  for i := 0 to 16 do
  begin
    ar.SetAsBcd(i,value);
    BcdAdd(value,IntegerToBCD(1),Value);
  end;

  Statement := Attachment.Prepare(Transaction,'Update FB4TestData_DECFloat_AR Set Float34 = ? Where RowID = 1');
  Statement.SQLParams[0].AsArray := ar;
  Statement.Execute;

  {NUMERIC(24,6)}
  {$IFDEF TESTINT128ARRAY}
  ar := Attachment.CreateArray(Transaction,'FB4TestData_DECFloat_AR','BigNumber');
  value := StrToBCD('123456123400.123456');
  for i := 0 to 16 do
  begin
    ar.SetAsBcd(i,value);
    BcdAdd(value,DoubleToBCD(1.5),value);
  end;

  Statement := Attachment.Prepare(Transaction,'Update FB4TestData_DECFloat_AR Set BigNumber = ? Where RowID = 1');
  Statement.SQLParams[0].AsArray := ar;
  Statement.Execute;
  {$ENDIF}

  Statement := Attachment.Prepare(Transaction,'Select RowID, Float16, Float34,BigNumber From FB4TestData_DECFloat_AR');
  writeln(OutFile);
  writeln(OutFile,'Decfloat Arrays');
  ResultSet := Statement.OpenCursor;
  while ResultSet.FetchNext do
  begin
    writeln(OutFile,'Row No ',ResultSet[0].AsInteger);
    write(OutFile,'Float16 ');
    ar := ResultSet[1].AsArray;
    WriteArray(ar);
    write(OutFile,'Float34 ');
    ar := ResultSet[2].AsArray;
    WriteArray(ar);
    {$IFDEF TESTINT128ARRAY}
    write(OutFile,'BigNumber ');
    ar := ResultSet[3].AsArray;
    WriteArray(ar);
    {$ENDIF}
  end;
end;

procedure TTest18.QueryDatabase4_DECFloat(Attachment: IAttachment);
var Transaction: ITransaction;
    Statement: IStatement;
    Results: IResultSet;
begin
  Transaction := Attachment.StartTransaction([isc_tpb_read,isc_tpb_nowait,isc_tpb_concurrency],taCommit);
  Statement := Attachment.Prepare(Transaction,'Select * from  FB4TestData_DECFloat');
  writeln(OutFile);
  writeln(OutFile,'FB4 Testdata_DECFloat');
  writeln(OutFile);
  PrintMetaData(Statement.MetaData);
  Results := Statement.OpenCursor;
  try
    while Results.FetchNext do
    with Results do
    begin
      writeln(OutFile,'RowID = ',ByName('ROWID').GetAsString);
      writeln(OutFile,'Float16 = ', ByName('Float16').GetAsString);
      DumpBCD(ByName('Float16').GetAsBCD);
      writeln(OutFile,'Float34 = ', ByName('Float34').GetAsString);
      DumpBCD(ByName('Float34').GetAsBCD);
      writeln(OutFile,'BigNumber = ', ByName('BigNumber').GetAsString);
      DumpBCD(ByName('BigNumber').GetAsBCD);
      if not ByName('BiggerNumber').IsNull then
      begin
        writeln(OutFile,'BiggerNumber = ', ByName('BiggerNumber').GetAsString);
        DumpBCD(ByName('BiggerNumber').GetAsBCD);
      end;
      if ByName('BigInteger').IsNull then
        writeln(OutFile,'BigInteger = Null')
      else
      begin
        writeln(OutFile,'BigInteger = ', ByName('BigInteger').GetAsString);
        DumpBCD(ByName('BigInteger').GetAsBCD);
      end;
      writeln(Outfile);
    end;
  finally
    Results.Close;
  end;
end;

function TTest18.TestTitle: AnsiString;
begin
  Result := 'Test 18: Firebird 4 Decfloat extensions';
end;

procedure TTest18.RunTest(CharSet: AnsiString; SQLDialect: integer);
var DPB: IDPB;
    Attachment: IAttachment;
    VerStrings: TStringList;
begin
  DPB := FirebirdAPI.AllocateDPB;
  DPB.Add(isc_dpb_user_name).setAsString(Owner.GetUserName);
  DPB.Add(isc_dpb_password).setAsString(Owner.GetPassword);
  DPB.Add(isc_dpb_lc_ctype).setAsString('UTF8');
  DPB.Add(isc_dpb_set_db_SQL_dialect).setAsByte(SQLDialect);
  Attachment := FirebirdAPI.CreateDatabase(Owner.GetNewDatabaseName,DPB);
  VerStrings := TStringList.Create;
  try
    Attachment.getFBVersion(VerStrings);
    writeln(OutFile,' FBVersion = ',VerStrings[0]);
  finally
    VerStrings.Free;
  end;

  if (FirebirdAPI.GetClientMajor < 4) or (Attachment.GetODSMajorVersion < 13) then
    writeln(OutFile,'Skipping test for Firebird 4 and later')
  else
  begin
    Attachment.ExecImmediate([isc_tpb_write,isc_tpb_wait,isc_tpb_consistency],sqlCreateTable);
    UpdateDatabase4_DECFloat(Attachment);
    QueryDatabase4_DECFloat(Attachment);
    ArrayTest(Attachment);
  end;
  Attachment.DropDatabase;
end;

initialization
  RegisterTest(TTest18);
end.


Revision:	380
Committed:	Mon Jan 10 10:13:17 2022 UTC (2 years, 11 months ago) by tony
Content type:	text/x-pascal
File size:	9492 byte(s)
Log Message:	propset for eol-style
#	Content
1	(*
2	* Firebird Interface (fbintf) Test suite. This program is used to
3	* test the Firebird Pascal Interface and provide a semi-automated
4	* pass/fail check for each test.
5	*
6	* The contents of this file are subject to the Initial Developer's
7	* Public License Version 1.0 (the "License"); you may not use this
8	* file except in compliance with the License. You may obtain a copy
9	* of the License here:
10	*
11	* http://www.firebirdsql.org/index.php?op=doc&id=idpl
12	*
13	* Software distributed under the License is distributed on an "AS
14	* IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
15	* implied. See the License for the specific language governing rights
16	* and limitations under the License.
17	*
18	* The Initial Developer of the Original Code is Tony Whyman.
19	*
20	* The Original Code is (C) 2020 Tony Whyman, MWA Software
21	* (http://www.mwasoftware.co.uk).
22	*
23	* All Rights Reserved.
24	*
25	* Contributor(s): ______________________________________.
26	*
27	*)
28
29	unit Test18;
30
31	{$IFDEF MSWINDOWS}
32	{$DEFINE WINDOWS}
33	{$ENDIF}
34
35	{$IFDEF FPC}
36	{$mode delphi}
37	{$codepage UTF8}
38	{$ENDIF}
39
40	{$DEFINE TESTINT128ARRAY} {Depends on resolution of CORE-6302}
41
42	{Test 18: Firebird 4 extensions: DecFloat data types}
43
44	{
45	This test provides tests for the new DECFloat16 and DECFloat34 types. The test
46	is skipped if not a Firebird 4 Client.
47
48	1. A new temporary database is created and a single table added containing
49	columns for each DecFloat data type.
50
51	2. Data insert is performed for the various ways of setting the column values.
52
53	3. A Select query is used to read back the rows, testing out the data read variations.
54
55	}
56
57	interface
58
59	uses
60	Classes, SysUtils, TestApplication, FBTestApp, IB {$IFDEF WINDOWS},Windows{$ENDIF};
61
62	type
63
64	{ TTest18 }
65
66	TTest18 = class(TFBTestBase)
67	private
68	procedure QueryDatabase4_DECFloat(Attachment: IAttachment);
69	procedure UpdateDatabase4_DECFloat(Attachment: IAttachment);
70	procedure ArrayTest(Attachment: IAttachment);
71	public
72	function TestTitle: AnsiString; override;
73	procedure RunTest(CharSet: AnsiString; SQLDialect: integer); override;
74	end;
75
76
77	implementation
78
79	uses IBUtils, FmtBCD;
80
81	const
82	sqlCreateTable =
83	'Create Table FB4TestData_DECFloat ('+
84	'RowID Integer not null,'+
85	'Float16 DecFloat(16),'+
86	'Float34 DecFloat(34),'+
87	'BigNumber NUMERIC(24,6),'+
88	'BiggerNumber NUMERIC(34,4),'+
89	'BigInteger INT128, '+
90	'Primary Key(RowID)'+
91	')';
92
93	sqlCreateTable2 =
94	'Create Table FB4TestData_DECFloat_AR ('+
95	'RowID Integer not null,'+
96	'Float16 DecFloat(16) [0:16],'+
97	'Float34 DecFloat(34) [0:16],'+
98	'BigNumber NUMERIC(24,6) [0:16],'+
99	'Primary Key(RowID)'+
100	')';
101
102	{ TTest18 }
103
104	procedure TTest18.UpdateDatabase4_DECFloat(Attachment: IAttachment);
105	var Transaction: ITransaction;
106	Statement: IStatement;
107	sqlInsert: AnsiString;
108	begin
109	Transaction := Attachment.StartTransaction([isc_tpb_write,isc_tpb_nowait,isc_tpb_concurrency],taCommit);
110	sqlInsert := 'Insert into FB4TestData_DECFLoat(RowID,Float16,Float34,BigNumber,BigInteger) ' +
111	'Values(1,64000000000.01,123456789123456789.12345678,123456123456.123456,123456789123456789)';
112	Attachment.ExecuteSQL(Transaction,sqlInsert,[]);
113	sqlInsert := 'Insert into FB4TestData_DECFLoat(RowID,Float16,Float34,BigNumber) '+
114	'Values(2,-64000000000.01,-123456789123456789.12345678,-123456123456.123456)';
115	Attachment.ExecuteSQL(Transaction,sqlInsert,[]);
116
117
118	Statement := Attachment.Prepare(Transaction,'Insert into FB4TestData_DECFLoat(RowID,Float16,Float34,BigNumber,BiggerNumber) VALUES (?,?,?,?,?)');
119
120	Statement.SQLParams[0].AsInteger := 3;
121	Statement.SQLParams[1].AsBCD := StrToBCD('64100000000.011');
122	Statement.SQLParams[2].AsCurrency := 12345678912.12;
123	Statement.SQLParams[3].AsString := '1234561234567.123456';
124	Statement.SQLParams[4].AsBCD := StrToBCD('11123456123456123456123456123456.123456'); {last digit should be dropped}
125	Statement.Execute;
126
127	Statement.SQLParams[0].AsInteger := 4;
128	Statement.SQLParams[1].AsBCD := StrToBCD('0');
129	Statement.SQLParams[2].AsBCD := StrToBCD('-1');
130	Statement.SQLParams[3].AsBCD := StrToBCD('0');
131	Statement.SQLParams[4].AsBCD := StrToBCD('0');
132	Statement.Execute;
133	end;
134
135	procedure TTest18.ArrayTest(Attachment: IAttachment);
136	var Transaction: ITransaction;
137	Statement: IStatement;
138	ResultSet: IResultSet;
139	ar: IArray;
140	value: tBCD;
141	i: integer;
142	begin
143	Attachment.ExecImmediate([isc_tpb_write,isc_tpb_wait,isc_tpb_consistency],sqlCreateTable2);
144	Transaction := Attachment.StartTransaction([isc_tpb_write,isc_tpb_nowait,isc_tpb_concurrency],taCommit);
145	Statement := Attachment.Prepare(Transaction,'Select * From FB4TestData_DECFloat_AR');
146	Printmetadata(Statement.MetaData);
147	Attachment.Prepare(Transaction,'Insert into FB4TestData_DECFloat_AR (RowID) Values(1)').Execute;
148
149	{Float16}
150	ar := Attachment.CreateArray(Transaction,'FB4TestData_DECFloat_AR','Float16');
151	value := StrToBCD('64100000000.011');
152	for i := 0 to 16 do
153	begin
154	ar.SetAsBcd(i,value);
155	BcdAdd(value,IntegerToBCD(1),Value);
156	end;
157
158	Statement := Attachment.Prepare(Transaction,'Update FB4TestData_DECFloat_AR Set Float16 = ? Where RowID = 1');
159	Statement.SQLParams[0].AsArray := ar;
160	Statement.Execute;
161
162	{Float 34}
163	ar := Attachment.CreateArray(Transaction,'FB4TestData_DECFloat_AR','Float34');
164	value := StrToBCD('123456789123456789.12345678');
165	for i := 0 to 16 do
166	begin
167	ar.SetAsBcd(i,value);
168	BcdAdd(value,IntegerToBCD(1),Value);
169	end;
170
171	Statement := Attachment.Prepare(Transaction,'Update FB4TestData_DECFloat_AR Set Float34 = ? Where RowID = 1');
172	Statement.SQLParams[0].AsArray := ar;
173	Statement.Execute;
174
175	{NUMERIC(24,6)}
176	{$IFDEF TESTINT128ARRAY}
177	ar := Attachment.CreateArray(Transaction,'FB4TestData_DECFloat_AR','BigNumber');
178	value := StrToBCD('123456123400.123456');
179	for i := 0 to 16 do
180	begin
181	ar.SetAsBcd(i,value);
182	BcdAdd(value,DoubleToBCD(1.5),value);
183	end;
184
185	Statement := Attachment.Prepare(Transaction,'Update FB4TestData_DECFloat_AR Set BigNumber = ? Where RowID = 1');
186	Statement.SQLParams[0].AsArray := ar;
187	Statement.Execute;
188	{$ENDIF}
189
190	Statement := Attachment.Prepare(Transaction,'Select RowID, Float16, Float34,BigNumber From FB4TestData_DECFloat_AR');
191	writeln(OutFile);
192	writeln(OutFile,'Decfloat Arrays');
193	ResultSet := Statement.OpenCursor;
194	while ResultSet.FetchNext do
195	begin
196	writeln(OutFile,'Row No ',ResultSet[0].AsInteger);
197	write(OutFile,'Float16 ');
198	ar := ResultSet[1].AsArray;
199	WriteArray(ar);
200	write(OutFile,'Float34 ');
201	ar := ResultSet[2].AsArray;
202	WriteArray(ar);
203	{$IFDEF TESTINT128ARRAY}
204	write(OutFile,'BigNumber ');
205	ar := ResultSet[3].AsArray;
206	WriteArray(ar);
207	{$ENDIF}
208	end;
209	end;
210
211	procedure TTest18.QueryDatabase4_DECFloat(Attachment: IAttachment);
212	var Transaction: ITransaction;
213	Statement: IStatement;
214	Results: IResultSet;
215	begin
216	Transaction := Attachment.StartTransaction([isc_tpb_read,isc_tpb_nowait,isc_tpb_concurrency],taCommit);
217	Statement := Attachment.Prepare(Transaction,'Select * from FB4TestData_DECFloat');
218	writeln(OutFile);
219	writeln(OutFile,'FB4 Testdata_DECFloat');
220	writeln(OutFile);
221	PrintMetaData(Statement.MetaData);
222	Results := Statement.OpenCursor;
223	try
224	while Results.FetchNext do
225	with Results do
226	begin
227	writeln(OutFile,'RowID = ',ByName('ROWID').GetAsString);
228	writeln(OutFile,'Float16 = ', ByName('Float16').GetAsString);
229	DumpBCD(ByName('Float16').GetAsBCD);
230	writeln(OutFile,'Float34 = ', ByName('Float34').GetAsString);
231	DumpBCD(ByName('Float34').GetAsBCD);
232	writeln(OutFile,'BigNumber = ', ByName('BigNumber').GetAsString);
233	DumpBCD(ByName('BigNumber').GetAsBCD);
234	if not ByName('BiggerNumber').IsNull then
235	begin
236	writeln(OutFile,'BiggerNumber = ', ByName('BiggerNumber').GetAsString);
237	DumpBCD(ByName('BiggerNumber').GetAsBCD);
238	end;
239	if ByName('BigInteger').IsNull then
240	writeln(OutFile,'BigInteger = Null')
241	else
242	begin
243	writeln(OutFile,'BigInteger = ', ByName('BigInteger').GetAsString);
244	DumpBCD(ByName('BigInteger').GetAsBCD);
245	end;
246	writeln(Outfile);
247	end;
248	finally
249	Results.Close;
250	end;
251	end;
252
253	function TTest18.TestTitle: AnsiString;
254	begin
255	Result := 'Test 18: Firebird 4 Decfloat extensions';
256	end;
257
258	procedure TTest18.RunTest(CharSet: AnsiString; SQLDialect: integer);
259	var DPB: IDPB;
260	Attachment: IAttachment;
261	VerStrings: TStringList;
262	begin
263	DPB := FirebirdAPI.AllocateDPB;
264	DPB.Add(isc_dpb_user_name).setAsString(Owner.GetUserName);
265	DPB.Add(isc_dpb_password).setAsString(Owner.GetPassword);
266	DPB.Add(isc_dpb_lc_ctype).setAsString('UTF8');
267	DPB.Add(isc_dpb_set_db_SQL_dialect).setAsByte(SQLDialect);
268	Attachment := FirebirdAPI.CreateDatabase(Owner.GetNewDatabaseName,DPB);
269	VerStrings := TStringList.Create;
270	try
271	Attachment.getFBVersion(VerStrings);
272	writeln(OutFile,' FBVersion = ',VerStrings[0]);
273	finally
274	VerStrings.Free;
275	end;
276
277	if (FirebirdAPI.GetClientMajor < 4) or (Attachment.GetODSMajorVersion < 13) then
278	writeln(OutFile,'Skipping test for Firebird 4 and later')
279	else
280	begin
281	Attachment.ExecImmediate([isc_tpb_write,isc_tpb_wait,isc_tpb_consistency],sqlCreateTable);
282	UpdateDatabase4_DECFloat(Attachment);
283	QueryDatabase4_DECFloat(Attachment);
284	ArrayTest(Attachment);
285	end;
286	Attachment.DropDatabase;
287	end;
288
289	initialization
290	RegisterTest(TTest18);
291	end.
292
293