diff --git a/packages/fcl-fpcunit/src/consoletestrunner.pas b/packages/fcl-fpcunit/src/consoletestrunner.pas index edbf428105..d0db43a817 100644 --- a/packages/fcl-fpcunit/src/consoletestrunner.pas +++ b/packages/fcl-fpcunit/src/consoletestrunner.pas @@ -63,6 +63,7 @@ type FSkipAddressInfo : Boolean; FSuite: String; FRunMode : TRunMode; + procedure DoStatus(const msg: string); protected Class function StrToFormat(const S: String): TFormat; function DefaultsFileName: String; @@ -97,10 +98,10 @@ uses inifiles, testdecorator; {$ENDIF FPC_DOTTEDUNITS} const - ShortOpts = 'alhpsyrn'; - DefaultLongOpts: array[1..11] of string = + ShortOpts = 'alhpsyrnu'; + DefaultLongOpts: array[1..12] of string = ('all', 'list', 'progress', 'help', 'skiptiming', - 'suite:', 'format:', 'file:', 'stylesheet:','sparse','no-addresses'); + 'suite:', 'format:', 'file:', 'stylesheet:','sparse','no-addresses','status'); Type TTestDecoratorClass = Class of TTestDecorator; @@ -242,6 +243,11 @@ begin inherited Destroy; end; +procedure TTestRunner.DoStatus(const msg: string); +begin + Writeln(stderr,msg); +end; + class function TTestRunner.StrToFormat(const S: String): TFormat; begin @@ -342,6 +348,7 @@ begin writeln(' -l or --list show a list of registered tests'); writeln(' -a or --all run all tests'); writeln(' -p or --progress show progress'); + writeln(' -u or --status show status messages on stderr'); writeln(' -s or --suite=MyTestSuiteName run single test suite class'); WriteCustomHelp; writeln; @@ -422,6 +429,8 @@ begin FSparse:=True; If HasOption('n','no-addresses') then FSkipAddressInfo:=True; + If HasOption('u','status') then + TAssert.StatusEvent:=@DoStatus; // Determine runmode if HasOption('s','suite') then begin diff --git a/packages/fcl-fpcunit/src/fpcunit.pp b/packages/fcl-fpcunit/src/fpcunit.pp index ca45130429..c7d61c4502 100644 --- a/packages/fcl-fpcunit/src/fpcunit.pp +++ b/packages/fcl-fpcunit/src/fpcunit.pp @@ -100,6 +100,14 @@ type protected Class var AssertCount : Integer; public + type + TStatusHook = Procedure(const msg : string); + TStatusEvent = Procedure(const msg : string) of object; + class var StatusHook : TStatusHook; + class var StatusEvent : TStatusEvent; + public + class procedure Status(const aMsg: String); inline; + class procedure Status(const aMsg: String; const aArgs: array of const); inline; class procedure Fail(const AMessage: string; AErrorAddrs: Pointer = nil); class procedure Fail(const AFmt: string; Args : Array of const; AErrorAddrs: Pointer = nil); class procedure FailEquals(const expected, actual: string; const ErrorMsg: string = ''; AErrorAddrs: Pointer = nil); @@ -647,6 +655,19 @@ end; { TAssert } +class procedure TAssert.Status(const aMsg: String); +begin + If Assigned(StatusHook) then + StatusHook(aMsg); + if Assigned(StatusEvent) then + StatusEvent(aMsg); +end; + +class procedure TAssert.Status(const aMsg: String; const aArgs: array of const); +begin + Status(SafeFormat(aMsg,aArgs)); +end; + class procedure TAssert.Fail(const AMessage: string; AErrorAddrs: Pointer); begin Inc(AssertCount);