ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/fbintf/testsuite/Test13.pas
Revision: 315
Committed: Thu Feb 25 11:56:36 2021 UTC (17 months, 2 weeks ago) by tony
File size: 6230 byte(s)
Log Message:
Updated for IBX 4 release
Line File contents
1 (*
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 {$IFDEF MSWINDOWS}
31 {$DEFINE WINDOWS}
32 {$ENDIF}
33
34 {$IFDEF FPC}
35 {$mode delphi}
36 {$codepage UTF8}
37 {$ENDIF}
38
39 {Test 13: Transaction over two databases}
40
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 Classes, SysUtils, TestApplication, FBTestApp, IB;
53
54 type
55 { TTest13 }
56
57 TTest13 = class(TFBTestBase)
58 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 function TestTitle: AnsiString; override;
65 procedure RunTest(CharSet: AnsiString; SQLDialect: integer); override;
66 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 'InClear VarChar(16) Character Set OCTETS, '+
79 '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 {$IFDEF DCC}
99 ByName('title').AsString := UTF8Encode('Blob Test ©€');
100 ByName('Notes').AsString := UTF8Encode('Écoute moi');
101 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 {$ELSE}
104 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 {$ENDIF}
109 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 function TTest13.TestTitle: AnsiString;
140 begin
141 Result := 'Test 13: Transaction over two databases';
142 end;
143
144 procedure TTest13.RunTest(CharSet: AnsiString; SQLDialect: integer);
145 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