"{ 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: %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.
].
index := arguments indexOf:'--resultFile'.
index > 0 ifTrue:[
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:'--exclude') > 0
] whileTrue:[
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:'run single test (forceTestCase): "%1"' with:forceTestCase.
].
(doRunSpecificUnitTests not and:[forceTestCase isNil]) ifTrue:[
self logInfo:'configured to run all available unit tests'.
].
"/ self logInfo:'collecting tests to run'.
unitTestSuite := TestSuite named:unitTestSuiteName.
(Smalltalk at: #'stx_goodies_regression') classNames do:[:eachClassName |
(excludedUnitTestClassNames includes:eachClassName) ifTrue:[
self logInfo:'exclude test "%1".' with:eachClassName.
] ifFalse:[
(runTestCases notEmptyOrNil and:[(runTestCases includes:eachClassName) not]) ifTrue:[
self logInfo:'not selected: "%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.
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 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' with:unitTestSuite tests size.
self logInfo:'start tests...'.
result := unitTestSuite
run:TestResultStX new
beforeEachDo:[:test |
self logInfo:'Run "%1"' with:test printString
]
afterEachDo:[:test :result|
|execTime status|
execTime := result lastOutcome executionTimeDuration.
status := result lastOutcome result.
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').
] 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 generated in %1' with:(resultFilePathName ? 'testresult.xml') asFilename pathName.
self logInfo:'Summary:'.
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"
! !
!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
|fmt msg|
fmt := '%1 RunUnitTests [%2]: %3'.
fmt := 'RunUnitTests [%2]: %3'.
msg := fmt
bindWith:Timestamp now printString
with:(aType printString asLowercase "paddedTo:'warning' size")
with:aString.
Transcript notNil ifTrue:[
Transcript showCR:msg.
^ self
].
Stderr notNil ifTrue:[
Stderr showCR:msg.
].
"Modified: / 26-03-2019 / 18:53:48 / Claus Gittinger"
!
logInfo:aString
self log:aString type:'INFO'
!
logInfo:aString with:arg
self log:(aString bindWith:arg) type:'INFO'
!
logInfo:aString with:arg1 with:arg2
self log:(aString bindWith:arg1 with:arg2) type:'INFO'
!
logWarning:aString
self log:aString type:'WARNING'
!
logWarning:aString with:arg
self log:(aString bindWith:arg) type:'WARNING'
! !
!RunUnitTests class methodsFor:'documentation'!
version
^ '$Header$'
!
version_CVS
^ '$Header$'
! !