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

! !

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

! !