ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/fbintf/testsuite/TestManager.pas
Revision: 45
Committed: Tue Dec 6 10:33:46 2016 UTC (7 years, 3 months ago) by tony
Content type: text/x-pascal
File size: 21296 byte(s)
Log Message:
Committing updates for Release R2-0-0

File Contents

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