"{ 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: %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.

    ].

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

    (Smalltalk at: #'stx_goodies_regression') classNames do:[:eachClassName |

	(excludedUnitTestClassNames includes:eachClassName) ifTrue:[

	    self logInfo:'exclude test "%1".' with:eachClassName.

	] ifFalse:[

	    ] ifFalse:[

			    ].

			].

			] ifFalse:[

			].

		    ] ifFalse:[

		    ].

		].

	    ].

	].

    ].

    self logInfo:'%1 unit test classes 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:'   Status: %1 (exec. Time: %2)' with:status with:execTime.

	]

	debug:debug.

    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' with:result tests size.

    self logInfo:'  %1 run' with:result runCount.

    self logInfo:'  %1 skipped' with:result skippedCount.

    self logInfo:'  %1 passed' with:result passedCount.

    self logInfo:'  %1 failed' with:result failureCount.

    self logInfo:'  %1 errors' 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"

! !

!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

		with:(aType printString asLowercase "paddedTo:'warning' size")

		with:aString.

	^ self

    ].

    "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 class methodsFor:'documentation'!

version

    ^ '$Header$'

!

version_CVS

    ^ '$Header$'

! !