"{ 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$'
! !