[squeak-dev] Squeak 4.6: SUnitTools-mt.3.mcz

commits at source.squeak.org commits at source.squeak.org
Fri Jun 5 20:18:54 UTC 2015


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

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

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

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