Smalltalk › Squeak › Squeak - Dev

The Trunk: SUnitTools-topa.1.mcz

_‹ Previous Topic Next Topic _›

Classic

List

Threaded

1 message

commits-2

The Trunk: SUnitTools-topa.1.mcz

Tobias Pape uploaded a new version of SUnitTools to project The Trunk:
http://source.squeak.org/trunk/SUnitTools-topa.1.mcz

==================== Summary ====================

Name: SUnitTools-topa.1
Author: topa
Time: 27 March 2015, 11:36:27.849 am
UUID: f60dd685-e19c-481a-9634-83d439b37e67
Ancestors:

Provide browser integration for SUnit.

- Indicate test status via tool icons
- Run tests from context menu
- Debug tests from context menu
- Switch between tested and testing code via context menu
(heursitically)

This is featurewise modeled after the OmniBrowser SUnit-Integration.

==================== Snapshot ====================

----- Method: TestCase class>>isTestClass (in category '*SUnitTools-testing') -----
isTestClass
^ true!

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

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

----- Method: Browser>>hasClassWithTestsSelected (in category '*SUnitTools-class list functions') -----
hasClassWithTestsSelected

^ (self selectedClass isTestClass and: [self selectedClass isAbstract not])!

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

----- Method: Browser>>testRunTests (in category '*SUnitTools-class list functions') -----
testRunTests

self testRunSuite: self selectedClass suite.
self changed: #classList.
self changed: #messageList.!

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

----- Method: Browser>>testsClassListMenu: (in category '*SUnitTools-menus') -----
testsClassListMenu: aMenu
<classListMenu>
self hasClassWithTestsSelected ifFalse: [^ aMenu].
^ aMenu addList: #(
-
('run all tests' testRunTests));
yourself!

----- Method: Browser>>testsSystemCategoryMenu: (in category '*SUnitTools-menus') -----
testsSystemCategoryMenu: aMenu
<systemCategoryMenu>
self hasSystemCategoryWithTestsSelected ifFalse: [^ aMenu].
^ aMenu addList: #(
-
('run all tests' testRunTestsCategory));
yourself!

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

----- Method: CodeHolder>>testBrowseClassNamed:possibleMessageNamed: (in category '*SUnitTools-running') -----
testBrowseClassNamed: aClassName possibleMessageNamed: aMessageName

| cls selector |
(self class environment hasClassNamed: aClassName) ifFalse: ["no dice" ^ self].
cls := self class environment classNamed: aClassName.

(aMessageName notNil and: [cls includesLocalSelector: (selector := aMessageName asSymbol)])
ifTrue: [ToolSet browse: cls selector: selector]
ifFalse: [ToolSet browseClass: cls].!

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

----- Method: CodeHolder>>testFindTest (in category '*SUnitTools-running') -----
testFindTest
| cls destClassName destMessage |
cls := self selectedClass ifNil: [^ self].
cls isTestClass ifTrue: [" already there " ^ self].
destClassName := cls name asString, 'Test'.
destMessage := self selectedMessageName ifNotNil: [:name | self testSelectorFrom: name].
self testBrowseClassNamed: destClassName possibleMessageNamed: destMessage
!

----- Method: CodeHolder>>testFindTested (in category '*SUnitTools-running') -----
testFindTested
| cls destClassName destMessage |
cls := self selectedClass ifNil: [^ self].
cls isTestClass ifFalse: [" already there " ^ self].

destClassName := (cls name asString endsWith: 'Test')
ifTrue: [cls name asString allButLast: 4]
ifFalse: [^ self].
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

!

----- 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].
!

----- Method: CodeHolder>>testRunTest (in category '*SUnitTools-message list functions') -----
testRunTest
| suite |
suite := self selectedClass selector: self selectedMessageName.
self testRunSuite: suite.
self changed: #messageList.!

----- 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])]]!

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

----- 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]
!

----- Method: Object>>isTestClass (in category '*SUnitTools-testing') -----
isTestClass

^ false!

----- Method: ToolIcons class>>testGray (in category '*SUnitTools-icons') -----
testGray

^ Form
extent: 12@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@0!

----- Method: ToolIcons class>>testGreen (in category '*SUnitTools-icons') -----
testGreen

^ Form
extent: 12@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@0!

----- Method: ToolIcons class>>testOrange (in category '*SUnitTools-icons') -----
testOrange

^ Form
extent: 12@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@0!

----- Method: ToolIcons class>>testRed (in category '*SUnitTools-icons') -----
testRed

^ Form
extent: 12@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@0!