Squeak 4.6: SUnitTools-mt.3.mcz

Previous Topic Next Topic
 
classic Classic list List threaded Threaded
1 message Options
Reply | Threaded
Open this post in threaded view
|

Squeak 4.6: SUnitTools-mt.3.mcz

commits-2
Chris Muller uploaded a new version of SUnitTools to project Squeak 4.6:
http://source.squeak.org/squeak46/SUnitTools-mt.3.mcz

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

Name: SUnitTools-mt.3
Author: mt
Time: 19 April 2015, 7:21:55.82 am
UUID: c2d3c452-b6ad-3b4a-ab7e-4b5f750648c0
Ancestors: SUnitTools-topa.2

Moved test for being a test-class to SUnit.

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

----- Method: StringHolder>>hasClassWithTestsSelected (in category '*SUnitTools-testing') -----
hasClassWithTestsSelected

        ^ self selectedClass
                ifNil: [false]
                ifNotNil: [:cls |
                        cls isTestClass and: [cls 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: 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: 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!