ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/branches/udr/udr/testsuite/Test04.pas
Revision: 381
Committed: Sat Jan 15 00:06:22 2022 UTC (4 months, 1 week ago) by tony
File size: 3871 byte(s)
Log Message:
Release Candidate 1
Line User Rev File contents
1 tony 371 (* 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 Test04;
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     {Test 04 is used to perform client side testing (UDR engine emulation) for the
47     UDR Trigger declared in udr_test04.pas.}
48    
49     { TTest04 }
50    
51     TTest04 = class(TFBUDRTestBase)
52     private
53     procedure DoQuery(Attachment: IAttachment);
54     protected
55     function GetTestID: AnsiString; override;
56     function GetTestTitle: AnsiString; override;
57     public
58     procedure RunTest(CharSet: AnsiString; SQLDialect: integer); override;
59     end;
60    
61    
62     implementation
63    
64     { TTest04 }
65    
66     procedure TTest04.DoQuery(Attachment: IAttachment);
67     var MyTestTrigger: TExternalTriggerWrapper;
68     Transaction: ITransaction;
69     begin
70     UDRPlugin.Attachment := Attachment;
71 tony 381 MyTestTrigger := UDRPlugin.makeTrigger('MyEmployeeUpdate','fbudrtests!my_employee_update','EMPLOYEE',1{trigger_before});
72 tony 371 try
73     writeln(OutFile,'Update EMPLOYEE 2');
74     Transaction := Attachment.StartTransaction([isc_tpb_write,isc_tpb_nowait,isc_tpb_concurrency],taRollback);
75     MyTestTrigger.OldValues[0].AsInteger := 2;
76     MyTestTrigger.OldValues[3].AsString := '250';
77     MyTestTrigger.NewValues[3].AsString := '999';
78     MyTestTrigger.Execute(Transaction,2{update trigger});
79     writeln(OutFile);
80     finally
81     MyTestTrigger.Free;
82     end;
83     end;
84    
85     function TTest04.GetTestID: AnsiString;
86     begin
87     Result := '04';
88     end;
89    
90     function TTest04.GetTestTitle: AnsiString;
91     begin
92     Result := 'UDR Trigger Test';
93     end;
94    
95     const
96     DDL: array [0..1] of Ansistring =
97     ('Alter Table EMPLOYEE Add PREVIOUS_PHONE_EXT VarChar(4)',
98     'Create or Alter Trigger MyEmployeeUpdate Active After Update On EMPLOYEE '+
99     'as begin end'
100     );
101    
102     CleanUpDDL: array [0..1] of Ansistring =
103     ('drop trigger MyEmployeeUpdate',
104     'Alter Table EMPLOYEE drop PREVIOUS_PHONE_EXT'
105     );
106    
107     {The test is run using the employee database. Note that dummy versions of the
108     UDR Trigger must be declared in the database in order to generate the input
109     and output parameter metadata. These are always (re-)defined when the test is
110     started and removed at the end.
111     }
112    
113     procedure TTest04.RunTest(CharSet: AnsiString; SQLDialect: integer);
114     var Attachment: IAttachment;
115     DPB: IDPB;
116     begin
117     DPB := FirebirdAPI.AllocateDPB;
118     DPB.Add(isc_dpb_user_name).setAsString(Owner.GetUserName);
119     DPB.Add(isc_dpb_password).setAsString(Owner.GetPassword);
120     DPB.Add(isc_dpb_lc_ctype).setAsString(CharSet);
121     DPB.Add(isc_dpb_set_db_SQL_dialect).setAsByte(SQLDialect);
122     Attachment := FirebirdAPI.OpenDatabase(Owner.GetEmployeeDatabaseName,DPB);
123     try
124     ApplyDDL(Attachment,DDL);
125     DoQuery(Attachment);
126     finally
127     ApplyDDL(Attachment,CleanUpDDL);
128     Attachment.Disconnect;
129     end;
130     end;
131    
132     initialization
133     RegisterTest(TTest04);
134    
135     end.
136    

Properties

Name Value
svn:eol-style native