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

    |doRunSpecificUnitTests unitTestSuiteName excludedUnitTestClassNames corruptedUnitTestClassNames

     cmdArgs

     unitTestSuite

     eachClassName eachClass

     result index

     settingsFilePathName resultFilePathName forceTestCase|

    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.

    ].

    index := cmdArgs indexOf:'--resultFile'.

    index > 0 ifTrue:[

	resultFilePathName := cmdArgs at:index + 1.

	self logInfo:'set custom result file: ', resultFilePathName printString.

    ].

    index := cmdArgs indexOf:'--forceTestCase'.

    index > 0 ifTrue:[

	forceTestCase := cmdArgs 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') classNamesAndAttributes do:[:eachClassNameAndAttributes |

	eachClassNameAndAttributes isSymbol ifTrue:[

	    eachClassName := eachClassNameAndAttributes.

	] ifFalse:[

	    eachClassName := eachClassNameAndAttributes

		firstIfEmpty:nil.

	].

	(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 ifTrue:[

			    self

				logInfo:('added unit test class "%1".'

				    bindWith:eachClassName).

			    unitTestSuite addTest:eachClass suite.

			].

		    ] 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:(cmdArgs includes:'--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:'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$'

! !