ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/testsuite/Test15.pas
Revision: 380
Committed: Mon Jan 10 10:13:17 2022 UTC (2 years, 10 months ago) by tony
Content type: text/x-pascal
File size: 4219 byte(s)
Log Message:
propset for eol-style

File Contents

# User Rev Content
1 tony 323 (*
2     * IBX Test suite. This program is used to test the IBX non-visual
3     * components and provides a semi-automated pass/fail check for each test.
4     *
5     * The contents of this file are subject to the Initial Developer's
6     * Public License Version 1.0 (the "License"); you may not use this
7     * file except in compliance with the License. You may obtain a copy
8     * of the License here:
9     *
10     * http://www.firebirdsql.org/index.php?op=doc&id=idpl
11     *
12     * Software distributed under the License is distributed on an "AS
13     * IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
14     * implied. See the License for the specific language governing rights
15     * and limitations under the License.
16     *
17     * The Initial Developer of the Original Code is Tony Whyman.
18     *
19     * The Original Code is (C) 2021 Tony Whyman, MWA Software
20     * (http://www.mwasoftware.co.uk).
21     *
22     * All Rights Reserved.
23     *
24     * Contributor(s): ______________________________________.
25     *
26     *)
27 tony 315 unit Test15;
28    
29     {$mode objfpc}{$H+}
30    
31     { Test 15: IBStored Proc with packages}
32    
33     {
34     This demonstrates the use of TIBStoredProc with the Firebird 3 packages example
35     provided with the Firebird 3 source code. A database is created in a temporary
36     location when the application is first run. Once this completes, IBStoredProc2 calls
37     the global stored procedure "test", which populates the temporary table FB$OUT.
38    
39     IBStoredProc1 then calls the GET_LINES procedure in the FB$OUT package. It returns
40     a text blob which is then printed out.
41    
42     }
43    
44    
45     interface
46    
47     uses
48     Classes, SysUtils, TestApplication, IBXTestBase, IB, IBStoredProc,
49     IBDatabase;
50    
51     const
52     aTestID = '15';
53     aTestTitle = 'IBStored Proc with packages';
54    
55     type
56    
57     { TTest15 }
58    
59     TTest15 = class(TIBXTestBase)
60     private
61     FIBStoredProc1: TIBStoredProc;
62     FIBStoredProc2: TIBStoredProc;
63     protected
64     procedure CreateObjects(Application: TTestApplication); override;
65     function GetTestID: AnsiString; override;
66     function GetTestTitle: AnsiString; override;
67     procedure InitTest; override;
68     procedure InitialiseDatabase(aDatabase: TIBDatabase); override;
69     function SkipTest: boolean; override;
70     public
71     procedure RunTest(CharSet: AnsiString; SQLDialect: integer); override;
72     end;
73    
74    
75     implementation
76    
77     { TTest15 }
78    
79     procedure TTest15.CreateObjects(Application: TTestApplication);
80     begin
81     inherited CreateObjects(Application);
82     IBQuery.SQL.Text := 'Select A.LINE_NUM, A.CONTENT From FB$OUT_TABLE A';
83     FIBStoredProc1 := TIBStoredProc.Create(Application);
84     FIBStoredProc1.Database := IBDatabase;
85     FIBStoredProc2 := TIBStoredProc.Create(Application);
86     FIBStoredProc2.Database := IBDatabase;
87     end;
88    
89     function TTest15.GetTestID: AnsiString;
90     begin
91     Result := aTestID;
92     end;
93    
94     function TTest15.GetTestTitle: AnsiString;
95     begin
96     Result := aTestTitle;
97     end;
98    
99     procedure TTest15.InitTest;
100     begin
101     IBDatabase.DatabaseName := Owner.GetNewDatabaseName;
102     IBDatabase.CreateIfNotExists := true;
103     FIBStoredProc1.PackageName := 'FB$OUT';
104     FIBStoredProc1.StoredProcName := 'GET_LINES';
105     FIBStoredProc2.StoredProcName := 'TEST';
106     ReadWriteTransaction;
107     end;
108    
109     procedure TTest15.InitialiseDatabase(aDatabase: TIBDatabase);
110     begin
111     if aDatabase.attachment.GetODSMajorVersion < 12 then
112     begin
113     aDatabase.DropDatabase;
114     raise ESkipException.Create('This test requires Firebird 3');
115     end;
116     RunScript(aDatabase,'resources/fbout-header.sql');
117     RunScript(aDatabase,'resources/fbout-body.sql');
118     RunScript(aDatabase,'resources/fbout-test.sql');
119     IBTransaction.Commit;
120     end;
121    
122     function TTest15.SkipTest: boolean;
123     begin
124     Result := FirebirdAPI.GetClientMajor < 3;
125     end;
126    
127     procedure TTest15.RunTest(CharSet: AnsiString; SQLDialect: integer);
128     begin
129     IBDatabase.Connected := true;
130     try
131     IBTransaction.Active := true;
132     writeln(Outfile,'-------------------------------------------------------');
133     writeln(Outfile,'Exec TEST proc');
134     FIBStoredProc2.ExecProc;
135     IBTransaction.Commit;
136     IBTransaction.Active := true;
137     writeln(Outfile,'Show FB$OUT_TABLE');
138     IBQuery.Active := true;
139     PrintDataSet(IBQuery);
140     FIBStoredProc1.ExecProc;
141     writeln(OutFile,FIBStoredProc1.ParamByName('LINES').AsString);
142     finally
143     IBDatabase.DropDatabase;
144     end;
145     end;
146    
147     initialization
148     RegisterTest(TTest15);
149    
150     end.
151    

Properties

Name Value
svn:eol-style native