trunk/testsuite/Test07.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 Test07;

{$mode objfpc}{$H+}

{Test 7: Open and read from Employee Database using TIBSQL}

{  This is a simple use of IBX to access the employee database in console mode.
  The program opens the database, runs a query and writes the result to stdout.

  If Scrollable cursors are supported then these calls are excercised.

}

interface

uses
  Classes, SysUtils, TestApplication, IBXTestBase, IB, IBCustomDataSet, IBDatabase, IBSQL;

const
  aTestID    = '07';
  aTestTitle = 'Open and read from Employee Database using IBSQL';

type

{ TTest07 }

  TTest07 = class(TIBXTestBase)
  private
    FIBSQL: TIBSQL;
    procedure DoScrollableQuery;
  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
  sqlExample =
'with recursive Depts As (   '+
'Select DEPT_NO, DEPARTMENT, HEAD_DEPT, cast(DEPARTMENT  as VarChar(256)) as DEPT_PATH,'+
'cast(DEPT_NO as VarChar(64)) as DEPT_KEY_PATH '+
'From DEPARTMENT Where HEAD_DEPT is NULL '+
'UNION ALL '+
'Select D.DEPT_NO, D.DEPARTMENT, D.HEAD_DEPT, Depts.DEPT_PATH ||  '' / '' || D.DEPARTMENT as DEPT_PATH,'+
'Depts.DEPT_KEY_PATH || '';'' || D.DEPT_NO as DEPT_KEY_PATH '+
'From DEPARTMENT D '+
'JOIN Depts On D.HEAD_DEPT = Depts.DEPT_NO '+
')'+

'Select A.EMP_NO, A.FIRST_NAME, A.LAST_NAME, A.PHONE_EXT, A.HIRE_DATE, A.DEPT_NO, A.JOB_CODE,'+
'A.JOB_GRADE, A.JOB_COUNTRY, A.SALARY, A.FULL_NAME, D.DEPT_PATH, D.DEPT_KEY_PATH '+
'From EMPLOYEE A '+
'JOIN Depts D On D.DEPT_NO = A.DEPT_NO';

  { TTest07 }

procedure TTest07.DoScrollableQuery;
begin
  with FIBSQL do
  begin
    Scrollable := true;
    GoToFirstRecordOnExecute := false;
    writeln(OutFile);
    writeln(Outfile,'Scollable Cursors');
    SQL.Text := 'Select * from EMPLOYEE order by EMP_NO';
    Transaction.Active := true;
    Prepare;
    ExecQuery;
    writeln(Outfile,'Do Fetch Next:');
    if FetchNext then
      ReportResult(Current);
    writeln(Outfile,'Do Fetch Last:');
    if FetchLast then
      ReportResult(Current);
    writeln(Outfile,'Do Fetch Prior:');
    if FetchPrior then
      ReportResult(Current);
    writeln(Outfile,'Do Fetch First:');
    if FetchFirst then
      ReportResult(Current);
    writeln(Outfile,'Do Fetch Abs 8 :');
    if FetchAbsolute(8) then
      ReportResult(Current);
    writeln(Outfile,'Do Fetch Relative -2 :');
    if FetchRelative(-2) then
      ReportResult(Current);
    writeln(Outfile,'Do Fetch beyond EOF :');
    if FetchAbsolute(150) then
        ReportResult(Current)
    else
      writeln(Outfile,'Fetch returned false');
    Close;
  end;
end;

procedure TTest07.CreateObjects(Application: TTestApplication);
begin
  inherited CreateObjects(Application);
  FIBSQL := TIBSQL.Create(Application);
  FIBSQL.Database := IBDatabase;
end;

function TTest07.GetTestID: AnsiString;
begin
  Result := aTestID;
end;

function TTest07.GetTestTitle: AnsiString;
begin
  Result := aTestTitle;
end;

procedure TTest07.InitTest;
begin
  inherited InitTest;
  IBDatabase.DatabaseName := Owner.GetEmployeeDatabaseName;
  ReadWriteTransaction;
end;

