fbintf/testsuite/testsuite.lpr

program testsuite;

{$mode objfpc}{$H+}
{$codepage utf8}

uses
  {$IFDEF UNIX}
  cthreads,
  {$ENDIF}
  Classes, SysUtils, CustApp, TestManager, Test1, test2, Test3, Test4, Test5,
  Test6, Test7, Test8, Test9, Test10, Test11, Test12, Test13, Test14, Test15,
  Test16, IB;

type

  { TFBIntTestbed }

  TFBIntTestbed = class(TCustomApplication)
  private
    FTestID: integer;
  protected
    procedure DoRun; override;
  public
    constructor Create(TheOwner: TComponent); override;
    destructor Destroy; override;
    procedure WriteHelp; virtual;
  end;

{ TFBIntTestbed }

procedure TFBIntTestbed.DoRun;
var
  ErrorMsg: String;
begin
  OutFile := stdout;
  // quick check parameters
  ErrorMsg := CheckOptions('htupensboS', 'help test user passwd employeedb newdbname secondnewdbname backupfile outfile stats');
  if ErrorMsg <> '' then begin
    ShowException(Exception.Create(ErrorMsg));
    Terminate;
    Exit;
  end;

  // parse parameters
  if HasOption('h', 'help') then begin
    WriteHelp;
    Terminate;
    Exit;
  end;

  if HasOption('t') then
    FTestID := StrToInt(GetOptionValue('t'));

  if TestMgr <> nil then
  begin
    if HasOption('u','user') then
      TestMgr.SetUserName(GetOptionValue('u'));

    if HasOption('p','passwd') then
      TestMgr.SetPassword(GetOptionValue('p'));

    if HasOption('e','employeedb') then
      TestMgr.SetEmployeeDatabaseName(GetOptionValue('e'));

    if HasOption('n','newdbname') then
      TestMgr.SetNewDatabaseName(GetOptionValue('n'));

    if HasOption('s','secondnewdbname') then
      TestMgr.SetSecondNewDatabaseName(GetOptionValue('s'));

    if HasOption('b','backupfile') then
      TestMgr.SetBackupFileName(GetOptionValue('b'));

    if HasOption('o','outfile') then
    begin
      system.Assign(outFile,GetOptionValue('o'));
      ReWrite(outFile);
    end;

    TestMgr.ShowStatistics := HasOption('S','stats');

    {Ensure consistent date reporting across platforms}
    DefaultFormatSettings.ShortDateFormat := 'd/m/yyyy';
    DefaultFormatSettings.DateSeparator := '/';

    writeln(OutFile,Title);
    writeln(OutFile,'Copyright MWA Software 2016');
    writeln(OutFile);
    writeln(OutFile,'Starting Tests');
    writeln(OutFile,'Client API Version = ',FirebirdAPI.GetImplementationVersion);

    if FTestID = 0 then
      TestMgr.RunAll
    else
      TestMgr.Run(FTestID);
    TestMgr.Free;
  end;

  writeln(OutFile,'Test Suite Ends');
  Flush(OutFile);
  {$IFDEF WINDOWS}
  //readln; {uncomment if running from IDE and console window closes before you can view results}
  {$ENDIF}

  // stop program loop
  Terminate;
end;

constructor TFBIntTestbed.Create(TheOwner: TComponent);
begin
  inherited Create(TheOwner);
  StopOnException := True;
end;

destructor TFBIntTestbed.Destroy;
begin
  inherited Destroy;
end;

procedure TFBIntTestbed.WriteHelp;
begin
  { add your help code here }
  writeln(OutFile,'Usage: ', ExeName, ' -h');
end;

var
  Application: TFBIntTestbed;
begin
  Application := TFBIntTestbed.Create(nil);
  Application.Title := 'Firebird API Test Suite';
  Application.Run;
  Application.Free;
end.

