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, 4 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

# User Rev Content
1 tony 45 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