ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/branches/udr/udr/testsuite/Test02.pas
Revision: 371
Committed: Wed Jan 5 15:21:22 2022 UTC (2 years, 2 months ago) by tony
Content type: text/x-pascal
File size: 4268 byte(s)
Log Message:
Beta Release 0.1

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 unit Test02;
30
31 {$IFDEF MSWINDOWS}
32 {$DEFINE WINDOWS}
33 {$ENDIF}
34
35 {$IFDEF FPC}
36 {$mode delphi}
37 {$codepage utf8}
38 {$ENDIF}
39
40 {Execute Procedure Tests}
41
42 interface
43
44 uses
45 Classes, SysUtils, TestApplication, FBUDRTestApp, IB, FBUdrPlugin;
46
47 type
48
49 {Test 02 is used to perform client side testing (UDR engine emulation) for the
50 UDR Execute Procedure declared in udr_test02.pas.}
51
52 { TTest02 }
53
54 TTest02 = class(TFBUDRTestBase)
55 private
56 procedure DoQuery(Attachment: IAttachment);
57 protected
58 function GetTestID: AnsiString; override;
59 function GetTestTitle: AnsiString; override;
60 public
61 procedure RunTest(CharSet: AnsiString; SQLDialect: integer); override;
62 end;
63
64
65 implementation
66
67 { TTest02 }
68
69 {This procedure is called to return the salary and full name of employee 24}
70
71 procedure TTest02.DoQuery(Attachment: IAttachment);
72 var MyTestProc: TExternalProcedureWrapper;
73 Transaction: ITransaction;
74 Results: IProcedureResults;
75 begin
76 UDRPlugin.Attachment := Attachment;
77 MyTestProc := UDRPlugin.GetExternalProcedure('MYTESTPROC','','fbudrtests!test_proc');
78 try
79 writeln(OutFile,'Salary and Name of Employee 24');
80 MyTestProc.InputParams[0].AsInteger := 24;
81 ParamInfo(MyTestProc.InputParams);
82 Transaction := Attachment.StartTransaction([isc_tpb_read,isc_tpb_nowait,isc_tpb_concurrency],taCommit);
83 Results := MyTestProc.Execute(Transaction);
84 if Results.FetchNext then
85 begin
86 writeln(OutFile,'Salary = ',Results[0].AsString);
87 writeln(OutFile,Results[1].AsString);
88 end;
89 writeln(OutFile);
90 finally
91 MyTestProc.Free;
92 end;
93 end;
94
95 function TTest02.GetTestID: AnsiString;
96 begin
97 Result := '02';
98 end;
99
100 function TTest02.GetTestTitle: AnsiString;
101 begin
102 Result := 'Execute Procedure Tests';
103 end;
104
105 const
106 DDL: array [0..0] of Ansistring = ('create or alter procedure MyTestProc ('+
107 'EMP_NO SMALLINT '+
108 ') returns (Salary Numeric(10,2), FullName VarChar(36)) as begin end'
109 );
110
111 CleanUpDDL: array [0..0] of Ansistring = ('Drop procedure MyTestProc'
112 );
113 {The test is run using the employee database. Note that a dummy version of the
114 UDR Execute procedure must be declared in the database in order to generate the input
115 and output parameter metadata. These are always (re-)defined when the test is
116 started and removed at the end.
117 }
118
119
120 procedure TTest02.RunTest(CharSet: AnsiString; SQLDialect: integer);
121 var Attachment: IAttachment;
122 DPB: IDPB;
123 begin
124 DPB := FirebirdAPI.AllocateDPB;
125 DPB.Add(isc_dpb_user_name).setAsString(Owner.GetUserName);
126 DPB.Add(isc_dpb_password).setAsString(Owner.GetPassword);
127 DPB.Add(isc_dpb_lc_ctype).setAsString(CharSet);
128 DPB.Add(isc_dpb_set_db_SQL_dialect).setAsByte(SQLDialect);
129 Attachment := FirebirdAPI.OpenDatabase(Owner.GetEmployeeDatabaseName,DPB);
130 try
131 if Attachment.HasProcedure('MYTESTPROC') then
132 ApplyDDL(Attachment,CleanUpDDL);
133 ApplyDDL(Attachment,DDL);
134 DoQuery(Attachment);
135 finally
136 ApplyDDL(Attachment,CleanUpDDL);
137 Attachment.Disconnect;
138 end;
139 end;
140
141 initialization
142 RegisterTest(TTest02);
143
144 end.
145