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
#	User	Rev	Content
1	tony	45	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	tony	47	'InClear VarChar(16) Character Set OCTETS, '+
46	tony	45	'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