udr/testsuite/Test21.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) 2016 Tony Whyman, MWA Software
 *  (http://www.mwasoftware.co.uk).
 *
 *  All Rights Reserved.
 *
 *  Contributor(s): ______________________________________.
 *
*)

unit Test21;

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

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

{Test 21: Exercise setting and getting of numeric data types}

interface

uses
  Classes, SysUtils, TestApplication, FBTestApp, IB;

type

  { TTest21 }

  TTest21 = class(TFBTestBase)
  private
    procedure UpdateDatabase(Attachment: IAttachment);
    procedure QueryDatabase(Attachment: IAttachment);
    procedure ValidateStrToNumeric;
    procedure ValidateNumericInterface;
  public
    function TestTitle: AnsiString; override;
    procedure RunTest(CharSet: AnsiString; SQLDialect: integer); override;
  end;


implementation

uses FBNumeric, FmtBCD;

const
  sqlCreateTable =
    'Create Table TestData ('+
    'RowID Integer not null,'+
    'iType Integer,'+
    'i64Type BIGINT,'+
    'CurrType Numeric(12,4),'+
    'dType DOUBLE PRECISION,'+
    'FixedPoint Numeric(10,6),'+
    'Primary Key (RowID)'+
    ')';

  sqlInsert = 'Insert into TestData(RowID,iType,i64Type,CurrType,dType,FixedPoint) Values(?,?,?,?,?,?)';


{ TTest21 }

procedure TTest21.UpdateDatabase(Attachment: IAttachment);
var Transaction: ITransaction;
    Statement: IStatement;
begin
  Transaction := Attachment.StartTransaction([isc_tpb_write,isc_tpb_nowait,isc_tpb_concurrency],taCommit);
  Statement := Attachment.Prepare(Transaction,sqlInsert);
  ParamInfo(Statement.GetSQLParams);
  with Statement.GetSQLParams do
  begin
    Params[0].AsInteger := 1;
    Params[1].AsString := '101';
    Params[2].AsString := ' 9223372036854775807';
    Params[3].AsString := '10000.1234';
    Params[4].AsString := '9999.123456780';
    Params[5].AsString := '1234567890.12345678';
  end;
  Statement.Execute;
  with Statement.GetSQLParams do
  begin
    Params[0].AsInteger := 2;
    Params[1].AsString := '-32457';
    Params[2].AsString := ' -9223372036854775808 ';
    Params[3].AsString := '+1000001.12';
    Params[4].AsString := '1.7E308';
    Params[5].AsString := '-1234567890.12345678';
  end;
  Statement.Execute;
  with Statement.GetSQLParams do
  begin
    Params[0].AsInteger := 3;
    Params[1].AsString := '0';
    Params[2].AsString := '0';
    Params[3].AsString := '0';
    Params[4].AsString := '0';
    Params[5].AsString := '0';
  end;
  Statement.Execute;
  with Statement.GetSQLParams do
  begin
    Params[0].AsInteger := 4;
    Params[1].AsString := '1.0';
    Params[2].AsString := '10.';
    Params[3].AsString := '2.3E-2';
    Params[4].AsString := '11e-4';
    Params[5].AsString := '2.33456E2';
  end;
  Statement.Execute;
  {error handling}
  with Statement.GetSQLParams do
  try
     Params[0].AsInteger := 5;
     Params[1].AsString := '1,000';
     Statement.Execute;
  except on E: Exception do
    writeln(Outfile,'Expected Error - ',E.Message);
  end;
  with Statement.GetSQLParams do
  try
     Params[0].AsInteger := 6;
     Params[5].AsString := '10.0.0';
     Statement.Execute;
  except on E: Exception do
    writeln(Outfile,'Expected Error - ',E.Message);
  end;
  writeln(OutFile,'Test Numeric Type');
  with Statement.GetSQLParams do
  begin
    Clear;
    Params[0].AsInteger := 7;
    Params[1].AsNumeric := NewNumeric(1.0);
    Params[2].AsVariant := 1234567;
    Params[3].AsNumeric := NewNumeric(StrToFloat('2.3E-2'),-4);
    Params[4].AsNumeric := NewNumeric('11e-4');
    Params[5].AsVariant := 1234.25;
  end;
  Statement.Execute;
