fbintf/testsuite/Test2.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 Test2;
{$IFDEF MSWINDOWS} 
{$DEFINE WINDOWS} 
{$ENDIF}

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

{Test 2: Open the employee database and run a query}

{ This test opens the employee example databases with the supplied user name/password
  and runs a simple query with no parameters. Note that the password parameter
  is first supplied empty and then updated.

  Both the output metadata and the query plan are printed out, followed by the results of the query.

  A specific employee record is then queried, first using a positional parameter
  and then a parameter by name. In each case, the SQL Parameter metadata is also
  printed followed by the query results.

  Finally, the database is explicitly disconnected.
}

interface

uses
  Classes, SysUtils, TestApplication, FBTestApp, IB;

type

{ TTest2 }

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


implementation

{ TTest2 }

procedure TTest2.DoQuery(Attachment: IAttachment);
var Transaction: ITransaction;
    Statement: IStatement;
begin
    Transaction := Attachment.StartTransaction([isc_tpb_read,isc_tpb_nowait,isc_tpb_concurrency],taCommit);
    PrintTPB(Transaction.getTPB);
    Statement := Attachment.Prepare(Transaction,
    '-- SQL style inline comment' + LineEnding +
    '/* this is a comment */ '+
    'Select First 3 * from EMPLOYEE'
    ,3);
    PrintMetaData(Statement.GetMetaData);
    writeln(OutFile,'Plan = ' ,Statement.GetPlan);
    writeln(OutFile,Statement.GetSQLText);
    writeln(OutFile);
    ReportResults(Statement);
    Statement := Attachment.Prepare(Transaction,'Select * from EMPLOYEE Where EMP_NO = ?',3);
    writeln(OutFile,Statement.GetSQLText);
    ParamInfo(Statement.SQLParams);
    Statement.GetSQLParams[0].AsInteger := 8;
    ReportResults(Statement);
    writeln(OutFile,'With param names');
    Statement := Attachment.PrepareWithNamedParameters(Transaction,
    'Select * from EMPLOYEE Where EMP_NO = :EMP_NO',3,false,false,'Test Cursor');
    Statement.SetRetainInterfaces(true);
    try
      writeln(OutFile,Statement.GetSQLText);
      ParamInfo(Statement.SQLParams);
      Statement.GetSQLParams.ByName('EMP_NO').AsInteger := 8;
      ReportResults(Statement,true);
    finally
      Statement.SetRetainInterfaces(false);
    end;
end;

procedure TTest2.DoScrollableQuery(Attachment: IAttachment);
var Transaction: ITransaction;
    Statement: IStatement;
    Results: IResultSet;
begin
  writeln(Outfile,'Scollable Cursors');
  WriteAttachmentInfo(Attachment);
  Transaction := Attachment.StartTransaction([isc_tpb_read,isc_tpb_nowait,isc_tpb_concurrency],taCommit);
  Statement := Attachment.Prepare(Transaction,'Select * from EMPLOYEE order by EMP_NO',3);
  Results := Statement.OpenCursor(true);
  writeln(Outfile,'Do Fetch Next:');
  if Results.FetchNext then
    ReportResult(Results);
  writeln(Outfile,'Do Fetch Last:');
  if Results.FetchLast then
    ReportResult(Results);
  writeln(Outfile,'Do Fetch Prior:');
  if Results.FetchPrior then
    ReportResult(Results);
  writeln(Outfile,'Do Fetch First:');
  if Results.FetchFirst then
    ReportResult(Results);
  writeln(Outfile,'Do Fetch Abs 8 :');
  if Results.FetchAbsolute(8) then
    ReportResult(Results);
  writeln(Outfile,'Do Fetch Relative -2 :');
  if Results.FetchRelative(-2) then
    ReportResult(Results);
  writeln(Outfile,'Do Fetch beyond EOF :');
  if Results.FetchAbsolute(150) then
      ReportResult(Results)
  else
    writeln(Outfile,'Fetch returned false');
end;

function TTest2.TestTitle: AnsiString;
begin
  Result := 'Test 2: Open the employee database and run a query';
end;

procedure TTest2.RunTest(CharSet: AnsiString; SQLDialect: integer);
var Attachment: IAttachment;
    DPB: IDPB;
