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 45 by tony, Tue Dec 6 10:33:46 2016 UTC vs.
Revision 61 by tony, Sun Apr 2 11:40:29 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 52 | 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 89 | 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 120 | 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 188 | 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 311 | 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 470 | 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
496    with DBInfo[i] do
497    case getItemType of
498 +  isc_info_db_read_only:
499 +     if getAsInteger <> 0 then
500 +       writeln(OutFile,'Database is Read Only')
501 +     else
502 +       writeln(OutFile,'Database is Read/Write');
503    isc_info_allocation:
504      writeln(OutFile,'Pages =',getAsInteger);
505    isc_info_base_level:
# Line 559 | Line 580 | begin
580       WriteOperationCounts('Sequential Table Scans',getOperationCounts);
581     isc_info_update_count:
582       WriteOperationCounts('Update Count',getOperationCounts);
583 +   isc_info_db_SQL_Dialect:
584 +     writeln(OutFile,'SQL Dialect = ',getAsInteger);
585     else
586       writeln(OutFile,'Unknown Response ',getItemType);
587    end;
# Line 572 | Line 595 | begin
595    writeln(OutFile);
596   end;
597  
598 < procedure TTestBase.WriteOperationCounts(Category: string;
598 > procedure TTestBase.WriteOperationCounts(Category: AnsiString;
599    ops: TDBOperationCounts);
600   var i: integer;
601   begin
# Line 585 | Line 608 | begin
608    writeln(OutFile);
609   end;
610  
611 + procedure TTestBase.WritePerfStats(stats: TPerfCounters);
612 + begin
613 +  writeln(OutFile,'Current memory = ', stats[psCurrentMemory]);
614 +  writeln(OutFile,'Delta memory = ', stats[psDeltaMemory]);
615 +  writeln(OutFile,'Max memory = ', stats[psMaxMemory]);
616 +  writeln(OutFile,'Elapsed time= ', FormatFloat('#0.000',stats[psRealTime]/1000),' sec');
617 +  writeln(OutFile,'Cpu = ', FormatFloat('#0.000',stats[psUserTime]/1000),' sec');
618 +  writeln(OutFile,'Buffers = ', stats[psBuffers]);
619 +  writeln(OutFile,'Reads = ', stats[psReads]);
620 +  writeln(OutFile,'Writes = ', stats[psWrites]);
621 +  writeln(OutFile,'Fetches = ', stats[psFetches]);
622 + end;
623 +
624   procedure TTestBase.CheckActivity(Attachment: IAttachment);
625   begin
626      writeln(OutFile,'Database Activity = ',Attachment.HasActivity)
# Line 636 | Line 672 | begin
672    inherited Destroy;
673   end;
674  
675 < function TTestManager.GetUserName: string;
675 > function TTestManager.GetUserName: AnsiString;
676   begin
677    Result := FUserName;
678   end;
679  
680 < function TTestManager.GetPassword: string;
680 > function TTestManager.GetPassword: AnsiString;
681   begin
682    Result := FPassword;
683   end;
684  
685 < function TTestManager.GetEmployeeDatabaseName: string;
685 > function TTestManager.GetEmployeeDatabaseName: AnsiString;
686   begin
687    Result := FEmployeeDatabaseName;
688   end;
689  
690 < function TTestManager.GetNewDatabaseName: string;
690 > function TTestManager.GetNewDatabaseName: AnsiString;
691   begin
692    Result := FNewDatabaseName;
693   end;
694  
695 < function TTestManager.GetSecondNewDatabaseName: string;
695 > function TTestManager.GetSecondNewDatabaseName: AnsiString;
696   begin
697    Result := FSecondNewDatabaseName;
698   end;
699  
700 < function TTestManager.GetBackupFileName: string;
700 > function TTestManager.GetBackupFileName: AnsiString;
701   begin
702    Result := FBackupFileName;
703   end;
# Line 674 | Line 710 | begin
710      with TTestBase(FTests[i]) do
711    begin
712      writeln(OutFile,'Running ' + TestTitle);
713 <    writeln(stderr,'Running ' + TestTitle);
713 >    writeln(ErrOutput,'Running ' + TestTitle);
714      try
715        RunTest('UTF8',3);
716      except on E:Exception do
# Line 691 | Line 727 | end;
727   procedure TTestManager.Run(TestID: integer);
728   begin
729    CleanUp;
730 +  if (TestID <= 0 ) or (TestID > FTests.Count) then
731 +  begin
732 +    writeln(OutFile,'Invalid Test ID - ',TestID);
733 +    Exit;
734 +  end;
735    with TTestBase(FTests[TestID-1]) do
736    begin
737      writeln(OutFile,'Running ' + TestTitle);
738 <    writeln(stderr,'Running ' + TestTitle);
738 >    writeln(ErrOutput,'Running ' + TestTitle);
739      try
740        RunTest('UTF8',3);
741      except on E:Exception do
# Line 708 | Line 749 | begin
749    end;
750   end;
751  
752 < procedure TTestManager.SetUserName(aValue: string);
752 > procedure TTestManager.SetUserName(aValue: AnsiString);
753   begin
754    FUserName := aValue;
755   end;
756  
757 < procedure TTestManager.SetPassword(aValue: string);
757 > procedure TTestManager.SetPassword(aValue: AnsiString);
758   begin
759    FPassword := aValue;
760   end;
761  
762 < procedure TTestManager.SetEmployeeDatabaseName(aValue: string);
762 > procedure TTestManager.SetEmployeeDatabaseName(aValue: AnsiString);
763   begin
764    FEmployeeDatabaseName := aValue;
765   end;
766  
767 < procedure TTestManager.SetNewDatabaseName(aValue: string);
767 > procedure TTestManager.SetNewDatabaseName(aValue: AnsiString);
768   begin
769    FNewDatabaseName := aValue;
770   end;
771  
772 < procedure TTestManager.SetSecondNewDatabaseName(aValue: string);
772 > procedure TTestManager.SetSecondNewDatabaseName(aValue: AnsiString);
773   begin
774    FSecondNewDatabaseName := aValue;
775   end;
776  
777 < procedure TTestManager.SetBackupFileName(aValue: string);
777 > procedure TTestManager.SetBackupFileName(aValue: AnsiString);
778   begin
779    FBackupFileName := aValue;
780   end;

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines