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
#	User	Rev	Content
1	tony	335	(*
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	tony	402	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	tony	335	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	tony	345	writeln(Outfile);
251	tony	335	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