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

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

{Test 13: Transaction over two databases}

{
  The objective of this test is to test multi-database transactions. Two new
  databases are created and both are populated with a table and data. The data
  insert uses the same transaction. This is committed. Both are then read back
  to ensure that the data has been written to both.
}


interface

uses
  Classes, SysUtils, TestApplication, FBTestApp, IB;

type
    { TTest13 }

  TTest13 = class(TFBTestBase)
  private
    procedure UpdateDatabase(Attachment: IAttachment);
    procedure QueryDatabase(Attachment: IAttachment);
    procedure ModifyDatabase1(Attachment: IAttachment; Transaction: ITransaction);
    procedure ModifyDatabase2(Attachment: IAttachment; Transaction: ITransaction);
  public
    function TestTitle: AnsiString; override;
    procedure RunTest(CharSet: AnsiString; SQLDialect: integer); override;
  end;

implementation

const
  sqlCreateTable =
    'Create Table TestData ('+
    'RowID Integer not null,'+
    'Title VarChar(32) Character Set UTF8,'+
    'Notes VarChar(64) Character Set ISO8859_1,'+
    'BlobData Blob sub_type 1 Character Set WIN1252, '+
    'BlobData2 Blob sub_type 1 Character Set UTF8, '+
    'InClear VarChar(16) Character Set OCTETS, '+
    'Primary Key(RowID)'+
    ')';


  sqlInsert = 'Insert into TestData(RowID,Title,Notes, BlobData,BlobData2,InClear) Values(:RowID,:Title,:Notes,:BlobData,:BlobData2,:InClear)';


{ TTest13 }

procedure TTest13.UpdateDatabase(Attachment: IAttachment);
var Transaction: ITransaction;
    Statement: IStatement;
begin
  Transaction := Attachment.StartTransaction([isc_tpb_write,isc_tpb_nowait,isc_tpb_concurrency],taCommit);

  Statement := Attachment.PrepareWithNamedParameters(Transaction,sqlInsert);
  with Statement.GetSQLParams do
  begin
    ByName('rowid').AsInteger := 1;
    {$IFDEF DCC}
    ByName('title').AsString := UTF8Encode('Blob Test ©€');
    ByName('Notes').AsString := UTF8Encode('Écoute moi');
    ByName('BlobData').AsString := UTF8Encode('Some German Special Characters like ÖÄÜöäüß');
    ByName('BlobData2').AsBlob := Attachment.CreateBlob(Transaction,'TestData','BlobData').SetString(UTF8Encode('Some German Special Characters like ÖÄÜöäüß'));
    {$ELSE}
    ByName('title').AsString := 'Blob Test ©€';
    ByName('Notes').AsString := 'Écoute moi';
    ByName('BlobData').AsString := 'Some German Special Characters like ÖÄÜöäüß';
    ByName('BlobData2').AsBlob := Attachment.CreateBlob(Transaction,'TestData','BlobData').SetString('Some German Special Characters like ÖÄÜöäüß');
    {$ENDIF}
    ByName('InClear').AsString := #$01'Test'#$0D#$C3;
  end;
  Statement.Execute;
end;

procedure TTest13.QueryDatabase(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,'Select * from TestData');
  ReportResults(Statement);
end;

procedure TTest13.ModifyDatabase1(Attachment: IAttachment;
  Transaction: ITransaction);
var Statement: IStatement;
begin
  Statement := Attachment.Prepare(Transaction,'Update TestData Set Title = ''Database1''');
  Statement.Execute;
end;

procedure TTest13.ModifyDatabase2(Attachment: IAttachment;
  Transaction: ITransaction);
var Statement: IStatement;
begin
  Statement := Attachment.Prepare(Transaction,'Update TestData Set Title = ''Database2''');
  Statement.Execute;
end;

function TTest13.TestTitle: AnsiString;
begin
  Result := 'Test 13: Transaction over two databases';
end;

procedure TTest13.RunTest(CharSet: AnsiString; SQLDialect: integer);
var DPB: IDPB;
    Attachment, Attachment2: IAttachment;
    Transaction: ITransaction;