procedure TTest07.RunTest(CharSet: AnsiString; SQLDialect: integer);
var stats: TPerfCounters;
begin
  IBDatabase.Connected := true;
  with FIBSQL do
  begin
     SQL.Text := sqlExample + ' Order By 1';
     Transaction.Active := true;
     Prepare;
     PrintMetaData(MetaData);
     Statement.EnableStatistics(true);
     writeln(OutFile,Plan);
     ExecQuery;
     try
       while not EOF do
       begin
         ReportResult(Current);
         Next;
       end;
     finally
       Close;
     end;

     if Statement.GetPerfStatistics(stats) then
       WritePerfStats(stats);
     PrintAffectedRows(IBQuery);
     writeln(OutFile);
     writeln(OutFile,'------------------------------------------------------');
     writeln(OutFile,'With Named Parameter');
     SQL.Text := sqlExample + ' Where Hire_Date < :HireDate';
     Transaction.Active := true;
     ParamByName('HireDate').AsDateTime := StrToDateTime('1/1/1991');
     ExecQuery;
     try
       while not EOF do
       begin
         ReportResult(Current);
         Next;
       end;
     finally
       Close;
     end;
     writeln(OutFile);
     writeln(OutFile,'With Positional Parameter');
     ParamCheck := false;
     SQL.Text := sqlExample + ' Where Hire_Date < ?';
     Transaction.Active := true;
     Params[0].AsDateTime := StrToDateTime('1/1/1990');
     ExecQuery;
     try
       while not EOF do
       begin
         ReportResult(Current);
         Next;
       end;
     finally
       Close;
     end;

     writeln(OutFile);
     writeln(OutFile,'Get Employee Project');
     ParamCheck := true;
     Transaction.Active := true;
     SQL.Text := 'Select * From GET_EMP_PROJ(:EMP_NO)';
     ParamByName('EMP_NO').AsInteger := 4;
     PrintMetaData(MetaData);
     ExecQuery;
     try
       while not EOF do
       begin
         ReportResult(Current);
         Next;
       end;
     finally
       Close;
     end;

     writeln(OutFile);
     writeln(OutFile,'Call Delete Employee - exception expected');
     SQL.Text := 'Execute Procedure Delete_EMPLOYEE :EMP_NO';
     ParamByName('EMP_NO').AsInteger := 11;
     try
       ExecQuery;
     except on E:Exception do
       writeln(OutFile,'Terminated with Exception:',E.Message);
     end;
     Transaction.Rollback;
     if FIBSQL.HasScollableCursors then
        DoScrollableQuery;
  end;
  IBDatabase.Connected := false;
  IBDatabase.DatabaseName := ExtractDBName(Owner.GetEmployeeDatabaseName); {open as local database}
  IBDatabase.Connected := true;
  if FIBSQL.HasScollableCursors then
     DoScrollableQuery;
end;

initialization
  RegisterTest(TTest07);

end.