begin
  DPB := FirebirdAPI.AllocateDPB;
  DPB.Add(isc_dpb_user_name).setAsString(Owner.GetUserName);
  DPB.Add(isc_dpb_password).setAsString(' ');
  DPB.Add(isc_dpb_lc_ctype).setAsString(CharSet);
  DPB.Add(isc_dpb_set_db_SQL_dialect).setAsByte(SQLDialect);
  try
    Attachment := FirebirdAPI.OpenDatabase(Owner.GetEmployeeDatabaseName,DPB);
  except on e: Exception do
    writeln(OutFile,'Open Database fails ',E.Message);
  end;
  DPB.Find(isc_dpb_password).setAsString(Owner.GetPassword);
  writeln(OutFile,'Opening ',Owner.GetEmployeeDatabaseName);
  Attachment := FirebirdAPI.OpenDatabase(Owner.GetEmployeeDatabaseName,DPB);
  writeln(OutFile,'Database Open, SQL Dialect = ',Attachment.GetSQLDialect);
  DoQuery(Attachment);
  if Attachment.HasScollableCursors then
  try
    DoScrollableQuery(Attachment);
  except on e: Exception do
    writeln(OutFile,'Remote Scrollable cursors test fails ',E.Message);
  end;
  Attachment.Disconnect;
  writeln(OutFile,'Now open the employee database as a local database');
  DPB := FirebirdAPI.AllocateDPB;
  DPB.Add(isc_dpb_lc_ctype).setAsString(CharSet);
  DPB.Add(isc_dpb_set_db_SQL_dialect).setAsByte(SQLDialect);
  DPB.Add(isc_dpb_user_name).setAsString(Owner.GetUserName);
  if FirebirdAPI.GetClientMajor < 3 then
    DPB.Add(isc_dpb_password).setAsString(Owner.GetPassword);
  try
    Attachment := FirebirdAPI.OpenDatabase(ExtractDBName(Owner.GetEmployeeDatabaseName),DPB);
  except on e: Exception do
    writeln(OutFile,'Open Local Database fails ',E.Message);
  end;
  DoQuery(Attachment);
  if Attachment.HasScollableCursors then
    DoScrollableQuery(Attachment);
  Attachment.Disconnect;
end;

initialization
  RegisterTest(TTest2);

end.

