ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/fbintf/testsuite/testsuite.dpr
Revision: 143
Committed: Fri Feb 23 12:11:21 2018 UTC (6 years, 9 months ago) by tony
File size: 3486 byte(s)
Log Message:
Fixes Merged

File Contents

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