ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/branches/udr/udr/testsuite/FBUDRTestApp.pas
Revision: 379
Committed: Mon Jan 10 10:08:03 2022 UTC (2 years, 2 months ago) by tony
Content type: text/x-pascal
File size: 2857 byte(s)
Log Message:
set line ending property

File Contents

# User Rev Content
1 tony 371 (*
2     * Firebird Interface (fbintf) Test suite. This program is used to
3     * test the Firebird Pascal Interface and provide a semi-automated
4     * pass/fail check for each test.
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) 2016-2020 Tony Whyman, MWA Software
21     * (http://www.mwasoftware.co.uk).
22     *
23     * All Rights Reserved.
24     *
25     * Contributor(s): ______________________________________.
26     *
27     *)
28     unit FBUDRTestApp;
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, IB, FBUDRController, FBUdrPlugin;
43    
44     type
45    
46     { TFBUDRTestSuite }
47    
48     { TFBUDRTestApp }
49    
50     TFBUDRTestApp = class(TTestApplication)
51     public
52     constructor Create(TheOwner: TComponent); override;
53     function getModuleName: AnsiString; virtual;
54     end;
55    
56     { TFBUDRTestBase }
57    
58     TFBUDRTestBase = class(TTestBase)
59     private
60     FUDRPlugin: TFBUdrPlugin;
61     function getModuleName: AnsiString;
62     protected
63     procedure CreateObjects(Application: TTestApplication); override;
64     public
65     destructor Destroy; override;
66     procedure ApplyDDL(attachment: IAttachment; sql: array of AnsiString);
67     property UDRPlugin: TFBUdrPlugin read FUDRPlugin;
68     end;
69    
70    
71     implementation
72    
73     { TFBUDRTestBase }
74    
75     function TFBUDRTestBase.getModuleName: AnsiString;
76     begin
77     Result := (Owner as TFBUDRTestApp).getModuleName;
78     end;
79    
80     procedure TFBUDRTestBase.CreateObjects(Application: TTestApplication);
81     begin
82     inherited CreateObjects(Application);
83     if FUDRPlugin = nil then
84     FUDRPlugin := TFBUdrPlugin.Create(getModuleName);
85     end;
86    
87     destructor TFBUDRTestBase.Destroy;
88     begin
89     if FUDRPlugin <> nil then
90     FUDRPlugin.Free;
91     inherited Destroy;
92     end;
93    
94     procedure TFBUDRTestBase.ApplyDDL(attachment: IAttachment;
95     sql: array of AnsiString);
96     var i: integer;
97     begin
98     for i := 0 to length(sql) - 1 do
99     try
100     attachment.ExecImmediate([isc_tpb_write,isc_tpb_wait,isc_tpb_consistency],sql[i]);
101     except on E:Exception do
102     writeln(OutFile,'ApplyDDL problem: ',E.Message);
103     end;
104     end;
105    
106    
107     { TFBUDRTestSuite }
108    
109     constructor TFBUDRTestApp.Create(TheOwner: TComponent);
110     begin
111     inherited Create(TheOwner);
112     StopOnException := True;
113     end;
114    
115     function TFBUDRTestApp.getModuleName: AnsiString;
116     begin
117     Result := 'udrfbtestsuite';
118     end;
119    
120     end.
121    

Properties

Name Value
svn:eol-style native