ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/branches/udr/udr/testsuite/FBUDRTestApp.pas
Revision: 381
Committed: Sat Jan 15 00:06:22 2022 UTC (3 days, 16 hours ago) by tony
File size: 2918 byte(s)
Log Message:
Release Candidate 1
Line File contents
1 (*
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 private
52 FUDRPlugin: TFBUdrPluginEmulator;
53 public
54 constructor Create(TheOwner: TComponent); override;
55 destructor Destroy; override;
56 function getModuleName: AnsiString; virtual;
57 property UDRPlugin: TFBUdrPluginEmulator read FUDRPlugin;
58 end;
59
60 { TFBUDRTestBase }
61
62 TFBUDRTestBase = class(TTestBase)
63 function getModuleName: AnsiString;
64 private
65 function GetUDRPlugin: TFBUdrPluginEmulator;
66 public
67 procedure ApplyDDL(attachment: IAttachment; sql: array of AnsiString);
68 property UDRPlugin: TFBUdrPluginEmulator read GetUDRPlugin;
69 end;
70
71
72 implementation
73
74 { TFBUDRTestBase }
75
76 function TFBUDRTestBase.getModuleName: AnsiString;
77 begin
78 Result := (Owner as TFBUDRTestApp).getModuleName;
79 end;
80
81 function TFBUDRTestBase.GetUDRPlugin: TFBUdrPluginEmulator;
82 begin
83 Result := (Owner as TFBUDRTestApp).UDRPlugin;
84 end;
85
86 procedure TFBUDRTestBase.ApplyDDL(attachment: IAttachment;
87 sql: array of AnsiString);
88 var i: integer;
89 begin
90 for i := 0 to length(sql) - 1 do
91 try
92 attachment.ExecImmediate([isc_tpb_write,isc_tpb_wait,isc_tpb_consistency],sql[i]);
93 except on E:Exception do
94 writeln(OutFile,'ApplyDDL problem: ',E.Message);
95 end;
96 end;
97
98
99 { TFBUDRTestSuite }
100
101 constructor TFBUDRTestApp.Create(TheOwner: TComponent);
102 begin
103 inherited Create(TheOwner);
104 StopOnException := True;
105 if FUDRPlugin = nil then
106 FUDRPlugin := TFBUdrPluginEmulator.Create(getModuleName);
107 end;
108
109 destructor TFBUDRTestApp.Destroy;
110 begin
111 if FUDRPlugin <> nil then
112 FUDRPlugin.Free;
113 inherited Destroy;
114 end;
115
116 function TFBUDRTestApp.getModuleName: AnsiString;
117 begin
118 Result := 'udrfbtestsuite';
119 end;
120
121 end.
122

Properties

Name Value
svn:eol-style native