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, 9 months ago) by tony
Content type:	text/x-pascal
File size:	4992 byte(s)
Log Message:	Committing updates for Trunk
#	User	Rev	Content
1	tony	56	unit Test13;
2			{$IFDEF MSWINDOWS}
3			{$DEFINE WINDOWS}
4			{$ENDIF}
5	tony	45
6	tony	56	{$IFDEF FPC}
7			{$mode delphi}
8	tony	45	{$codepage UTF8}
9	tony	56	{$ENDIF}
10	tony	45
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	tony	56	function TestTitle: AnsiString; override;
37			procedure RunTest(CharSet: AnsiString; SQLDialect: integer); override;
38	tony	45	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	tony	47	'InClear VarChar(16) Character Set OCTETS, '+
51	tony	45	'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	tony	56	{$IFDEF DCC}
71			ByName('title').AsString := UTF8Encode('Blob Test ©€');
72			ByName('Notes').AsString := UTF8Encode('Écoute moi');
73			{$ELSE}
74	tony	45	ByName('title').AsString := 'Blob Test ©€';
75			ByName('Notes').AsString := 'Écoute moi';
76	tony	56	{$ENDIF}
77	tony	45	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	tony	56	function TTest13.TestTitle: AnsiString;
111	tony	45	begin
112			Result := 'Test 13: Transaction over two databases';
113			end;
114
115	tony	56	procedure TTest13.RunTest(CharSet: AnsiString; SQLDialect: integer);
116	tony	45	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