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);
  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;
  DPB.Add(isc_dpb_set_db_SQL_dialect).AsByte := SQLDialect;

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

initialization
  RegisterTest(TTest3);

end.

Revision:	315
Committed:	Thu Feb 25 11:56:36 2021 UTC (3 years, 1 month ago) by tony
Content type:	text/x-pascal
File size:	5811 byte(s)
Log Message:	Updated for IBX 4 release
#	User	Rev	Content
1	tony	315	(*
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	tony	45	unit Test3;
30	tony	56	{$IFDEF MSWINDOWS}
31			{$DEFINE WINDOWS}
32			{$ENDIF}
33	tony	45
34	tony	56	{$IFDEF FPC}
35			{$mode delphi}
36	tony	45	{$codepage utf8}
37	tony	56	{$ENDIF}
38	tony	45
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	tony	315	Classes, SysUtils, TestApplication, FBTestApp, IB;
62	tony	45
63			type
64			{ TTest3 }
65
66	tony	315	TTest3 = class(TFBTestBase)
67	tony	45	private
68			procedure DoQuery(Attachment: IAttachment);
69			public
70	tony	56	function TestTitle: AnsiString; override;
71			procedure RunTest(CharSet: AnsiString; SQLDialect: integer); override;
72	tony	45	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	tony	70	us: UnicodeString;
85	tony	45	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			Attachment.ExecuteSQL(Transaction, 'Execute Procedure DELETE_EMPLOYEE ?', [8]);
96
97			ResultSet := Attachment.OpenCursorAtStart(
98			Transaction,
99			'Select count(*) from EMPLOYEE',3);
100
101			writeln(OutFile,'Employee Count = ',ResultSet[0].AsInteger);
102
103			ResultSet := Attachment.OpenCursorAtStart('Select count(*) from EMPLOYEE');
104			writeln(OutFile,'Employee Count = ',ResultSet[0].AsInteger);
105
106	tony	56	{$IFNDEF FPC}
107			Transaction.Rollback; {Delphi does not dispose of interfaces until the end of the function
108			so we need to explicitly rollback here. FPC will dispose of the
109			interface as soon as it is overwritten - hence this is not needed.}
110			{$ENDIF}
111	tony	45	Transaction := Attachment.StartTransaction([isc_tpb_write,isc_tpb_nowait,isc_tpb_concurrency],taRollback);
112			Statement := Attachment.PrepareWithNamedParameters(Transaction,'Execute Procedure DELETE_EMPLOYEE :EMP_NO',3);
113			Statement.GetSQLParams.ByName('EMP_NO').AsInteger := 8;
114			Statement.Execute;
115
116			ResultSet := Attachment.OpenCursorAtStart(
117			Transaction,
118			'Select count(*) from EMPLOYEE',3);
119
120			writeln(OutFile,'Employee Count = ',ResultSet[0].AsInteger);
121
122			Transaction := nil; {implicit rollback}
123
124
125			writeln(OutFile,'Employee Count = ',Attachment.OpenCursorAtStart(
126			Attachment.StartTransaction([isc_tpb_read,isc_tpb_nowait,isc_tpb_concurrency],taCommit),
127			'Select count(*) As Counter from EMPLOYEE',3)[0].AsInteger);
128
129			writeln(OutFile,'Constrained Employee Count = ',Attachment.OpenCursorAtStart(
130			Attachment.StartTransaction([isc_tpb_read,isc_tpb_nowait,isc_tpb_concurrency],taCommit),
131			'Select count(*) As Counter from EMPLOYEE Where EMP_NO < ?',3,[8])[0].AsInteger);
132
133	tony	70	writeln(OutFile,'"Johnson" Employee Count = ',Attachment.OpenCursorAtStart(
134			Attachment.StartTransaction([isc_tpb_read,isc_tpb_nowait,isc_tpb_concurrency],taCommit),
135			'Select count(*) As Counter from EMPLOYEE Where LAST_NAME = ?',3,['Johnson'])[0].AsInteger);
136
137			us := UTF8Decode('Yanowski'); {Test a UnicodeString as a parameter}
138
139			writeln(OutFile,'"Yanowski" Employee Count = ',Attachment.OpenCursorAtStart(
140			Attachment.StartTransaction([isc_tpb_read,isc_tpb_nowait,isc_tpb_concurrency],taCommit),
141			'Select count(*) As Counter from EMPLOYEE Where LAST_NAME = ?',3,[us])[0].AsInteger);
142
143	tony	45	end;
144
145	tony	56	function TTest3.TestTitle: AnsiString;
146	tony	45	begin
147			Result := 'Test 3: ad hoc queries';
148			end;
149
150	tony	56	procedure TTest3.RunTest(CharSet: AnsiString; SQLDialect: integer);
151	tony	45	var Attachment: IAttachment;
152			DPB: IDPB;
153			begin
154			DPB := FirebirdAPI.AllocateDPB;
155			DPB.Add(isc_dpb_user_name).AsString := Owner.GetUserName;
156			DPB.Add(isc_dpb_password).AsString := Owner.GetPassword;
157			DPB.Add(isc_dpb_lc_ctype).AsString := CharSet;
158			DPB.Add(isc_dpb_set_db_SQL_dialect).AsByte := SQLDialect;
159
160			writeln(OutFile,'Opening ',Owner.GetEmployeeDatabaseName);
161			Attachment := FirebirdAPI.OpenDatabase(Owner.GetEmployeeDatabaseName,DPB);
162			writeln(OutFile,'Database Open');
163			DoQuery(Attachment);
164			end;
165
166			initialization
167			RegisterTest(TTest3);
168
169			end.
170