Revision:	353
Committed:	Sat Oct 23 14:11:37 2021 UTC (2 years, 6 months ago) by tony
Content type:	text/x-pascal
File size:	6846 byte(s)
Log Message:	Fixes 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 Test07;
28
29			{$mode objfpc}{$H+}
30
31			{Test 7: Open and read from Employee Database using TIBSQL}
32
33			{ This is a simple use of IBX to access the employee database in console mode.
34			The program opens the database, runs a query and writes the result to stdout.
35
36	tony	353	If Scrollable cursors are supported then these calls are excercised.
37
38	tony	315	}
39
40			interface
41
42			uses
43			Classes, SysUtils, TestApplication, IBXTestBase, IB, IBCustomDataSet, IBDatabase, IBSQL;
44
45			const
46			aTestID = '07';
47			aTestTitle = 'Open and read from Employee Database using IBSQL';
48
49			type
50
51			{ TTest07 }
52
53			TTest07 = class(TIBXTestBase)
54			private
55			FIBSQL: TIBSQL;
56	tony	353	procedure DoScrollableQuery;
57	tony	315	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			sqlExample =
71			'with recursive Depts As ( '+
72			'Select DEPT_NO, DEPARTMENT, HEAD_DEPT, cast(DEPARTMENT as VarChar(256)) as DEPT_PATH,'+
73			'cast(DEPT_NO as VarChar(64)) as DEPT_KEY_PATH '+
74			'From DEPARTMENT Where HEAD_DEPT is NULL '+
75			'UNION ALL '+
76			'Select D.DEPT_NO, D.DEPARTMENT, D.HEAD_DEPT, Depts.DEPT_PATH \|\| '' / '' \|\| D.DEPARTMENT as DEPT_PATH,'+
77			'Depts.DEPT_KEY_PATH \|\| '';'' \|\| D.DEPT_NO as DEPT_KEY_PATH '+
78			'From DEPARTMENT D '+
79			'JOIN Depts On D.HEAD_DEPT = Depts.DEPT_NO '+
80			')'+
81
82			'Select A.EMP_NO, A.FIRST_NAME, A.LAST_NAME, A.PHONE_EXT, A.HIRE_DATE, A.DEPT_NO, A.JOB_CODE,'+
83			'A.JOB_GRADE, A.JOB_COUNTRY, A.SALARY, A.FULL_NAME, D.DEPT_PATH, D.DEPT_KEY_PATH '+
84			'From EMPLOYEE A '+
85			'JOIN Depts D On D.DEPT_NO = A.DEPT_NO';
86
87			{ TTest07 }
88
89	tony	353	procedure TTest07.DoScrollableQuery;
90			begin
91			with FIBSQL do
92			begin
93			Scrollable := true;
94			GoToFirstRecordOnExecute := false;
95			writeln(OutFile);
96			writeln(Outfile,'Scollable Cursors');
97			SQL.Text := 'Select * from EMPLOYEE order by EMP_NO';
98			Transaction.Active := true;
99			Prepare;
100			ExecQuery;
101			writeln(Outfile,'Do Fetch Next:');
102			if FetchNext then
103			ReportResult(Current);
104			writeln(Outfile,'Do Fetch Last:');
105			if FetchLast then
106			ReportResult(Current);
107			writeln(Outfile,'Do Fetch Prior:');
108			if FetchPrior then
109			ReportResult(Current);
110			writeln(Outfile,'Do Fetch First:');
111			if FetchFirst then
112			ReportResult(Current);
113			writeln(Outfile,'Do Fetch Abs 8 :');
114			if FetchAbsolute(8) then
115			ReportResult(Current);
116			writeln(Outfile,'Do Fetch Relative -2 :');
117			if FetchRelative(-2) then
118			ReportResult(Current);
119			writeln(Outfile,'Do Fetch beyond EOF :');
120			if FetchAbsolute(150) then
121			ReportResult(Current)
122			else
123			writeln(Outfile,'Fetch returned false');
124			Close;
125			end;
126			end;
127
128	tony	315	procedure TTest07.CreateObjects(Application: TTestApplication);
129			begin
130			inherited CreateObjects(Application);
131			FIBSQL := TIBSQL.Create(Application);
132			FIBSQL.Database := IBDatabase;
133			end;
134
135			function TTest07.GetTestID: AnsiString;
136			begin
137			Result := aTestID;
138			end;
139
140			function TTest07.GetTestTitle: AnsiString;
141			begin
142			Result := aTestTitle;
143			end;
144
145			procedure TTest07.InitTest;
146			begin
147			inherited InitTest;
148			IBDatabase.DatabaseName := Owner.GetEmployeeDatabaseName;
149			ReadWriteTransaction;
150			end;
151
152			procedure TTest07.RunTest(CharSet: AnsiString; SQLDialect: integer);
153			var stats: TPerfCounters;
154			begin
155			IBDatabase.Connected := true;
156			with FIBSQL do
157			begin
158			SQL.Text := sqlExample + ' Order By 1';
159			Transaction.Active := true;
160			Prepare;
161			PrintMetaData(MetaData);
162			Statement.EnableStatistics(true);
163			writeln(OutFile,Plan);
164			ExecQuery;
165			try
166			while not EOF do
167			begin
168			ReportResult(Current);
169			Next;
170			end;
171			finally
172			Close;
173			end;
174
175			if Statement.GetPerfStatistics(stats) then
176			WritePerfStats(stats);
177			PrintAffectedRows(IBQuery);
178			writeln(OutFile);
179			writeln(OutFile,'------------------------------------------------------');
180			writeln(OutFile,'With Named Parameter');
181			SQL.Text := sqlExample + ' Where Hire_Date < :HireDate';
182			Transaction.Active := true;
183			ParamByName('HireDate').AsDateTime := StrToDateTime('1/1/1991');
184			ExecQuery;
185			try
186			while not EOF do
187			begin
188			ReportResult(Current);
189			Next;
190			end;
191			finally
192			Close;
193			end;
194			writeln(OutFile);
195			writeln(OutFile,'With Positional Parameter');
196			ParamCheck := false;
197			SQL.Text := sqlExample + ' Where Hire_Date < ?';
198			Transaction.Active := true;
199			Params[0].AsDateTime := StrToDateTime('1/1/1990');
200			ExecQuery;
201			try
202			while not EOF do
203			begin
204			ReportResult(Current);
205			Next;
206			end;
207			finally
208			Close;
209			end;
210
211			writeln(OutFile);
212			writeln(OutFile,'Get Employee Project');
213			ParamCheck := true;
214			Transaction.Active := true;
215			SQL.Text := 'Select * From GET_EMP_PROJ(:EMP_NO)';
216			ParamByName('EMP_NO').AsInteger := 4;
217			PrintMetaData(MetaData);
218			ExecQuery;
219			try
220			while not EOF do
221			begin
222			ReportResult(Current);
223			Next;
224			end;
225			finally
226			Close;
227			end;
228
229			writeln(OutFile);
230			writeln(OutFile,'Call Delete Employee - exception expected');
231			SQL.Text := 'Execute Procedure Delete_EMPLOYEE :EMP_NO';
232			ParamByName('EMP_NO').AsInteger := 11;
233			try
234			ExecQuery;
235			except on E:Exception do
236			writeln(OutFile,'Terminated with Exception:',E.Message);
237			end;
238			Transaction.Rollback;
239	tony	353	if FIBSQL.HasScollableCursors then
240			DoScrollableQuery;
241	tony	315	end;
242	tony	353	IBDatabase.Connected := false;
243			IBDatabase.DatabaseName := ExtractDBName(Owner.GetEmployeeDatabaseName); {open as local database}
244			IBDatabase.Connected := true;
245			if FIBSQL.HasScollableCursors then
246			DoScrollableQuery;
247	tony	315	end;
248
249			initialization
250			RegisterTest(TTest07);
251
252			end.
253