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

Comparing ibx/trunk/fbintf/testsuite/testsuite.lpr (file contents):
Revision 68 by tony, Tue Oct 17 10:07:58 2017 UTC vs.
Revision 315 by tony, Thu Feb 25 11:56:36 2021 UTC

# Line 1 | Line 1
1 + (*
2 + *  Firebird Interface (fbintf) Test suite. This program is used to
3 + *  test the Firebird Pascal Interface and provide a semi-automated
4 + *  pass/fail check for each test.
5 + *
6 + *  The contents of this file are subject to the Initial Developer's
7 + *  Public License Version 1.0 (the "License"); you may not use this
8 + *  file except in compliance with the License. You may obtain a copy
9 + *  of the License here:
10 + *
11 + *    http://www.firebirdsql.org/index.php?op=doc&id=idpl
12 + *
13 + *  Software distributed under the License is distributed on an "AS
14 + *  IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
15 + *  implied. See the License for the specific language governing rights
16 + *  and limitations under the License.
17 + *
18 + *  The Initial Developer of the Original Code is Tony Whyman.
19 + *
20 + *  The Original Code is (C) 2016-2020 Tony Whyman, MWA Software
21 + *  (http://www.mwasoftware.co.uk).
22 + *
23 + *  All Rights Reserved.
24 + *
25 + *  Contributor(s): ______________________________________.
26 + *
27 + *)
28   program testsuite;
29  
30   {$IFDEF FPC}
# Line 9 | Line 36 | uses
36    {$IFDEF UNIX}
37    cthreads,
38    {$ENDIF}
39 <  Classes, SysUtils, CustApp, TestManager, Test1, test2, Test3, Test4, Test5,
39 >  Classes, SysUtils, CustApp, Test1, Test2, Test3, Test4, Test5,
40    Test6, Test7, Test8, Test9, Test10, Test11, Test12, Test13, Test14, Test15,
41 <  Test16, IB;
41 >  Test16, IB, Test17, Test18, TestApplication, FBTestApp;
42  
43   type
44  
45    { TFBIntTestbed }
46  
47 <  TFBIntTestbed = class(TCustomApplication)
21 <  private
22 <    FTestID: integer;
23 <  protected
24 <    procedure DoRun; override;
25 <  public
47 >  TFBIntTestbed = class(TTestApplication)
48      constructor Create(TheOwner: TComponent); override;
27    destructor Destroy; override;
28    procedure WriteHelp; virtual;
49    end;
50  
51   { TFBIntTestbed }
52  
33 procedure TFBIntTestbed.DoRun;
34 var
35  ErrorMsg: String;
36 begin
37  OutFile := stdout;
38  // quick check parameters
39  ErrorMsg := CheckOptions('htupensboS', 'help test user passwd employeedb newdbname secondnewdbname backupfile outfile stats');
40  if ErrorMsg <> '' then begin
41    ShowException(Exception.Create(ErrorMsg));
42    Terminate;
43    Exit;
44  end;
45
46  // parse parameters
47  if HasOption('h', 'help') then begin
48    WriteHelp;
49    Terminate;
50    Exit;
51  end;
52
53  if HasOption('t') then
54    FTestID := StrToInt(GetOptionValue('t'));
55
56  if TestMgr <> nil then
57  begin
58    if HasOption('u','user') then
59      TestMgr.SetUserName(GetOptionValue('u'));
60
61    if HasOption('p','passwd') then
62      TestMgr.SetPassword(GetOptionValue('p'));
63
64    if HasOption('e','employeedb') then
65      TestMgr.SetEmployeeDatabaseName(GetOptionValue('e'));
66
67    if HasOption('n','newdbname') then
68      TestMgr.SetNewDatabaseName(GetOptionValue('n'));
69
70    if HasOption('s','secondnewdbname') then
71      TestMgr.SetSecondNewDatabaseName(GetOptionValue('s'));
72
73    if HasOption('b','backupfile') then
74      TestMgr.SetBackupFileName(GetOptionValue('b'));
75
76    if HasOption('o','outfile') then
77    begin
78      system.Assign(outFile,GetOptionValue('o'));
79      ReWrite(outFile);
80    end;
81
82    TestMgr.ShowStatistics := HasOption('S','stats');
83    {$IF declared(SetTextCodePage)}
84    {Ensure consistent UTF-8 output}
85    SetTextCodePage(OutFile,cp_utf8);
86    {$IFEND}
87
88    {Ensure consistent date reporting across platforms}
89    DefaultFormatSettings.ShortDateFormat := 'd/m/yyyy';
90    DefaultFormatSettings.LongTimeFormat := 'HH:MM:SS';
91    DefaultFormatSettings.DateSeparator := '/';
92
93    writeln(OutFile,Title);
94    writeln(OutFile,'Copyright MWA Software 2016');
95    writeln(OutFile);
96    writeln(OutFile,'Starting Tests');
97    writeln(OutFile,'Client API Version = ',FirebirdAPI.GetImplementationVersion);
98
99    if FTestID = 0 then
100      TestMgr.RunAll
101    else
102      TestMgr.Run(FTestID);
103    TestMgr.Free;
104  end;
105
106  writeln(OutFile,'Test Suite Ends');
107  Flush(OutFile);
108  {$IFDEF WINDOWS}
109  //readln; {uncomment if running from IDE and console window closes before you can view results}
110  {$ENDIF}
111
112  // stop program loop
113  Terminate;
114 end;
115
53   constructor TFBIntTestbed.Create(TheOwner: TComponent);
54   begin
55    inherited Create(TheOwner);
56    StopOnException := True;
57   end;
58  
122 destructor TFBIntTestbed.Destroy;
123 begin
124  inherited Destroy;
125 end;
126
127 procedure TFBIntTestbed.WriteHelp;
128 begin
129  { add your help code here }
130  writeln(OutFile,'Usage: ', ExeName, ' -h');
131 end;
132
59   var
60    Application: TFBIntTestbed;
61   begin
62    Application := TFBIntTestbed.Create(nil);
63 <  Application.Title := 'Firebird API Test Suite';
63 >  Application.Title:='Firebird API Test Suite';
64    Application.Run;
65    Application.Free;
66   end.

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines