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, 3 months ago) by tony
Content type: text/x-pascal
File size: 4268 byte(s)
Log Message:
Beta Release 0.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     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