end;

procedure TTest21.QueryDatabase(Attachment: IAttachment);
var Transaction: ITransaction;
    Statement: IStatement;
begin
  Transaction := Attachment.StartTransaction([isc_tpb_read,isc_tpb_nowait,isc_tpb_concurrency],taCommit);
  Statement := Attachment.Prepare(Transaction,'Select * from TestData');
  ReportResults(Statement);
end;

procedure TTest21.ValidateStrToNumeric;
const
  TestValues: array of string = ['1234.567','-765.4321','0.1','0.01','+123',
                                 '1.23456E308','-1.2e-02','10.','.12', '0.12',
                                 '1.2E1.2', '1,000', '1e1e1', '1.2+3']; {bad syntax}
var
  i: integer;
  aValue: Int64;
  aScale: integer;
begin
  for i := 0 to Length(TestValues) - 1 do
  begin
    if TryStrToNumeric(TestValues[i],aValue,aScale) then
    begin
      writeln(Outfile,TestValues[i],' parsed to ',aValue,' scale = ',aScale);
      writeln(Outfile,'As Float = ',NumericToDouble(aValue,aScale));
    end
    else
      writeln(Outfile,'Parsing of ',TestValues[i],' failed');
  end;
end;

procedure TTest21.ValidateNumericInterface;
var numeric: IFBNumeric;
begin
  writeln(Outfile,'Validating Numeric Interface - IFBNumeric');
  numeric := NewNumeric(StrToCurr('9999.123456780'));
  writeln(Outfile,'Value from Currency = ',numeric.getAsString);
  writeln(Outfile,'Raw Value = ',numeric.getRawValue,' Scale = ',numeric.getScale);
  numeric := NewNumeric(StrToCurr('9999.123456780')).clone(-2);
  writeln(Outfile,'Value from Currency(rescaled) = ',numeric.getAsString);
  writeln(Outfile,'Raw Value = ',numeric.getRawValue,' Scale = ',numeric.getScale);
  numeric := NewNumeric(StrToFloat('9999.123456780'),-8);
  writeln(Outfile,'Value from Double = ',numeric.getAsString);
  writeln(Outfile,'Raw Value = ',numeric.getRawValue,' Scale = ',numeric.getScale);
  numeric := NewNumeric(StrToInt64('9223372036854775807'));
  writeln(Outfile,'Value from Integer = ',numeric.getAsString);
  writeln(Outfile,'Raw Value = ',numeric.getRawValue,' Scale = ',numeric.getScale);
  numeric := NewNumeric('9223372036854775807');
  writeln(Outfile,'Value from string = ',numeric.getAsString);
  writeln(Outfile,'Raw Value = ',numeric.getRawValue,' Scale = ',numeric.getScale);
  numeric := NewNumeric('9999.123456780');
  writeln(Outfile,'Value from string = ',numeric.getAsString);
  writeln(Outfile,'Raw Value = ',numeric.getRawValue,' Scale = ',numeric.getScale);
  numeric := NewNumeric('-1.2e-02');
  writeln(Outfile,'Value from string = ',numeric.getAsString);
  writeln(Outfile,'Raw Value = ',numeric.getRawValue,' Scale = ',numeric.getScale);
  numeric := NewNumeric(StrToBCD('9999.123456780'));
  writeln(Outfile,'Value from BCD = ',numeric.getAsString);
  writeln(Outfile,'Raw Value = ',numeric.getRawValue,' Scale = ',numeric.getScale);
  numeric := NumericFromRawValues(9999123456780,-6);
  writeln(Outfile,'Value from Raw Data = ',numeric.getAsString);
  writeln(Outfile,'Raw Value = ',numeric.getRawValue,' Scale = ',numeric.getScale);
