ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/branches/journaling/fbintf/testsuite/testsuite.lpr
Revision: 56
Committed: Mon Mar 6 10:20:02 2017 UTC (7 years ago) by tony
Original Path: ibx/trunk/fbintf/testsuite/testsuite.lpr
File size: 3189 byte(s)
Log Message:
Committing updates for Trunk

File Contents

# Content
1 program testsuite;
2
3 {$IFDEF FPC}
4 {$mode objfpc}{$H+}
5 {$codepage utf8}
6 {$ENDIF}
7
8 uses
9 {$IFDEF UNIX}
10 cthreads,
11 {$ENDIF}
12 Classes, SysUtils, CustApp, TestManager, Test1, test2, Test3, Test4, Test5,
13 Test6, Test7, Test8, Test9, Test10, Test11, Test12, Test13, Test14, Test15,
14 Test16, IB;
15
16 type
17
18 { TFBIntTestbed }
19
20 TFBIntTestbed = class(TCustomApplication)
21 private
22 FTestID: integer;
23 protected
24 procedure DoRun; override;
25 public
26 constructor Create(TheOwner: TComponent); override;
27 destructor Destroy; override;
28 procedure WriteHelp; virtual;
29 end;
30
31 { TFBIntTestbed }
32
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
112 constructor TFBIntTestbed.Create(TheOwner: TComponent);
113 begin
114 inherited Create(TheOwner);
115 StopOnException := True;
116 end;
117
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
129 var
130 Application: TFBIntTestbed;
131 begin
132 Application := TFBIntTestbed.Create(nil);
133 Application.Title := 'Firebird API Test Suite';
134 Application.Run;
135 Application.Free;
136 end.
137