--- a/quickSelfTest/RunUnitTests.st Thu Mar 28 13:54:42 2019 +0100
+++ b/quickSelfTest/RunUnitTests.st Thu Mar 28 13:54:53 2019 +0100
@@ -18,7 +18,7 @@
typically invoked by RunUnitTestsStart
[author:]
- sr
+ sr
[instance variables:]
@@ -67,142 +67,153 @@
index := arguments indexOf:'--settingsFile'.
index > 0 ifTrue:[
- settingsFilePathName := arguments at:index + 1.
- self logInfo:'load settings file: ', settingsFilePathName printString.
- settingsFilePathName asFilename fileIn.
- self logInfo:'ParserFlags makeCommand: ', ParserFlags makeCommand printString.
+ settingsFilePathName := arguments at:index + 1.
+ self logInfo:'load settings file: %1' with:settingsFilePathName.
+ settingsFilePathName asFilename fileIn.
+ self logInfo:'makeCommand (from ParserFlags) is: %1' with:(ParserFlags makeCommand).
].
(arguments includes:'--runOnlyExpeccoUnitTests') ifTrue:[
- self logInfo:'configured to run expecco unit tests only'.
- doRunSpecificUnitTests := true.
- unitTestSuiteName := 'expecco Unit Tests'.
- excludedUnitTestClassNames := self excludedUnitTestClassNamesForExpecco.
+ self logInfo:'configured to run expecco unit tests only'.
+ doRunSpecificUnitTests := true.
+ unitTestSuiteName := 'expecco Unit Tests'.
+ excludedUnitTestClassNames := self excludedUnitTestClassNamesForExpecco.
].
index := arguments indexOf:'--resultFile'.
index > 0 ifTrue:[
- resultFilePathName := arguments at:index + 1.
- self logInfo:'set custom result file: ', resultFilePathName printString.
+ resultFilePathName := arguments at:index + 1.
+ self logInfo:'set custom result file: %1' with:resultFilePathName.
+ ].
+
+ [
+ (index := arguments indexOf:'--run') > 0
+ ] whileTrue:[
+ runTestCases add:(arguments at:index + 1).
+ self logInfo:'run test: "%1"' with:(arguments at:index + 1).
+ arguments removeIndex:index + 1.
+ arguments removeIndex:index.
].
- [
- (index := arguments indexOf:'--run') > 0
+ [
+ (index := arguments indexOf:'--exclude') > 0
] whileTrue:[
- runTestCases add:(arguments at:index + 1).
- self logInfo:'run test case: ', (arguments at:index + 1) printString.
- arguments removeIndex:index + 1.
- arguments removeIndex:index.
+ excludedUnitTestClassNames add:(arguments at:index + 1).
+ self logInfo:'exclude test: "%1"' with:(arguments at:index + 1).
+ arguments removeIndex:index + 1.
+ arguments removeIndex:index.
].
-
+
index := arguments indexOf:'--forceTestCase'.
index > 0 ifTrue:[
- forceTestCase := arguments at:index + 1.
- self logInfo:'set force test case: ', forceTestCase printString.
+ forceTestCase := arguments at:index + 1.
+ self logInfo:'run single test (forceTestCase): "%1"' with:forceTestCase.
].
- doRunSpecificUnitTests ifFalse:[
- self logInfo:'configured to run all available unit tests'.
+ (doRunSpecificUnitTests not and:[forceTestCase isNil]) ifTrue:[
+ self logInfo:'configured to run all available unit tests'.
].
- self logInfo:'collecting unit test classes to run'.
+ "/ self logInfo:'collecting tests to run'.
unitTestSuite := TestSuite named:unitTestSuiteName.
(Smalltalk at: #'stx_goodies_regression') classNames do:[:eachClassName |
- (excludedUnitTestClassNames includes:eachClassName) ifTrue:[
- self
- logInfo:('excluded unit test class "%1".'
- bindWith:eachClassName).
- ] ifFalse:[
- (corruptedUnitTestClassNames includes:eachClassName) ifTrue:[
- self
- logWarning:('RunUnitTest: unit test class is marked as corrupted, please fix #%1'
- bindWith:eachClassName).
- ] ifFalse:[
- (eachClassName notNil
- and:[
- "/ skip non test case classes
- (#(
- 'stx_goodies_regression'
- ) includes:eachClassName) not
- and:[
- forceTestCase isNil
- or:[forceTestCase = eachClassName
- or:[forceTestCase = ((eachClassName subStrings:'::') lastIfEmpty:nil)]]
- ]]) ifTrue:[
- eachClass := Smalltalk at:eachClassName.
-
- useCompiledUnitTestClasses ifFalse:[
- "here we want test the jitter code
- therfor we file in, exit if the class is already present somwhow"
- eachClass notNil ifTrue:[
- self
- logWarning:('Unit test class "%1" was already present before file in.'
- bindWith:eachClassName).
+ (excludedUnitTestClassNames includes:eachClassName) ifTrue:[
+ self logInfo:'exclude test "%1".' with:eachClassName.
+ ] ifFalse:[
+ (corruptedUnitTestClassNames includes:eachClassName) ifTrue:[
+ self logWarning:'test "%1" is marked as corrupted, please fix' with:eachClassName.
+ ] ifFalse:[
+ (eachClassName notNil
+ and:[
+ "/ skip non test class classes
+ (#(
+ 'stx_goodies_regression'
+ ) includes:eachClassName) not
+ and:[
+ forceTestCase isNil
+ or:[forceTestCase = eachClassName
+ or:[forceTestCase = ((eachClassName subStrings:'::') lastIfEmpty:nil)]]
+ ]]) ifTrue:[
+ eachClass := Smalltalk at:eachClassName.
- Smalltalk exit:1.
- ].
+ useCompiledUnitTestClasses ifFalse:[
+ "here we want to test the jitter code
+ therfore we file in, exit if the class is already present somwhow"
+ eachClass notNil ifTrue:[
+ self logWarning:'test class "%1" was already present as stc-compiled class before file in.' with:eachClassName.
+ Smalltalk isSmalltalkDevelopmentSystem ifFalse:[
+ Smalltalk exit:1.
+ ].
+ ].
- eachClass := Smalltalk
- fileInClass:eachClassName
- package:'stx:goodies/regression'.
- ].
-
- eachClass notNil ifTrue:[
- (eachClass isTestCaseLike
- and:[eachClass isAbstract not]) ifTrue:[
- self
- logInfo:('added unit test class "%1".'
- bindWith:eachClassName).
+ eachClass := Smalltalk
+ fileInClass:eachClassName
+ package:'stx:goodies/regression'.
+ ].
- unitTestSuite addTest:eachClass suite.
- ] ifFalse:[
- self
- logInfo:('not a unit test class "%1" (class is abstract or something else).'
- bindWith:eachClassName).
- ].
- ] ifFalse:[
- self
- logWarning:('unit test class "%1" is not loaded.'
- bindWith:eachClassName).
- ].
- ] ifFalse:[
- self
- logInfo:('skipped unit test class "%1".'
- bindWith:eachClassName).
- ].
- ].
- ].
+ eachClass notNil ifTrue:[
+ (eachClass isTestCaseLike
+ and:[eachClass isAbstract not]) ifTrue:[
+ self logInfo:'added test "%1".' with:eachClassName.
+ unitTestSuite addTest:eachClass suite.
+ ] ifFalse:[
+ self logInfo:'not a test "%1" (abstract or something else).'
+ with:eachClassName.
+ ].
+ ] ifFalse:[
+ self logWarning:'test class "%1" is not loaded.' with:eachClassName.
+ ].
+ ] ifFalse:[
+ self logInfo:'skipped test "%1".' with:eachClassName.
+ ].
+ ].
+ ].
].
- self
- logInfo:('%1 unit test classes collected'
- bindWith:unitTestSuite tests size).
+ self logInfo:'%1 unit test classes collected' with:unitTestSuite tests size.
self logInfo:'start tests...'.
result := unitTestSuite
- run:TestResultStX new
- beforeEachDo:[:test | self logInfo:'performing unit test ', test printString]
- afterEachDo:[:test| ]
- debug:debug.
+ run:TestResultStX new
+ beforeEachDo:[:test |
+ self logInfo:'performing unit test "%1"' with:test printString
+ ]
+ afterEachDo:[:test :result|
+ |execTime status|
+
+ execTime := result lastOutcome executionTimeDuration.
+ status := result lastOutcome overallOutcome.
+ self logInfo:' Status: %1 (exec. Time: %2)' with:status with:execTime.
+ ]
+ debug:debug.
self logInfo:'tests finished.'.
-
+
self logInfo:'generating xml report...'.
- TestResultReporter
- report:result
- format:#xml_jUnit
- as:resultFilePathName ? 'testresult.xml'.
+ [
+ TestResultReporter
+ report:result
+ format:#xml_jUnit
+ as:(resultFilePathName ? 'testresult.xml').
+ ] on:Error do:[:ex |
+ self logWarning:'error while generating xml report: %1' with:ex description.
+ self logWarning:'in: %1' with:(ex suspendedContext fullPrintAllString).
+ Smalltalk isSmalltalkDevelopmentSystem ifFalse:[
+ Smalltalk exit:1.
+ ].
+ ].
- self logInfo:('xml report in %1' bindWith:(resultFilePathName ? 'testresult.xml') asFilename pathName).
+ self logInfo:'xml report generated in %1' with:(resultFilePathName ? 'testresult.xml') asFilename pathName.
self logInfo:'Summary:'.
- self logInfo:('%1 tests' bindWith:result tests size).
- self logInfo:('%1 run' bindWith:result runCount).
- self logInfo:('%1 skipped' bindWith:result skippedCount).
- self logInfo:('%1 passed' bindWith:result passedCount).
- self logInfo:('%1 failed' bindWith:result failureCount).
- self logInfo:('%1 errors' bindWith:result errorCount).
+ self logInfo:' %1 tests' with:result tests size.
+ self logInfo:' %1 run' with:result runCount.
+ self logInfo:' %1 skipped' with:result skippedCount.
+ self logInfo:' %1 passed' with:result passedCount.
+ self logInfo:' %1 failed' with:result failureCount.
+ self logInfo:' %1 errors' with:result errorCount.
+ self logInfo:' exec. time: %1' with:(TimeDuration fromSeconds:result executionTime).
"Modified (format): / 16-05-2018 / 13:59:47 / sr"
"Modified: / 26-03-2019 / 19:00:38 / Claus Gittinger"
@@ -268,64 +279,64 @@
example2
Processor activeProcess exceptionHandlerSet
- on:Class updateChangeFileQuerySignal
- do:[:ex | ex proceedWith:false].
+ on:Class updateChangeFileQuerySignal
+ do:[:ex | ex proceedWith:false].
self
- runWithCompiledUnitTestClasses:true
- arguments:#(
- '--forceTestCase'
- 'RegressionTests::ExternalStreamTest'
- )
- debug:true
+ runWithCompiledUnitTestClasses:true
+ arguments:#(
+ '--forceTestCase'
+ 'RegressionTests::ExternalStreamTest'
+ )
+ debug:true
"Created: / 26-03-2019 / 18:46:46 / Claus Gittinger"
!
example2b
Processor activeProcess exceptionHandlerSet
- on:Class updateChangeFileQuerySignal
- do:[:ex | ex proceedWith:false].
+ on:Class updateChangeFileQuerySignal
+ do:[:ex | ex proceedWith:false].
self
- runWithCompiledUnitTestClasses:true
- arguments:#(
- '--forceTestCase'
- 'ExternalStreamTest'
- )
- debug:true
+ runWithCompiledUnitTestClasses:true
+ arguments:#(
+ '--forceTestCase'
+ 'ExternalStreamTest'
+ )
+ debug:true
"Created: / 26-03-2019 / 18:55:46 / Claus Gittinger"
!
example2c
Processor activeProcess exceptionHandlerSet
- on:Class updateChangeFileQuerySignal
- do:[:ex | ex proceedWith:false].
+ on:Class updateChangeFileQuerySignal
+ do:[:ex | ex proceedWith:false].
self
- runWithCompiledUnitTestClasses:true
- arguments:#(
- '--forceTestCase'
- 'CRCTests'
- )
- debug:true
+ runWithCompiledUnitTestClasses:true
+ arguments:#(
+ '--forceTestCase'
+ 'CRCTests'
+ )
+ debug:true
"Created: / 26-03-2019 / 18:58:36 / Claus Gittinger"
!
example3
Processor activeProcess exceptionHandlerSet
- on:Class updateChangeFileQuerySignal
- do:[:ex | ex proceedWith:false].
+ on:Class updateChangeFileQuerySignal
+ do:[:ex | ex proceedWith:false].
self
- runWithCompiledUnitTestClasses:true
- arguments:#(
- '--run'
- 'ExternalStreamTest'
- )
- debug:true
+ runWithCompiledUnitTestClasses:true
+ arguments:#(
+ '--run'
+ 'ExternalStreamTest'
+ )
+ debug:true
"Created: / 26-03-2019 / 18:51:42 / Claus Gittinger"
! !
@@ -334,30 +345,34 @@
log:aString type:aType
Transcript notNil ifTrue:[
- Transcript showCR:'%1 [%2] : %3'
- with:Timestamp now printString
- with:(aType printString asLowercase paddedTo:'warning' size)
- with:aString.
- ^ self
- ].
+ Transcript showCR:'%1 [%2] : %3'
+ with:Timestamp now printString
+ with:(aType printString asLowercase paddedTo:'warning' size)
+ with:aString.
+ ^ self
+ ].
Stderr showCR:'%1 [%2] : %3'
- with:Timestamp now printString
- with:(aType printString asLowercase paddedTo:'warning' size)
- with:aString.
+ with:Timestamp now printString
+ with:(aType printString asLowercase paddedTo:'warning' size)
+ with:aString.
"Modified: / 26-03-2019 / 18:53:48 / Claus Gittinger"
!
logInfo:aString
- self
- log:aString
- type:'INFO'
+ self log:aString type:'INFO'
+!
+
+logInfo:aString with:arg
+ self log:(aString bindWith:arg) type:'INFO'
!
logWarning:aString
- self
- log:aString
- type:'WARNING'
+ self log:aString type:'WARNING'
+!
+
+logWarning:aString with:arg
+ self log:(aString bindWith:arg) type:'WARNING'
! !
!RunUnitTests class methodsFor:'documentation'!
@@ -369,4 +384,3 @@
version_CVS
^ '$Header$'
! !
-