#DOCUMENTATION by cg
class: stx_goodies_builder_quickSelfTest
class definition
class: stx_goodies_builder_quickSelfTest class
added:18 methods
"{ Encoding: utf8 }"
"{ Package: 'stx:goodies/builder/quickSelfTest' }"
"{ NameSpace: Smalltalk }"
Object subclass:#RunUnitTests
instanceVariableNames:''
classVariableNames:''
poolDictionaries:''
category:'tests-Regression'
!
!RunUnitTests class methodsFor:'documentation'!
documentation
"
typically invoked by RunUnitTestsStart
[author:]
sr
[instance variables:]
[class variables:]
[see also:]
"
! !
!RunUnitTests class methodsFor:'actions'!
run
self runWithCompiledUnitTestClasses:false.
!
runWithCompiledUnitTestClasses:useCompiledUnitTestClasses
|cmdArgs|
cmdArgs := Smalltalk commandLineArguments.
self
runWithCompiledUnitTestClasses:useCompiledUnitTestClasses
arguments:cmdArgs
debug:(cmdArgs includes:'--debug')
!
runWithCompiledUnitTestClasses:useCompiledUnitTestClasses
arguments:argumentsIn
debug:debug
|arguments
doRunSpecificUnitTests unitTestSuiteName excludedUnitTestClassNames corruptedUnitTestClassNames
unitTestSuite
eachClass
result index
settingsFilePathName resultFilePathName forceTestCase runTestCases|
arguments := argumentsIn asOrderedCollection.
runTestCases := OrderedCollection new.
doRunSpecificUnitTests := false.
unitTestSuiteName := 'All Unit Tests'.
excludedUnitTestClassNames := self excludedUnitTestClassNamesForAll.
corruptedUnitTestClassNames := self corruptedUnitTestClassNames.
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.
].
(arguments includes:'--runOnlyExpeccoUnitTests') ifTrue:[
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.
].
[
(index := arguments indexOf:'--run') > 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.
].
index := arguments indexOf:'--forceTestCase'.
index > 0 ifTrue:[
forceTestCase := arguments at:index + 1.
self logInfo:'set force test case: ', forceTestCase printString.
].
doRunSpecificUnitTests ifFalse:[
self logInfo:'configured to run all available unit tests'.
].
self logInfo:'collecting unit test classes 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).
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).
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).
].
].
].
].
self
logInfo:('%1 unit test classes collected'
bindWith: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.
self logInfo:'tests finished.'.
self logInfo:'generating xml report...'.
TestResultReporter
report:result
format:#xml_jUnit
as:resultFilePathName ? 'testresult.xml'.
self logInfo:('xml report in %1' bindWith:(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).
"Modified (format): / 16-05-2018 / 13:59:47 / sr"
"Modified: / 26-03-2019 / 19:00:38 / Claus Gittinger"
! !
!RunUnitTests class methodsFor:'constants'!
corruptedUnitTestClassNames
^ #(
#'RegressionTests::ExternalInterfaceTests'
#'RegressionTests::DebuggerTest'
#'RegressionTests::ContextTest2'
)
!
excludedUnitTestClassNamesForAll
^ #(
#'RegressionTests::SelectorNamespacesTests'
)
!
excludedUnitTestClassNamesForExpecco
^ self excludedUnitTestClassNamesForAll
, #(
#'RegressionTests::VMCrashTestCase'
#'RegressionTests::VMCrashTests'
#'RegressionTests::ParserTests'
#'RegressionTests::BreakpointTests'
#'RegressionTests::SunitXMLOutputTest'
#'RegressionTests::CompilerTests2'
#'RegressionTests::BehaviorLookupObjectTests'
#'RegressionTests::ChangeSetTests'
#'RegressionTests::MakefileTests'
#'RegressionTests::MetaphoneStringComparatorTest'
#'RegressionTests::STCCompilerTests'
#'RegressionTests::VMCrashTests'
#'RegressionTests::SnapshotRestartTests'
#'RegressionTests::GraphicDrawingTest'
#'RegressionTests::OS_OLE_Tests'
#'RegressionTests::ExternalInterfaceTests'
#'RegressionTests::DebuggerTest'
#'RegressionTests::ContextTest2'
#'RegressionTests::QDoubleTests'
)
! !
!RunUnitTests class methodsFor:'examples'!
example1
Processor activeProcess exceptionHandlerSet
on:Class updateChangeFileQuerySignal
do:[:ex | ex proceedWith:false].
self
runWithCompiledUnitTestClasses:true
arguments:#(
'--runOnlyExpeccoUnitTests'
'--forceTestCase'
'ExternalStreamTest'
)
debug:true
!
example2
Processor activeProcess exceptionHandlerSet
on:Class updateChangeFileQuerySignal
do:[:ex | ex proceedWith:false].
self
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].
self
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].
self
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].
self
runWithCompiledUnitTestClasses:true
arguments:#(
'--run'
'ExternalStreamTest'
)
debug:true
"Created: / 26-03-2019 / 18:51:42 / Claus Gittinger"
! !
!RunUnitTests class methodsFor:'logging'!
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
].
Stderr showCR:'%1 [%2] : %3'
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'
!
logWarning:aString
self
log:aString
type:'WARNING'
! !
!RunUnitTests class methodsFor:'documentation'!
version
^ '$Header$'
!
version_CVS
^ '$Header$'
! !