ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/branches/udr/udr/testsuite/Test01.pas
Revision: 379
Committed: Mon Jan 10 10:08:03 2022 UTC (2 years, 2 months ago) by tony
Content type: text/x-pascal
File size: 6810 byte(s)
Log Message:
set line ending property

File Contents

# Content
1 (*
2 * Firebird UDR Support (fbudrtestbed). The fbudr components provide a set of
3 * Pascal language bindings for the Firebird API in support of server
4 * side User Defined Routines (UDRs). The fbudr package is an extension
5 * to the Firebird Pascal API.
6 *
7 * The contents of this file are subject to the Initial Developer's
8 * Public License Version 1.0 (the "License"); you may not use this
9 * file except in compliance with the License. You may obtain a copy
10 * of the License here:
11 *
12 * http://www.firebirdsql.org/index.php?op=doc&id=idpl
13 *
14 * Software distributed under the License is distributed on an "AS
15 * IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
16 * implied. See the License for the specific language governing rights
17 * and limitations under the License.
18 *
19 * The Initial Developer of the Original Code is Tony Whyman.
20 *
21 * The Original Code is (C) 2021 Tony Whyman, MWA Software
22 * (http://www.mwasoftware.co.uk).
23 *
24 * All Rights Reserved.
25 *
26 * Contributor(s): ______________________________________.
27 *
28 *)
29
30 unit Test01;
31 {$IFDEF MSWINDOWS}
32 {$DEFINE WINDOWS}
33 {$ENDIF}
34
35 {$IFDEF FPC}
36 {$mode delphi}
37 {$codepage utf8}
38 {$ENDIF}
39
40 interface
41
42 uses
43 Classes, SysUtils, TestApplication, FBUDRTestApp, IB, FBUdrPlugin;
44
45 type
46
47 { TTest01 }
48
49 {Test 01 is used to perform client side testing (UDR engine emulation) for the
50 UDR functions declared in udr_test01.pas.}
51
52 TTest01 = class(TFBUDRTestBase)
53 private
54 procedure DoQuery(Attachment: IAttachment);
55 procedure DoCheckInfo(Attachment: IAttachment);
56 protected
57 function GetTestID: AnsiString; override;
58 function GetTestTitle: AnsiString; override;
59 public
60 procedure RunTest(CharSet: AnsiString; SQLDialect: integer); override;
61 end;
62
63 implementation
64
65 { TTest01 }
66
67 {DoQuery is where the functions that are expected to do work are tested.}
68
69 procedure TTest01.DoQuery(Attachment: IAttachment);
70 var MyRowCount: TExternalFunctionWrapper;
71 Transaction: ITransaction;
72 Rows: integer;
73 begin
74 {initialize the emulator with the database connection}
75 UDRPlugin.Attachment := Attachment;
76 {Get the emulator wrapper for the row_count function, declared as MyRowCount}
77 MyRowCount := UDRPlugin.GetExternalFunction('MYROWCOUNT','','fbudrtests!row_count');
78 try
79 writeln(OutFile,'Row Count for Employee');
80 {set the input parameter to the EMPLOYEE table}
81 MyRowCount.InputParams[0].AsString := 'EMPLOYEE';
82 {check the settings of the input parameter}
83 ParamInfo(MyRowCount.InputParams);
84 Transaction := Attachment.StartTransaction([isc_tpb_read,isc_tpb_nowait,isc_tpb_concurrency],taCommit);
85 {invoke the function and print the result}
86 writeln('Employee Row Count = ',MyRowCount.Execute(Transaction).AsInteger);
87 writeln(OutFile);
88
89 {Try again with the DEPARTMENT table}
90 MyRowCount.InputParams[0].AsString := 'DEPARTMENT';
91 ParamInfo(MyRowCount.InputParams);
92 writeln('Dept Row Count = ',MyRowCount.Execute(Transaction).AsInteger);
93 writeln(OutFile);
94
95 {And again but demonstrate exception handling by using an invalid table name}
96 MyRowCount.InputParams[0].AsString := 'BAD';
97 try
98 ParamInfo(MyRowCount.InputParams);
99 Rows := MyRowCount.Execute(Transaction).AsInteger;
100 writeln('Dept Row Count = ',Rows);
101 writeln(OutFile);
102 except on E: Exception do
103 writeln(Outfile,'Expected exception: ',E.Message);
104 end;
105 finally
106 MyRowCount.Free
107 end;
108
109 writeln(OutFile);
110 {Now call the external version with an error}
111 MyRowCount := UDRPlugin.GetExternalFunction('BADROWCOUNT','','fbudrtests!bad_row_count');
112 try
113 try
114 writeln(OutFile,'Row Count for Employee');
115 MyRowCount.InputParams[0].AsString := 'EMPLOYEE';
116 ParamInfo(MyRowCount.InputParams);
117 Transaction := Attachment.StartTransaction([isc_tpb_read,isc_tpb_nowait,isc_tpb_concurrency],taCommit);
118 writeln('Employee Row Count = ',MyRowCount.Execute(Transaction).AsInteger);
119 except on E: Exception do
120 writeln(Outfile,'Expected exception: ',E.Message);
121 end;
122 finally
123 MyRowCount.Free;
124 end;
125 end;
126
127 {The DoCheckInfo function simply reflects back the value of the "info" field in the
128 external name. Here this is set in the emulator to "Hello World".}
129
130 procedure TTest01.DoCheckInfo(Attachment: IAttachment);
131 var ReturnInfo: TExternalFunctionWrapper;
132 Transaction: ITransaction;
133 begin
134 UDRPlugin.Attachment := Attachment;
135 ReturnInfo := UDRPlugin.GetExternalFunction('RETURNINFO','','fbudrtests!return_info!Hello World');
136 try
137 Transaction := Attachment.StartTransaction([isc_tpb_read,isc_tpb_nowait,isc_tpb_concurrency],taCommit);
138 writeln(OutFile,'Info returned = ',ReturnInfo.Execute(Transaction).AsString);
139 finally
140 ReturnInfo.Free;
141 end;
142 end;
143
144 function TTest01.GetTestID: AnsiString;
145 begin
146 Result := '01';
147 end;
148
149 function TTest01.GetTestTitle: AnsiString;
150 begin
151 Result := 'Open the employee database and run a simple UDR Function';
152 end;
153
154 const
155 DDL: array [0..2] of Ansistring = ('create or alter function MyRowCount ('+
156 'table_name varchar(31) '+
157 ') returns integer as begin end',
158
159 'create or alter function BadRowCount ('+
160 'table_name varchar(31) '+
161 ') returns integer as begin end',
162
163 'create or alter function ReturnInfo '+
164 'returns VarChar(32) as begin end'
165 );
166
167 CleanUpDDL: array [0..2] of Ansistring = ('Drop function MyRowCount',
168 'Drop function BadRowCount',
169 'Drop function ReturnInfo'
170 );
171 {The test is run using the employee database. Note that dummy versions of the
172 UDR functions must be declared in the database in order to generate the input
173 and output parameter metadata. These are always (re-)defined when the test is
174 started and removed at the end.
175 }
176
177 procedure TTest01.RunTest(CharSet: AnsiString; SQLDialect: integer);
178 var Attachment: IAttachment;
179 DPB: IDPB;
180 begin
181 DPB := FirebirdAPI.AllocateDPB;
182 DPB.Add(isc_dpb_user_name).setAsString(Owner.GetUserName);
183 DPB.Add(isc_dpb_password).setAsString(Owner.GetPassword);
184 DPB.Add(isc_dpb_lc_ctype).setAsString(CharSet);
185 DPB.Add(isc_dpb_set_db_SQL_dialect).setAsByte(SQLDialect);
186 Attachment := FirebirdAPI.OpenDatabase(Owner.GetEmployeeDatabaseName,DPB);
187 try
188 ApplyDDL(Attachment,DDL);
189 DoQuery(Attachment);
190 DoCheckInfo(Attachment);
191 finally
192 ApplyDDL(Attachment,CleanUpDDL);
193 Attachment.Disconnect;
194 end;
195 end;
196
197 initialization
198 RegisterTest(TTest01);
199 end.
200

Properties

Name Value
svn:eol-style native