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,
                                                            fb_info_tra_dbpath,
                                                            isc_info_tra_access,
                                                            isc_info_tra_isolation]));
  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:	380
Committed:	Mon Jan 10 10:13:17 2022 UTC (2 years, 11 months ago) by tony
Content type:	text/x-pascal
File size:	6777 byte(s)
Log Message:	propset for eol-style
#	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	tony	359	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			fb_info_tra_dbpath,
107			isc_info_tra_access,
108			isc_info_tra_isolation]));
109	tony	45	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	tony	56	{$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	tony	45	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	tony	70	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	tony	45	end;
158
159	tony	56	function TTest3.TestTitle: AnsiString;
160	tony	45	begin
161			Result := 'Test 3: ad hoc queries';
162			end;
163
164	tony	56	procedure TTest3.RunTest(CharSet: AnsiString; SQLDialect: integer);
165	tony	45	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			DPB.Add(isc_dpb_set_db_SQL_dialect).AsByte := SQLDialect;
173
174			writeln(OutFile,'Opening ',Owner.GetEmployeeDatabaseName);
175			Attachment := FirebirdAPI.OpenDatabase(Owner.GetEmployeeDatabaseName,DPB);
176			writeln(OutFile,'Database Open');
177			DoQuery(Attachment);
178			end;
179
180			initialization
181			RegisterTest(TTest3);
182
183			end.
184