begin
  FHexStrings := true;
  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);
  Attachment.ExecImmediate([isc_tpb_write,isc_tpb_wait,isc_tpb_consistency],sqlCreateTable);

  writeln(OutFile,'Init Database 1');
  UpdateDatabase(Attachment);
  QueryDatabase(Attachment);

  {Now create second identical database}

  Attachment2 := FirebirdAPI.CreateDatabase(Owner.GetSecondNewDatabaseName,DPB);
  Attachment2.ExecImmediate([isc_tpb_write,isc_tpb_wait,isc_tpb_consistency],sqlCreateTable);

  writeln(OutFile,'Init Database 2');
  UpdateDatabase(Attachment2);
  QueryDatabase(Attachment2);

  Transaction := FirebirdAPI.StartTransaction(
                   [Attachment,Attachment2],
                   [isc_tpb_write,isc_tpb_nowait,isc_tpb_concurrency], taCommit);

  ModifyDatabase1(Attachment,Transaction);
  ModifyDatabase2(Attachment2,Transaction);

  Transaction.PrepareForCommit;
  Transaction.Commit;

  QueryDatabase(Attachment);
  QueryDatabase(Attachment2);

  Attachment.DropDatabase;
  Attachment2.DropDatabase;

end;

initialization
  RegisterTest(TTest13);
end.

