ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/fbintf/testsuite/testsuite.lpr
Revision: 68
Committed: Tue Oct 17 10:07:58 2017 UTC (6 years, 6 months ago) by tony
File size: 3313 byte(s)
Log Message:
IBX: Editor Positioning tidy up
FBINTF: Trap uninitialised SQL parameters on SQL Exec. Avoids Unknown SQL Type errors.
Consistent setting of Modified (SQLParam).

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 {$IF declared(SetTextCodePage)}
84 {Ensure consistent UTF-8 output}
85 SetTextCodePage(OutFile,cp_utf8);
86 {$IFEND}
87
88 {Ensure consistent date reporting across platforms}
89 DefaultFormatSettings.ShortDateFormat := 'd/m/yyyy';
90 DefaultFormatSettings.LongTimeFormat := 'HH:MM:SS';
91 DefaultFormatSettings.DateSeparator := '/';
92
93 writeln(OutFile,Title);
94 writeln(OutFile,'Copyright MWA Software 2016');
95 writeln(OutFile);
96 writeln(OutFile,'Starting Tests');
97 writeln(OutFile,'Client API Version = ',FirebirdAPI.GetImplementationVersion);
98
99 if FTestID = 0 then
100 TestMgr.RunAll
101 else
102 TestMgr.Run(FTestID);
103 TestMgr.Free;
104 end;
105
106 writeln(OutFile,'Test Suite Ends');
107 Flush(OutFile);
108 {$IFDEF WINDOWS}
109 //readln; {uncomment if running from IDE and console window closes before you can view results}
110 {$ENDIF}
111
112 // stop program loop
113 Terminate;
114 end;
115
116 constructor TFBIntTestbed.Create(TheOwner: TComponent);
117 begin
118 inherited Create(TheOwner);
119 StopOnException := True;
120 end;
121
122 destructor TFBIntTestbed.Destroy;
123 begin
124 inherited Destroy;
125 end;
126
127 procedure TFBIntTestbed.WriteHelp;
128 begin
129 { add your help code here }
130 writeln(OutFile,'Usage: ', ExeName, ' -h');
131 end;
132
133 var
134 Application: TFBIntTestbed;
135 begin
136 Application := TFBIntTestbed.Create(nil);
137 Application.Title := 'Firebird API Test Suite';
138 Application.Run;
139 Application.Free;
140 end.
141