fbintf/testsuite/Test3.pas

(*
 *  Firebird Interface (fbintf) Test suite. This program is used to
 *  test the Firebird Pascal Interface and provide 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) 2016 Tony Whyman, MWA Software
 *  (http://www.mwasoftware.co.uk).
 *
 *  All Rights Reserved.
 *
 *  Contributor(s): ______________________________________.
 *
*)

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

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

{ Test 3: ad hoc queries}

{ This test opens the employee example databases with the supplied user name/password
  and runs several queries:

  1. The convenience function OpenCursorAtStart is used to return a count of the
     records in the employee database. This creates its own read only transaction.

  2. A parameterised query is used to delete a record. The record count is repeated
     using the same transaction as the deletion. The transaction is rolled back.

  3. Rollback is demonstrated by returning a record count. This time creating the
     transaction in place.

  4. The above two steps are repeated but with a named parameter ad an implicit end to the transaction.

  5. Note implicit disconnect on end
}

interface

uses
  Classes, SysUtils, TestApplication, FBTestApp, IB;

type
  { TTest3 }

  TTest3 = class(TFBTestBase)
  private
    procedure DoQuery(Attachment: IAttachment);
  public
    function TestTitle: AnsiString; override;
    procedure RunTest(CharSet: AnsiString; SQLDialect: integer); override;
  end;


implementation

{ TTest3 }

procedure TTest3.DoQuery(Attachment: IAttachment);
var Transaction: ITransaction;
    ResultSet: IResultSet;
    Statement: IStatement;
    TPB: ITPB;
    us: UnicodeString;
begin
  writeln(OutFile,'Employee Count = ',Attachment.OpenCursorAtStart('Select count(*) from EMPLOYEE')[0].AsInteger);

  TPB := FirebirdAPI.AllocateTPB;
  TPB.Add(isc_tpb_write);
  TPB.Add(isc_tpb_nowait);
  TPB.Add(isc_tpb_concurrency);
  TPB.Add(isc_tpb_lock_read).AsString := 'EMPLOYEE';
  TPB.Add(isc_tpb_protected);
  Transaction := Attachment.StartTransaction(TPB,taRollback);
  writeln(OutFile,'Transaction ID = ',Transaction.GetTransactionID);
  if Transaction.GetIsReadOnly then
    writeln(OutFile,'Transaction is Read Only')
  else
    writeln(OutFile,'Transaction is Read/Write');
  writeTRInfo(Transaction.GetTrInformation([isc_info_tra_id,
                                                            isc_info_tra_oldest_interesting,
                                                            isc_info_tra_oldest_active,
                                                            isc_info_tra_oldest_snapshot,
                                                            fb_info_tra_snapshot_number,
                                                            isc_info_tra_lock_timeout,
                                                            isc_info_tra_access,
                                                            isc_info_tra_isolation,
                                                            fb_info_tra_dbpath]));
  Attachment.ExecuteSQL(Transaction, 'Execute Procedure DELETE_EMPLOYEE ?', [8]);

  ResultSet := Attachment.OpenCursorAtStart(
         Transaction,
         'Select count(*) from EMPLOYEE',3);

  writeln(OutFile,'Employee Count = ',ResultSet[0].AsInteger);

  ResultSet := Attachment.OpenCursorAtStart('Select count(*) from EMPLOYEE');
  writeln(OutFile,'Employee Count = ',ResultSet[0].AsInteger);

  {$IFNDEF FPC}
  Transaction.Rollback; {Delphi does not dispose of interfaces until the end of the function
                         so we need to explicitly rollback here. FPC will dispose of the
                         interface as soon as it is overwritten - hence this is not needed.}
  {$ENDIF}
  Transaction := Attachment.StartTransaction([isc_tpb_write,isc_tpb_nowait,isc_tpb_concurrency],taRollback);
  Statement := Attachment.PrepareWithNamedParameters(Transaction,'Execute Procedure DELETE_EMPLOYEE :EMP_NO',3);
  Statement.GetSQLParams.ByName('EMP_NO').AsInteger := 8;
  Statement.Execute;

  ResultSet := Attachment.OpenCursorAtStart(
         Transaction,
         'Select count(*) from EMPLOYEE',3);

  writeln(OutFile,'Employee Count = ',ResultSet[0].AsInteger);

  Transaction := nil; {implicit rollback}


  writeln(OutFile,'Employee Count = ',Attachment.OpenCursorAtStart(
         Attachment.StartTransaction([isc_tpb_read,isc_tpb_nowait,isc_tpb_concurrency],taCommit),
         'Select count(*) As Counter from EMPLOYEE',3)[0].AsInteger);

  writeln(OutFile,'Constrained Employee Count = ',Attachment.OpenCursorAtStart(
         Attachment.StartTransaction([isc_tpb_read,isc_tpb_nowait,isc_tpb_concurrency],taCommit),
         'Select count(*) As Counter from EMPLOYEE Where EMP_NO < ?',3,[8])[0].AsInteger);

  writeln(OutFile,'"Johnson" Employee Count = ',Attachment.OpenCursorAtStart(
         Attachment.StartTransaction([isc_tpb_read,isc_tpb_nowait,isc_tpb_concurrency],taCommit),
         'Select count(*) As Counter from EMPLOYEE Where LAST_NAME = ?',3,['Johnson'])[0].AsInteger);

  us := UTF8Decode('Yanowski');   {Test a UnicodeString as a parameter}

  writeln(OutFile,'"Yanowski" Employee Count = ',Attachment.OpenCursorAtStart(
         Attachment.StartTransaction([isc_tpb_read,isc_tpb_nowait,isc_tpb_concurrency],taCommit),
         'Select count(*) As Counter from EMPLOYEE Where LAST_NAME = ?',3,[us])[0].AsInteger);

