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;
  try
    Statement.SQLParams[3].AsString := '1234561234567.123456';
  except on E:Exception do
    writeln(OutFile,'Delphi has a problem with this big a number: ',E.Message);
  end;
  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:	402
Committed:	Mon Aug 1 10:07:24 2022 UTC (2 years, 3 months ago) by tony
Content type:	text/x-pascal
File size:	9614 byte(s)
Log Message:	IBX Release 2.5.0
#	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	try
124	Statement.SQLParams[3].AsString := '1234561234567.123456';
125	except on E:Exception do
126	writeln(OutFile,'Delphi has a problem with this big a number: ',E.Message);
127	end;
128	Statement.SQLParams[4].AsBCD := StrToBCD('11123456123456123456123456123456.123456'); {last digit should be dropped}
129	Statement.Execute;
130
131	Statement.SQLParams[0].AsInteger := 4;
132	Statement.SQLParams[1].AsBCD := StrToBCD('0');
133	Statement.SQLParams[2].AsBCD := StrToBCD('-1');
134	Statement.SQLParams[3].AsBCD := StrToBCD('0');
135	Statement.SQLParams[4].AsBCD := StrToBCD('0');
136	Statement.Execute;
137	end;
138
139	procedure TTest18.ArrayTest(Attachment: IAttachment);
140	var Transaction: ITransaction;
141	Statement: IStatement;
142	ResultSet: IResultSet;
143	ar: IArray;
144	value: tBCD;
145	i: integer;
146	begin
147	Attachment.ExecImmediate([isc_tpb_write,isc_tpb_wait,isc_tpb_consistency],sqlCreateTable2);
148	Transaction := Attachment.StartTransaction([isc_tpb_write,isc_tpb_nowait,isc_tpb_concurrency],taCommit);
149	Statement := Attachment.Prepare(Transaction,'Select * From FB4TestData_DECFloat_AR');
150	Printmetadata(Statement.MetaData);
151	Attachment.Prepare(Transaction,'Insert into FB4TestData_DECFloat_AR (RowID) Values(1)').Execute;
152
153	{Float16}
154	ar := Attachment.CreateArray(Transaction,'FB4TestData_DECFloat_AR','Float16');
155	value := StrToBCD('64100000000.011');
156	for i := 0 to 16 do
157	begin
158	ar.SetAsBcd(i,value);
159	BcdAdd(value,IntegerToBCD(1),Value);
160	end;
161
162	Statement := Attachment.Prepare(Transaction,'Update FB4TestData_DECFloat_AR Set Float16 = ? Where RowID = 1');
163	Statement.SQLParams[0].AsArray := ar;
164	Statement.Execute;
165
166	{Float 34}
167	ar := Attachment.CreateArray(Transaction,'FB4TestData_DECFloat_AR','Float34');
168	value := StrToBCD('123456789123456789.12345678');
169	for i := 0 to 16 do
170	begin
171	ar.SetAsBcd(i,value);
172	BcdAdd(value,IntegerToBCD(1),Value);
173	end;
174
175	Statement := Attachment.Prepare(Transaction,'Update FB4TestData_DECFloat_AR Set Float34 = ? Where RowID = 1');
176	Statement.SQLParams[0].AsArray := ar;
177	Statement.Execute;
178
179	{NUMERIC(24,6)}
180	{$IFDEF TESTINT128ARRAY}
181	ar := Attachment.CreateArray(Transaction,'FB4TestData_DECFloat_AR','BigNumber');
182	value := StrToBCD('123456123400.123456');
183	for i := 0 to 16 do
184	begin
185	ar.SetAsBcd(i,value);
186	BcdAdd(value,DoubleToBCD(1.5),value);
187	end;
188
189	Statement := Attachment.Prepare(Transaction,'Update FB4TestData_DECFloat_AR Set BigNumber = ? Where RowID = 1');
190	Statement.SQLParams[0].AsArray := ar;
191	Statement.Execute;
192	{$ENDIF}
193
194	Statement := Attachment.Prepare(Transaction,'Select RowID, Float16, Float34,BigNumber From FB4TestData_DECFloat_AR');
195	writeln(OutFile);
196	writeln(OutFile,'Decfloat Arrays');
197	ResultSet := Statement.OpenCursor;
198	while ResultSet.FetchNext do
199	begin
200	writeln(OutFile,'Row No ',ResultSet[0].AsInteger);
201	write(OutFile,'Float16 ');
202	ar := ResultSet[1].AsArray;
203	WriteArray(ar);
204	write(OutFile,'Float34 ');
205	ar := ResultSet[2].AsArray;
206	WriteArray(ar);
207	{$IFDEF TESTINT128ARRAY}
208	write(OutFile,'BigNumber ');
209	ar := ResultSet[3].AsArray;
210	WriteArray(ar);
211	{$ENDIF}
212	end;
213	end;
214
215	procedure TTest18.QueryDatabase4_DECFloat(Attachment: IAttachment);
216	var Transaction: ITransaction;
217	Statement: IStatement;
218	Results: IResultSet;
219	begin
220	Transaction := Attachment.StartTransaction([isc_tpb_read,isc_tpb_nowait,isc_tpb_concurrency],taCommit);
221	Statement := Attachment.Prepare(Transaction,'Select * from FB4TestData_DECFloat');
222	writeln(OutFile);
223	writeln(OutFile,'FB4 Testdata_DECFloat');
224	writeln(OutFile);
225	PrintMetaData(Statement.MetaData);
226	Results := Statement.OpenCursor;
227	try
228	while Results.FetchNext do
229	with Results do
230	begin
231	writeln(OutFile,'RowID = ',ByName('ROWID').GetAsString);
232	writeln(OutFile,'Float16 = ', ByName('Float16').GetAsString);
233	DumpBCD(ByName('Float16').GetAsBCD);
234	writeln(OutFile,'Float34 = ', ByName('Float34').GetAsString);
235	DumpBCD(ByName('Float34').GetAsBCD);
236	writeln(OutFile,'BigNumber = ', ByName('BigNumber').GetAsString);
237	DumpBCD(ByName('BigNumber').GetAsBCD);
238	if not ByName('BiggerNumber').IsNull then
239	begin
240	writeln(OutFile,'BiggerNumber = ', ByName('BiggerNumber').GetAsString);
241	DumpBCD(ByName('BiggerNumber').GetAsBCD);
242	end;
243	if ByName('BigInteger').IsNull then
244	writeln(OutFile,'BigInteger = Null')
245	else
246	begin
247	writeln(OutFile,'BigInteger = ', ByName('BigInteger').GetAsString);
248	DumpBCD(ByName('BigInteger').GetAsBCD);
249	end;
250	writeln(Outfile);
251	end;
252	finally
253	Results.Close;
254	end;
255	end;
256
257	function TTest18.TestTitle: AnsiString;
258	begin
259	Result := 'Test 18: Firebird 4 Decfloat extensions';
260	end;
261
262	procedure TTest18.RunTest(CharSet: AnsiString; SQLDialect: integer);
263	var DPB: IDPB;
264	Attachment: IAttachment;
265	VerStrings: TStringList;
266	begin
267	DPB := FirebirdAPI.AllocateDPB;
268	DPB.Add(isc_dpb_user_name).setAsString(Owner.GetUserName);
269	DPB.Add(isc_dpb_password).setAsString(Owner.GetPassword);
270	DPB.Add(isc_dpb_lc_ctype).setAsString('UTF8');
271	DPB.Add(isc_dpb_set_db_SQL_dialect).setAsByte(SQLDialect);
272	Attachment := FirebirdAPI.CreateDatabase(Owner.GetNewDatabaseName,DPB);
273	VerStrings := TStringList.Create;
274	try
275	Attachment.getFBVersion(VerStrings);
276	writeln(OutFile,' FBVersion = ',VerStrings[0]);
277	finally
278	VerStrings.Free;
279	end;
280
281	if (FirebirdAPI.GetClientMajor < 4) or (Attachment.GetODSMajorVersion < 13) then
282	writeln(OutFile,'Skipping test for Firebird 4 and later')
283	else
284	begin
285	Attachment.ExecImmediate([isc_tpb_write,isc_tpb_wait,isc_tpb_consistency],sqlCreateTable);
286	UpdateDatabase4_DECFloat(Attachment);
287	QueryDatabase4_DECFloat(Attachment);
288	ArrayTest(Attachment);
289	end;
290	Attachment.DropDatabase;
291	end;
292
293	initialization
294	RegisterTest(TTest18);
295	end.
296
297