ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/fbintf/testsuite/TestManager.pas
(Generate patch)

Comparing ibx/trunk/fbintf/testsuite/TestManager.pas (file contents):
Revision 55 by tony, Mon Jan 9 15:31:51 2017 UTC vs.
Revision 56 by tony, Mon Mar 6 10:20:02 2017 UTC

# Line 1 | Line 1
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  
# Line 16 | Line 21 | type
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);
# Line 35 | Line 39 | type
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  
# Line 53 | Line 57 | type
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;
# Line 90 | Line 94 | 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
# Line 121 | Line 136 | end;
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
# Line 189 | Line 204 | 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
# Line 312 | Line 327 | end;
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
# Line 471 | Line 486 | procedure TTestBase.WriteDBInfo(DBInfo:
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
# Line 575 | Line 590 | begin
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
# Line 652 | Line 667 | 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;
# Line 690 | Line 705 | begin
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
# Line 707 | Line 722 | end;
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
# Line 724 | Line 744 | begin
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;

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines