|
@@ -28,7 +28,12 @@ unit ConsoleTestRunner;
|
|
interface
|
|
interface
|
|
|
|
|
|
uses
|
|
uses
|
|
- NodeJSApp, Classes, SysUtils,
|
|
|
|
|
|
+ {$IFDEF NODEJS}
|
|
|
|
+ NodeJSApp,
|
|
|
|
+ {$else}
|
|
|
|
+ BrowserApp,
|
|
|
|
+ {$endif}
|
|
|
|
+ Classes, SysUtils,
|
|
FPCUnit, TestRegistry, TestDecorator,
|
|
FPCUnit, TestRegistry, TestDecorator,
|
|
//testutils,
|
|
//testutils,
|
|
FPCUnitReport,
|
|
FPCUnitReport,
|
|
@@ -56,13 +61,27 @@ var
|
|
type
|
|
type
|
|
{ TTestRunner }
|
|
{ TTestRunner }
|
|
|
|
|
|
- TTestRunner = class(TNodeJSApplication)
|
|
|
|
|
|
+ { TRunForm }
|
|
|
|
+ // For compatibility with browser testrunner
|
|
|
|
+ TRunForm = class(TComponent)
|
|
private
|
|
private
|
|
|
|
+ FOnRun: TNotifyEvent;
|
|
|
|
+ Public
|
|
|
|
+ Procedure Initialize; virtual;
|
|
|
|
+ Property OnRun : TNotifyEvent Read FOnRun Write FOnRun;
|
|
|
|
+ end;
|
|
|
|
+ TRunFormClass = class of TRunForm;
|
|
|
|
+
|
|
|
|
+ TTestRunner = class({$IFDEF NODEJS}TNodeJSApplication{$ELSE}TBrowserApplication {$ENDIF})
|
|
|
|
+ private
|
|
|
|
+ FRunFormClass: TRunFormClass;
|
|
|
|
+ FLastTest : TTest;
|
|
FShowProgress: boolean;
|
|
FShowProgress: boolean;
|
|
FFileName: string;
|
|
FFileName: string;
|
|
FStyleSheet: string;
|
|
FStyleSheet: string;
|
|
FLongOpts: TStrings;
|
|
FLongOpts: TStrings;
|
|
FFormatParam: TFormat;
|
|
FFormatParam: TFormat;
|
|
|
|
+ procedure DoRunAgain(Sender: TObject);
|
|
protected
|
|
protected
|
|
property FileName: string read FFileName write FFileName;
|
|
property FileName: string read FFileName write FFileName;
|
|
property LongOpts: TStrings read FLongOpts write FLongOpts;
|
|
property LongOpts: TStrings read FLongOpts write FLongOpts;
|
|
@@ -80,6 +99,7 @@ type
|
|
public
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
destructor Destroy; override;
|
|
|
|
+ Property RunFormClass : TRunFormClass Read FRunFormClass Write FRunFormClass;
|
|
end;
|
|
end;
|
|
|
|
|
|
implementation
|
|
implementation
|
|
@@ -200,6 +220,8 @@ var
|
|
TS : TDecoratorTestSuite;
|
|
TS : TDecoratorTestSuite;
|
|
T : TTest;
|
|
T : TTest;
|
|
|
|
|
|
|
|
+ R : TRunForm;
|
|
|
|
+
|
|
begin
|
|
begin
|
|
S := CheckOptions(GetShortOpts, LongOpts);
|
|
S := CheckOptions(GetShortOpts, LongOpts);
|
|
if (S <> '') then
|
|
if (S <> '') then
|
|
@@ -217,7 +239,12 @@ begin
|
|
//Write(GetSuiteAsXml(GetTestRegistry));
|
|
//Write(GetSuiteAsXml(GetTestRegistry));
|
|
Write(GetSuiteAsPlain(GetTestRegistry));
|
|
Write(GetSuiteAsPlain(GetTestRegistry));
|
|
end;
|
|
end;
|
|
-
|
|
|
|
|
|
+ If Assigned(RunFormClass) then
|
|
|
|
+ begin
|
|
|
|
+ R:=RunFormClass.Create(Self);
|
|
|
|
+ R.OnRun:=@DoRunAgain;
|
|
|
|
+ R.Initialize;
|
|
|
|
+ end;
|
|
//run the tests
|
|
//run the tests
|
|
if HasOption('suite') then
|
|
if HasOption('suite') then
|
|
begin
|
|
begin
|
|
@@ -261,11 +288,13 @@ begin
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure TTestRunner.DoTestRun(ATest: TTest);
|
|
procedure TTestRunner.DoTestRun(ATest: TTest);
|
|
|
|
+
|
|
var
|
|
var
|
|
ResultsWriter: TCustomResultsWriter;
|
|
ResultsWriter: TCustomResultsWriter;
|
|
ProgressWriter: TProgressWriter;
|
|
ProgressWriter: TProgressWriter;
|
|
TestResult: TTestResult;
|
|
TestResult: TTestResult;
|
|
begin
|
|
begin
|
|
|
|
+ FLastTest:=aTest;
|
|
ResultsWriter := GetResultsWriter;
|
|
ResultsWriter := GetResultsWriter;
|
|
ResultsWriter.Filename := FileName;
|
|
ResultsWriter.Filename := FileName;
|
|
TestResult := TTestResult.Create;
|
|
TestResult := TTestResult.Create;
|
|
@@ -385,5 +414,18 @@ begin
|
|
inherited Destroy;
|
|
inherited Destroy;
|
|
end;
|
|
end;
|
|
|
|
|
|
|
|
+procedure TTestRunner.DoRunAgain(Sender : TObject);
|
|
|
|
+
|
|
|
|
+begin
|
|
|
|
+ if Assigned(FLastTest) then
|
|
|
|
+ DoTestRun(FLastTest);
|
|
|
|
+end;
|
|
|
|
+
|
|
|
|
+procedure TRunForm.Initialize;
|
|
|
|
+begin
|
|
|
|
+ // Do nothing
|
|
|
|
+end;
|
|
|
|
+
|
|
|
|
+
|
|
end.
|
|
end.
|
|
|
|
|