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:	323
Committed:	Thu Feb 25 12:14:35 2021 UTC (3 years, 8 months ago) by tony
Content type:	text/x-pascal
File size:	5113 byte(s)
Log Message:	Fixed Merged
#	User	Rev	Content
1	tony	323	(*
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	tony	315	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