"{ Encoding: utf8 }"

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

"{ NameSpace: Smalltalk }"

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

TestCase subclass:#RunnerSelfTest
	instanceVariableNames:''
	classVariableNames:''
	poolDictionaries:''
	privateIn:RunUnitTests
!

!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
     possibleClassNames
     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 excludedUnitTestClassNames.
    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.
    ].

    index := arguments indexOf:'--testRunner'.
    index > 0 ifTrue:[
        arguments removeIndex:index.
        forceTestCase := #'RunUnitTests::RunnerSelfTest'.
        self logInfo:'execute runner self test'.
    ].

    (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.

    possibleClassNames := (Smalltalk at: #'stx_goodies_regression') classNames.
    possibleClassNames add:#'RunUnitTests::RunnerSelfTest'.

    possibleClassNames 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(s) 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:'   %1 (%2)' with:status with:execTime.
                    (status == TestResult stateFail or:[status == TestResult stateError]) ifTrue:[
                        self logInfo:'   ==================='.
                    ]
                ]
                debug:debug.
    ] ifCurtailed:[
        self logWarning:'aborted in:.'.
        thisContext fullPrintAllOn:Stderr.
    ].

    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, %2 run (%3 skipped) / %4 passed, %5 failed, %6 errors'
                bindWith:result tests size
                with:result runCount
                with:result skippedCount
                with:result passedCount
                with:result failureCount
                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"
    "Modified: / 06-06-2019 / 10:02:52 / Stefan Reise"
! !

!RunUnitTests class methodsFor:'constants'!

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

excludedUnitTestClassNames
    |collection|

    collection := OrderedCollection new.
    collection add:#'RegressionTests::SelectorNamespacesTests'.

    "now exclude architecture dependent stuff"
    (OperatingSystem isMSWINDOWSlike not 
    or:[ExternalAddress pointerSize = 8]) ifTrue:[
        collection add:#'RegressionTests::Win32OLETests'.
    ].

    ^ collection

    "Created: / 06-06-2019 / 10:02:46 / Stefan Reise"
!

excludedUnitTestClassNamesForExpecco
    ^ self excludedUnitTestClassNames
        , #(
            #'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'
        )

    "Modified: / 06-06-2019 / 10:02:54 / Stefan Reise"
! !

!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::RunnerSelfTest methodsFor:'tests'!

test01_shouldPass
    self assert:true.
!

test02_shouldFail
    self assert:false.
!

test03_shouldError
    |zero|
    zero := 0.
    self assert:(10 / zero).
!

test04_shouldError
    self assert:(10 foo).
!

test05_shouldBeSkipped
    self skip:'this is skipped'.
    self assert:(10 foo).
! !

!RunUnitTests class methodsFor:'documentation'!

version
    ^ '$Header$'
!

version_CVS
    ^ '$Header$'
! !