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, 1 month ago) by tony
Original Path: ibx/trunk/fbintf/testsuite/testsuite.lpr
File size: 3189 byte(s)
Log Message:
Committing updates for Trunk

File Contents

# User Rev Content
1 tony 45 program testsuite;
2    
3 tony 56 {$IFDEF FPC}
4 tony 45 {$mode objfpc}{$H+}
5     {$codepage utf8}
6 tony 56 {$ENDIF}
7 tony 45
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 tony 56 DefaultFormatSettings.LongTimeFormat := 'HH:MM:SS';
87 tony 45 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