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 |
|
program testsuite; |
29 |
|
|
30 |
|
{$IFDEF FPC} |
36 |
|
{$IFDEF UNIX} |
37 |
|
cthreads, |
38 |
|
{$ENDIF} |
39 |
< |
Classes, SysUtils, CustApp, TestManager, Test1, test2, Test3, Test4, Test5, |
39 |
> |
Classes, SysUtils, CustApp, Test1, Test2, Test3, Test4, Test5, |
40 |
|
Test6, Test7, Test8, Test9, Test10, Test11, Test12, Test13, Test14, Test15, |
41 |
< |
Test16, IB; |
41 |
> |
Test16, IB, Test17, Test18, TestApplication, FBTestApp, Test19, Test20, |
42 |
> |
Test21; |
43 |
|
|
44 |
|
type |
45 |
|
|
46 |
|
{ TFBIntTestbed } |
47 |
|
|
48 |
< |
TFBIntTestbed = class(TCustomApplication) |
21 |
< |
private |
22 |
< |
FTestID: integer; |
23 |
< |
protected |
24 |
< |
procedure DoRun; override; |
25 |
< |
public |
48 |
> |
TFBIntTestbed = class(TTestApplication) |
49 |
|
constructor Create(TheOwner: TComponent); override; |
27 |
– |
destructor Destroy; override; |
28 |
– |
procedure WriteHelp; virtual; |
50 |
|
end; |
51 |
|
|
52 |
|
{ TFBIntTestbed } |
53 |
|
|
33 |
– |
procedure TFBIntTestbed.DoRun; |
34 |
– |
var |
35 |
– |
ErrorMsg: String; |
36 |
– |
begin |
37 |
– |
OutFile := stdout; |
38 |
– |
// quick check parameters |
39 |
– |
ErrorMsg := CheckOptions('htupensboS', 'help test user passwd employeedb newdbname secondnewdbname backupfile outfile stats'); |
40 |
– |
if ErrorMsg <> '' then begin |
41 |
– |
ShowException(Exception.Create(ErrorMsg)); |
42 |
– |
Terminate; |
43 |
– |
Exit; |
44 |
– |
end; |
45 |
– |
|
46 |
– |
// parse parameters |
47 |
– |
if HasOption('h', 'help') then begin |
48 |
– |
WriteHelp; |
49 |
– |
Terminate; |
50 |
– |
Exit; |
51 |
– |
end; |
52 |
– |
|
53 |
– |
if HasOption('t') then |
54 |
– |
FTestID := StrToInt(GetOptionValue('t')); |
55 |
– |
|
56 |
– |
if TestMgr <> nil then |
57 |
– |
begin |
58 |
– |
if HasOption('u','user') then |
59 |
– |
TestMgr.SetUserName(GetOptionValue('u')); |
60 |
– |
|
61 |
– |
if HasOption('p','passwd') then |
62 |
– |
TestMgr.SetPassword(GetOptionValue('p')); |
63 |
– |
|
64 |
– |
if HasOption('e','employeedb') then |
65 |
– |
TestMgr.SetEmployeeDatabaseName(GetOptionValue('e')); |
66 |
– |
|
67 |
– |
if HasOption('n','newdbname') then |
68 |
– |
TestMgr.SetNewDatabaseName(GetOptionValue('n')); |
69 |
– |
|
70 |
– |
if HasOption('s','secondnewdbname') then |
71 |
– |
TestMgr.SetSecondNewDatabaseName(GetOptionValue('s')); |
72 |
– |
|
73 |
– |
if HasOption('b','backupfile') then |
74 |
– |
TestMgr.SetBackupFileName(GetOptionValue('b')); |
75 |
– |
|
76 |
– |
if HasOption('o','outfile') then |
77 |
– |
begin |
78 |
– |
system.Assign(outFile,GetOptionValue('o')); |
79 |
– |
ReWrite(outFile); |
80 |
– |
end; |
81 |
– |
|
82 |
– |
TestMgr.ShowStatistics := HasOption('S','stats'); |
83 |
– |
|
84 |
– |
{Ensure consistent date reporting across platforms} |
85 |
– |
DefaultFormatSettings.ShortDateFormat := 'd/m/yyyy'; |
86 |
– |
DefaultFormatSettings.LongTimeFormat := 'HH:MM:SS'; |
87 |
– |
DefaultFormatSettings.DateSeparator := '/'; |
88 |
– |
|
89 |
– |
writeln(OutFile,Title); |
90 |
– |
writeln(OutFile,'Copyright MWA Software 2016'); |
91 |
– |
writeln(OutFile); |
92 |
– |
writeln(OutFile,'Starting Tests'); |
93 |
– |
writeln(OutFile,'Client API Version = ',FirebirdAPI.GetImplementationVersion); |
94 |
– |
|
95 |
– |
if FTestID = 0 then |
96 |
– |
TestMgr.RunAll |
97 |
– |
else |
98 |
– |
TestMgr.Run(FTestID); |
99 |
– |
TestMgr.Free; |
100 |
– |
end; |
101 |
– |
|
102 |
– |
writeln(OutFile,'Test Suite Ends'); |
103 |
– |
Flush(OutFile); |
104 |
– |
{$IFDEF WINDOWS} |
105 |
– |
//readln; {uncomment if running from IDE and console window closes before you can view results} |
106 |
– |
{$ENDIF} |
107 |
– |
|
108 |
– |
// stop program loop |
109 |
– |
Terminate; |
110 |
– |
end; |
111 |
– |
|
54 |
|
constructor TFBIntTestbed.Create(TheOwner: TComponent); |
55 |
|
begin |
56 |
|
inherited Create(TheOwner); |
57 |
|
StopOnException := True; |
58 |
|
end; |
59 |
|
|
118 |
– |
destructor TFBIntTestbed.Destroy; |
119 |
– |
begin |
120 |
– |
inherited Destroy; |
121 |
– |
end; |
122 |
– |
|
123 |
– |
procedure TFBIntTestbed.WriteHelp; |
124 |
– |
begin |
125 |
– |
{ add your help code here } |
126 |
– |
writeln(OutFile,'Usage: ', ExeName, ' -h'); |
127 |
– |
end; |
128 |
– |
|
60 |
|
var |
61 |
|
Application: TFBIntTestbed; |
62 |
|
begin |
63 |
|
Application := TFBIntTestbed.Create(nil); |
64 |
< |
Application.Title := 'Firebird API Test Suite'; |
64 |
> |
Application.Title:='Firebird API Test Suite'; |
65 |
|
Application.Run; |
66 |
|
Application.Free; |
67 |
|
end. |