1 |
unit TestManager;
|
2 |
{$IFDEF MSWINDOWS}
|
3 |
{$DEFINE WINDOWS}
|
4 |
{$ENDIF}
|
5 |
|
6 |
{$IFDEF FPC}
|
7 |
{$mode delphi}
|
8 |
{$codepage utf8}
|
9 |
{$ENDIF}
|
10 |
|
11 |
interface
|
12 |
|
13 |
uses
|
14 |
Classes, SysUtils, IB;
|
15 |
|
16 |
{$IFDEF MSWINDOWS}
|
17 |
const LineEnding = #$0D#$0A;
|
18 |
{$ENDIF}
|
19 |
|
20 |
type
|
21 |
TTestManager = class;
|
22 |
|
23 |
{ TTestBase }
|
24 |
|
25 |
TTestBase = class
|
26 |
private
|
27 |
FOwner: TTestManager;
|
28 |
protected
|
29 |
FHexStrings: boolean;
|
30 |
function ExtractDBName(ConnectString: AnsiString): AnsiString;
|
31 |
function ReportResults(Statement: IStatement): IResultSet;
|
32 |
procedure ReportResult(aValue: IResults);
|
33 |
procedure PrintHexString(s: AnsiString);
|
34 |
procedure PrintDPB(DPB: IDPB);
|
35 |
procedure PrintMetaData(meta: IMetaData);
|
36 |
procedure ParamInfo(SQLParams: ISQLParams);
|
37 |
procedure WriteArray(ar: IArray);
|
38 |
procedure WriteAffectedRows(Statement: IStatement);
|
39 |
function WriteServiceQueryResult(QueryResult: IServiceQueryResults): boolean;
|
40 |
procedure writeLicence(Item: IServiceQueryResultItem);
|
41 |
procedure WriteConfig(config: IServiceQueryResultItem);
|
42 |
procedure WriteUsers(users: IServiceQueryResultItem);
|
43 |
procedure WriteDBAttachments(att: IServiceQueryResultItem);
|
44 |
procedure WriteLimboTransactions(limbo: IServiceQueryResultItem);
|
45 |
procedure WriteDBInfo(DBInfo: IDBInformation);
|
46 |
procedure WriteBytes(Bytes: TByteArray);
|
47 |
procedure WriteOperationCounts(Category: AnsiString; ops: TDBOperationCounts);
|
48 |
procedure WritePerfStats(stats: TPerfCounters);
|
49 |
procedure CheckActivity(Attachment: IAttachment); overload;
|
50 |
procedure CheckActivity(Transaction: ITransaction); overload;
|
51 |
public
|
52 |
constructor Create(aOwner: TTestManager); virtual;
|
53 |
function TestTitle: AnsiString; virtual; abstract;
|
54 |
procedure RunTest(CharSet: AnsiString; SQLDialect: integer); virtual; abstract;
|
55 |
property Owner: TTestManager read FOwner;
|
56 |
end;
|
57 |
|
58 |
TTest = class of TTestBase;
|
59 |
|
60 |
{ TTestManager }
|
61 |
|
62 |
TTestManager = class
|
63 |
private
|
64 |
FTests: TList;
|
65 |
FServer: AnsiString;
|
66 |
FPortNo: AnsiString;
|
67 |
FEmployeeDatabaseName: AnsiString;
|
68 |
FNewDatabaseName: AnsiString;
|
69 |
FSecondNewDatabaseName: AnsiString;
|
70 |
FUserName: AnsiString;
|
71 |
FPassword: AnsiString;
|
72 |
FBackupFileName: AnsiString;
|
73 |
FShowStatistics: boolean;
|
74 |
procedure CleanUp;
|
75 |
public
|
76 |
constructor Create;
|
77 |
destructor Destroy; override;
|
78 |
function GetUserName: AnsiString;
|
79 |
function GetPassword: AnsiString;
|
80 |
function GetEmployeeDatabaseName: AnsiString;
|
81 |
function GetNewDatabaseName: AnsiString;
|
82 |
function GetSecondNewDatabaseName: AnsiString;
|
83 |
function GetBackupFileName: AnsiString;
|
84 |
procedure RunAll;
|
85 |
procedure Run(TestID: integer);
|
86 |
procedure SetUserName(aValue: AnsiString);
|
87 |
procedure SetPassword(aValue: AnsiString);
|
88 |
procedure SetEmployeeDatabaseName(aValue: AnsiString);
|
89 |
procedure SetNewDatabaseName(aValue: AnsiString);
|
90 |
procedure SetSecondNewDatabaseName(aValue: AnsiString);
|
91 |
procedure SetBackupFileName(aValue: AnsiString);
|
92 |
property ShowStatistics: boolean read FShowStatistics write FShowStatistics;
|
93 |
property Server: AnsiString read FServer;
|
94 |
end;
|
95 |
|
96 |
var
|
97 |
TestMgr: TTestManager = nil;
|
98 |
|
99 |
var OutFile: text;
|
100 |
|
101 |
procedure RegisterTest(aTest: TTest);
|
102 |
|
103 |
implementation
|
104 |
|
105 |
uses IBUtils
|
106 |
{$IFDEF MSWINDOWS}
|
107 |
, windows;
|
108 |
|
109 |
function GetTempDir: AnsiString;
|
110 |
var
|
111 |
tempFolder: array[0..MAX_PATH] of Char;
|
112 |
begin
|
113 |
GetTempPath(MAX_PATH, @tempFolder);
|
114 |
result := StrPas(tempFolder);
|
115 |
end;
|
116 |
{$ELSE}
|
117 |
;
|
118 |
{$ENDIF}
|
119 |
|
120 |
procedure RegisterTest(aTest: TTest);
|
121 |
begin
|
122 |
if TestMgr = nil then
|
123 |
TestMgr := TTestManager.Create;
|
124 |
TestMgr.FTests.Add(aTest.Create(TestMgr));
|
125 |
end;
|
126 |
|
127 |
{ TTestBase }
|
128 |
|
129 |
constructor TTestBase.Create(aOwner: TTestManager);
|
130 |
begin
|
131 |
inherited Create;
|
132 |
FOwner := aOwner;
|
133 |
end;
|
134 |
|
135 |
function TTestBase.ExtractDBName(ConnectString: AnsiString): AnsiString;
|
136 |
var ServerName: AnsiString;
|
137 |
Protocol: TProtocolAll;
|
138 |
PortNo: AnsiString;
|
139 |
i: integer;
|
140 |
begin
|
141 |
if not ParseConnectString(ConnectString, ServerName, Result, Protocol,PortNo) then
|
142 |
begin
|
143 |
{assume either inet format (remote) or localhost}
|
144 |
Result := ConnectString;
|
145 |
if Pos('inet',Result) = 1 then
|
146 |
begin
|
147 |
system.Delete(Result,1,7);
|
148 |
i := Pos('/',Result);
|
149 |
if i > 0 then
|
150 |
system.delete(Result,1,i);
|
151 |
end
|
152 |
else
|
153 |
if Pos('localhost:',Result) = 1 then
|
154 |
system.Delete(Result,1,10)
|
155 |
end;
|
156 |
end;
|
157 |
|
158 |
function TTestBase.ReportResults(Statement: IStatement): IResultSet;
|
159 |
begin
|
160 |
Result := Statement.OpenCursor;
|
161 |
try
|
162 |
while Result.FetchNext do
|
163 |
ReportResult(Result);
|
164 |
finally
|
165 |
Result.Close;
|
166 |
end;
|
167 |
writeln(OutFile);
|
168 |
end;
|
169 |
|
170 |
procedure TTestBase.ReportResult(aValue: IResults);
|
171 |
var i: integer;
|
172 |
s: AnsiString;
|
173 |
begin
|
174 |
for i := 0 to aValue.getCount - 1 do
|
175 |
begin
|
176 |
if aValue[i].IsNull then
|
177 |
writeln(OutFile,aValue[i].Name,' = NULL')
|
178 |
else
|
179 |
case aValue[i].SQLType of
|
180 |
SQL_ARRAY:
|
181 |
begin
|
182 |
if not aValue[i].IsNull then
|
183 |
WriteArray(aValue[i].AsArray);
|
184 |
end;
|
185 |
SQL_FLOAT,SQL_DOUBLE,
|
186 |
SQL_D_FLOAT:
|
187 |
writeln(OutFile, aValue[i].Name,' = ',FormatFloat('#,##0.00',aValue[i].AsFloat));
|
188 |
|
189 |
SQL_INT64:
|
190 |
if aValue[i].Scale <> 0 then
|
191 |
writeln(OutFile, aValue[i].Name,' = ',FormatFloat('#,##0.00',aValue[i].AsFloat))
|
192 |
else
|
193 |
writeln(OutFile,aValue[i].Name,' = ',aValue[i].AsString);
|
194 |
|
195 |
SQL_BLOB:
|
196 |
if aValue[i].IsNull then
|
197 |
writeln(OutFile,aValue[i].Name,' = (null blob)')
|
198 |
else
|
199 |
if aValue[i].SQLSubType = 1 then
|
200 |
begin
|
201 |
s := aValue[i].AsString;
|
202 |
if FHexStrings then
|
203 |
begin
|
204 |
write(OutFile,aValue[i].Name,' = ');
|
205 |
PrintHexString(s);
|
206 |
writeln(OutFile,' (Charset Id = ',aValue[i].GetCharSetID, ' Codepage = ',StringCodePage(s),')');
|
207 |
end
|
208 |
else
|
209 |
begin
|
210 |
writeln(OutFile,aValue[i].Name,' (Charset Id = ',aValue[i].GetCharSetID, ' Codepage = ',StringCodePage(s),')');
|
211 |
writeln(OutFile);
|
212 |
writeln(OutFile,s);
|
213 |
end
|
214 |
end
|
215 |
else
|
216 |
writeln(OutFile,aValue[i].Name,' = (blob), Length = ',aValue[i].AsBlob.GetBlobSize);
|
217 |
|
218 |
SQL_TEXT,SQL_VARYING:
|
219 |
begin
|
220 |
if aValue[i].GetCharSetID = 1 then
|
221 |
s := aValue[i].AsString
|
222 |
else
|
223 |
s := Trim(aValue[i].AsString);
|
224 |
if FHexStrings then
|
225 |
begin
|
226 |
write(OutFile,aValue[i].Name,' = ');
|
227 |
PrintHexString(s);
|
228 |
writeln(OutFile,' (Charset Id = ',aValue[i].GetCharSetID, ' Codepage = ',StringCodePage(s),
|
229 |
' Byte Length = ',Length(aValue[i].AsString),')');
|
230 |
end
|
231 |
else
|
232 |
if aValue[i].GetCharSetID > 0 then
|
233 |
writeln(OutFile,aValue[i].Name,' = ',s,' (Charset Id = ',aValue[i].GetCharSetID, ' Codepage = ',StringCodePage(s),
|
234 |
' Byte Length = ',Length(aValue[i].AsString), ')')
|
235 |
else
|
236 |
writeln(OutFile,aValue[i].Name,' = ',s);
|
237 |
end;
|
238 |
|
239 |
else
|
240 |
writeln(OutFile,aValue[i].Name,' = ',aValue[i].AsString);
|
241 |
end;
|
242 |
end;
|
243 |
end;
|
244 |
|
245 |
procedure TTestBase.PrintHexString(s: AnsiString);
|
246 |
var i: integer;
|
247 |
begin
|
248 |
for i := 1 to length(s) do
|
249 |
write(OutFile,Format('%x ',[byte(s[i])]));
|
250 |
end;
|
251 |
|
252 |
procedure TTestBase.PrintDPB(DPB: IDPB);
|
253 |
var i: integer;
|
254 |
begin
|
255 |
writeln(OutFile,'DPB');
|
256 |
writeln(OutFile,'Count = ', DPB.getCount);
|
257 |
for i := 0 to DPB.getCount - 1 do
|
258 |
writeln(OutFile,DPB[i].getParamType,' = ', DPB[i].AsString);
|
259 |
writeln(OutFile);
|
260 |
end;
|
261 |
|
262 |
procedure TTestBase.PrintMetaData(meta: IMetaData);
|
263 |
var i, j: integer;
|
264 |
ar: IArrayMetaData;
|
265 |
bm: IBlobMetaData;
|
266 |
Bounds: TArrayBounds;
|
267 |
begin
|
268 |
writeln(OutFile,'Metadata');
|
269 |
for i := 0 to meta.GetCount - 1 do
|
270 |
with meta[i] do
|
271 |
begin
|
272 |
writeln(OutFile,'SQLType =',GetSQLTypeName);
|
273 |
writeln(OutFile,'sub type = ',getSubType);
|
274 |
writeln(OutFile,'Table = ',getRelationName);
|
275 |
writeln(OutFile,'Owner = ',getOwnerName);
|
276 |
writeln(OutFile,'Column Name = ',getSQLName);
|
277 |
writeln(OutFile,'Alias Name = ',getAliasName);
|
278 |
writeln(OutFile,'Field Name = ',getName);
|
279 |
writeln(OutFile,'Scale = ',getScale);
|
280 |
writeln(OutFile,'Charset id = ',getCharSetID);
|
281 |
if getIsNullable then writeln(OutFile,'Nullable') else writeln(OutFile,'Not Null');
|
282 |
writeln(OutFile,'Size = ',GetSize);
|
283 |
case getSQLType of
|
284 |
SQL_ARRAY:
|
285 |
begin
|
286 |
writeln(OutFile,'Array Meta Data:');
|
287 |
ar := GetArrayMetaData;
|
288 |
writeln(OutFile,'SQLType =',ar.GetSQLTypeName);
|
289 |
writeln(OutFile,'Scale = ',ar.getScale);
|
290 |
writeln(OutFile,'Charset id = ',ar.getCharSetID);
|
291 |
writeln(OutFile,'Size = ',ar.GetSize);
|
292 |
writeln(OutFile,'Table = ',ar.GetTableName);
|
293 |
writeln(OutFile,'Column = ',ar.GetColumnName);
|
294 |
writeln(OutFile,'Dimensions = ',ar.GetDimensions);
|
295 |
write(OutFile,'Bounds: ');
|
296 |
Bounds := ar.GetBounds;
|
297 |
for j := 0 to Length(Bounds) - 1 do
|
298 |
write(OutFile,'(',Bounds[j].LowerBound,':',Bounds[j].UpperBound,') ');
|
299 |
writeln(OutFile);
|
300 |
end;
|
301 |
SQL_BLOB:
|
302 |
begin
|
303 |
writeln(OutFile);
|
304 |
writeln(OutFile,'Blob Meta Data');
|
305 |
bm := GetBlobMetaData;
|
306 |
writeln(OutFile,'SQL SubType =',bm.GetSubType);
|
307 |
writeln(OutFile,'Table = ',bm.GetRelationName);
|
308 |
writeln(OutFile,'Column = ',bm.GetColumnName);
|
309 |
writeln(OutFile,'CharSetID = ',bm.GetCharSetID);
|
310 |
writeln(OutFile,'Segment Size = ',bm.GetSegmentSize);
|
311 |
writeln(OutFile);
|
312 |
end;
|
313 |
end;
|
314 |
writeln(OutFile);
|
315 |
end;
|
316 |
end;
|
317 |
|
318 |
procedure TTestBase.ParamInfo(SQLParams: ISQLParams);
|
319 |
var i: integer;
|
320 |
begin
|
321 |
writeln(OutFile,'SQL Params');
|
322 |
for i := 0 to SQLParams.Count - 1 do
|
323 |
with SQLParams[i] do
|
324 |
begin
|
325 |
writeln(OutFile,'SQLType =',GetSQLTypeName);
|
326 |
writeln(OutFile,'sub type = ',getSubType);
|
327 |
writeln(OutFile,'Field Name = ',getName);
|
328 |
writeln(OutFile,'Scale = ',getScale);
|
329 |
writeln(OutFile,'Charset id = ',getCharSetID);
|
330 |
if getIsNullable then writeln(OutFile,'Nullable') else writeln(OutFile,'Not Null');
|
331 |
writeln(OutFile,'Size = ',GetSize);
|
332 |
writeln(OutFile);
|
333 |
end;
|
334 |
end;
|
335 |
|
336 |
procedure TTestBase.WriteArray(ar: IArray);
|
337 |
var Bounds: TArrayBounds;
|
338 |
i,j: integer;
|
339 |
begin
|
340 |
write(OutFile,'Array: ');
|
341 |
Bounds := ar.GetBounds;
|
342 |
case ar.GetDimensions of
|
343 |
1:
|
344 |
begin
|
345 |
for i := Bounds[0].LowerBound to Bounds[0].UpperBound do
|
346 |
write(OutFile,'(',i,': ',ar.GetAsVariant([i]),') ');
|
347 |
end;
|
348 |
|
349 |
2:
|
350 |
begin
|
351 |
for i := Bounds[0].LowerBound to Bounds[0].UpperBound do
|
352 |
for j := Bounds[1].LowerBound to Bounds[1].UpperBound do
|
353 |
write(OutFile,'(',i,',',j,': ',ar.GetAsVariant([i,j]),') ');
|
354 |
end;
|
355 |
end;
|
356 |
writeln(OutFile);
|
357 |
end;
|
358 |
|
359 |
procedure TTestBase.WriteAffectedRows(Statement: IStatement);
|
360 |
var SelectCount, InsertCount, UpdateCount, DeleteCount: integer;
|
361 |
begin
|
362 |
Statement.GetRowsAffected(SelectCount, InsertCount, UpdateCount, DeleteCount);
|
363 |
writeln(OutFile,'Select Count = ', SelectCount,' InsertCount = ',InsertCount,' UpdateCount = ', UpdateCount, ' DeleteCount = ',DeleteCount);
|
364 |
end;
|
365 |
|
366 |
function TTestBase.WriteServiceQueryResult(QueryResult: IServiceQueryResults): boolean;
|
367 |
var i: integer;
|
368 |
line: AnsiString;
|
369 |
begin
|
370 |
Result := true;
|
371 |
for i := 0 to QueryResult.GetCount - 1 do
|
372 |
with QueryResult[i] do
|
373 |
case getItemType of
|
374 |
isc_info_svc_version:
|
375 |
writeln(OutFile,'Service Manager Version = ',getAsInteger);
|
376 |
isc_info_svc_server_version:
|
377 |
writeln(OutFile,'Server Version = ',getAsString);
|
378 |
isc_info_svc_implementation:
|
379 |
writeln(OutFile,'Implementation = ',getAsString);
|
380 |
isc_info_svc_get_license:
|
381 |
writeLicence(QueryResult[i]);
|
382 |
isc_info_svc_get_license_mask:
|
383 |
writeln(OutFile,'Licence Mask = ',getAsInteger);
|
384 |
isc_info_svc_capabilities:
|
385 |
writeln(OutFile,'Capabilities = ',getAsInteger);
|
386 |
isc_info_svc_get_config:
|
387 |
WriteConfig(QueryResult[i]);
|
388 |
isc_info_svc_get_env:
|
389 |
writeln(OutFile,'Root Directory = ',getAsString);
|
390 |
isc_info_svc_get_env_lock:
|
391 |
writeln(OutFile,'Lock Directory = ',getAsString);
|
392 |
isc_info_svc_get_env_msg:
|
393 |
writeln(OutFile,'Message File = ',getAsString);
|
394 |
isc_info_svc_user_dbpath:
|
395 |
writeln(OutFile,'Security File = ',getAsString);
|
396 |
isc_info_svc_get_licensed_users:
|
397 |
writeln(OutFile,'Max Licenced Users = ',getAsInteger);
|
398 |
isc_info_svc_get_users:
|
399 |
WriteUsers(QueryResult[i]);
|
400 |
isc_info_svc_svr_db_info:
|
401 |
WriteDBAttachments(QueryResult[i]);
|
402 |
isc_info_svc_line:
|
403 |
begin
|
404 |
line := getAsString;
|
405 |
writeln(OutFile,line);
|
406 |
Result := line <> '';
|
407 |
end;
|
408 |
isc_info_svc_running:
|
409 |
writeln(OutFile,'Is Running = ',getAsInteger);
|
410 |
isc_info_svc_limbo_trans:
|
411 |
WriteLimboTransactions(QueryResult[i]);
|
412 |
isc_info_svc_to_eof,
|
413 |
isc_info_svc_timeout,
|
414 |
isc_info_truncated,
|
415 |
isc_info_data_not_ready,
|
416 |
isc_info_svc_stdin:
|
417 |
{ignore};
|
418 |
else
|
419 |
writeln(OutFile,'Unknown Service Response Item ', getItemType);
|
420 |
end;
|
421 |
writeln(OutFile);
|
422 |
end;
|
423 |
|
424 |
procedure TTestBase.writeLicence(Item: IServiceQueryResultItem);
|
425 |
var i: integer;
|
426 |
begin
|
427 |
for i := 0 to Item.getCount - 1 do
|
428 |
with Item[i] do
|
429 |
case getItemType of
|
430 |
isc_spb_lic_id:
|
431 |
writeln(OutFile,'Licence ID = ',GetAsString);
|
432 |
isc_spb_lic_key:
|
433 |
writeln(OutFile,'Licence Key = ',GetAsString);
|
434 |
end;
|
435 |
end;
|
436 |
|
437 |
procedure TTestBase.WriteConfig(config: IServiceQueryResultItem);
|
438 |
var i: integer;
|
439 |
begin
|
440 |
writeln(OutFile,'Firebird Configuration File');
|
441 |
for i := 0 to config.getCount - 1 do
|
442 |
writeln(OutFile,'Key = ',config[i].getItemType,', Value = ',config[i].getAsInteger);
|
443 |
writeln(OutFile);
|
444 |
end;
|
445 |
|
446 |
procedure TTestBase.WriteUsers(users: IServiceQueryResultItem);
|
447 |
var i: integer;
|
448 |
begin
|
449 |
writeln(OutFile,'Sec. Database User');
|
450 |
for i := 0 to users.getCount - 1 do
|
451 |
with users[i] do
|
452 |
case getItemType of
|
453 |
isc_spb_sec_username:
|
454 |
writeln(OutFile,'User Name = ',getAsString);
|
455 |
isc_spb_sec_firstname:
|
456 |
writeln(OutFile,'First Name = ',getAsString);
|
457 |
isc_spb_sec_middlename:
|
458 |
writeln(OutFile,'Middle Name = ',getAsString);
|
459 |
isc_spb_sec_lastname:
|
460 |
writeln(OutFile,'Last Name = ',getAsString);
|
461 |
isc_spb_sec_userid:
|
462 |
writeln(OutFile,'User ID = ',getAsInteger);
|
463 |
isc_spb_sec_groupid:
|
464 |
writeln(OutFile,'Group ID = ',getAsInteger);
|
465 |
else
|
466 |
writeln(OutFile,'Unknown user info ', getItemType);
|
467 |
end;
|
468 |
writeln(OutFile);
|
469 |
end;
|
470 |
|
471 |
procedure TTestBase.WriteDBAttachments(att: IServiceQueryResultItem);
|
472 |
var i: integer;
|
473 |
begin
|
474 |
writeln(OutFile,'DB Attachments');
|
475 |
for i := 0 to att.getCount - 1 do
|
476 |
with att[i] do
|
477 |
case getItemType of
|
478 |
isc_spb_num_att:
|
479 |
writeln(OutFile,'No. of Attachments = ',getAsInteger);
|
480 |
isc_spb_num_db:
|
481 |
writeln(OutFile,'Databases In Use = ',getAsInteger);
|
482 |
isc_spb_dbname:
|
483 |
writeln(OutFile,'DB Name = ',getAsString);
|
484 |
end;
|
485 |
end;
|
486 |
|
487 |
procedure TTestBase.WriteLimboTransactions(limbo: IServiceQueryResultItem);
|
488 |
var i: integer;
|
489 |
begin
|
490 |
writeln(OutFile,'Limbo Transactions');
|
491 |
for i := 0 to limbo.getCount - 1 do
|
492 |
with limbo[i] do
|
493 |
case getItemType of
|
494 |
isc_spb_single_tra_id:
|
495 |
writeln(OutFile,'Single DB Transaction = ',getAsInteger);
|
496 |
isc_spb_multi_tra_id:
|
497 |
writeln(OutFile,'Multi DB Transaction = ',getAsInteger);
|
498 |
isc_spb_tra_host_site:
|
499 |
writeln(OutFile,'Host Name = ',getAsString);
|
500 |
isc_spb_tra_advise:
|
501 |
writeln(OutFile,'Resolution Advisory = ',getAsInteger);
|
502 |
isc_spb_tra_remote_site:
|
503 |
writeln(OutFile,'Server Name = ',getAsString);
|
504 |
isc_spb_tra_db_path:
|
505 |
writeln(OutFile,'DB Primary File Name = ',getAsString);
|
506 |
isc_spb_tra_state:
|
507 |
begin
|
508 |
write(OutFile,'State = ');
|
509 |
case getAsInteger of
|
510 |
isc_spb_tra_state_limbo:
|
511 |
writeln(OutFile,'limbo');
|
512 |
isc_spb_tra_state_commit:
|
513 |
writeln(OutFile,'commit');
|
514 |
isc_spb_tra_state_rollback:
|
515 |
writeln(OutFile,'rollback');
|
516 |
isc_spb_tra_state_unknown:
|
517 |
writeln(OutFile,'Unknown');
|
518 |
end;
|
519 |
end;
|
520 |
end;
|
521 |
end;
|
522 |
|
523 |
procedure TTestBase.WriteDBInfo(DBInfo: IDBInformation);
|
524 |
var i, j: integer;
|
525 |
bytes: TByteArray;
|
526 |
ConType: integer;
|
527 |
DBFileName: AnsiString;
|
528 |
DBSiteName: AnsiString;
|
529 |
Version: byte;
|
530 |
VersionString: AnsiString;
|
531 |
Users: TStringList;
|
532 |
begin
|
533 |
for i := 0 to DBInfo.GetCount - 1 do
|
534 |
with DBInfo[i] do
|
535 |
case getItemType of
|
536 |
isc_info_db_read_only:
|
537 |
if getAsInteger <> 0 then
|
538 |
writeln(OutFile,'Database is Read Only')
|
539 |
else
|
540 |
writeln(OutFile,'Database is Read/Write');
|
541 |
isc_info_allocation:
|
542 |
writeln(OutFile,'Pages =',getAsInteger);
|
543 |
isc_info_base_level:
|
544 |
begin
|
545 |
bytes := getAsBytes;
|
546 |
write(OutFile,'Base Level = ');
|
547 |
WriteBytes(Bytes);
|
548 |
end;
|
549 |
isc_info_db_id:
|
550 |
begin
|
551 |
DecodeIDCluster(ConType,DBFileName,DBSiteName);
|
552 |
writeln(OutFile,'Database ID = ', ConType,' FB = ', DBFileName, ' SN = ',DBSiteName);
|
553 |
end;
|
554 |
isc_info_implementation:
|
555 |
begin
|
556 |
bytes := getAsBytes;
|
557 |
write(OutFile,'Implementation = ');
|
558 |
WriteBytes(Bytes);
|
559 |
end;
|
560 |
isc_info_no_reserve:
|
561 |
writeln(OutFile,'Reserved = ',getAsInteger);
|
562 |
isc_info_ods_minor_version:
|
563 |
writeln(OutFile,'ODS minor = ',getAsInteger);
|
564 |
isc_info_ods_version:
|
565 |
writeln(OutFile,'ODS major = ',getAsInteger);
|
566 |
isc_info_page_size:
|
567 |
writeln(OutFile,'Page Size = ',getAsInteger);
|
568 |
isc_info_version:
|
569 |
begin
|
570 |
DecodeVersionString(Version,VersionString);
|
571 |
writeln(OutFile,'Version = ',Version,': ',VersionString);
|
572 |
end;
|
573 |
isc_info_current_memory:
|
574 |
writeln(OutFile,'Server Memory = ',getAsInteger);
|
575 |
isc_info_forced_writes:
|
576 |
writeln(OutFile,'Forced Writes = ',getAsInteger);
|
577 |
isc_info_max_memory:
|
578 |
writeln(OutFile,'Max Memory = ',getAsInteger);
|
579 |
isc_info_num_buffers:
|
580 |
writeln(OutFile,'Num Buffers = ',getAsInteger);
|
581 |
isc_info_sweep_interval:
|
582 |
writeln(OutFile,'Sweep Interval = ',getAsInteger);
|
583 |
isc_info_user_names:
|
584 |
begin
|
585 |
Users := TStringList.Create;
|
586 |
try
|
587 |
write(OutFile,'Logged in Users: ');
|
588 |
DecodeUserNames(Users);
|
589 |
for j := 0 to Users.Count - 1 do
|
590 |
write(OutFile,Users[j],',');
|
591 |
|
592 |
finally
|
593 |
Users.Free;
|
594 |
end;
|
595 |
writeln(OutFile);
|
596 |
end;
|
597 |
isc_info_fetches:
|
598 |
writeln(OutFile,'Fetches = ',getAsInteger);
|
599 |
isc_info_marks:
|
600 |
writeln(OutFile,'Writes = ',getAsInteger);
|
601 |
isc_info_reads:
|
602 |
writeln(OutFile,'Reads = ',getAsInteger);
|
603 |
isc_info_writes:
|
604 |
writeln(OutFile,'Page Writes = ',getAsInteger);
|
605 |
isc_info_backout_count:
|
606 |
WriteOperationCounts('Record Version Removals',getOperationCounts);
|
607 |
isc_info_delete_count:
|
608 |
WriteOperationCounts('Deletes',getOperationCounts);
|
609 |
isc_info_expunge_count:
|
610 |
WriteOperationCounts('Expunge Count',getOperationCounts);
|
611 |
isc_info_insert_count:
|
612 |
WriteOperationCounts('Insert Count',getOperationCounts);
|
613 |
isc_info_purge_count:
|
614 |
WriteOperationCounts('Purge Count Countites',getOperationCounts);
|
615 |
isc_info_read_idx_count:
|
616 |
WriteOperationCounts('Indexed Reads Count',getOperationCounts);
|
617 |
isc_info_read_seq_count:
|
618 |
WriteOperationCounts('Sequential Table Scans',getOperationCounts);
|
619 |
isc_info_update_count:
|
620 |
WriteOperationCounts('Update Count',getOperationCounts);
|
621 |
isc_info_db_SQL_Dialect:
|
622 |
writeln(OutFile,'SQL Dialect = ',getAsInteger);
|
623 |
isc_info_creation_date:
|
624 |
writeln(OutFile,'Database Created: ',DateTimeToStr(getAsDateTime));
|
625 |
isc_info_active_tran_count:
|
626 |
writeln(OutFile,'Active Transaction Count = ',getAsInteger);
|
627 |
fb_info_page_contents:
|
628 |
begin
|
629 |
writeln('Database Page');
|
630 |
PrintHexString(getAsString);
|
631 |
writeln;
|
632 |
end;
|
633 |
fb_info_pages_used:
|
634 |
writeln(OutFile,'Pages Used = ',getAsInteger);
|
635 |
fb_info_pages_free:
|
636 |
writeln(OutFile,'Pages Free = ',getAsInteger);
|
637 |
|
638 |
isc_info_truncated:
|
639 |
writeln(OutFile,'Results Truncated');
|
640 |
else
|
641 |
writeln(OutFile,'Unknown Response ',getItemType);
|
642 |
end;
|
643 |
end;
|
644 |
|
645 |
procedure TTestBase.WriteBytes(Bytes: TByteArray);
|
646 |
var i: integer;
|
647 |
begin
|
648 |
for i := 0 to length(Bytes) - 1 do
|
649 |
write(OutFile,Bytes[i],',');
|
650 |
writeln(OutFile);
|
651 |
end;
|
652 |
|
653 |
procedure TTestBase.WriteOperationCounts(Category: AnsiString;
|
654 |
ops: TDBOperationCounts);
|
655 |
var i: integer;
|
656 |
begin
|
657 |
writeln(OutFile,Category,' Operation Counts');
|
658 |
for i := 0 to Length(ops) - 1 do
|
659 |
begin
|
660 |
writeln(OutFile,'Table ID = ',ops[i].TableID);
|
661 |
writeln(OutFile,'Count = ',ops[i].Count);
|
662 |
end;
|
663 |
writeln(OutFile);
|
664 |
end;
|
665 |
|
666 |
procedure TTestBase.WritePerfStats(stats: TPerfCounters);
|
667 |
begin
|
668 |
writeln(OutFile,'Current memory = ', stats[psCurrentMemory]);
|
669 |
writeln(OutFile,'Delta memory = ', stats[psDeltaMemory]);
|
670 |
writeln(OutFile,'Max memory = ', stats[psMaxMemory]);
|
671 |
writeln(OutFile,'Elapsed time= ', FormatFloat('#0.000',stats[psRealTime]/1000),' sec');
|
672 |
writeln(OutFile,'Cpu = ', FormatFloat('#0.000',stats[psUserTime]/1000),' sec');
|
673 |
writeln(OutFile,'Buffers = ', stats[psBuffers]);
|
674 |
writeln(OutFile,'Reads = ', stats[psReads]);
|
675 |
writeln(OutFile,'Writes = ', stats[psWrites]);
|
676 |
writeln(OutFile,'Fetches = ', stats[psFetches]);
|
677 |
end;
|
678 |
|
679 |
procedure TTestBase.CheckActivity(Attachment: IAttachment);
|
680 |
begin
|
681 |
writeln(OutFile,'Database Activity = ',Attachment.HasActivity)
|
682 |
end;
|
683 |
|
684 |
procedure TTestBase.CheckActivity(Transaction: ITransaction);
|
685 |
begin
|
686 |
writeln(OutFile,'Transaction Activity = ',Transaction.HasActivity)
|
687 |
end;
|
688 |
|
689 |
{ TTestManager }
|
690 |
|
691 |
procedure TTestManager.CleanUp;
|
692 |
var DPB: IDPB;
|
693 |
Attachment: IAttachment;
|
694 |
begin
|
695 |
DPB := FirebirdAPI.AllocateDPB;
|
696 |
DPB.Add(isc_dpb_user_name).setAsString(GetUserName);
|
697 |
DPB.Add(isc_dpb_password).setAsString(GetPassword);
|
698 |
Attachment := FirebirdAPI.OpenDatabase(GetNewDatabaseName,DPB,false);
|
699 |
if Attachment <> nil then
|
700 |
Attachment.DropDatabase;
|
701 |
Attachment := FirebirdAPI.OpenDatabase(GetSecondNewDatabaseName,DPB,false);
|
702 |
if Attachment <> nil then
|
703 |
Attachment.DropDatabase;
|
704 |
end;
|
705 |
|
706 |
constructor TTestManager.Create;
|
707 |
begin
|
708 |
inherited Create;
|
709 |
FTests := TList.Create;
|
710 |
FNewDatabaseName := GetTempDir + 'fbtestsuite.fdb';
|
711 |
FSecondNewDatabaseName := GetTempDir + 'fbtestsuite2.fdb';
|
712 |
FUserName := 'SYSDBA';
|
713 |
FPassword := 'masterkey';
|
714 |
FEmployeeDatabaseName := 'employee';
|
715 |
FBackupFileName := GetTempDir + 'testbackup.gbk';
|
716 |
FServer := 'localhost';
|
717 |
end;
|
718 |
|
719 |
destructor TTestManager.Destroy;
|
720 |
var i: integer;
|
721 |
begin
|
722 |
if assigned(FTests) then
|
723 |
begin
|
724 |
for i := 0 to FTests.Count - 1 do
|
725 |
TObject(FTests[i]).Free;
|
726 |
FTests.Free;
|
727 |
end;
|
728 |
inherited Destroy;
|
729 |
end;
|
730 |
|
731 |
function TTestManager.GetUserName: AnsiString;
|
732 |
begin
|
733 |
Result := FUserName;
|
734 |
end;
|
735 |
|
736 |
function TTestManager.GetPassword: AnsiString;
|
737 |
begin
|
738 |
Result := FPassword;
|
739 |
end;
|
740 |
|
741 |
function TTestManager.GetEmployeeDatabaseName: AnsiString;
|
742 |
begin
|
743 |
if FirebirdAPI.GetClientMajor < 3 then
|
744 |
Result := MakeConnectString(FServer, FEmployeeDatabaseName, TCP,FPortNo)
|
745 |
else
|
746 |
Result := MakeConnectString(FServer, FEmployeeDatabaseName, inet,FPortNo);
|
747 |
end;
|
748 |
|
749 |
function TTestManager.GetNewDatabaseName: AnsiString;
|
750 |
begin
|
751 |
if FirebirdAPI.GetClientMajor < 3 then
|
752 |
Result := MakeConnectString(FServer, FNewDatabaseName, TCP,FPortNo)
|
753 |
else
|
754 |
Result := MakeConnectString(FServer, FNewDatabaseName, inet,FPortNo);
|
755 |
end;
|
756 |
|
757 |
function TTestManager.GetSecondNewDatabaseName: AnsiString;
|
758 |
begin
|
759 |
if FirebirdAPI.GetClientMajor < 3 then
|
760 |
Result := MakeConnectString(FServer, FSecondNewDatabaseName, TCP,FPortNo)
|
761 |
else
|
762 |
Result := MakeConnectString(FServer, FSecondNewDatabaseName, inet,FPortNo);
|
763 |
end;
|
764 |
|
765 |
function TTestManager.GetBackupFileName: AnsiString;
|
766 |
begin
|
767 |
Result := FBackupFileName;
|
768 |
end;
|
769 |
|
770 |
procedure TTestManager.RunAll;
|
771 |
var i: integer;
|
772 |
begin
|
773 |
CleanUP;
|
774 |
for i := 0 to FTests.Count - 1 do
|
775 |
with TTestBase(FTests[i]) do
|
776 |
begin
|
777 |
writeln(OutFile,'Running ' + TestTitle);
|
778 |
writeln(ErrOutput,'Running ' + TestTitle);
|
779 |
try
|
780 |
RunTest('UTF8',3);
|
781 |
except on E:Exception do
|
782 |
begin
|
783 |
writeln(OutFile,'Test Completed with Error: ' + E.Message);
|
784 |
Exit;
|
785 |
end;
|
786 |
end;
|
787 |
writeln(OutFile);
|
788 |
writeln(OutFile);
|
789 |
end;
|
790 |
end;
|
791 |
|
792 |
procedure TTestManager.Run(TestID: integer);
|
793 |
begin
|
794 |
CleanUp;
|
795 |
if (TestID <= 0 ) or (TestID > FTests.Count) then
|
796 |
begin
|
797 |
writeln(OutFile,'Invalid Test ID - ',TestID);
|
798 |
Exit;
|
799 |
end;
|
800 |
with TTestBase(FTests[TestID-1]) do
|
801 |
begin
|
802 |
writeln(OutFile,'Running ' + TestTitle);
|
803 |
writeln(ErrOutput,'Running ' + TestTitle);
|
804 |
try
|
805 |
RunTest('UTF8',3);
|
806 |
except on E:Exception do
|
807 |
begin
|
808 |
writeln(OutFile,'Test Completed with Error: ' + E.Message);
|
809 |
Exit;
|
810 |
end;
|
811 |
end;
|
812 |
writeln(OutFile);
|
813 |
writeln(OutFile);
|
814 |
end;
|
815 |
end;
|
816 |
|
817 |
procedure TTestManager.SetUserName(aValue: AnsiString);
|
818 |
begin
|
819 |
FUserName := aValue;
|
820 |
end;
|
821 |
|
822 |
procedure TTestManager.SetPassword(aValue: AnsiString);
|
823 |
begin
|
824 |
FPassword := aValue;
|
825 |
end;
|
826 |
|
827 |
procedure TTestManager.SetEmployeeDatabaseName(aValue: AnsiString);
|
828 |
begin
|
829 |
FEmployeeDatabaseName := aValue;
|
830 |
end;
|
831 |
|
832 |
procedure TTestManager.SetNewDatabaseName(aValue: AnsiString);
|
833 |
begin
|
834 |
FNewDatabaseName := aValue;
|
835 |
end;
|
836 |
|
837 |
procedure TTestManager.SetSecondNewDatabaseName(aValue: AnsiString);
|
838 |
begin
|
839 |
FSecondNewDatabaseName := aValue;
|
840 |
end;
|
841 |
|
842 |
procedure TTestManager.SetBackupFileName(aValue: AnsiString);
|
843 |
begin
|
844 |
FBackupFileName := aValue;
|
845 |
end;
|
846 |
|
847 |
end.
|
848 |
|