ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/fbintf/testsuite/TestManager.pas
Revision: 61
Committed: Sun Apr 2 11:40:29 2017 UTC (6 years, 11 months ago) by tony
Content type: text/x-pascal
File size: 22748 byte(s)
Log Message:

File Contents

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