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

    self runWithCompiledUnitTestClasses:false.

!

runWithCompiledUnitTestClasses:useCompiledUnitTestClasses

    |cmdArgs|

    cmdArgs := Smalltalk commandLineArguments.

    self 

        runWithCompiledUnitTestClasses:useCompiledUnitTestClasses

        arguments:cmdArgs

        debug:(cmdArgs includes:'--debug')

!

runWithCompiledUnitTestClasses:useCompiledUnitTestClasses

    arguments:arguments

    debug:debug

    |doRunSpecificUnitTests unitTestSuiteName excludedUnitTestClassNames corruptedUnitTestClassNames

     unitTestSuite

     eachClass

     result index

     settingsFilePathName resultFilePathName forceTestCase|

    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:'--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:('corrupted unit test class detected, 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:'starting unit tests'.

    result := unitTestSuite

        run:TestResultStX new

        beforeEachDo:[:test | self logInfo:'performing unit test ', test printString]

        afterEachDo:[:test| ]

        debug:debug.

    self logInfo:'generating report'.

    TestResultReporter

        report:result

        format:#xml_jUnit

        as:resultFilePathName ? '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

    ^ #(

	#'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::HTTPServerTests'

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

! !

!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

    ^ '$Header$'

!

version_CVS

    ^ '$Header$'

! !