Revision:	315
Committed:	Thu Feb 25 11:56:36 2021 UTC (3 years, 8 months ago) by tony
Content type:	text/x-pascal
File size:	6230 byte(s)
Log Message:	Updated for IBX 4 release
#	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) 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 Test13;
30	{$IFDEF MSWINDOWS}
31	{$DEFINE WINDOWS}
32	{$ENDIF}
33
34	{$IFDEF FPC}
35	{$mode delphi}
36	{$codepage UTF8}
37	{$ENDIF}
38
39	{Test 13: Transaction over two databases}
40
41	{
42	The objective of this test is to test multi-database transactions. Two new
43	databases are created and both are populated with a table and data. The data
44	insert uses the same transaction. This is committed. Both are then read back
45	to ensure that the data has been written to both.
46	}
47
48
49	interface
50
51	uses
52	Classes, SysUtils, TestApplication, FBTestApp, IB;
53
54	type
55	{ TTest13 }
56
57	TTest13 = class(TFBTestBase)
58	private
59	procedure UpdateDatabase(Attachment: IAttachment);
60	procedure QueryDatabase(Attachment: IAttachment);
61	procedure ModifyDatabase1(Attachment: IAttachment; Transaction: ITransaction);
62	procedure ModifyDatabase2(Attachment: IAttachment; Transaction: ITransaction);
63	public
64	function TestTitle: AnsiString; override;
65	procedure RunTest(CharSet: AnsiString; SQLDialect: integer); override;
66	end;
67
68	implementation
69
70	const
71	sqlCreateTable =
72	'Create Table TestData ('+
73	'RowID Integer not null,'+
74	'Title VarChar(32) Character Set UTF8,'+
75	'Notes VarChar(64) Character Set ISO8859_1,'+
76	'BlobData Blob sub_type 1 Character Set WIN1252, '+
77	'BlobData2 Blob sub_type 1 Character Set UTF8, '+
78	'InClear VarChar(16) Character Set OCTETS, '+
79	'Primary Key(RowID)'+
80	')';
81
82
83	sqlInsert = 'Insert into TestData(RowID,Title,Notes, BlobData,BlobData2,InClear) Values(:RowID,:Title,:Notes,:BlobData,:BlobData2,:InClear)';
84
85
86	{ TTest13 }
87
88	procedure TTest13.UpdateDatabase(Attachment: IAttachment);
89	var Transaction: ITransaction;
90	Statement: IStatement;
91	begin
92	Transaction := Attachment.StartTransaction([isc_tpb_write,isc_tpb_nowait,isc_tpb_concurrency],taCommit);
93
94	Statement := Attachment.PrepareWithNamedParameters(Transaction,sqlInsert);
95	with Statement.GetSQLParams do
96	begin
97	ByName('rowid').AsInteger := 1;
98	{$IFDEF DCC}
99	ByName('title').AsString := UTF8Encode('Blob Test ©€');
100	ByName('Notes').AsString := UTF8Encode('Écoute moi');
101	ByName('BlobData').AsString := UTF8Encode('Some German Special Characters like ÖÄÜöäüß');
102	ByName('BlobData2').AsBlob := Attachment.CreateBlob(Transaction,'TestData','BlobData').SetString(UTF8Encode('Some German Special Characters like ÖÄÜöäüß'));
103	{$ELSE}
104	ByName('title').AsString := 'Blob Test ©€';
105	ByName('Notes').AsString := 'Écoute moi';
106	ByName('BlobData').AsString := 'Some German Special Characters like ÖÄÜöäüß';
107	ByName('BlobData2').AsBlob := Attachment.CreateBlob(Transaction,'TestData','BlobData').SetString('Some German Special Characters like ÖÄÜöäüß');
108	{$ENDIF}
109	ByName('InClear').AsString := #$01'Test'#$0D#$C3;
110	end;
111	Statement.Execute;
112	end;
113
114	procedure TTest13.QueryDatabase(Attachment: IAttachment);
115	var Transaction: ITransaction;
116	Statement: IStatement;
117	begin
118	Transaction := Attachment.StartTransaction([isc_tpb_write,isc_tpb_nowait,isc_tpb_concurrency],taCommit);
119	Statement := Attachment.Prepare(Transaction,'Select * from TestData');
120	ReportResults(Statement);
121	end;
122
123	procedure TTest13.ModifyDatabase1(Attachment: IAttachment;
124	Transaction: ITransaction);
125	var Statement: IStatement;
126	begin
127	Statement := Attachment.Prepare(Transaction,'Update TestData Set Title = ''Database1''');
128	Statement.Execute;
129	end;
130
131	procedure TTest13.ModifyDatabase2(Attachment: IAttachment;
132	Transaction: ITransaction);
133	var Statement: IStatement;
134	begin
135	Statement := Attachment.Prepare(Transaction,'Update TestData Set Title = ''Database2''');
136	Statement.Execute;
137	end;
138
139	function TTest13.TestTitle: AnsiString;
140	begin
141	Result := 'Test 13: Transaction over two databases';
142	end;
143
144	procedure TTest13.RunTest(CharSet: AnsiString; SQLDialect: integer);
145	var DPB: IDPB;
146	Attachment, Attachment2: IAttachment;
147	Transaction: ITransaction;
148	begin
149	FHexStrings := true;
150	DPB := FirebirdAPI.AllocateDPB;
151	DPB.Add(isc_dpb_user_name).setAsString(Owner.GetUserName);
152	DPB.Add(isc_dpb_password).setAsString(Owner.GetPassword);
153	DPB.Add(isc_dpb_lc_ctype).setAsString('UTF8');
154	DPB.Add(isc_dpb_set_db_SQL_dialect).setAsByte(SQLDialect);
155	Attachment := FirebirdAPI.CreateDatabase(Owner.GetNewDatabaseName,DPB);
156	Attachment.ExecImmediate([isc_tpb_write,isc_tpb_wait,isc_tpb_consistency],sqlCreateTable);
157
158	writeln(OutFile,'Init Database 1');
159	UpdateDatabase(Attachment);
160	QueryDatabase(Attachment);
161
162	{Now create second identical database}
163
164	Attachment2 := FirebirdAPI.CreateDatabase(Owner.GetSecondNewDatabaseName,DPB);
165	Attachment2.ExecImmediate([isc_tpb_write,isc_tpb_wait,isc_tpb_consistency],sqlCreateTable);
166
167	writeln(OutFile,'Init Database 2');
168	UpdateDatabase(Attachment2);
169	QueryDatabase(Attachment2);
170
171	Transaction := FirebirdAPI.StartTransaction(
172	[Attachment,Attachment2],
173	[isc_tpb_write,isc_tpb_nowait,isc_tpb_concurrency], taCommit);
174
175	ModifyDatabase1(Attachment,Transaction);
176	ModifyDatabase2(Attachment2,Transaction);
177
178	Transaction.PrepareForCommit;
179	Transaction.Commit;
180
181	QueryDatabase(Attachment);
182	QueryDatabase(Attachment2);
183
184	Attachment.DropDatabase;
185	Attachment2.DropDatabase;
186
187	end;
188
189	initialization
190	RegisterTest(TTest13);
191	end.
192