# HG changeset patch # User sr # Date 1559808192 -7200 # Node ID e8b3552904ba23d683e4736697a0d44a42c0160d # Parent 57af1d2ef11ef00eae7ef3f9e859d9c833e4c2a2 #BUGFIX by Stefan Reise class: RunUnitTests class definition class: RunUnitTests class added:20 methods class: RunUnitTests::RunnerSelfTest class definition added: #test01_shouldPass #test02_shouldFail #test03_shouldError #test04_shouldError #test05_shouldBeSkipped diff -r 57af1d2ef11e -r e8b3552904ba quickSelfTest/RunUnitTests.st --- a/quickSelfTest/RunUnitTests.st Thu Mar 28 15:57:11 2019 +0100 +++ b/quickSelfTest/RunUnitTests.st Thu Jun 06 10:03:12 2019 +0200 @@ -18,32 +18,6 @@ privateIn:RunUnitTests ! -!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'! documentation @@ -96,63 +70,63 @@ runTestCases := OrderedCollection new. doRunSpecificUnitTests := false. unitTestSuiteName := 'All Unit Tests'. - excludedUnitTestClassNames := self excludedUnitTestClassNamesForAll. + 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). + 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. + 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. + resultFilePathName := arguments at:index + 1. + self logInfo:'set custom result file: %1' with:resultFilePathName. ]. [ - (index := arguments indexOf:'--run') > 0 + (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. + 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 + (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. + 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. + 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'. + 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:'configured to run all available unit tests'. ]. "/ self logInfo:'collecting tests to run'. @@ -162,119 +136,120 @@ 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. + (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. - ]. - ]. + 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 := 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. - ]. - ]. - ]. - ]. + 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| + 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. + 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 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'). + 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 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). + 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'! @@ -287,35 +262,48 @@ ) ! -excludedUnitTestClassNamesForAll - ^ #( - #'RegressionTests::SelectorNamespacesTests' - ) +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 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' - ) + ^ 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' + ) + + "Modified: / 06-06-2019 / 10:02:54 / Stefan Reise" ! ! !RunUnitTests class methodsFor:'examples'! @@ -443,6 +431,31 @@ 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 @@ -452,3 +465,4 @@ version_CVS ^ '$Header$' ! ! +