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

File Contents

# Content
1 program testsuite;
2
3 {$APPTYPE CONSOLE}
4
5 {$R *.res}
6
7 uses
8 SysUtils, IB,
9 Test1 in 'Test1.pas',
10 test2 in 'test2.pas',
11 Test3 in 'Test3.pas',
12 Test4 in 'Test4.pas',
13 Test5 in 'Test5.pas',
14 Test6 in 'Test6.pas',
15 Test7 in 'Test7.pas',
16 Test8 in 'Test8.pas',
17 Test9 in 'Test9.pas',
18 Test10 in 'Test10.pas',
19 Test11 in 'Test11.pas',
20 Test12 in 'Test12.pas',
21 Test13 in 'Test13.pas',
22 Test14 in 'Test14.pas',
23 Test15 in 'Test15.pas',
24 Test16 in 'Test16.pas',
25 TestManager in 'TestManager.pas';
26
27 procedure WriteHelp;
28 begin
29 { add your help code here }
30 writeln(OutFile,'Usage: ', ParamStr(0), ' -h');
31 end;
32
33 function GetCmdLineValue(const Switch: string; var aValue: string): boolean;
34 var i: integer;
35 begin
36 Result := FindCmdLineSwitch(Switch,false);
37 if Result then
38 begin
39 for i := 0 to ParamCount do
40 if (ParamStr(i) = '-' + Switch) and (i <= ParamCount) then
41 begin
42 aValue := ParamStr(i+1);
43 exit;
44 end;
45 Result := false;
46 end;
47 end;
48
49
50 var
51 ErrorMsg: AnsiString;
52 FTestID: integer;
53 aValue: string;
54 begin
55 try
56
57 FTestID := 0;
58 AssignFile(OutFile,'');
59 ReWrite(outFile);
60
61
62 // parse parameters
63 if FindCmdLineSwitch('h') or FindCmdLineSwitch('help') then
64 begin
65 WriteHelp;
66 Exit;
67 end;
68
69 if GetCmdLineValue('t',aValue) then
70 FTestID := StrToInt(aValue);
71
72 if TestMgr <> nil then
73 begin
74 if GetCmdLineValue('u',aValue) or GetCmdLineValue('user',aValue) then
75 TestMgr.SetUserName(aValue);
76
77 if GetCmdLineValue('p',aValue) or GetCmdLineValue('passwd',aValue) then
78 TestMgr.SetPassword(aValue);
79
80 if GetCmdLineValue('e',aValue) or GetCmdLineValue('employeedb',aValue) then
81 TestMgr.SetEmployeeDatabaseName(aValue);
82
83 if GetCmdLineValue('n',aValue) or GetCmdLineValue('newdbname',aValue) then
84 TestMgr.SetNewDatabaseName(aValue);
85
86 if GetCmdLineValue('s',aValue) or GetCmdLineValue('secondnewdbname',aValue) then
87 TestMgr.SetSecondNewDatabaseName(aValue);
88
89 if GetCmdLineValue('b',aValue) or GetCmdLineValue('backupfile',aValue) then
90 TestMgr.SetBackupFileName(aValue);
91
92 if GetCmdLineValue('o',aValue) or GetCmdLineValue('outfile',aValue) then
93 begin
94 system.Assign(outFile,aValue);
95 ReWrite(outFile);
96 end;
97
98 TestMgr.ShowStatistics := FindCmdLineSwitch('S',false) or FindCmdLineSwitch('stats');
99
100 {Ensure consistent date reporting across platforms}
101 {$IF declared(FormatSettings)}
102 FormatSettings.ShortDateFormat := 'd/m/yyyy';
103 FormatSettings.LongTimeFormat := 'HH:MM:SS';
104 FormatSettings.DateSeparator := '/';
105 {$ELSE}
106 ShortDateFormat := 'd/m/yyyy';
107 LongTimeFormat := 'HH:MM:SS';
108 DateSeparator := '/';
109 {$IFEND}
110
111 writeln(OutFile,'Firebird Client API Test Suite');
112 writeln(OutFile,'Copyright MWA Software 2016');
113 writeln(OutFile);
114 writeln(OutFile,'Starting Tests');
115 writeln(OutFile,'Client API Version = ',FirebirdAPI.GetImplementationVersion);
116
117 if FTestID = 0 then
118 TestMgr.RunAll
119 else
120 TestMgr.Run(FTestID);
121 TestMgr.Free;
122 end;
123
124 writeln(OutFile,'Test Suite Ends');
125 Flush(OutFile);
126 //readln; {uncomment if running from IDE and console window closes before you can view results}
127
128 except
129 on E: Exception do
130 Writeln(E.ClassName, ': ', E.Message);
131 end;
132 end.