udr/testsuite/Test22.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 Test22;
{$IFDEF MSWINDOWS}
{$DEFINE WINDOWS}
{$ENDIF}

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

{Test 22: Journalling}


interface

uses
  Classes, SysUtils, TestApplication, FBTestApp, IB;

type

  { TTest22 }

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


implementation

uses FBNumeric;

const
  sqlCreateTable =
    'Create Table TestData ('+
    'RowID Integer not null,'+
    'iType Integer,'+
    'i64Type BIGINT,'+
    'CurrType Numeric(12,4),'+
    'dType DOUBLE PRECISION,'+
    'FixedPoint Numeric(10,6),'+
    'Str VarChar(256),' +
    'TextBlob BLOB sub_type 1,'+
    'OtherBlob Blob sub_type 0,'+
    'MyArray Integer [0:16],'+
    'Primary Key (RowID)'+
    ')';

  sqlInsert = 'Insert into TestData(RowID,iType,i64Type,CurrType,dType,FixedPoint) Values(?,?,?,?,?,?)';
  sqlInsertText = 'Insert into TestData(RowID, Str, TextBlob) Values(?,?,?)';
  sqlInsertArray = 'Insert into TestData(RowID,MyArray) Values (?,?)';
  sqlInsertBlob = 'Insert into TestData(RowID,OtherBlob) Values (?,?)';

  { TTest22 }

procedure TTest22.UpdateDatabase(Attachment: IAttachment);
var Transaction: ITransaction;
    Statement: IStatement;
    i,j: integer;
    ar: IArray;
begin
  Transaction := Attachment.StartTransaction([isc_tpb_write,isc_tpb_nowait,isc_tpb_concurrency],taCommit,'Transaction_29_1');
  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;
  Transaction.CommitRetaining;
  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;
  Transaction.RollbackRetaining;
  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;
  writeln(OutFile);
  writeln(OutFile,'Text Tests');
  Transaction := Attachment.StartTransaction([isc_tpb_write,isc_tpb_nowait,isc_tpb_concurrency],taRollback,'Transaction_29_2');
  Statement := Attachment.Prepare(Transaction,sqlInsertText);
  ParamInfo(Statement.GetSQLParams);
  with Statement.GetSQLParams do
  begin
    Params[0].AsInteger := 5;
    Params[1].AsString := 'It''s the quick brown fox jumps over the lazy dog';
    Params[2].AsBlob := Attachment.CreateBlob(Transaction,'TestData','TextBlob').LoadFromFile('testtext.txt');
  end;
  Statement.Execute;
  writeln(OutFile);
  writeln(OutFile,'Binary Blob Tests');
  Statement := Attachment.Prepare(Transaction,sqlInsertBlob);
  with Statement.GetSQLParams do
  begin
    Params[0].AsInteger := 6;
    Params[1].AsBlob := Attachment.CreateBlob(Transaction,'TestData','OtherBlob').LoadFromFile('Test22.dat');
  end;
  Statement.Execute;
  writeln(OutFile);
  writeln(OutFile,'Array Test');
  Statement := Attachment.Prepare(Transaction,sqlInsertArray);
  ar := Attachment.CreateArray(Transaction,'TestData','MyArray');
  j := 100;
  for i := 0 to 16 do
  begin
    ar.SetAsInteger([i],j);
    dec(j);
  end;
  ParamInfo(Statement.GetSQLParams);
  with Statement.GetSQLParams do
  begin
    Params[0].AsInteger := 7;
    Params[1].AsArray := ar;
  end;
  Statement.Execute;
end;

procedure TTest22.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 TTest22.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;

function TTest22.TestTitle: AnsiString;
begin
  Result := 'Test 22: Journalling';
end;

procedure TTest22.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);
    writeln(OutFile,'Start Journaling. Session ID = ',
    Attachment.StartJournaling('Test'+GetTestID+'.log'));
    ValidateStrToNumeric;
    SetFloatTemplate('#,###.00000000');
    UpdateDatabase(Attachment);
    QueryDatabase(Attachment);
    PrintJournalTable(Attachment);
    Attachment.StopJournaling(true);
  finally
    Attachment.DropDatabase;
  end;
  writeln(OutFile);
  PrintJournalFile('Test'+GetTestID+'.log');
end;

initialization
  RegisterTest(TTest22);

end.

