quickSelfTest/RunUnitTests.st
author sr
Tue, 10 Oct 2017 15:16:03 +0200
changeset 398 84b58f2602d9
parent 349 ed255c6cf368
child 399 98d1fb9a0b33
permissions -rw-r--r--
#BUGFIX by sr class: RunUnitTests class added: #runWithCompiledUnitTestClasses:

"{ Encoding: utf8 }"

"{ Package: 'stx:goodies/builder/quickSelfTest' }"

"{ NameSpace: Smalltalk }"

Object subclass:#RunUnitTests
	instanceVariableNames:''
	classVariableNames:''
	poolDictionaries:''
	category:'tests-Regression'
!

!RunUnitTests class methodsFor:'documentation'!

documentation
"
    documentation to be added.

    [author:]
	sr

    [instance variables:]

    [class variables:]

    [see also:]

"
! !

!RunUnitTests class methodsFor:'actions'!

run
    |doRunSpecificUnitTests unitTestSuiteName excludedUnitTestClassNames corruptedUnitTestClassNames
     cmdArgs
     unitTestSuite
     eachClassName eachClass
     result index settingsFilePathName|

    doRunSpecificUnitTests := false.
    unitTestSuiteName := 'All Unit Tests'.
    excludedUnitTestClassNames := self excludedUnitTestClassNamesForAll.
    corruptedUnitTestClassNames := self corruptedUnitTestClassNames.

    cmdArgs := Smalltalk commandLineArguments.
    index := cmdArgs indexOf:'--settingsFile'.
    index > 0 ifTrue:[
	settingsFilePathName := cmdArgs at:index + 1.
	self logInfo:'load settings file: ', settingsFilePathName printString.
	settingsFilePathName asFilename fileIn.
	self logInfo:'ParserFlags makeCommand: ', ParserFlags makeCommand printString.
    ].

    (cmdArgs includes:'--runOnlyExpeccoUnitTests') ifTrue:[
	self logInfo:'configured to run expecco unit tests only'.
	doRunSpecificUnitTests := true.
	unitTestSuiteName := 'expecco Unit Tests'.
	excludedUnitTestClassNames := self excludedUnitTestClassNamesForExpecco.
    ].

    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') classNamesAndAttributes do:[:eachClassNameAndAttributes |
	eachClassNameAndAttributes isSymbol ifTrue:[
	    eachClassName := eachClassNameAndAttributes.
	] ifFalse:[
	    eachClassName := eachClassNameAndAttributes
		firstIfEmpty:nil.
	].

	(excludedUnitTestClassNames includes:eachClassName) ifFalse:[
	    (corruptedUnitTestClassNames includes:eachClassName) ifTrue:[
		self
		    logWarning:('corrupted unit test class detected, please fix #%1'
			bindWith:eachClassName).
	    ] ifFalse:[
		eachClassName notNil ifTrue:[
				eachClass := Smalltalk
					fileInClass:eachClassName
					package:'stx:goodies/regression'.

				eachClass notNil ifTrue:[
				eachClass isTestCaseLike ifTrue:[
					unitTestSuite addTest:eachClass suite.
				].
		    ].
		].
	    ].
	].
    ].

    self
	logInfo:('%1 unit test classes collected'
	    bindWith:unitTestSuite tests size).

    self logInfo:'starting unit tests'.
    result := unitTestSuite
	run:TestResultStX new
	beforeEachDo:[:test | self logInfo:'performing unit test ', test printString]
	afterEachDo:[:test| ]
	debug:(cmdArgs includes:'--debug').

    self logInfo:'generating report'.
    TestResultReporter
	report:result
	format:#xml_jUnit
	as:'testresult.xml'.

    self logInfo:'summary:'.
    self logInfo:('%1 tests' bindWith:result runCount).
    self logInfo:('%1 passed' bindWith:result passedCount).
    self logInfo:('%1 failed' bindWith:result failureCount).
    self logInfo:('%1 errors' bindWith:result errorCount).
!

