fbintf/testsuite/Test13.pas

unit Test13;

{$mode objfpc}{$H+}
{$codepage UTF8}

{Test 13: Tranasction 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, TestManager, IB;

type
    { TTest13 }

  TTest13 = class(TTestBase)
  private
    procedure UpdateDatabase(Attachment: IAttachment);
    procedure QueryDatabase(Attachment: IAttachment);
    procedure ModifyDatabase1(Attachment: IAttachment; Transaction: ITransaction);
    procedure ModifyDatabase2(Attachment: IAttachment; Transaction: ITransaction);
  public
    function TestTitle: string; override;
    procedure RunTest(CharSet: string; 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;
    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 ÖÄÜöäüß');
    ByName('InClear').AsString := #$01'Test'#$0D#$C3;
  end;
  Statement.Execute;
end;

procedure TTest13.QueryDatabase(Attachment: IAttachment);
var Transaction: ITransaction;
    Statement: IStatement;
    ResultSet: IResultSet;
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: string;
begin
  Result := 'Test 13: Transaction over two databases';
end;

procedure TTest13.RunTest(CharSet: string; 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:	47
Committed:	Mon Jan 9 15:31:51 2017 UTC (7 years, 11 months ago) by tony
Content type:	text/x-pascal
File size:	4744 byte(s)
Log Message:	Committing updates for Release R2-0-1
#	Content
1	unit Test13;
2
3	{$mode objfpc}{$H+}
4	{$codepage UTF8}
5
6	{Test 13: Tranasction over two databases}
7
8	{
9	The objective of this test is to test multi-database transactions. Two new
10	databases are created and both are populated with a table and data. The data
11	insert uses the same transaction. This is committed. Both are then read back
12	to ensure that the data has been written to both.
13	}
14
15
16	interface
17
18	uses
19	Classes, SysUtils, TestManager, IB;
20
21	type
22	{ TTest13 }
23
24	TTest13 = class(TTestBase)
25	private
26	procedure UpdateDatabase(Attachment: IAttachment);
27	procedure QueryDatabase(Attachment: IAttachment);
28	procedure ModifyDatabase1(Attachment: IAttachment; Transaction: ITransaction);
29	procedure ModifyDatabase2(Attachment: IAttachment; Transaction: ITransaction);
30	public
31	function TestTitle: string; override;
32	procedure RunTest(CharSet: string; SQLDialect: integer); override;
33	end;
34
35	implementation
36
37	const
38	sqlCreateTable =
39	'Create Table TestData ('+
40	'RowID Integer not null,'+
41	'Title VarChar(32) Character Set UTF8,'+
42	'Notes VarChar(64) Character Set ISO8859_1,'+
43	'BlobData Blob sub_type 1 Character Set WIN1252, '+
44	'BlobData2 Blob sub_type 1 Character Set UTF8, '+
45	'InClear VarChar(16) Character Set OCTETS, '+
46	'Primary Key(RowID)'+
47	')';
48
49
50	sqlInsert = 'Insert into TestData(RowID,Title,Notes, BlobData,BlobData2,InClear) Values(:RowID,:Title,:Notes,:BlobData,:BlobData2,:InClear)';
51
52
53	{ TTest13 }
54
55	procedure TTest13.UpdateDatabase(Attachment: IAttachment);
56	var Transaction: ITransaction;
57	Statement: IStatement;
58	begin
59	Transaction := Attachment.StartTransaction([isc_tpb_write,isc_tpb_nowait,isc_tpb_concurrency],taCommit);
60
61	Statement := Attachment.PrepareWithNamedParameters(Transaction,sqlInsert);
62	with Statement.GetSQLParams do
63	begin
64	ByName('rowid').AsInteger := 1;
65	ByName('title').AsString := 'Blob Test ©€';
66	ByName('Notes').AsString := 'Écoute moi';
67	ByName('BlobData').AsString := 'Some German Special Characters like ÖÄÜöäüß';
68	ByName('BlobData2').AsBlob := Attachment.CreateBlob(Transaction,'TestData','BlobData').SetString('Some German Special Characters like ÖÄÜöäüß');
69	ByName('InClear').AsString := #$01'Test'#$0D#$C3;
70	end;
71	Statement.Execute;
72	end;
73
74	procedure TTest13.QueryDatabase(Attachment: IAttachment);
75	var Transaction: ITransaction;
76	Statement: IStatement;
77	ResultSet: IResultSet;
78	begin
79	Transaction := Attachment.StartTransaction([isc_tpb_write,isc_tpb_nowait,isc_tpb_concurrency],taCommit);
80	Statement := Attachment.Prepare(Transaction,'Select * from TestData');
81	ReportResults(Statement);
82	end;
83
84	procedure TTest13.ModifyDatabase1(Attachment: IAttachment;
85	Transaction: ITransaction);
86	var Statement: IStatement;
87	begin
88	Statement := Attachment.Prepare(Transaction,'Update TestData Set Title = ''Database1''');
89	Statement.Execute;
90	end;
91
92	procedure TTest13.ModifyDatabase2(Attachment: IAttachment;
93	Transaction: ITransaction);
94	var Statement: IStatement;
95	begin
96	Statement := Attachment.Prepare(Transaction,'Update TestData Set Title = ''Database2''');
97	Statement.Execute;
98	end;
99
100	function TTest13.TestTitle: string;
101	begin
102	Result := 'Test 13: Transaction over two databases';
103	end;
104
105	procedure TTest13.RunTest(CharSet: string; SQLDialect: integer);
106	var DPB: IDPB;
107	Attachment, Attachment2: IAttachment;
108	Transaction: ITransaction;
109	begin
110	FHexStrings := true;
111	DPB := FirebirdAPI.AllocateDPB;
112	DPB.Add(isc_dpb_user_name).setAsString(Owner.GetUserName);
113	DPB.Add(isc_dpb_password).setAsString(Owner.GetPassword);
114	DPB.Add(isc_dpb_lc_ctype).setAsString('UTF8');
115	DPB.Add(isc_dpb_set_db_SQL_dialect).setAsByte(SQLDialect);
116	Attachment := FirebirdAPI.CreateDatabase(Owner.GetNewDatabaseName,DPB);
117	Attachment.ExecImmediate([isc_tpb_write,isc_tpb_wait,isc_tpb_consistency],sqlCreateTable);
118
119	writeln(OutFile,'Init Database 1');
120	UpdateDatabase(Attachment);
121	QueryDatabase(Attachment);
122
123	{Now create second identical database}
124
125	Attachment2 := FirebirdAPI.CreateDatabase(Owner.GetSecondNewDatabaseName,DPB);
126	Attachment2.ExecImmediate([isc_tpb_write,isc_tpb_wait,isc_tpb_consistency],sqlCreateTable);
127
128	writeln(OutFile,'Init Database 2');
129	UpdateDatabase(Attachment2);
130	QueryDatabase(Attachment2);
131
132	Transaction := FirebirdAPI.StartTransaction(
133	[Attachment,Attachment2],
134	[isc_tpb_write,isc_tpb_nowait,isc_tpb_concurrency], taCommit);
135
136	ModifyDatabase1(Attachment,Transaction);
137	ModifyDatabase2(Attachment2,Transaction);
138
139	Transaction.PrepareForCommit;
140	Transaction.Commit;
141
142	QueryDatabase(Attachment);
143	QueryDatabase(Attachment2);
144
145	Attachment.DropDatabase;
146	Attachment2.DropDatabase;
147
148	end;
149
150	initialization
151	RegisterTest(TTest13);
152	end.
153