quickSelfTest/RunUnitTests.st
author sr
Tue, 12 Sep 2017 13:33:30 +0200
changeset 335 aaa1ed543bd0
parent 329 6a3fe7cea4e1
child 336 8dcc6a1f364b
permissions -rw-r--r--
*** empty log message ***

'From Smalltalk/X, Version:7.1.0.0 on 12-09-2017 at 13:33:27'                   !

"{ Package: 'stx:goodies/regression' }"

"{ 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|

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

    cmdArgs := Smalltalk commandLineArguments.
    (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.
        ].

        (corruptedUnitTestClassNames includes:eachClassName) ifTrue:[
            self 
                logWarning:('corrupted unit test class detected, please fix #%1' 
                    bindWith:eachClassName).
        ] ifFalse:[
            (excludedUnitTestClassNames includes: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::Win32OLETests'
        #'RegressionTests::HTTPServerTests'
        #'RegressionTests::SocketTests'
        #'RegressionTests::DelayTest'
        #'RegressionTests::ContextTest2'
        #'RegressionTests::DebuggerTest'
        #'RegressionTests::OperatingSystem'
    )
!

excludedUnitTestClassNamesForAll
    ^ #()
!

excludedUnitTestClassNamesForExpecco 
    ^ self excludedUnitTestClassNamesForAll
        , #(
            #'RegressionTests::BreakpointTests'
        )
! !

!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'
! !