Revision:	379
Committed:	Mon Jan 10 10:08:03 2022 UTC (2 years, 3 months ago) by tony
Content type:	text/x-pascal
File size:	7405 byte(s)
Log Message:	set line ending property
#	User	Rev	Content
1	tony	368	(*
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 Test22;
30			{$IFDEF MSWINDOWS}
31			{$DEFINE WINDOWS}
32			{$ENDIF}
33
34			{$IFDEF FPC}
35			{$mode delphi}
36			{$codepage utf8}
37			{$ENDIF}
38
39			{Test 22: Journalling}
40
41
42			interface
43
44			uses
45	tony	371	Classes, SysUtils, TestApplication, FBTestApp, IB;
46	tony	368
47			type
48
49			{ TTest22 }
50
51			TTest22 = class(TFBTestBase)
52			private
53			procedure UpdateDatabase(Attachment: IAttachment);
54			procedure QueryDatabase(Attachment: IAttachment);
55			procedure ValidateStrToNumeric;
56			public
57			function TestTitle: AnsiString; override;
58			procedure RunTest(CharSet: AnsiString; SQLDialect: integer); override;
59			end;
60
61
62			implementation
63
64	tony	371	uses FBNumeric;
65
66	tony	368	const
67			sqlCreateTable =
68			'Create Table TestData ('+
69			'RowID Integer not null,'+
70			'iType Integer,'+
71			'i64Type BIGINT,'+
72			'CurrType Numeric(12,4),'+
73			'dType DOUBLE PRECISION,'+
74			'FixedPoint Numeric(10,6),'+
75			'Str VarChar(256),' +
76			'TextBlob BLOB sub_type 1,'+
77			'OtherBlob Blob sub_type 0,'+
78			'MyArray Integer [0:16],'+
79			'Primary Key (RowID)'+
80			')';
81
82			sqlInsert = 'Insert into TestData(RowID,iType,i64Type,CurrType,dType,FixedPoint) Values(?,?,?,?,?,?)';
83			sqlInsertText = 'Insert into TestData(RowID, Str, TextBlob) Values(?,?,?)';
84			sqlInsertArray = 'Insert into TestData(RowID,MyArray) Values (?,?)';
85			sqlInsertBlob = 'Insert into TestData(RowID,OtherBlob) Values (?,?)';
86
87			{ TTest22 }
88
89			procedure TTest22.UpdateDatabase(Attachment: IAttachment);
90			var Transaction: ITransaction;
91			Statement: IStatement;
92			i,j: integer;
93			ar: IArray;
94			begin
95			Transaction := Attachment.StartTransaction([isc_tpb_write,isc_tpb_nowait,isc_tpb_concurrency],taCommit,'Transaction_29_1');
96			Statement := Attachment.Prepare(Transaction,sqlInsert);
97			ParamInfo(Statement.GetSQLParams);
98			with Statement.GetSQLParams do
99			begin
100			Params[0].AsInteger := 1;
101			Params[1].AsString := '101';
102			Params[2].AsString := ' 9223372036854775807';
103			Params[3].AsString := '10000.1234';
104			Params[4].AsString := '9999.123456780';
105			Params[5].AsString := '1234567890.12345678';
106			end;
107			Statement.Execute;
108			with Statement.GetSQLParams do
109			begin
110			Params[0].AsInteger := 2;
111			Params[1].AsString := '-32457';
112			Params[2].AsString := ' -9223372036854775808 ';
113			Params[3].AsString := '+1000001.12';
114			Params[4].AsString := '1.7E308';
115			Params[5].AsString := '-1234567890.12345678';
116			end;
117			Statement.Execute;
118			Transaction.CommitRetaining;
119			with Statement.GetSQLParams do
120			begin
121			Params[0].AsInteger := 3;
122			Params[1].AsString := '0';
123			Params[2].AsString := '0';
124			Params[3].AsString := '0';
125			Params[4].AsString := '0';
126			Params[5].AsString := '0';
127			end;
128			Statement.Execute;
129			Transaction.RollbackRetaining;
130			with Statement.GetSQLParams do
131			begin
132			Params[0].AsInteger := 4;
133			Params[1].AsString := '1.0';
134			Params[2].AsString := '10.';
135			Params[3].AsString := '2.3E-2';
136			Params[4].AsString := '11e-4';
137			Params[5].AsString := '2.33456E2';
138			end;
139			Statement.Execute;
140			writeln(OutFile);
141			writeln(OutFile,'Text Tests');
142			Transaction := Attachment.StartTransaction([isc_tpb_write,isc_tpb_nowait,isc_tpb_concurrency],taRollback,'Transaction_29_2');
143			Statement := Attachment.Prepare(Transaction,sqlInsertText);
144			ParamInfo(Statement.GetSQLParams);
145			with Statement.GetSQLParams do
146			begin
147			Params[0].AsInteger := 5;
148			Params[1].AsString := 'It''s the quick brown fox jumps over the lazy dog';
149			Params[2].AsBlob := Attachment.CreateBlob(Transaction,'TestData','TextBlob').LoadFromFile('testtext.txt');
150			end;
151			Statement.Execute;
152			writeln(OutFile);
153			writeln(OutFile,'Binary Blob Tests');
154			Statement := Attachment.Prepare(Transaction,sqlInsertBlob);
155			with Statement.GetSQLParams do
156			begin
157			Params[0].AsInteger := 6;
158			Params[1].AsBlob := Attachment.CreateBlob(Transaction,'TestData','OtherBlob').LoadFromFile('Test22.dat');
159			end;
160			Statement.Execute;
161			writeln(OutFile);
162			writeln(OutFile,'Array Test');
163			Statement := Attachment.Prepare(Transaction,sqlInsertArray);
164			ar := Attachment.CreateArray(Transaction,'TestData','MyArray');
165			j := 100;
166			for i := 0 to 16 do
167			begin
168			ar.SetAsInteger([i],j);
169			dec(j);
170			end;
171			ParamInfo(Statement.GetSQLParams);
172			with Statement.GetSQLParams do
173			begin
174			Params[0].AsInteger := 7;
175			Params[1].AsArray := ar;
176			end;
177			Statement.Execute;
178			end;
179
180			procedure TTest22.QueryDatabase(Attachment: IAttachment);
181			var Transaction: ITransaction;
182			Statement: IStatement;
183			begin
184			Transaction := Attachment.StartTransaction([isc_tpb_read,isc_tpb_nowait,isc_tpb_concurrency],taCommit);
185			Statement := Attachment.Prepare(Transaction,'Select * from TestData');
186			ReportResults(Statement);
187			end;
188
189			procedure TTest22.ValidateStrToNumeric;
190			const
191			TestValues: array of string = ['1234.567','-765.4321','0.1','0.01','+123',
192			'1.23456E308','-1.2e-02','10.','.12', '0.12',
193			'1.2E1.2', '1,000', '1e1e1', '1.2+3']; {bad syntax}
194			var
195			i: integer;
196			aValue: Int64;
197			aScale: integer;
198			begin
199			for i := 0 to Length(TestValues) - 1 do
200			begin
201			if TryStrToNumeric(TestValues[i],aValue,aScale) then
202			begin
203			writeln(Outfile,TestValues[i],' parsed to ',aValue,' scale = ',aScale);
204			writeln(Outfile,'As Float = ',NumericToDouble(aValue,aScale));
205			end
206			else
207			writeln(Outfile,'Parsing of ',TestValues[i],' failed');
208			end;
209			end;
210
211			function TTest22.TestTitle: AnsiString;
212			begin
213			Result := 'Test 22: Journalling';
214			end;
215
216			procedure TTest22.RunTest(CharSet: AnsiString; SQLDialect: integer);
217			var DPB: IDPB;
218			Attachment: IAttachment;
219			begin
220			DPB := FirebirdAPI.AllocateDPB;
221			DPB.Add(isc_dpb_user_name).setAsString(Owner.GetUserName);
222			DPB.Add(isc_dpb_password).setAsString(Owner.GetPassword);
223			DPB.Add(isc_dpb_lc_ctype).setAsString(CharSet);
224			DPB.Add(isc_dpb_set_db_SQL_dialect).setAsByte(SQLDialect);
225			Attachment := FirebirdAPI.CreateDatabase(Owner.GetNewDatabaseName,DPB);
226			try
227			Attachment.ExecImmediate([isc_tpb_write,isc_tpb_wait,isc_tpb_consistency],sqlCreateTable);
228			writeln(OutFile,'Start Journaling. Session ID = ',
229			Attachment.StartJournaling('Test'+GetTestID+'.log'));
230			ValidateStrToNumeric;
231			SetFloatTemplate('#,###.00000000');
232			UpdateDatabase(Attachment);
233			QueryDatabase(Attachment);
234			PrintJournalTable(Attachment);
235			Attachment.StopJournaling(true);
236			finally
237			Attachment.DropDatabase;
238			end;
239			writeln(OutFile);
240			PrintJournalFile('Test'+GetTestID+'.log');
241			end;
242
243			initialization
244			RegisterTest(TTest22);
245
246			end.
247