1 |
|
unit TestManager; |
2 |
+ |
{$IFDEF MSWINDOWS} |
3 |
+ |
{$DEFINE WINDOWS} |
4 |
+ |
{$ENDIF} |
5 |
|
|
6 |
< |
{$mode objfpc}{$H+} |
6 |
> |
{$IFDEF FPC} |
7 |
> |
{$mode delphi} |
8 |
|
{$codepage utf8} |
9 |
+ |
{$ENDIF} |
10 |
|
|
11 |
|
interface |
12 |
|
|
21 |
|
TTestBase = class |
22 |
|
private |
23 |
|
FOwner: TTestManager; |
19 |
– |
FOutputFi: TFileStream; |
24 |
|
protected |
25 |
|
FHexStrings: boolean; |
26 |
|
function ReportResults(Statement: IStatement): IResultSet; |
27 |
|
procedure ReportResult(aValue: IResults); |
28 |
< |
procedure PrintHexString(s: string); |
28 |
> |
procedure PrintHexString(s: AnsiString); |
29 |
|
procedure PrintDPB(DPB: IDPB); |
30 |
|
procedure PrintMetaData(meta: IMetaData); |
31 |
|
procedure ParamInfo(SQLParams: ISQLParams); |
39 |
|
procedure WriteLimboTransactions(limbo: IServiceQueryResultItem); |
40 |
|
procedure WriteDBInfo(DBInfo: IDBInformation); |
41 |
|
procedure WriteBytes(Bytes: TByteArray); |
42 |
< |
procedure WriteOperationCounts(Category: string; ops: TDBOperationCounts); |
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: string; virtual; abstract; |
49 |
< |
procedure RunTest(CharSet: string; SQLDialect: integer); virtual; abstract; |
48 |
> |
function TestTitle: AnsiString; virtual; abstract; |
49 |
> |
procedure RunTest(CharSet: AnsiString; SQLDialect: integer); virtual; abstract; |
50 |
|
property Owner: TTestManager read FOwner; |
51 |
|
end; |
52 |
|
|
57 |
|
TTestManager = class |
58 |
|
private |
59 |
|
FTests: TList; |
60 |
< |
FEmployeeDatabaseName: string; |
61 |
< |
FNewDatabaseName: string; |
62 |
< |
FSecondNewDatabaseName: string; |
63 |
< |
FUserName: string; |
64 |
< |
FPassword: string; |
65 |
< |
FBackupFileName: string; |
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: string; |
72 |
< |
function GetPassword: string; |
73 |
< |
function GetEmployeeDatabaseName: string; |
74 |
< |
function GetNewDatabaseName: string; |
75 |
< |
function GetSecondNewDatabaseName: string; |
76 |
< |
function GetBackupFileName: string; |
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: string); |
80 |
< |
procedure SetPassword(aValue: string); |
81 |
< |
procedure SetEmployeeDatabaseName(aValue: string); |
82 |
< |
procedure SetNewDatabaseName(aValue: string); |
83 |
< |
procedure SetSecondNewDatabaseName(aValue: string); |
84 |
< |
procedure SetBackupFileName(aValue: string); |
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 |
< |
const |
88 |
> |
var |
89 |
|
TestMgr: TTestManager = nil; |
90 |
|
|
91 |
|
var OutFile: text; |
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 |
136 |
|
|
137 |
|
procedure TTestBase.ReportResult(aValue: IResults); |
138 |
|
var i: integer; |
139 |
< |
s: string; |
139 |
> |
s: AnsiString; |
140 |
|
begin |
141 |
|
for i := 0 to aValue.getCount - 1 do |
142 |
|
begin |
204 |
|
end; |
205 |
|
end; |
206 |
|
|
207 |
< |
procedure TTestBase.PrintHexString(s: string); |
207 |
> |
procedure TTestBase.PrintHexString(s: AnsiString); |
208 |
|
var i: integer; |
209 |
|
begin |
210 |
|
for i := 1 to length(s) do |
327 |
|
|
328 |
|
function TTestBase.WriteServiceQueryResult(QueryResult: IServiceQueryResults): boolean; |
329 |
|
var i: integer; |
330 |
< |
line: string; |
330 |
> |
line: AnsiString; |
331 |
|
begin |
332 |
|
Result := true; |
333 |
|
for i := 0 to QueryResult.GetCount - 1 do |
486 |
|
var i, j: integer; |
487 |
|
bytes: TByteArray; |
488 |
|
ConType: integer; |
489 |
< |
DBFileName: string; |
490 |
< |
DBSiteName: string; |
489 |
> |
DBFileName: AnsiString; |
490 |
> |
DBSiteName: AnsiString; |
491 |
|
Version: byte; |
492 |
< |
VersionString: string; |
492 |
> |
VersionString: AnsiString; |
493 |
|
Users: TStringList; |
494 |
|
begin |
495 |
|
for i := 0 to DBInfo.GetCount - 1 do |
590 |
|
writeln(OutFile); |
591 |
|
end; |
592 |
|
|
593 |
< |
procedure TTestBase.WriteOperationCounts(Category: string; |
593 |
> |
procedure TTestBase.WriteOperationCounts(Category: AnsiString; |
594 |
|
ops: TDBOperationCounts); |
595 |
|
var i: integer; |
596 |
|
begin |
667 |
|
inherited Destroy; |
668 |
|
end; |
669 |
|
|
670 |
< |
function TTestManager.GetUserName: string; |
670 |
> |
function TTestManager.GetUserName: AnsiString; |
671 |
|
begin |
672 |
|
Result := FUserName; |
673 |
|
end; |
674 |
|
|
675 |
< |
function TTestManager.GetPassword: string; |
675 |
> |
function TTestManager.GetPassword: AnsiString; |
676 |
|
begin |
677 |
|
Result := FPassword; |
678 |
|
end; |
679 |
|
|
680 |
< |
function TTestManager.GetEmployeeDatabaseName: string; |
680 |
> |
function TTestManager.GetEmployeeDatabaseName: AnsiString; |
681 |
|
begin |
682 |
|
Result := FEmployeeDatabaseName; |
683 |
|
end; |
684 |
|
|
685 |
< |
function TTestManager.GetNewDatabaseName: string; |
685 |
> |
function TTestManager.GetNewDatabaseName: AnsiString; |
686 |
|
begin |
687 |
|
Result := FNewDatabaseName; |
688 |
|
end; |
689 |
|
|
690 |
< |
function TTestManager.GetSecondNewDatabaseName: string; |
690 |
> |
function TTestManager.GetSecondNewDatabaseName: AnsiString; |
691 |
|
begin |
692 |
|
Result := FSecondNewDatabaseName; |
693 |
|
end; |
694 |
|
|
695 |
< |
function TTestManager.GetBackupFileName: string; |
695 |
> |
function TTestManager.GetBackupFileName: AnsiString; |
696 |
|
begin |
697 |
|
Result := FBackupFileName; |
698 |
|
end; |
705 |
|
with TTestBase(FTests[i]) do |
706 |
|
begin |
707 |
|
writeln(OutFile,'Running ' + TestTitle); |
708 |
< |
writeln(stderr,'Running ' + TestTitle); |
708 |
> |
writeln(ErrOutput,'Running ' + TestTitle); |
709 |
|
try |
710 |
|
RunTest('UTF8',3); |
711 |
|
except on E:Exception do |
722 |
|
procedure TTestManager.Run(TestID: integer); |
723 |
|
begin |
724 |
|
CleanUp; |
725 |
+ |
if (TestID <= 0 ) or (TestID > FTests.Count) then |
726 |
+ |
begin |
727 |
+ |
writeln(OutFile,'Invalid Test ID - ',TestID); |
728 |
+ |
Exit; |
729 |
+ |
end; |
730 |
|
with TTestBase(FTests[TestID-1]) do |
731 |
|
begin |
732 |
|
writeln(OutFile,'Running ' + TestTitle); |
733 |
< |
writeln(stderr,'Running ' + TestTitle); |
733 |
> |
writeln(ErrOutput,'Running ' + TestTitle); |
734 |
|
try |
735 |
|
RunTest('UTF8',3); |
736 |
|
except on E:Exception do |
744 |
|
end; |
745 |
|
end; |
746 |
|
|
747 |
< |
procedure TTestManager.SetUserName(aValue: string); |
747 |
> |
procedure TTestManager.SetUserName(aValue: AnsiString); |
748 |
|
begin |
749 |
|
FUserName := aValue; |
750 |
|
end; |
751 |
|
|
752 |
< |
procedure TTestManager.SetPassword(aValue: string); |
752 |
> |
procedure TTestManager.SetPassword(aValue: AnsiString); |
753 |
|
begin |
754 |
|
FPassword := aValue; |
755 |
|
end; |
756 |
|
|
757 |
< |
procedure TTestManager.SetEmployeeDatabaseName(aValue: string); |
757 |
> |
procedure TTestManager.SetEmployeeDatabaseName(aValue: AnsiString); |
758 |
|
begin |
759 |
|
FEmployeeDatabaseName := aValue; |
760 |
|
end; |
761 |
|
|
762 |
< |
procedure TTestManager.SetNewDatabaseName(aValue: string); |
762 |
> |
procedure TTestManager.SetNewDatabaseName(aValue: AnsiString); |
763 |
|
begin |
764 |
|
FNewDatabaseName := aValue; |
765 |
|
end; |
766 |
|
|
767 |
< |
procedure TTestManager.SetSecondNewDatabaseName(aValue: string); |
767 |
> |
procedure TTestManager.SetSecondNewDatabaseName(aValue: AnsiString); |
768 |
|
begin |
769 |
|
FSecondNewDatabaseName := aValue; |
770 |
|
end; |
771 |
|
|
772 |
< |
procedure TTestManager.SetBackupFileName(aValue: string); |
772 |
> |
procedure TTestManager.SetBackupFileName(aValue: AnsiString); |
773 |
|
begin |
774 |
|
FBackupFileName := aValue; |
775 |
|
end; |