ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/fbintf/testsuite/TestManager.pas
Revision: 47
Committed: Mon Jan 9 15:31:51 2017 UTC (7 years, 2 months ago) by tony
Content type: text/x-pascal
File size: 22049 byte(s)
Log Message:
Committing updates for Release R2-0-1

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