ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/branches/udr/udr/testsuite/Test03.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: 5244 byte(s)
Log Message:
Release Candidate 1

File Contents

# Content
1 (* Firebird UDR Support (fbudrtestbed). The fbudr components provide a set of
2 * Pascal language bindings for the Firebird API in support of server
3 * side User Defined Routines (UDRs). The fbudr package is an extension
4 * to the Firebird Pascal API.
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) 2021 Tony Whyman, MWA Software
21 * (http://www.mwasoftware.co.uk).
22 *
23 * All Rights Reserved.
24 *
25 * Contributor(s): ______________________________________.
26 *
27 *)
28 unit Test03;
29
30 {$IFDEF MSWINDOWS}
31 {$DEFINE WINDOWS}
32 {$ENDIF}
33
34 {$IFDEF FPC}
35 {$mode delphi}
36 {$codepage utf8}
37 {$ENDIF}
38
39 interface
40
41 uses
42 Classes, SysUtils, TestApplication, FBUDRTestApp, IB, FBUdrPlugin;
43
44 type
45
46 { TTest03 }
47
48 {Test 03 is used to perform client side testing (UDR engine emulation) for the
49 UDR Select procedures declared in udr_test03.pas.}
50
51 TTest03 = class(TFBUDRTestBase)
52 private
53 procedure DoAccSalaries(Attachment: IAttachment);
54 procedure DoReadText(Attachment: IAttachment);
55 protected
56 function GetTestID: AnsiString; override;
57 function GetTestTitle: AnsiString; override;
58 public
59 procedure RunTest(CharSet: AnsiString; SQLDialect: integer); override;
60 end;
61
62 implementation
63
64 { TTest03 }
65
66 procedure TTest03.DoAccSalaries(Attachment: IAttachment);
67 var MyTestProc: TExternalProcedureWrapper;
68 Transaction: ITransaction;
69 Results: IProcedureResults;
70 begin
71 UDRPlugin.Attachment := Attachment;
72 MyTestProc := UDRPlugin.makeProcedure('MYSELECTPROC','','fbudrtests!select_proc');
73 try
74 writeln(OutFile,'List Employees, salaries and accumulated salary');
75 Transaction := Attachment.StartTransaction([isc_tpb_read,isc_tpb_nowait,isc_tpb_concurrency],taCommit);
76 Results := MyTestProc.Execute(Transaction);
77 while Results.FetchNext do
78 begin
79 write(OutFile,Results[0].AsString);
80 write(OutFile,', Salary = ',Results[1].AsString);
81 writeln(Outfile,' Acc Salary = $',Results[2].AsString);
82 end;
83 writeln(OutFile);
84 finally
85 MyTestProc.Free;
86 end;
87 end;
88
89 procedure TTest03.DoReadText(Attachment: IAttachment);
90 var MyReadText: TExternalProcedureWrapper;
91 Transaction: ITransaction;
92 Results: IProcedureResults;
93 begin
94 UDRPlugin.Attachment := Attachment;
95 MyReadText := UDRPlugin.makeProcedure('MYREADTEXT','','fbudrtests!read_txt');
96 try
97 MyReadText.InputParams[0].AsString := 'testsuite.conf';
98 writeln(OutFile,'Dump text file - testsuite.conf');
99 Transaction := Attachment.StartTransaction([isc_tpb_read,isc_tpb_nowait,isc_tpb_concurrency],taCommit);
100 Results := MyReadText.Execute(Transaction);
101 while Results.FetchNext do
102 begin
103 writeln(OutFile,Results[0].AsString);
104 end;
105 writeln(OutFile,'EOF');
106 writeln(OutFile);
107 finally
108 MyReadText.Free;
109 end;
110 end;
111
112 function TTest03.GetTestID: AnsiString;
113 begin
114 Result := '03';
115 end;
116
117 function TTest03.GetTestTitle: AnsiString;
118 begin
119 Result := 'UDR Select Procedure Test';
120 end;
121
122 const
123 DDL: array [0..1] of Ansistring = ('create or alter procedure MySelectProc () '+
124 'returns (FullName VarChar(36), '+
125 'Salary Numeric(10,2), AccSalary Numeric(10,2) ) as begin SUSPEND; end',
126 'create or alter procedure MyReadText ('+
127 'path varchar(200) not null /*relative to udr directory */ '+
128 ') returns (text varchar(3000) not null) '+
129 'As Begin Suspend; End'
130 );
131
132 CleanUpDDL: array [0..1] of Ansistring = ('Drop procedure MySelectProc',
133 'Drop procedure MyReadText');
134
135
136 {The test is run using the employee database. Note that dummy versions of the
137 UDR Select Procedure must be declared in the database in order to generate the input
138 and output parameter metadata. These are always (re-)defined when the test is
139 started and removed at the end.
140 }
141
142 procedure TTest03.RunTest(CharSet: AnsiString; SQLDialect: integer);
143 var Attachment: IAttachment;
144 DPB: IDPB;
145 begin
146 DPB := FirebirdAPI.AllocateDPB;
147 DPB.Add(isc_dpb_user_name).setAsString(Owner.GetUserName);
148 DPB.Add(isc_dpb_password).setAsString(Owner.GetPassword);
149 DPB.Add(isc_dpb_lc_ctype).setAsString(CharSet);
150 DPB.Add(isc_dpb_set_db_SQL_dialect).setAsByte(SQLDialect);
151 Attachment := FirebirdAPI.OpenDatabase(Owner.GetEmployeeDatabaseName,DPB);
152 try
153 ApplyDDL(Attachment,DDL);
154 DoAccSalaries(Attachment);
155 DoReadText(Attachment);
156 finally
157 ApplyDDL(Attachment,CleanUpDDL);
158 Attachment.Disconnect;
159 end;
160 end;
161
162 initialization
163 RegisterTest(TTest03);
164 end.
165

Properties

Name Value
svn:eol-style native