end;

function TTest3.TestTitle: AnsiString;
begin
  Result := 'Test 3: ad hoc queries';
end;

procedure TTest3.RunTest(CharSet: AnsiString; SQLDialect: integer);
var Attachment: IAttachment;
    DPB: IDPB;
begin
  DPB := FirebirdAPI.AllocateDPB;
  DPB.Add(isc_dpb_user_name).AsString := Owner.GetUserName;
  DPB.Add(isc_dpb_password).AsString := Owner.GetPassword;
  DPB.Add(isc_dpb_lc_ctype).AsString := CharSet;

  writeln(OutFile,'Opening ',Owner.GetEmployeeDatabaseName);
  Attachment := FirebirdAPI.OpenDatabase(Owner.GetEmployeeDatabaseName,DPB);
  writeln(OutFile,'Database Open');
  DoQuery(Attachment);
end;

initialization
  RegisterTest(TTest3);

end.

Revision:	402
Committed:	Mon Aug 1 10:07:24 2022 UTC (2 years, 4 months ago) by tony
Content type:	text/x-pascal
File size:	6717 byte(s)
Log Message:	IBX Release 2.5.0
#	Content
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 Test3;
30	{$IFDEF MSWINDOWS}
31	{$DEFINE WINDOWS}
32	{$ENDIF}
33
34	{$IFDEF FPC}
35	{$mode delphi}
36	{$codepage utf8}
37	{$ENDIF}
38
39	{ Test 3: ad hoc queries}
40
41	{ This test opens the employee example databases with the supplied user name/password
42	and runs several queries:
43
44	1. The convenience function OpenCursorAtStart is used to return a count of the
45	records in the employee database. This creates its own read only transaction.
46
47	2. A parameterised query is used to delete a record. The record count is repeated
48	using the same transaction as the deletion. The transaction is rolled back.
49
50	3. Rollback is demonstrated by returning a record count. This time creating the
51	transaction in place.
52
53	4. The above two steps are repeated but with a named parameter ad an implicit end to the transaction.
54
55	5. Note implicit disconnect on end
56	}
57
58	interface
59
60	uses
61	Classes, SysUtils, TestApplication, FBTestApp, IB;
62
63	type
64	{ TTest3 }
65
66	TTest3 = class(TFBTestBase)
67	private
68	procedure DoQuery(Attachment: IAttachment);
69	public
70	function TestTitle: AnsiString; override;
71	procedure RunTest(CharSet: AnsiString; SQLDialect: integer); override;
72	end;
73
74
75	implementation
76
77	{ TTest3 }
78
79	procedure TTest3.DoQuery(Attachment: IAttachment);
80	var Transaction: ITransaction;
81	ResultSet: IResultSet;
82	Statement: IStatement;
83	TPB: ITPB;
84	us: UnicodeString;
85	begin
86	writeln(OutFile,'Employee Count = ',Attachment.OpenCursorAtStart('Select count(*) from EMPLOYEE')[0].AsInteger);
87
88	TPB := FirebirdAPI.AllocateTPB;
89	TPB.Add(isc_tpb_write);
90	TPB.Add(isc_tpb_nowait);
91	TPB.Add(isc_tpb_concurrency);
92	TPB.Add(isc_tpb_lock_read).AsString := 'EMPLOYEE';
93	TPB.Add(isc_tpb_protected);
94	Transaction := Attachment.StartTransaction(TPB,taRollback);
95	writeln(OutFile,'Transaction ID = ',Transaction.GetTransactionID);
96	if Transaction.GetIsReadOnly then
97	writeln(OutFile,'Transaction is Read Only')
98	else
99	writeln(OutFile,'Transaction is Read/Write');
100	writeTRInfo(Transaction.GetTrInformation([isc_info_tra_id,
101	isc_info_tra_oldest_interesting,
102	isc_info_tra_oldest_active,
103	isc_info_tra_oldest_snapshot,
104	fb_info_tra_snapshot_number,
105	isc_info_tra_lock_timeout,
106	isc_info_tra_access,
107	isc_info_tra_isolation,
108	fb_info_tra_dbpath]));
109	Attachment.ExecuteSQL(Transaction, 'Execute Procedure DELETE_EMPLOYEE ?', [8]);
110
111	ResultSet := Attachment.OpenCursorAtStart(
112	Transaction,
113	'Select count(*) from EMPLOYEE',3);
114
115	writeln(OutFile,'Employee Count = ',ResultSet[0].AsInteger);
116
117	ResultSet := Attachment.OpenCursorAtStart('Select count(*) from EMPLOYEE');
118	writeln(OutFile,'Employee Count = ',ResultSet[0].AsInteger);
119
120	{$IFNDEF FPC}
121	Transaction.Rollback; {Delphi does not dispose of interfaces until the end of the function
122	so we need to explicitly rollback here. FPC will dispose of the
123	interface as soon as it is overwritten - hence this is not needed.}
124	{$ENDIF}
125	Transaction := Attachment.StartTransaction([isc_tpb_write,isc_tpb_nowait,isc_tpb_concurrency],taRollback);
126	Statement := Attachment.PrepareWithNamedParameters(Transaction,'Execute Procedure DELETE_EMPLOYEE :EMP_NO',3);
127	Statement.GetSQLParams.ByName('EMP_NO').AsInteger := 8;
128	Statement.Execute;
129
130	ResultSet := Attachment.OpenCursorAtStart(
131	Transaction,
132	'Select count(*) from EMPLOYEE',3);
133
134	writeln(OutFile,'Employee Count = ',ResultSet[0].AsInteger);
135
136	Transaction := nil; {implicit rollback}
137
138
139	writeln(OutFile,'Employee Count = ',Attachment.OpenCursorAtStart(
140	Attachment.StartTransaction([isc_tpb_read,isc_tpb_nowait,isc_tpb_concurrency],taCommit),
141	'Select count(*) As Counter from EMPLOYEE',3)[0].AsInteger);
142
143	writeln(OutFile,'Constrained Employee Count = ',Attachment.OpenCursorAtStart(
144	Attachment.StartTransaction([isc_tpb_read,isc_tpb_nowait,isc_tpb_concurrency],taCommit),
145	'Select count(*) As Counter from EMPLOYEE Where EMP_NO < ?',3,[8])[0].AsInteger);
146
147	writeln(OutFile,'"Johnson" Employee Count = ',Attachment.OpenCursorAtStart(
148	Attachment.StartTransaction([isc_tpb_read,isc_tpb_nowait,isc_tpb_concurrency],taCommit),
149	'Select count(*) As Counter from EMPLOYEE Where LAST_NAME = ?',3,['Johnson'])[0].AsInteger);
150
151	us := UTF8Decode('Yanowski'); {Test a UnicodeString as a parameter}
152
153	writeln(OutFile,'"Yanowski" Employee Count = ',Attachment.OpenCursorAtStart(
154	Attachment.StartTransaction([isc_tpb_read,isc_tpb_nowait,isc_tpb_concurrency],taCommit),
155	'Select count(*) As Counter from EMPLOYEE Where LAST_NAME = ?',3,[us])[0].AsInteger);
156
157	end;
158
159	function TTest3.TestTitle: AnsiString;
160	begin
161	Result := 'Test 3: ad hoc queries';
162	end;
163
164	procedure TTest3.RunTest(CharSet: AnsiString; SQLDialect: integer);
165	var Attachment: IAttachment;
166	DPB: IDPB;
167	begin
168	DPB := FirebirdAPI.AllocateDPB;
169	DPB.Add(isc_dpb_user_name).AsString := Owner.GetUserName;
170	DPB.Add(isc_dpb_password).AsString := Owner.GetPassword;
171	DPB.Add(isc_dpb_lc_ctype).AsString := CharSet;
172
173	writeln(OutFile,'Opening ',Owner.GetEmployeeDatabaseName);
174	Attachment := FirebirdAPI.OpenDatabase(Owner.GetEmployeeDatabaseName,DPB);
175	writeln(OutFile,'Database Open');
176	DoQuery(Attachment);
177	end;
178
179	initialization
180	RegisterTest(TTest3);
181
182	end.
183