runWithCompiledUnitTestClasses:useCompiledUnitTestClasses
    |doRunSpecificUnitTests unitTestSuiteName excludedUnitTestClassNames corruptedUnitTestClassNames
     cmdArgs
     unitTestSuite
     eachClassName eachClass
     result index settingsFilePathName|

    doRunSpecificUnitTests := false.
    unitTestSuiteName := 'All Unit Tests'.
    excludedUnitTestClassNames := self excludedUnitTestClassNamesForAll.
    corruptedUnitTestClassNames := self corruptedUnitTestClassNames.

    cmdArgs := Smalltalk commandLineArguments.
    index := cmdArgs indexOf:'--settingsFile'.
    index > 0 ifTrue:[
        settingsFilePathName := cmdArgs at:index + 1.
        self logInfo:'load settings file: ', settingsFilePathName printString.
        settingsFilePathName asFilename fileIn.
        self logInfo:'ParserFlags makeCommand: ', ParserFlags makeCommand printString.
    ].

    (cmdArgs includes:'--runOnlyExpeccoUnitTests') ifTrue:[
        self logInfo:'configured to run expecco unit tests only'.
        doRunSpecificUnitTests := true.
        unitTestSuiteName := 'expecco Unit Tests'.
        excludedUnitTestClassNames := self excludedUnitTestClassNamesForExpecco.
    ].

    doRunSpecificUnitTests ifFalse:[
        self logInfo:'configured to run all available unit tests'.
    ].

    self logInfo:'collecting unit test classes to run'.
    unitTestSuite := TestSuite named:unitTestSuiteName.

Transcript showCR:'1 ', (Smalltalk at: #'stx_goodies_regression') printString.
Transcript showCR:'2 ', (Smalltalk at: #'stx_goodies_regression') classNamesAndAttributes printString.

    (Smalltalk at: #'stx_goodies_regression') classNamesAndAttributes do:[:eachClassNameAndAttributes |
        eachClassNameAndAttributes isSymbol ifTrue:[
            eachClassName := eachClassNameAndAttributes.
        ] ifFalse:[
            eachClassName := eachClassNameAndAttributes
                firstIfEmpty:nil.
        ].

        (excludedUnitTestClassNames includes:eachClassName) ifFalse:[
            (corruptedUnitTestClassNames includes:eachClassName) ifTrue:[
                self
                    logWarning:('corrupted unit test class detected, please fix #%1'
                        bindWith:eachClassName).
            ] ifFalse:[
                eachClassName notNil ifTrue:[
                                eachClass := Smalltalk
                                        fileInClass:eachClassName
                                        package:'stx:goodies/regression'.

                                eachClass notNil ifTrue:[
                                eachClass isTestCaseLike ifTrue:[
                                        unitTestSuite addTest:eachClass suite.
                                ].
                    ].
                ].
            ].
        ].
    ].

    self
        logInfo:('%1 unit test classes collected'
            bindWith:unitTestSuite tests size).

    self logInfo:'starting unit tests'.
    result := unitTestSuite
        run:TestResultStX new
        beforeEachDo:[:test | self logInfo:'performing unit test ', test printString]
        afterEachDo:[:test| ]
        debug:(cmdArgs includes:'--debug').

    self logInfo:'generating report'.
    TestResultReporter
        report:result
        format:#xml_jUnit
        as:'testresult.xml'.

    self logInfo:'summary:'.
    self logInfo:('%1 tests' bindWith:result runCount).
    self logInfo:('%1 passed' bindWith:result passedCount).
    self logInfo:('%1 failed' bindWith:result failureCount).
    self logInfo:('%1 errors' bindWith:result errorCount).
! !

!RunUnitTests class methodsFor:'constants'!

corruptedUnitTestClassNames
    ^ #(
	#'RegressionTests::ExternalInterfaceTests'
	#'RegressionTests::HTTPServerTests'
	#'RegressionTests::DebuggerTest'
	#'RegressionTests::ContextTest2'
    )
!

excludedUnitTestClassNamesForAll
    ^ #()
!

excludedUnitTestClassNamesForExpecco
    ^ self excludedUnitTestClassNamesForAll
	, #(
	    #'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::HTTPServerTests'
		#'RegressionTests::DebuggerTest'
		#'RegressionTests::ContextTest2'
	)
! !

!RunUnitTests class methodsFor:'logging'!

log:aString
    type:aType

    Stdout
	showCR:('%1 [%2] : %3'
	    bindWith:Timestamp now printString
	    with:(aType printString asLowercase paddedTo:'warning' size)
	    with:aString).
!

logInfo:aString
    self
	log:aString
	type:'INFO'
!

logWarning:aString
    self
	log:aString
	type:'WARNING'
! !

!RunUnitTests class methodsFor:'documentation'!

version_CVS
    ^ '$Header$'
! !