fbintf/testsuite/Test13.pas

unit Test13;
{$IFDEF MSWINDOWS} 
{$DEFINE WINDOWS} 
{$ENDIF}

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

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