ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/branches/udr/udr/testsuite/Test01.pas
Revision: 381
Committed: Sat Jan 15 00:06:22 2022 UTC (2 years, 2 months ago) by tony
Content type: text/x-pascal
File size: 6821 byte(s)
Log Message:
Release Candidate 1

File Contents

# User Rev Content
1 tony 371 (*
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 tony 381 MyRowCount := UDRPlugin.makeFunction('MYROWCOUNT','','fbudrtests!row_count');
78 tony 371 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 tony 381 writeln(Outfile,'Employee Row Count = ',MyRowCount.Execute(Transaction).AsInteger);
87 tony 371 writeln(OutFile);
88    
89     {Try again with the DEPARTMENT table}
90     MyRowCount.InputParams[0].AsString := 'DEPARTMENT';
91     ParamInfo(MyRowCount.InputParams);
92 tony 381 writeln(Outfile,'Dept Row Count = ',MyRowCount.Execute(Transaction).AsInteger);
93 tony 371 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 tony 381 writeln(Outfile,'Dept Row Count = ',Rows);
101 tony 371 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 tony 381 MyRowCount := UDRPlugin.makeFunction('BADROWCOUNT','','fbudrtests!bad_row_count');
112 tony 371 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 tony 381 writeln(Outfile,'Employee Row Count = ',MyRowCount.Execute(Transaction).AsInteger);
119 tony 371 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 tony 381 ReturnInfo := UDRPlugin.makeFunction('RETURNINFO','','fbudrtests!return_info!Hello World');
136 tony 371 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