end;

function TTest21.TestTitle: AnsiString;
begin
  Result := 'Test 21: Exercise setting and getting of numeric data types';
end;

procedure TTest21.RunTest(CharSet: AnsiString; SQLDialect: integer);
var DPB: IDPB;
    Attachment: IAttachment;
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(CharSet);
  DPB.Add(isc_dpb_set_db_SQL_dialect).setAsByte(SQLDialect);
  Attachment := FirebirdAPI.CreateDatabase(Owner.GetNewDatabaseName,DPB);
  try
    Attachment.ExecImmediate([isc_tpb_write,isc_tpb_wait,isc_tpb_consistency],sqlCreateTable);
    ValidateStrToNumeric;
    ValidateNumericInterface;
    SetFloatTemplate('#,###.00000000');
    UpdateDatabase(Attachment);
    QueryDatabase(Attachment);
  finally
    Attachment.DropDatabase;
  end;
end;

initialization
  RegisterTest(TTest21);
end.

Revision:	371
Committed:	Wed Jan 5 15:21:22 2022 UTC (2 years, 3 months ago) by tony
Content type:	text/x-pascal
File size:	8296 byte(s)
Log Message:	Beta Release 0.1
#	User	Rev	Content
1	tony	351	(*
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) 2016 Tony Whyman, MWA Software
21			* (http://www.mwasoftware.co.uk).
22			*
23			* All Rights Reserved.
24			*
25			* Contributor(s): ______________________________________.
26			*
27			*)
28
29			unit Test21;
30
31			{$IFDEF MSWINDOWS}
32			{$DEFINE WINDOWS}
33			{$ENDIF}
34
35			{$IFDEF FPC}
36			{$mode delphi}
37			{$codepage utf8}
38			{$ENDIF}
39
40			{Test 21: Exercise setting and getting of numeric data types}
41
42			interface
43
44			uses
45			Classes, SysUtils, TestApplication, FBTestApp, IB;
46
47			type
48
49			{ TTest21 }
50
51			TTest21 = class(TFBTestBase)
52			private
53			procedure UpdateDatabase(Attachment: IAttachment);
54			procedure QueryDatabase(Attachment: IAttachment);
55	tony	356	procedure ValidateStrToNumeric;
56	tony	371	procedure ValidateNumericInterface;
57	tony	351	public
58			function TestTitle: AnsiString; override;
59			procedure RunTest(CharSet: AnsiString; SQLDialect: integer); override;
60			end;
61
62
63
64			implementation
65
66	tony	371	uses FBNumeric, FmtBCD;
67	tony	356
68	tony	351	const
69			sqlCreateTable =
70			'Create Table TestData ('+
71			'RowID Integer not null,'+
72			'iType Integer,'+
73			'i64Type BIGINT,'+
74			'CurrType Numeric(12,4),'+
75			'dType DOUBLE PRECISION,'+
76			'FixedPoint Numeric(10,6),'+
77			'Primary Key (RowID)'+
78			')';
79
80			sqlInsert = 'Insert into TestData(RowID,iType,i64Type,CurrType,dType,FixedPoint) Values(?,?,?,?,?,?)';
81
82
83			{ TTest21 }
84
85			procedure TTest21.UpdateDatabase(Attachment: IAttachment);
86			var Transaction: ITransaction;
87			Statement: IStatement;
88			begin
89			Transaction := Attachment.StartTransaction([isc_tpb_write,isc_tpb_nowait,isc_tpb_concurrency],taCommit);
90			Statement := Attachment.Prepare(Transaction,sqlInsert);
91			ParamInfo(Statement.GetSQLParams);
92			with Statement.GetSQLParams do
93			begin
94			Params[0].AsInteger := 1;
95			Params[1].AsString := '101';
96			Params[2].AsString := ' 9223372036854775807';
97			Params[3].AsString := '10000.1234';
98			Params[4].AsString := '9999.123456780';
99			Params[5].AsString := '1234567890.12345678';
100			end;
101			Statement.Execute;
102			with Statement.GetSQLParams do
103			begin
104			Params[0].AsInteger := 2;
105			Params[1].AsString := '-32457';
106			Params[2].AsString := ' -9223372036854775808 ';
107			Params[3].AsString := '+1000001.12';
108			Params[4].AsString := '1.7E308';
109			Params[5].AsString := '-1234567890.12345678';
110			end;
111			Statement.Execute;
112			with Statement.GetSQLParams do
113			begin
114			Params[0].AsInteger := 3;
115			Params[1].AsString := '0';
116			Params[2].AsString := '0';
117			Params[3].AsString := '0';
118			Params[4].AsString := '0';
119			Params[5].AsString := '0';
120			end;
121			Statement.Execute;
122			with Statement.GetSQLParams do
123			begin
124			Params[0].AsInteger := 4;
125			Params[1].AsString := '1.0';
126			Params[2].AsString := '10.';
127			Params[3].AsString := '2.3E-2';
128	tony	353	Params[4].AsString := '11e-4';
129	tony	351	Params[5].AsString := '2.33456E2';
130			end;
131			Statement.Execute;
132			{error handling}
133			with Statement.GetSQLParams do
134			try
135			Params[0].AsInteger := 5;
136			Params[1].AsString := '1,000';
137			Statement.Execute;
138			except on E: Exception do
139			writeln(Outfile,'Expected Error - ',E.Message);
140			end;
141			with Statement.GetSQLParams do
142			try
143			Params[0].AsInteger := 6;
144			Params[5].AsString := '10.0.0';
145			Statement.Execute;
146			except on E: Exception do
147			writeln(Outfile,'Expected Error - ',E.Message);
148			end;
149	tony	371	writeln(OutFile,'Test Numeric Type');
150			with Statement.GetSQLParams do
151			begin
152			Clear;
153			Params[0].AsInteger := 7;
154			Params[1].AsNumeric := NewNumeric(1.0);
155			Params[2].AsVariant := 1234567;
156			Params[3].AsNumeric := NewNumeric(StrToFloat('2.3E-2'),-4);
157			Params[4].AsNumeric := NewNumeric('11e-4');
158			Params[5].AsVariant := 1234.25;
159			end;
160			Statement.Execute;
161	tony	351	end;
162
163			procedure TTest21.QueryDatabase(Attachment: IAttachment);
164			var Transaction: ITransaction;
165			Statement: IStatement;
166			begin
167			Transaction := Attachment.StartTransaction([isc_tpb_read,isc_tpb_nowait,isc_tpb_concurrency],taCommit);
168			Statement := Attachment.Prepare(Transaction,'Select * from TestData');
169			ReportResults(Statement);
170			end;
171
172	tony	356	procedure TTest21.ValidateStrToNumeric;
173			const
174			TestValues: array of string = ['1234.567','-765.4321','0.1','0.01','+123',
175			'1.23456E308','-1.2e-02','10.','.12', '0.12',
176			'1.2E1.2', '1,000', '1e1e1', '1.2+3']; {bad syntax}
177			var
178			i: integer;
179			aValue: Int64;
180			aScale: integer;
181			begin
182			for i := 0 to Length(TestValues) - 1 do
183			begin
184			if TryStrToNumeric(TestValues[i],aValue,aScale) then
185			begin
186			writeln(Outfile,TestValues[i],' parsed to ',aValue,' scale = ',aScale);
187			writeln(Outfile,'As Float = ',NumericToDouble(aValue,aScale));
188			end
189			else
190			writeln(Outfile,'Parsing of ',TestValues[i],' failed');
191			end;
192			end;
193
194	tony	371	procedure TTest21.ValidateNumericInterface;
195			var numeric: IFBNumeric;
196			begin
197			writeln(Outfile,'Validating Numeric Interface - IFBNumeric');
198			numeric := NewNumeric(StrToCurr('9999.123456780'));
199			writeln(Outfile,'Value from Currency = ',numeric.getAsString);
200			writeln(Outfile,'Raw Value = ',numeric.getRawValue,' Scale = ',numeric.getScale);
201			numeric := NewNumeric(StrToCurr('9999.123456780')).clone(-2);
202			writeln(Outfile,'Value from Currency(rescaled) = ',numeric.getAsString);
203			writeln(Outfile,'Raw Value = ',numeric.getRawValue,' Scale = ',numeric.getScale);
204			numeric := NewNumeric(StrToFloat('9999.123456780'),-8);
205			writeln(Outfile,'Value from Double = ',numeric.getAsString);
206			writeln(Outfile,'Raw Value = ',numeric.getRawValue,' Scale = ',numeric.getScale);
207			numeric := NewNumeric(StrToInt64('9223372036854775807'));
208			writeln(Outfile,'Value from Integer = ',numeric.getAsString);
209			writeln(Outfile,'Raw Value = ',numeric.getRawValue,' Scale = ',numeric.getScale);
210			numeric := NewNumeric('9223372036854775807');
211			writeln(Outfile,'Value from string = ',numeric.getAsString);
212			writeln(Outfile,'Raw Value = ',numeric.getRawValue,' Scale = ',numeric.getScale);
213			numeric := NewNumeric('9999.123456780');
214			writeln(Outfile,'Value from string = ',numeric.getAsString);
215			writeln(Outfile,'Raw Value = ',numeric.getRawValue,' Scale = ',numeric.getScale);
216			numeric := NewNumeric('-1.2e-02');
217			writeln(Outfile,'Value from string = ',numeric.getAsString);
218			writeln(Outfile,'Raw Value = ',numeric.getRawValue,' Scale = ',numeric.getScale);
219			numeric := NewNumeric(StrToBCD('9999.123456780'));
220			writeln(Outfile,'Value from BCD = ',numeric.getAsString);
221			writeln(Outfile,'Raw Value = ',numeric.getRawValue,' Scale = ',numeric.getScale);
222			numeric := NumericFromRawValues(9999123456780,-6);
223			writeln(Outfile,'Value from Raw Data = ',numeric.getAsString);
224			writeln(Outfile,'Raw Value = ',numeric.getRawValue,' Scale = ',numeric.getScale);
225			end;
226
227	tony	351	function TTest21.TestTitle: AnsiString;
228			begin
229			Result := 'Test 21: Exercise setting and getting of numeric data types';
230			end;
231
232			procedure TTest21.RunTest(CharSet: AnsiString; SQLDialect: integer);
233			var DPB: IDPB;
234			Attachment: IAttachment;
235			begin
236			DPB := FirebirdAPI.AllocateDPB;
237			DPB.Add(isc_dpb_user_name).setAsString(Owner.GetUserName);
238			DPB.Add(isc_dpb_password).setAsString(Owner.GetPassword);
239			DPB.Add(isc_dpb_lc_ctype).setAsString(CharSet);
240			DPB.Add(isc_dpb_set_db_SQL_dialect).setAsByte(SQLDialect);
241			Attachment := FirebirdAPI.CreateDatabase(Owner.GetNewDatabaseName,DPB);
242			try
243			Attachment.ExecImmediate([isc_tpb_write,isc_tpb_wait,isc_tpb_consistency],sqlCreateTable);
244	tony	356	ValidateStrToNumeric;
245	tony	371	ValidateNumericInterface;
246	tony	351	SetFloatTemplate('#,###.00000000');
247			UpdateDatabase(Attachment);
248			QueryDatabase(Attachment);
249			finally
250			Attachment.DropDatabase;
251			end;
252			end;
253
254			initialization
255			RegisterTest(TTest21);
256			end.
257