Revision:	359
Committed:	Tue Dec 7 09:37:32 2021 UTC (2 years, 11 months ago) by tony
Content type:	text/x-pascal
File size:	6608 byte(s)
Log Message:	Fixes Merged
#	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 Test2;
30	{$IFDEF MSWINDOWS}
31	{$DEFINE WINDOWS}
32	{$ENDIF}
33
34	{$IFDEF FPC}
35	{$mode delphi}
36	{$codepage utf8}
37	{$ENDIF}
38
39	{Test 2: Open the employee database and run a query}
40
41	{ This test opens the employee example databases with the supplied user name/password
42	and runs a simple query with no parameters. Note that the password parameter
43	is first supplied empty and then updated.
44
45	Both the output metadata and the query plan are printed out, followed by the results of the query.
46
47	A specific employee record is then queried, first using a positional parameter
48	and then a parameter by name. In each case, the SQL Parameter metadata is also
49	printed followed by the query results.
50
51	Finally, the database is explicitly disconnected.
52	}
53
54	interface
55
56	uses
57	Classes, SysUtils, TestApplication, FBTestApp, IB;
58
59	type
60
61	{ TTest2 }
62
63	TTest2 = class(TFBTestBase)
64	private
65	procedure DoQuery(Attachment: IAttachment);
66	procedure DoScrollableQuery(Attachment: IAttachment);
67	public
68	function TestTitle: AnsiString; override;
69	procedure RunTest(CharSet: AnsiString; SQLDialect: integer); override;
70	end;
71
72
73	implementation
74
75	{ TTest2 }
76
77	procedure TTest2.DoQuery(Attachment: IAttachment);
78	var Transaction: ITransaction;
79	Statement: IStatement;
80	begin
81	Transaction := Attachment.StartTransaction([isc_tpb_read,isc_tpb_nowait,isc_tpb_concurrency],taCommit);
82	PrintTPB(Transaction.getTPB);
83	Statement := Attachment.Prepare(Transaction,
84	'-- SQL style inline comment' + LineEnding +
85	'/* this is a comment */ '+
86	'Select First 3 * from EMPLOYEE'
87	,3);
88	PrintMetaData(Statement.GetMetaData);
89	writeln(OutFile,'Plan = ' ,Statement.GetPlan);
90	writeln(OutFile,Statement.GetSQLText);
91	writeln(OutFile);
92	ReportResults(Statement);
93	Statement := Attachment.Prepare(Transaction,'Select * from EMPLOYEE Where EMP_NO = ?',3);
94	writeln(OutFile,Statement.GetSQLText);
95	ParamInfo(Statement.SQLParams);
96	Statement.GetSQLParams[0].AsInteger := 8;
97	ReportResults(Statement);
98	writeln(OutFile,'With param names');
99	Statement := Attachment.PrepareWithNamedParameters(Transaction,
100	'Select * from EMPLOYEE Where EMP_NO = :EMP_NO',3,false,false,'Test Cursor');
101	Statement.SetRetainInterfaces(true);
102	try
103	writeln(OutFile,Statement.GetSQLText);
104	ParamInfo(Statement.SQLParams);
105	Statement.GetSQLParams.ByName('EMP_NO').AsInteger := 8;
106	ReportResults(Statement,true);
107	finally
108	Statement.SetRetainInterfaces(false);
109	end;
110	end;
111
112	procedure TTest2.DoScrollableQuery(Attachment: IAttachment);
113	var Transaction: ITransaction;
114	Statement: IStatement;
115	Results: IResultSet;
116	begin
117	writeln(Outfile,'Scollable Cursors');
118	WriteAttachmentInfo(Attachment);
119	Transaction := Attachment.StartTransaction([isc_tpb_read,isc_tpb_nowait,isc_tpb_concurrency],taCommit);
120	Statement := Attachment.Prepare(Transaction,'Select * from EMPLOYEE order by EMP_NO',3);
121	Results := Statement.OpenCursor(true);
122	writeln(Outfile,'Do Fetch Next:');
123	if Results.FetchNext then
124	ReportResult(Results);
125	writeln(Outfile,'Do Fetch Last:');
126	if Results.FetchLast then
127	ReportResult(Results);
128	writeln(Outfile,'Do Fetch Prior:');
129	if Results.FetchPrior then
130	ReportResult(Results);
131	writeln(Outfile,'Do Fetch First:');
132	if Results.FetchFirst then
133	ReportResult(Results);
134	writeln(Outfile,'Do Fetch Abs 8 :');
135	if Results.FetchAbsolute(8) then
136	ReportResult(Results);
137	writeln(Outfile,'Do Fetch Relative -2 :');
138	if Results.FetchRelative(-2) then
139	ReportResult(Results);
140	writeln(Outfile,'Do Fetch beyond EOF :');
141	if Results.FetchAbsolute(150) then
142	ReportResult(Results)
143	else
144	writeln(Outfile,'Fetch returned false');
145	end;
146
147	function TTest2.TestTitle: AnsiString;
148	begin
149	Result := 'Test 2: Open the employee database and run a query';
150	end;
151
152	procedure TTest2.RunTest(CharSet: AnsiString; SQLDialect: integer);
153	var Attachment: IAttachment;
154	DPB: IDPB;
155	begin
156	DPB := FirebirdAPI.AllocateDPB;
157	DPB.Add(isc_dpb_user_name).setAsString(Owner.GetUserName);
158	DPB.Add(isc_dpb_password).setAsString(' ');
159	DPB.Add(isc_dpb_lc_ctype).setAsString(CharSet);
160	DPB.Add(isc_dpb_set_db_SQL_dialect).setAsByte(SQLDialect);
161	try
162	Attachment := FirebirdAPI.OpenDatabase(Owner.GetEmployeeDatabaseName,DPB);
163	except on e: Exception do
164	writeln(OutFile,'Open Database fails ',E.Message);
165	end;
166	DPB.Find(isc_dpb_password).setAsString(Owner.GetPassword);
167	writeln(OutFile,'Opening ',Owner.GetEmployeeDatabaseName);
168	Attachment := FirebirdAPI.OpenDatabase(Owner.GetEmployeeDatabaseName,DPB);
169	writeln(OutFile,'Database Open, SQL Dialect = ',Attachment.GetSQLDialect);
170	DoQuery(Attachment);
171	if Attachment.HasScollableCursors then
172	try
173	DoScrollableQuery(Attachment);
174	except on e: Exception do
175	writeln(OutFile,'Remote Scrollable cursors test fails ',E.Message);
176	end;
177	Attachment.Disconnect;
178	writeln(OutFile,'Now open the employee database as a local database');
179	DPB := FirebirdAPI.AllocateDPB;
180	DPB.Add(isc_dpb_lc_ctype).setAsString(CharSet);
181	DPB.Add(isc_dpb_set_db_SQL_dialect).setAsByte(SQLDialect);
182	DPB.Add(isc_dpb_user_name).setAsString(Owner.GetUserName);
183	if FirebirdAPI.GetClientMajor < 3 then
184	DPB.Add(isc_dpb_password).setAsString(Owner.GetPassword);
185	try
186	Attachment := FirebirdAPI.OpenDatabase(ExtractDBName(Owner.GetEmployeeDatabaseName),DPB);
187	except on e: Exception do
188	writeln(OutFile,'Open Local Database fails ',E.Message);
189	end;
190	DoQuery(Attachment);
191	if Attachment.HasScollableCursors then
192	DoScrollableQuery(Attachment);
193	Attachment.Disconnect;
194	end;
195
196	initialization
197	RegisterTest(TTest2);
198
199	end.
200