Revision:	45
Committed:	Tue Dec 6 10:33:46 2016 UTC (7 years, 4 months ago) by tony
Original Path:	*ibx/trunk/fbintf/testsuite/testsuite.lpr*
File size:	3111 byte(s)
Log Message:	Committing updates for Release R2-0-0
#	User	Rev	Content
1	tony	45	program testsuite;
2
3			{$mode objfpc}{$H+}
4			{$codepage utf8}
5
6			uses
7			{$IFDEF UNIX}
8			cthreads,
9			{$ENDIF}
10			Classes, SysUtils, CustApp, TestManager, Test1, test2, Test3, Test4, Test5,
11			Test6, Test7, Test8, Test9, Test10, Test11, Test12, Test13, Test14, Test15,
12			Test16, IB;
13
14			type
15
16			{ TFBIntTestbed }
17
18			TFBIntTestbed = class(TCustomApplication)
19			private
20			FTestID: integer;
21			protected
22			procedure DoRun; override;
23			public
24			constructor Create(TheOwner: TComponent); override;
25			destructor Destroy; override;
26			procedure WriteHelp; virtual;
27			end;
28
29			{ TFBIntTestbed }
30
31			procedure TFBIntTestbed.DoRun;
32			var
33			ErrorMsg: String;
34			begin
35			OutFile := stdout;
36			// quick check parameters
37			ErrorMsg := CheckOptions('htupensboS', 'help test user passwd employeedb newdbname secondnewdbname backupfile outfile stats');
38			if ErrorMsg <> '' then begin
39			ShowException(Exception.Create(ErrorMsg));
40			Terminate;
41			Exit;
42			end;
43
44			// parse parameters
45			if HasOption('h', 'help') then begin
46			WriteHelp;
47			Terminate;
48			Exit;
49			end;
50
51			if HasOption('t') then
52			FTestID := StrToInt(GetOptionValue('t'));
53
54			if TestMgr <> nil then
55			begin
56			if HasOption('u','user') then
57			TestMgr.SetUserName(GetOptionValue('u'));
58
59			if HasOption('p','passwd') then
60			TestMgr.SetPassword(GetOptionValue('p'));
61
62			if HasOption('e','employeedb') then
63			TestMgr.SetEmployeeDatabaseName(GetOptionValue('e'));
64
65			if HasOption('n','newdbname') then
66			TestMgr.SetNewDatabaseName(GetOptionValue('n'));
67
68			if HasOption('s','secondnewdbname') then
69			TestMgr.SetSecondNewDatabaseName(GetOptionValue('s'));
70
71			if HasOption('b','backupfile') then
72			TestMgr.SetBackupFileName(GetOptionValue('b'));
73
74			if HasOption('o','outfile') then
75			begin
76			system.Assign(outFile,GetOptionValue('o'));
77			ReWrite(outFile);
78			end;
79
80			TestMgr.ShowStatistics := HasOption('S','stats');
81
82			{Ensure consistent date reporting across platforms}
83			DefaultFormatSettings.ShortDateFormat := 'd/m/yyyy';
84			DefaultFormatSettings.DateSeparator := '/';
85
86			writeln(OutFile,Title);
87			writeln(OutFile,'Copyright MWA Software 2016');
88			writeln(OutFile);
89			writeln(OutFile,'Starting Tests');
90			writeln(OutFile,'Client API Version = ',FirebirdAPI.GetImplementationVersion);
91
92			if FTestID = 0 then
93			TestMgr.RunAll
94			else
95			TestMgr.Run(FTestID);
96			TestMgr.Free;
97			end;
98
99			writeln(OutFile,'Test Suite Ends');
100			Flush(OutFile);
101			{$IFDEF WINDOWS}
102			//readln; {uncomment if running from IDE and console window closes before you can view results}
103			{$ENDIF}
104
105			// stop program loop
106			Terminate;
107			end;
108
109			constructor TFBIntTestbed.Create(TheOwner: TComponent);
110			begin
111			inherited Create(TheOwner);
112			StopOnException := True;
113			end;
114
115			destructor TFBIntTestbed.Destroy;
116			begin
117			inherited Destroy;
118			end;
119
120			procedure TFBIntTestbed.WriteHelp;
121			begin
122			{ add your help code here }
123			writeln(OutFile,'Usage: ', ExeName, ' -h');
124			end;
125
126			var
127			Application: TFBIntTestbed;
128			begin
129			Application := TFBIntTestbed.Create(nil);
130			Application.Title := 'Firebird API Test Suite';
131			Application.Run;
132			Application.Free;
133			end.
134