trunk/testsuite/Test06.pas

(*
 *  IBX Test suite. This program is used to test the IBX non-visual
 *  components and provides a semi-automated pass/fail check for each test.
 *
 *  The contents of this file are subject to the Initial Developer's
 *  Public License Version 1.0 (the "License"); you may not use this
 *  file except in compliance with the License. You may obtain a copy
 *  of the License here:
 *
 *    http://www.firebirdsql.org/index.php?op=doc&id=idpl
 *
 *  Software distributed under the License is distributed on an "AS
 *  IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
 *  implied. See the License for the specific language governing rights
 *  and limitations under the License.
 *
 *  The Initial Developer of the Original Code is Tony Whyman.
 *
 *  The Original Code is (C) 2021 Tony Whyman, MWA Software
 *  (http://www.mwasoftware.co.uk).
 *
 *  All Rights Reserved.
 *
 *  Contributor(s): ______________________________________.
 *
*)      
unit Test06;

{$mode objfpc}{$H+}

{Test 6: Multi-Database Transaction}

{ creates two databases and adds a record to each as a multi-database transaction.
  Commit and print results.
}

interface

uses
  Classes, SysUtils,   TestApplication, IBXTestBase, IB, IBDatabase, IBSQL;

const
  aTestID    = '06';
  aTestTitle = 'Multi-Database Transaction';

type

{ TTest6 }

  TTest6 = class(TIBXTestBase)
  private
    FIBDatabase2: TIBDatabase;
    FIBTransaction2: TIBTransaction;
    FIBMultiTransaction: TIBTransaction;
    FIBSQL: TIBSQL;
    procedure HandleCreateDatebase(Sender: TObject);
  protected
    procedure CreateObjects(Application: TTestApplication); override;
    function GetTestID: AnsiString; override;
    function GetTestTitle: AnsiString; override;
    procedure InitTest; override;
  public
    procedure RunTest(CharSet: AnsiString; SQLDialect: integer); override;
  end;


implementation

const
  InsertSQL = 'Insert into IBXTEST(TABLEKEY, F1) VALUES(GEN_ID(IBXGEN,1),?) Returning TABLEKEY';
  SelectSQL = 'Select TABLEKEY, F1 From IBXTest';

{ TTest6 }

procedure TTest6.HandleCreateDatebase(Sender: TObject);
begin
  InitialiseDatabase(FIBDatabase2);
end;

procedure TTest6.CreateObjects(Application: TTestApplication);
begin
  inherited CreateObjects(Application);
  FIBDatabase2 := TIBDatabase.Create(Application);
  FIBDatabase2.FirebirdLibraryPathName := Owner.ClientLibraryPath;
  FIBDatabase2.LoginPrompt := false;
  FIBDatabase2.Params.Add('user_name=' + Owner.GetUserName);
  FIBDatabase2.Params.Add('password=' + Owner.GetPassword);
  FIBDatabase2.Params.Add('lc_ctype=UTF8');
  FIBDatabase2.OnCreateDatabase := @HandleCreateDatebase;
  FIBDatabase2.Name := 'Test_Database2_' + GetTestID;
  FIBTransaction2 := TIBTransaction.Create(Application);
  FIBTransaction2.DefaultDatabase := FIBDatabase2;
  FIBDatabase2.DefaultTransaction := FIBTransaction2;
  FIBTransaction2.Name := 'Test_Transaction2_' + GetTestID;
  FIBTransaction2.Params.Add('concurrency');
  FIBTransaction2.Params.Add('wait');
  FIBTransaction2.Params.Add('write');
  FIBMultiTransaction := TIBTransaction.Create(Application);
  FIBMultiTransaction.AddDatabase(IBDatabase);
  FIBMultiTransaction.AddDatabase(FIBDatabase2);
  FIBMultiTransaction.Name := 'Multi_Transaction';
  FIBMultiTransaction.Params.Add('concurrency');
  FIBMultiTransaction.Params.Add('wait');
  FIBMultiTransaction.Params.Add('write');
  FIBSQL := TIBSQL.Create(Application);
  FIBSQL.ParamCheck := false;
end;

function TTest6.GetTestID: AnsiString;
begin
  Result := aTestID;
end;

function TTest6.GetTestTitle: AnsiString;
begin
  Result := aTestTitle;
end;

procedure TTest6.InitTest;
begin
  IBDatabase.DatabaseName := Owner.GetNewDatabaseName;
  IBDatabase.CreateIfNotExists := true;
  ReadWriteTransaction;
  FIBDatabase2.DatabaseName := Owner.GetSecondNewDatabaseName;
  FIBDatabase2.CreateIfNotExists := true;
end;

procedure TTest6.RunTest(CharSet: AnsiString; SQLDialect: integer);
begin
  try
    IBDatabase.Connected := true;
    FIBDatabase2.Connected := true;
    FIBMultiTransaction.Active := true;
    FIBSQL.Database := IBDatabase;
    FIBSQL.Transaction := FIBMultiTransaction;
    FIBSQL.SQL.Text := InsertSQL;
    FIBSQL.Params[0].AsInteger := 1;
    writeln(OutFile,'Add Row to First Database');
    FIBSQL.ExecQuery;
    ReportResult(FIBSQL.Current);
    FIBSQL.Database := FIBDatabase2;
    FIBSQL.Params[0].AsInteger := 2;
    writeln(OutFile,'Add Row to Second Database');
    FIBSQL.ExecQuery;
    ReportResult(FIBSQL.Current);
    FIBMultiTransaction.Commit;
    FIBSQL.Database := IBDatabase;
    FIBSQL.Transaction := IBTransaction;
    FIBSQL.SQL.Text := SelectSQL;
    IBTransaction.Active := true;
    FIBSQL.Prepare;
    writeln(OutFile,'Query First Database');
    ReportResults(FIBSQL.Statement);
    FIBSQL.Database := FIBDatabase2;
    FIBSQL.Transaction := FIBTransaction2;
    FIBTransaction2.Active := true;
    FIBSQL.Prepare;
    writeln(OutFile,'Query Second Database');
    ReportResults(FIBSQL.Statement);
  finally
    IBDatabase.DropDatabase;
    FIBDatabase2.DropDatabase;
  end;
end;

initialization
  RegisterTest(TTest6);

end.

Revision:	380
Committed:	Mon Jan 10 10:13:17 2022 UTC (2 years, 10 months ago) by tony
Content type:	text/x-pascal
File size:	5113 byte(s)
Log Message:	propset for eol-style
#	Content
1	(*
2	* IBX Test suite. This program is used to test the IBX non-visual
3	* components and provides a semi-automated pass/fail check for each test.
4	*
5	* The contents of this file are subject to the Initial Developer's
6	* Public License Version 1.0 (the "License"); you may not use this
7	* file except in compliance with the License. You may obtain a copy
8	* of the License here:
9	*
10	* http://www.firebirdsql.org/index.php?op=doc&id=idpl
11	*
12	* Software distributed under the License is distributed on an "AS
13	* IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
14	* implied. See the License for the specific language governing rights
15	* and limitations under the License.
16	*
17	* The Initial Developer of the Original Code is Tony Whyman.
18	*
19	* The Original Code is (C) 2021 Tony Whyman, MWA Software
20	* (http://www.mwasoftware.co.uk).
21	*
22	* All Rights Reserved.
23	*
24	* Contributor(s): ______________________________________.
25	*
26	*)
27	unit Test06;
28
29	{$mode objfpc}{$H+}
30
31	{Test 6: Multi-Database Transaction}
32
33	{ creates two databases and adds a record to each as a multi-database transaction.
34	Commit and print results.
35	}
36
37	interface
38
39	uses
40	Classes, SysUtils, TestApplication, IBXTestBase, IB, IBDatabase, IBSQL;
41
42	const
43	aTestID = '06';
44	aTestTitle = 'Multi-Database Transaction';
45
46	type
47
48	{ TTest6 }
49
50	TTest6 = class(TIBXTestBase)
51	private
52	FIBDatabase2: TIBDatabase;
53	FIBTransaction2: TIBTransaction;
54	FIBMultiTransaction: TIBTransaction;
55	FIBSQL: TIBSQL;
56	procedure HandleCreateDatebase(Sender: TObject);
57	protected
58	procedure CreateObjects(Application: TTestApplication); override;
59	function GetTestID: AnsiString; override;
60	function GetTestTitle: AnsiString; override;
61	procedure InitTest; override;
62	public
63	procedure RunTest(CharSet: AnsiString; SQLDialect: integer); override;
64	end;
65
66
67	implementation
68
69	const
70	InsertSQL = 'Insert into IBXTEST(TABLEKEY, F1) VALUES(GEN_ID(IBXGEN,1),?) Returning TABLEKEY';
71	SelectSQL = 'Select TABLEKEY, F1 From IBXTest';
72
73	{ TTest6 }
74
75	procedure TTest6.HandleCreateDatebase(Sender: TObject);
76	begin
77	InitialiseDatabase(FIBDatabase2);
78	end;
79
80	procedure TTest6.CreateObjects(Application: TTestApplication);
81	begin
82	inherited CreateObjects(Application);
83	FIBDatabase2 := TIBDatabase.Create(Application);
84	FIBDatabase2.FirebirdLibraryPathName := Owner.ClientLibraryPath;
85	FIBDatabase2.LoginPrompt := false;
86	FIBDatabase2.Params.Add('user_name=' + Owner.GetUserName);
87	FIBDatabase2.Params.Add('password=' + Owner.GetPassword);
88	FIBDatabase2.Params.Add('lc_ctype=UTF8');
89	FIBDatabase2.OnCreateDatabase := @HandleCreateDatebase;
90	FIBDatabase2.Name := 'Test_Database2_' + GetTestID;
91	FIBTransaction2 := TIBTransaction.Create(Application);
92	FIBTransaction2.DefaultDatabase := FIBDatabase2;
93	FIBDatabase2.DefaultTransaction := FIBTransaction2;
94	FIBTransaction2.Name := 'Test_Transaction2_' + GetTestID;
95	FIBTransaction2.Params.Add('concurrency');
96	FIBTransaction2.Params.Add('wait');
97	FIBTransaction2.Params.Add('write');
98	FIBMultiTransaction := TIBTransaction.Create(Application);
99	FIBMultiTransaction.AddDatabase(IBDatabase);
100	FIBMultiTransaction.AddDatabase(FIBDatabase2);
101	FIBMultiTransaction.Name := 'Multi_Transaction';
102	FIBMultiTransaction.Params.Add('concurrency');
103	FIBMultiTransaction.Params.Add('wait');
104	FIBMultiTransaction.Params.Add('write');
105	FIBSQL := TIBSQL.Create(Application);
106	FIBSQL.ParamCheck := false;
107	end;
108
109	function TTest6.GetTestID: AnsiString;
110	begin
111	Result := aTestID;
112	end;
113
114	function TTest6.GetTestTitle: AnsiString;
115	begin
116	Result := aTestTitle;
117	end;
118
119	procedure TTest6.InitTest;
120	begin
121	IBDatabase.DatabaseName := Owner.GetNewDatabaseName;
122	IBDatabase.CreateIfNotExists := true;
123	ReadWriteTransaction;
124	FIBDatabase2.DatabaseName := Owner.GetSecondNewDatabaseName;
125	FIBDatabase2.CreateIfNotExists := true;
126	end;
127
128	procedure TTest6.RunTest(CharSet: AnsiString; SQLDialect: integer);
129	begin
130	try
131	IBDatabase.Connected := true;
132	FIBDatabase2.Connected := true;
133	FIBMultiTransaction.Active := true;
134	FIBSQL.Database := IBDatabase;
135	FIBSQL.Transaction := FIBMultiTransaction;
136	FIBSQL.SQL.Text := InsertSQL;
137	FIBSQL.Params[0].AsInteger := 1;
138	writeln(OutFile,'Add Row to First Database');
139	FIBSQL.ExecQuery;
140	ReportResult(FIBSQL.Current);
141	FIBSQL.Database := FIBDatabase2;
142	FIBSQL.Params[0].AsInteger := 2;
143	writeln(OutFile,'Add Row to Second Database');
144	FIBSQL.ExecQuery;
145	ReportResult(FIBSQL.Current);
146	FIBMultiTransaction.Commit;
147	FIBSQL.Database := IBDatabase;
148	FIBSQL.Transaction := IBTransaction;
149	FIBSQL.SQL.Text := SelectSQL;
150	IBTransaction.Active := true;
151	FIBSQL.Prepare;
152	writeln(OutFile,'Query First Database');
153	ReportResults(FIBSQL.Statement);
154	FIBSQL.Database := FIBDatabase2;
155	FIBSQL.Transaction := FIBTransaction2;
156	FIBTransaction2.Active := true;
157	FIBSQL.Prepare;
158	writeln(OutFile,'Query Second Database');
159	ReportResults(FIBSQL.Statement);
160	finally
161	IBDatabase.DropDatabase;
162	FIBDatabase2.DropDatabase;
163	end;
164	end;
165
166	initialization
167	RegisterTest(TTest6);
168
169	end.
170