[squeak-dev] The Inbox: SUnitTools-jr.9.mczcommits at source.squeak.org commits at source.squeak.orgSat Jul 16 16:41:07 UTC 2022
A new version of SUnitTools was added to project The Inbox: http://source.squeak.org/inbox/SUnitTools-jr.9.mcz ==================== Summary ==================== Name: SUnitTools-jr.9 Author: jr Time: 16 July 2022, 6:41:00.785653 pm UUID: 81d39fe4-b439-6a46-a0e9-0c922caf0dba Ancestors: SUnitTools-ct.8 Override run test menu items in Lexicon to run tests on the targetClass instead of the selectedClass The selectedClass is the class that defines the selected method. The targetClass is the browsed class in the Lexicon. This makes a difference for test methods if the selected method is inherited from an abstract TestCase subclass. In that case, self selectedClass isAbstract answers true and the test items were previously not shown. If the browsed class is not abstract as well, it can run the selected test method just fine. This introduces code duplication with the CodeHolder methods with the same selectors. =============== Diff against SUnitTools-ct.8 =============== Item was added: + ----- Method: BasicClassOrganizer>>categoryForTestCases (in category '*SUnitTools-accessing') ----- + categoryForTestCases + ^ self categories + detect: [:each | each beginsWith: 'test'] + ifNone: [Categorizer allCategory]! Item was added: + ----- Method: Browser>>hasSystemCategoryWithTestsSelected (in category '*SUnitTools-system category functions') ----- + hasSystemCategoryWithTestsSelected + + (systemOrganizer listAtCategoryNamed: (self selectedSystemCategory ifNil: [^ false])) + detect: [:name | + self class environment + at: name + ifPresent: [:cls | cls isTestClass and: [cls isAbstract not]] + ifAbsent: [false]] + ifNone: [^ false]. + ^ true + ! Item was added: + ----- Method: Browser>>testRunTests (in category '*SUnitTools-class list functions') ----- + testRunTests + + self testRunSuite: self selectedClass suite. + self changed: #classList. + self changed: #messageList.! Item was added: + ----- Method: Browser>>testRunTestsCategory (in category '*SUnitTools-system category functions') ----- + testRunTestsCategory + | suite | + suite :=TestSuite new. + ((systemOrganizer listAtCategoryNamed: self selectedSystemCategory) + collect: [:each | self class environment at: each]) + select: [:each | each isTestClass and: [each isAbstract not]] + thenDo: [:each | each addToSuiteFromSelectors: suite]. + self testRunSuite: suite. + self changed: #classList. + self changed: #messageList.! Item was added: + ----- Method: Browser>>testsClassListMenu: (in category '*SUnitTools-menus') ----- + testsClassListMenu: aMenu + <classListMenu> + self hasClassWithTestsSelected ifFalse: [^ aMenu]. + ^ aMenu addList: #( + - + ('run all tests' testRunTests)); + yourself! Item was added: + ----- Method: Browser>>testsSystemCategoryMenu: (in category '*SUnitTools-menus') ----- + testsSystemCategoryMenu: aMenu + <systemCategoryMenu> + self hasSystemCategoryWithTestsSelected ifFalse: [^ aMenu]. + ^ aMenu addList: #( + - + ('run all tests' testRunTestsCategory)); + yourself! Item was added: + ----- Method: CodeHolder>>testAskToCreateNewTest: (in category '*SUnitTools-running') ----- + testAskToCreateNewTest: className + | newClass | + (self confirm: 'Test class not found. Create one?' translated) ifFalse: [^ false]. + (ClassBuilder new) + name: className asSymbol + inEnvironment: self selectedClass environment + subclassOf: TestCase + type: #normal + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: + ((self selectedClass category includes: $-) + ifTrue: [((self selectedClass category copyUpToLast: $-), '-Tests')] + ifFalse: [(self selectedClass category, 'Tests')]) asSymbol. + newClass := self selectedClass environment classNamed: className asSymbol. + newClass organization addCategory: #tests. + ^ true! Item was added: + ----- Method: CodeHolder>>testBinarySelectorNames (in category '*SUnitTools-running') ----- + testBinarySelectorNames + + ^ IdentityDictionary newFromPairs: #( + #& 'conjunction' + #| 'disjunction' + #==> 'implication' + #* 'multiply' + #+ 'add' + #- 'subtract' + #/ 'divide' + #// 'remainder' + #\\ 'modulo' + #<< 'shiftLeft' + #>> 'shiftRight' + + #= 'equality' + #== 'identity' + #~= 'difference' + #~~ 'mismatch' + + #< 'lessThan' + #<= 'lessOrEqualThan' + #> 'greaterThan' + #>= 'greaterOrEqualThan' + + #<=> 'spaceshipOperator' + + #@ 'at' + #, 'concatenation' + #-> 'association' + #=> 'binding' + ) + ! Item was added: + ----- Method: CodeHolder>>testBrowseClassNamed:possibleMessageNamed: (in category '*SUnitTools-running') ----- + testBrowseClassNamed: aClassName possibleMessageNamed: aMessageName + + | cls selector | + (self class environment hasClassNamed: aClassName) ifFalse: + [(self testAskToCreateNewTest: aClassName) ifFalse: [^ false]]. + cls := self class environment classNamed: aClassName. + + (aMessageName notNil and: [cls includesLocalSelector: (selector := aMessageName asSymbol)]) + ifTrue: [ToolSet browse: cls selector: selector] + ifFalse: + [ToolSet + browseClass: cls + category: cls organization categoryForTestCases]. + ^ true! Item was added: + ----- Method: CodeHolder>>testDebugTest (in category '*SUnitTools-message list functions') ----- + testDebugTest + | case selector cls | + cls := self selectedClass ifNil: [^ self]. + selector := self selectedMessageName ifNil: [^ self]. + case := cls selector: selector. + + case debugAsFailure.! Item was added: + ----- Method: CodeHolder>>testFindTest (in category '*SUnitTools-running') ----- + testFindTest + | cls destClassName destMessage | + cls := self selectedClass ifNil: [^ self]. + destClassName := cls name asString, 'Test'. + destMessage := self selectedMessageName ifNotNil: [:name | self testSelectorFrom: name]. + + self testBrowseClassNamed: destClassName possibleMessageNamed: destMessage.! Item was added: + ----- Method: CodeHolder>>testFindTested (in category '*SUnitTools-running') ----- + testFindTested + | cls classNameParts destClassName destMessage | + cls := self selectedClass ifNil: [^ self]. + cls isTestClass ifFalse: [" already there " ^ self]. + + classNameParts := cls name asString piecesCutWhere: [:a :b | b isUppercase]. + destClassName := (classNameParts last beginsWith: 'Test') + ifTrue: [classNameParts allButLast join] + ifFalse: [^ self inform: ('Did not find tested item for {1}' translated + format: {cls})]. + destMessage := self selectedMessageName ifNotNil: [:selector | | messageName | + messageName := selector asString. + (messageName beginsWith: 'test') "operate on test methods only" + ifTrue: [ (self class environment classNamed: destClassName) + ifNotNil: [:destClass | destClass selectors + detect: [:destSelector | (self testSelectorFrom: destSelector) = messageName] + ifNone: [nil]]] + ifFalse: [nil]]. + + (self testBrowseClassNamed: destClassName possibleMessageNamed: destMessage) + ifFalse: [self inform: ('Did not find tested item for {1}' translated + format: {self selectedMessageName ifNil: [cls]})].! Item was added: + ----- Method: CodeHolder>>testRunSuite: (in category '*SUnitTools-running') ----- + testRunSuite: suite + + | result | + result := suite run. + + (result respondsTo: #dispatchResultsIntoHistory) + ifTrue: [result dispatchResultsIntoHistory]. + + result hasPassed ifTrue: [^ self]. + + (result defects size = 1 + ifTrue: [result defects anyOne] + ifFalse: [UIManager default + chooseFrom: (result defects collect: [:each | each class name , '>>' , each selector printString]) + values: result defects + title: ('{1} passes, {2} failures, {3} errors\\Debug a failure or error?' format: { + result runCount . result failureCount . result errorCount}) withCRs] + ) ifNotNil: [:defect | defect debug]. + ! Item was added: + ----- Method: CodeHolder>>testRunTest (in category '*SUnitTools-message list functions') ----- + testRunTest + | suite | + suite := self selectedClass selector: self selectedMessageName. + self testRunSuite: suite. + self changed: #messageList.! Item was added: + ----- Method: CodeHolder>>testSelectorFrom: (in category '*SUnitTools-running') ----- + testSelectorFrom: aSelector + | name | + name := aSelector isBinary + ifTrue: [self testBinarySelectorNames at: aSelector ifAbsent: [^ nil]] + ifFalse: [aSelector asString]. + ^ String streamContents: [:stream | + stream nextPutAll: 'test'. + (name findTokens: $:) do: [:each | + stream nextPutAll: (each capitalized + select: [:char | char isAlphaNumeric])]]! Item was added: + ----- Method: CodeHolder>>testsMessageListMenu: (in category '*SUnitTools-menus') ----- + testsMessageListMenu: aMenu + <messageListMenu> + (self selectedClass isTestClass + and: [self selectedClass isAbstract not + and: [self selectedClass allTestSelectors includes: self selectedMessageName]]) + ifFalse: [^ aMenu]. + ^ aMenu addList: #( + - + ('run test' testRunTest) + ('debug test' testDebugTest)); + yourself! Item was added: + ----- Method: CodeHolder>>testsTestFindingMenu: (in category '*SUnitTools-menus') ----- + testsTestFindingMenu: aMenu + <classListMenu> + <messageListMenu> + ^ self hasClassWithTestsSelected + ifTrue: [aMenu add: 'find tested item' action: #testFindTested; yourself] + ifFalse: [aMenu add: 'find test case' action: #testFindTest; yourself] + ! Item was added: + ----- Method: Lexicon>>testDebugTest (in category '*SUnitTools-message list functions') ----- + testDebugTest + | case selector cls | + cls := self targetClass ifNil: [^ self]. + selector := self selectedMessageName ifNil: [^ self]. + case := cls selector: selector. + + case debugAsFailure.! Item was added: + ----- Method: Lexicon>>testRunTest (in category '*SUnitTools-message list functions') ----- + testRunTest + | suite | + suite := self targetClass selector: self selectedMessageName. + self testRunSuite: suite. + self changed: #messageList.! Item was added: + ----- Method: Lexicon>>testsMessageListMenu: (in category '*SUnitTools-menus') ----- + testsMessageListMenu: aMenu + (self targetClass isTestClass + and: [self targetClass isAbstract not + and: [self targetClass allTestSelectors includes: self selectedMessageName]]) + ifFalse: [^ aMenu]. + ^ aMenu addList: #( + - + ('run test' testRunTest) + ('debug test' testDebugTest)); + yourself! Item was added: + ----- Method: StringHolder>>hasClassWithTestsSelected (in category '*SUnitTools-testing') ----- + hasClassWithTestsSelected + + ^ self selectedClass + ifNil: [false] + ifNotNil: [:cls | + cls isTestClass and: [cls isAbstract not]]! Item was added: + ----- Method: TestCase class>>toolIcon (in category '*SUnitTools-icons') ----- + toolIcon + | classHistory | + self isAbstract ifTrue: [^ super toolIcon]. + classHistory := TestResult historyFor: self. + (classHistory at: #errors) ifNotEmpty: [^ #testRed]. + (classHistory at: #failures) ifNotEmpty: [^ #testOrange]. + (classHistory at: #passed) ifNotEmpty: [ ^ #testGreen]. + ^ #testGray! Item was added: + ----- Method: TestCase class>>toolIconSelector: (in category '*SUnitTools-icons') ----- + toolIconSelector: aSelector + + (self isMeta or: [self isAbstract or: [ + (self allTestSelectors includes: aSelector) not]]) + ifTrue: [^ super toolIconSelector: aSelector]. + + (self methodRaisedError: aSelector) ifTrue: [^ #testRed]. + (self methodFailed: aSelector) ifTrue: [^ #testOrange]. + (self methodPassed: aSelector) ifTrue: [^ #testGreen]. + ^ #testGray! Item was added: + ----- Method: ToolIcons class>>testGray (in category '*SUnitTools-icons') ----- + testGray + + ^ Form + extent: 12 at 12 + depth: 32 + fromArray: #( 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 4294177779 4291217094 4288585374 4288453788 4290953922 4294111986 0 0 0 0 0 0 4291217094 4291151301 4292796126 4292532954 4290690750 4290624957 0 0 0 0 0 0 4288585374 4292730333 4290953922 4290427578 4291414473 4287466893 0 0 0 0 0 0 4288387995 4292203989 4290493371 4290164406 4291019715 4287072135 0 0 0 0 0 0 4290822336 4290624957 4291414473 4291019715 4290230199 4289835441 0 0 0 0 0 0 4294111986 4290493371 4287269514 4286940549 4289769648 4293848814 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0) + offset: 0 at 0! Item was added: + ----- Method: ToolIcons class>>testGreen (in category '*SUnitTools-icons') ----- + testGreen + + ^ Form + extent: 12 at 12 + depth: 32 + fromArray: #( 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 4293720299 4288666780 4284466010 4284465241 4288599706 4293654250 0 0 0 0 0 0 4288666780 4288403095 4290962113 4290502586 4288007314 4288401048 0 0 0 0 0 0 4284465754 4290830784 4288008853 4287220872 4288992418 4283999824 0 0 0 0 0 0 4284398936 4290108596 4287351946 4286958211 4288532634 4283800910 0 0 0 0 0 0 4288533401 4288007057 4288926881 4288401561 4287677068 4288133778 0 0 0 0 0 0 4293653994 4288400279 4283867471 4283734348 4288067729 4293521384 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0) + offset: 0 at 0! Item was added: + ----- Method: ToolIcons class>>testOrange (in category '*SUnitTools-icons') ----- + testOrange + + ^ Form + extent: 12 at 12 + depth: 32 + fromArray: #( 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 4294964456 4294953101 4294943038 4294942778 4294951813 4294963941 0 0 0 0 0 0 4294953101 4294952588 4294959549 4294958774 4294951038 4294688127 0 0 0 0 0 0 4294943293 4294959548 4294953862 4294951029 4294954132 4293888298 0 0 0 0 0 0 4294941751 4294957228 4294951287 4294949998 4294952328 4293165354 0 0 0 0 0 0 4294951298 4294950267 4294954131 4294952583 4294948207 4293110399 0 0 0 0 0 0 4294898405 4294424959 4293559850 4292902442 4292979327 4294438117 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0) + offset: 0 at 0! Item was added: + ----- Method: ToolIcons class>>testRed (in category '*SUnitTools-icons') ----- + testRed + + ^ Form + extent: 12 at 12 + depth: 32 + fromArray: #( 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 4294960869 4294935167 4294716714 4294389034 4294344831 4294764005 0 0 0 0 0 0 4294935167 4294803840 4294687929 4294620593 4293950845 4293623680 0 0 0 0 0 0 4294585642 4294687928 4294477438 4294276206 4294284433 4292028973 0 0 0 0 0 0 4294061098 4294487209 4294276976 4294208615 4294150278 4291242543 0 0 0 0 0 0 4294082687 4293819516 4294284176 4294150277 4293163129 4291854213 0 0 0 0 0 0 4294698469 4293296000 4291635758 4290914863 4291657605 4294174183 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0) + offset: 0 at 0!
More information about the Squeak-dev mailing list |