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:	345
Committed:	Mon Aug 23 14:22:29 2021 UTC (3 years, 3 months ago) by tony
Content type:	text/x-pascal
File size:	9492 byte(s)
Log Message:	Merged into public release
#	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			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	tony	345	writeln(Outfile);
247	tony	335	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