"{ 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'
	    #'RegressionTests::LargeFloatTest'
	)

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