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
#	User	Rev	Content
1	tony	315	(*
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	tony	56	{$IFDEF MSWINDOWS}
31			{$DEFINE WINDOWS}
32			{$ENDIF}
33	tony	45
34	tony	56	{$IFDEF FPC}
35			{$mode delphi}
36	tony	45	{$codepage UTF8}
37	tony	56	{$ENDIF}
38	tony	45
39	tony	315	{Test 13: Transaction over two databases}
40	tony	45
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	tony	315	Classes, SysUtils, TestApplication, FBTestApp, IB;
53	tony	45
54			type
55			{ TTest13 }
56
57	tony	315	TTest13 = class(TFBTestBase)
58	tony	45	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	tony	56	function TestTitle: AnsiString; override;
65			procedure RunTest(CharSet: AnsiString; SQLDialect: integer); override;
66	tony	45	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	tony	47	'InClear VarChar(16) Character Set OCTETS, '+
79	tony	45	'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	tony	56	{$IFDEF DCC}
99			ByName('title').AsString := UTF8Encode('Blob Test ©€');
100			ByName('Notes').AsString := UTF8Encode('Écoute moi');
101	tony	315	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	tony	56	{$ELSE}
104	tony	45	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	tony	315	{$ENDIF}
109	tony	45	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	tony	56	function TTest13.TestTitle: AnsiString;
140	tony	45	begin
141			Result := 'Test 13: Transaction over two databases';
142			end;
143
144	tony	56	procedure TTest13.RunTest(CharSet: AnsiString; SQLDialect: integer);
145	tony	45	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