SystemOrganization addCategory: #'OB-SUnitIntegration'! !OBCodeBrowser methodsFor: '*ob-sunitIntegration' stamp: 'lr 10/29/2010 11:51'! testCommands ^ Array with: OBCmdRunTests with: OBCmdDebugTest with: OBCmdFlowTests with: OBCmdBreakpoint! ! OBCommand subclass: #OBCmdBreakpoint instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-SUnitIntegration'! !OBCmdBreakpoint methodsFor: 'accessing' stamp: 'lr 9/20/2010 13:23'! compiledMethod ^ target theClass compiledMethodAt: target selector! ! !OBCmdBreakpoint methodsFor: 'execution' stamp: 'lr 9/20/2010 13:27'! execute | method | method := self compiledMethod. method class = OBBreakpoint ifTrue: [ method uninstall ] ifFalse: [ (OBBreakpoint on: method) install ]. requestor announce: OBRefreshRequired! ! !OBCmdBreakpoint methodsFor: 'accessing' stamp: 'lr 9/20/2010 13:24'! group ^ #testing! ! !OBCmdBreakpoint methodsFor: 'testing' stamp: 'lr 9/20/2010 13:21'! isActive ^ (requestor isSelected: target) and: [ target isKindOf: OBMethodNode ]! ! !OBCmdBreakpoint methodsFor: 'accessing' stamp: 'lr 9/20/2010 14:21'! label ^ 'Toggle Breakpoint'! ! !OBCmdBreakpoint methodsFor: 'accessing' stamp: 'lr 9/20/2010 13:24'! order ^ '3'! ! OBCommand subclass: #OBCmdDebugTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-SUnitIntegration'! !OBCmdDebugTest methodsFor: 'execution' stamp: 'lr 5/6/2011 19:30'! execute | context process | context := [ :value | [ value run ] ensure: [ self kill ] ] asContext. context pop; push: target testSuite. [ context isNil or: [ context selector = target selector ] ] whileFalse: [ context := context selector = #setUp ifTrue: [ context quickStep ] ifFalse: [ context step ] ]. context isNil ifTrue: [ ^ OBInformRequest message: 'Unable to open debugger on #' , target selector ]. process := Process forContext: context priority: Processor userInterruptPriority. Debugger openOn: process context: context label: 'Debug ' , target theClassName , '>>#' , target selector contents: nil fullView: true! ! !OBCmdDebugTest methodsFor: 'accessing' stamp: 'lr 5/11/2010 14:32'! group ^ #testing! ! !OBCmdDebugTest methodsFor: 'testing' stamp: 'lr 4/30/2010 14:12'! isActive ^ (requestor isSelected: target) and: [ target hasTestSuite and: [ target isKindOf: OBMethodNode ] ]! ! !OBCmdDebugTest methodsFor: 'accessing' stamp: 'lr 5/11/2010 14:34'! keystroke ^ $d! ! !OBCmdDebugTest methodsFor: 'execution' stamp: 'lr 5/27/2010 12:03'! kill "This code makes sure that everything stays fine, no matter if the debugger is simply closed or the user hits on proceed." (Project uiProcess == Processor activeProcess) ifFalse: [ Processor activeProcess terminate ] ! ! !OBCmdDebugTest methodsFor: 'accessing' stamp: 'lr 9/5/2010 14:18'! label ^ 'Debug Test...'! ! !OBCmdDebugTest methodsFor: 'accessing' stamp: 'lr 5/11/2010 14:33'! order ^ '2'! ! OBCommand subclass: #OBCmdFlowTests instanceVariableNames: '' classVariableNames: 'BinarySelectors' poolDictionaries: '' category: 'OB-SUnitIntegration'! !OBCmdFlowTests class methodsFor: 'initialization' stamp: 'lr 9/5/2010 14:47'! initialize BinarySelectors := Dictionary new. #( #& 'conjunction' #| 'disjunction' #==> 'implication' #* 'multiply' #+ 'add' #- 'subtract' #/ 'divide' #// 'remainder' #\\ 'modulo' #<< 'shiftLeft' #>> 'shiftRight' #= 'equals' #== 'identityEquals' #~= 'notEquals' #~~ 'notIdentityEquals' #< 'lessThan' #<= 'lessOrEqualThan' #> 'greaterThan' #>= 'greaterOrEqualThan' #@ 'at' #, 'concate' #-> 'associate' ) pairsDo: [ :sel :nam | BinarySelectors at: sel put: nam ]! ! !OBCmdFlowTests methodsFor: 'accessing-names' stamp: 'lr 9/5/2010 13:28'! baseClass ^ Smalltalk globals classNamed: (self baseClassName ifNil: [ ^ nil ])! ! !OBCmdFlowTests methodsFor: 'accessing-names' stamp: 'lr 9/5/2010 13:28'! baseClassName ^ self isTestClass ifTrue: [ (target theNonMetaClassName endsWith: 'Test') ifTrue: [ target theNonMetaClassName allButLast: 4 ] ] ifFalse: [ target theNonMetaClassName ]! ! !OBCmdFlowTests methodsFor: 'accessing-names' stamp: 'lr 9/5/2010 13:56'! baseSelector ^ self isTestMethod ifTrue: [ self baseClass ifNotNil: [ :class | class selectors detect: [ :selector | (self testSelectorFrom: selector) = target selector ] ifNone: [ nil ] ] ] ifFalse: [ target selector ]! ! !OBCmdFlowTests methodsFor: 'execution' stamp: 'lr 9/5/2010 14:11'! execute self isTestClass ifTrue: [ self executeOnTest ] ifFalse: [ self executeOnModel ]! ! !OBCmdFlowTests methodsFor: 'execution' stamp: 'lr 9/5/2010 14:13'! executeOnModel | class selector | class := self testClass ifNil: [ TestCase subclass: self testClassName asSymbol instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: self baseClass category , '-Tests' ]. target hasSelector ifTrue: [ selector := self testSelector. (selector notNil and: [ (class selectors includes: selector) not ]) ifTrue: [ class compile: selector , String cr , ' "Tests ' , self baseClassName , '>>#' , self baseSelector , '"' , String cr, String cr , ' self assert: false' classified: #tests ] ]. self jumpTo: class selector: selector! ! !OBCmdFlowTests methodsFor: 'execution' stamp: 'lr 9/5/2010 14:18'! executeOnTest self jumpTo: (self baseClass ifNil: [ ^ self ]) selector: (target hasSelector ifTrue: [ self baseSelector ])! ! !OBCmdFlowTests methodsFor: 'accessing' stamp: 'jre 9/3/2010 16:22'! group ^ #testing! ! !OBCmdFlowTests methodsFor: 'testing' stamp: 'jre 9/3/2010 16:24'! isActive ^ (requestor isSelected: target) and: [ target isKindOf: OBClassAwareNode ]! ! !OBCmdFlowTests methodsFor: 'testing' stamp: 'lr 9/5/2010 13:27'! isTestClass ^ target theNonMetaClass includesBehavior: TestCase! ! !OBCmdFlowTests methodsFor: 'testing' stamp: 'lr 9/5/2010 13:27'! isTestMethod ^ self isTestClass and: [ target hasSelector and: [ target theNonMetaClass allTestSelectors includes: target selector ] ]! ! !OBCmdFlowTests methodsFor: 'execution' stamp: 'lr 9/5/2010 14:16'! jumpTo: aClass selector: aSelector requestor browser announce: (OBSelectingNode node: (aSelector isNil ifFalse: [ OBMethodNode on: aSelector inClass: aClass ] ifTrue: [ aClass asNode ]))! ! !OBCmdFlowTests methodsFor: 'accessing' stamp: 'lr 9/5/2010 13:15'! keystroke ^ $j! ! !OBCmdFlowTests methodsFor: 'accessing' stamp: 'lr 9/5/2010 13:57'! label ^ 'Jump to ' , (self isTestClass ifTrue: [ 'Implementation' ] ifFalse: [ 'Test' ])! ! !OBCmdFlowTests methodsFor: 'accessing' stamp: 'jre 9/3/2010 16:23'! order ^ '2'! ! !OBCmdFlowTests methodsFor: 'accessing-names' stamp: 'lr 9/5/2010 13:28'! testClass ^ Smalltalk globals classNamed: (self testClassName ifNil: [ ^ nil ])! ! !OBCmdFlowTests methodsFor: 'accessing-names' stamp: 'lr 9/5/2010 13:28'! testClassName ^ self isTestClass ifTrue: [ target theNonMetaClassName ] ifFalse: [ target theNonMetaClassName , 'Test' ]! ! !OBCmdFlowTests methodsFor: 'accessing-names' stamp: 'lr 9/5/2010 14:06'! testSelector ^ self isTestMethod ifTrue: [ target selector ] ifFalse: [ self testSelectorFrom: target selector ]! ! !OBCmdFlowTests methodsFor: 'private' stamp: 'lr 9/5/2010 13:54'! testSelectorFrom: aSelector | name | name := aSelector isBinary ifTrue: [ BinarySelectors 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 ]) ] ]! ! OBCommand subclass: #OBCmdRunTests instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-SUnitIntegration'! !OBCmdRunTests methodsFor: 'execution' stamp: 'lr 10/10/2010 18:34'! execute | result defect | result := OBWaitRequest block: [ target testSuite run ]. (result respondsTo: #dispatchResultsIntoHistory) ifTrue: [ result dispatchResultsIntoHistory ]. requestor announce: OBRefreshRequired. result hasPassed ifTrue: [ ^ self ]. defect := result defects size = 1 ifTrue: [ result defects anyOne ] ifFalse: [ OBCompletionRequest new prompt: result runCount printString , ' run, ' , result failureCount printString , ' failures, ' , result errorCount printString , ' errors'; collection: result defects; labelBlock: [ :each | each class name , '>>' , each selector printString ]; iconBlock: [ :each | each class browserIcon: each class selector: each selector ]; signal ]. defect isNil ifTrue: [ ^ self ]. defect debug! ! !OBCmdRunTests methodsFor: 'accessing' stamp: 'lr 5/11/2010 14:34'! group ^ #testing! ! !OBCmdRunTests methodsFor: 'testing' stamp: 'lr 1/7/2010 13:37'! isActive ^ (requestor isSelected: target) and: [ target hasTestSuite ]! ! !OBCmdRunTests methodsFor: 'accessing' stamp: 'dc 7/22/2007 20:45'! keystroke ^ $t! ! !OBCmdRunTests methodsFor: 'accessing' stamp: 'lr 9/5/2010 14:18'! label ^ (target hasTestSuite and: [ target isKindOf: OBMethodNode ]) ifTrue: [ 'Run Test' ] ifFalse: [ 'Run Tests' ]! ! !OBCmdRunTests methodsFor: 'accessing' stamp: 'lr 5/11/2010 14:33'! order ^ '1'! ! ProtoObject subclass: #OBBreakpoint instanceVariableNames: 'method' classVariableNames: '' poolDictionaries: '' category: 'OB-SUnitIntegration'! !OBBreakpoint class methodsFor: 'instance creation' stamp: 'lr 9/20/2010 13:14'! on: aCompiledMethod ^ self basicNew initializeOn: aCompiledMethod! ! !OBBreakpoint methodsFor: 'private' stamp: 'lr 9/20/2010 13:15'! doesNotUnderstand: aMessage ^ method perform: aMessage selector withArguments: aMessage arguments! ! !OBBreakpoint methodsFor: 'private' stamp: 'lr 4/3/2011 11:08'! flushCache method selector flushCache! ! !OBBreakpoint methodsFor: 'initialization' stamp: 'lr 9/20/2010 13:12'! initializeOn: aCompiledMethod method := aCompiledMethod! ! !OBBreakpoint methodsFor: 'public' stamp: 'lr 9/20/2010 13:14'! install method methodClass methodDictionary at: method selector put: self! ! !OBBreakpoint methodsFor: 'literals' stamp: 'lr 9/20/2010 13:29'! literalsDo: aBlock "This method is necessary to show the breakpoint-flag in the browser." aBlock value: #halt. method literalsDo: aBlock! ! !OBBreakpoint methodsFor: 'evaluation' stamp: 'lr 9/20/2010 14:16'! run: aSelector with: anArray in: aReceiver | process | process := Process forContext: (MethodContext sender: thisContext sender receiver: aReceiver method: method arguments: anArray) priority: Processor activeProcess priority. Debugger openOn: process context: process suspendedContext label: 'Breakpoint in ' , method methodClass name , '>>#' , method selector contents: nil fullView: true. Project spawnNewProcessIfThisIsUI: Processor activeProcess. thisContext swapSender: nil. Processor activeProcess terminate! ! !OBBreakpoint methodsFor: 'public' stamp: 'lr 9/20/2010 13:14'! uninstall method methodClass methodDictionary at: method selector put: method! ! !OBClassCategoryNode methodsFor: '*ob-sunitintegration' stamp: 'AdrianKuhn 12/22/2009 16:39'! hasTestSuite ^ self classes anySatisfy: [ :node | node hasTestSuite ]! ! !OBClassCategoryNode methodsFor: '*ob-sunitintegration' stamp: 'lr 12/24/2009 10:51'! testSuite ^ self classes inject: TestSuite new into: [ :suite :each | each hasTestSuite ifTrue: [ suite addTest: each testSuite ]. suite ]! ! !OBClassAwareNode methodsFor: '*ob-sunitintegration' stamp: 'lr 1/7/2010 13:36'! hasTestSuite ^ (self theClass includesBehavior: TestCase) and: [ self theClass isAbstract not ]! ! !OBClassAwareNode methodsFor: '*ob-sunitintegration' stamp: 'lr 12/24/2009 10:50'! testSuite ^ self theClass suite! ! !TestCase class methodsFor: '*ob-sunitintegration' stamp: 'lr 1/3/2010 15:29'! browserIcon | classHistory | self isAbstract ifTrue: [ ^ super browserIcon ]. classHistory := TestResult historyFor: self. (classHistory at: #errors) isEmpty ifFalse: [ ^ #testRed ]. (classHistory at: #failures) isEmpty ifFalse: [ ^ #testOrange ]. (classHistory at: #passed) isEmpty ifFalse: [ ^ #testGreen ]. ^ #testGray! ! !TestCase class methodsFor: '*ob-sunitintegration' stamp: 'lr 9/8/2011 19:57'! browserIcon: aClassDescription selector: aSelector (aClassDescription isMeta or: [ aClassDescription isAbstract or: [ (aClassDescription testSelectors includes: aSelector) not ] ]) ifTrue: [ ^ super browserIcon: aClassDescription selector: aSelector ]. (aClassDescription methodRaisedError: aSelector) ifTrue: [ ^ #testRed ]. (aClassDescription methodFailed: aSelector) ifTrue: [ ^ #testOrange ]. (aClassDescription methodPassed: aSelector) ifTrue: [ ^ #testGreen ]. ^ #testGray! ! !OBMorphicIcons methodsFor: '*ob-sunitintegration' stamp: 'lr 3/28/2009 19:01'! testGray ^ ((ColorForm extent: 12@12 depth: 8 fromArray: #( 471604252 471604252 471604252 471604252 471604252 471604252 471604252 471604252 471604252 471604245 67180800 52173852 471604228 302583304 119282716 471604225 436213762 370940956 471604237 319162885 270277660 471604247 117572884 253500444 471604227 101388571 203168796 471604252 471604252 471604252 471604252 471604252 471604252 471604252 471604252 471604252) offset: 0@0) colorsFromArray: #(#(0.761 0.761 0.761) #(0.62 0.62 0.62) #(0.788 0.788 0.788) #(0.949 0.949 0.949) #(0.776 0.776 0.776) #(0.764 0.764 0.764) #(0.733 0.733 0.733) #(0.741 0.741 0.741) #(0.745 0.745 0.745) #(0.871 0.871 0.871) #(0.714 0.714 0.714) #(0.542 0.542 0.542) #(0.934 0.934 0.934) #(0.608 0.608 0.608) #(0.855 0.855 0.855) #(0.694 0.694 0.694) #(0.53 0.53 0.53) #(0.522 0.522 0.522) #(0.772 0.772 0.772) #(0.836 0.836 0.836) #(0.717 0.717 0.717) #(0.953 0.953 0.953) #(0.553 0.553 0.553) #(0.753 0.753 0.753) #(0.729 0.729 0.729) #(0.612 0.612 0.612) #(0.867 0.867 0.867) #(0.69 0.69 0.69) #( ) ))! ! !OBMorphicIcons methodsFor: '*ob-sunitintegration' stamp: 'lr 3/28/2009 19:00'! testGreen ^ ((ColorForm extent: 12@12 depth: 8 fromArray: #( 589505315 589505315 589505315 589505315 589505315 589505315 589505315 589505315 589505315 589505302 1248283 337847075 589505280 185011458 488842019 589505281 270075936 404955939 589505298 237047580 170074915 589505303 520428049 505619235 589505284 571803907 102966051 589505315 589505315 589505315 589505315 589505315 589505315 589505315 589505315 589505315) offset: 0@0) colorsFromArray: #(#(0.624 0.863 0.612) #(0.372 0.761 0.353) #(0.585 0.8 0.573) #(0.588 0.721 0.569) #(0.922 0.961 0.918) #(0.639 0.831 0.631) #(0.914 0.937 0.91) #(0.761 0.887 0.757) #(0.538 0.8 0.534) #(0.329 0.6 0.298) #(0.333 0.616 0.306) #(0.608 0.84 0.592) #(0.372 0.753 0.349) #(0.733 0.875 0.729) #(0.71 0.863 0.706) #(0.522 0.792 0.514) #(0.753 0.883 0.753) #(0.565 0.761 0.549) #(0.369 0.741 0.345) #(0.372 0.764 0.353) #(0.922 0.965 0.918) #(0.337 0.631 0.31) #(0.926 0.973 0.922) #(0.616 0.827 0.6) #(0.345 0.651 0.314) #(0.585 0.823 0.585) #(0.608 0.815 0.6) #(0.62 0.84 0.604) #(0.616 0.815 0.604) #(0.608 0.807 0.596) #(0.592 0.729 0.573) #(0.585 0.796 0.569) #(0.643 0.831 0.635) #(0.545 0.8 0.542) #(0.608 0.796 0.592) #( ) ))! ! !OBMorphicIcons methodsFor: '*ob-sunitintegration' stamp: 'lr 3/28/2009 18:59'! testOrange ^ ((ColorForm extent: 12@12 depth: 8 fromArray: #( 589505315 589505315 589505315 589505315 589505315 589505315 589505315 589505315 589505315 589505292 1318158 52634403 589505280 353567759 186852131 589505308 35522317 572728099 589505298 136384537 539173667 589505311 151064856 102966051 589505302 454694661 170074915 589505315 589505315 589505315 589505315 589505315 589505315 589505315 589505315 589505315) offset: 0@0) colorsFromArray: #(#(1.0 0.784 0.553) #(1.0 0.8 0.577) #(1.0 0.883 0.737) #(1.0 0.949 0.898) #(1.0 0.871 0.714) #(0.883 0.667 0.498) #(0.891 0.667 0.498) #(1.0 0.753 0.458) #(1.0 0.848 0.674) #(1.0 0.741 0.482) #(0.969 0.926 0.898) #(0.984 0.741 0.498) #(1.0 0.957 0.91) #(1.0 0.8 0.581) #(1.0 0.764 0.522) #(1.0 0.753 0.494) #(1.0 0.737 0.431) #(1.0 0.776 0.53) #(1.0 0.612 0.216) #(1.0 0.883 0.741) #(1.0 0.631 0.243) #(1.0 0.776 0.549) #(0.996 0.949 0.898) #(0.879 0.494 0.164) #(1.0 0.71 0.435) #(1.0 0.772 0.534) #(0.918 0.526 0.164) #(0.969 0.725 0.498) #(1.0 0.635 0.239) #(1.0 0.628 0.228) #(1.0 0.796 0.526) #(1.0 0.757 0.51) #(0.894 0.506 0.164) #(1.0 0.757 0.466) #(0.937 0.538 0.164) #( ) ))! ! !OBMorphicIcons methodsFor: '*ob-sunitintegration' stamp: 'lr 3/28/2009 18:59'! testRed ^ ((ColorForm extent: 12@12 depth: 8 fromArray: #( 589505315 589505315 589505315 589505315 589505315 589505315 589505315 589505315 589505315 589505302 269830 287515427 589505280 151065628 488842019 589505282 437981986 220406563 589505288 236066819 186852131 589505290 555032591 86188835 589505311 202835737 270738211 589505315 589505315 589505315 589505315 589505315 589505315 589505315 589505315 589505315) offset: 0@0) colorsFromArray: #(#(1.0 0.51 0.498) #(0.984 0.737 0.725) #(0.98 0.177 0.164) #(0.953 0.534 0.526) #(0.988 0.177 0.164) #(0.815 0.498 0.522) #(0.965 0.502 0.498) #(0.761 0.164 0.185) #(0.949 0.173 0.164) #(0.992 0.506 0.502) #(0.949 0.502 0.498) #(0.78 0.164 0.185) #(0.902 0.498 0.502) #(0.827 0.164 0.177) #(0.973 0.674 0.663) #(0.894 0.47 0.474) #(0.953 0.898 0.906) #(0.988 0.898 0.898) #(0.961 0.466 0.439) #(0.961 0.455 0.431) #(0.98 0.71 0.694) #(0.961 0.577 0.565) #(1.0 0.902 0.898) #(0.804 0.164 0.181) #(0.957 0.423 0.404) #(0.804 0.498 0.522) #(0.984 0.737 0.721) #(0.973 0.526 0.494) #(0.941 0.49 0.49) #(0.922 0.498 0.502) #(0.969 0.177 0.164) #(0.984 0.898 0.898) #(0.953 0.534 0.522) #(0.934 0.486 0.486) #(0.961 0.581 0.569) #( )))! ! !OBIcon methodsFor: '*ob-sunitintegration' stamp: 'lr 12/9/2011 07:47'! testGray width := 12. height := 12. bytes := #[0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 243 243 243 255 198 198 198 255 158 158 158 255 155 155 155 255 192 192 192 255 242 242 242 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 198 198 198 255 197 197 197 255 221 221 221 255 213 213 213 255 189 189 189 255 187 187 187 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 158 158 158 255 222 222 222 255 194 194 194 255 187 187 187 255 201 201 201 255 138 138 138 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 156 156 156 255 218 218 218 255 186 186 186 255 182 182 182 255 195 195 195 255 133 133 133 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 194 194 194 255 190 190 190 255 201 201 201 255 195 195 195 255 183 183 183 255 176 176 176 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 242 242 242 255 189 189 189 255 141 141 141 255 135 135 135 255 177 177 177 255 238 238 238 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0]! ! !OBIcon methodsFor: '*ob-sunitintegration' stamp: 'lr 12/9/2011 07:47'! testGreen width := 12. height := 12. bytes := #[0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 236 248 235 255 159 220 156 255 95 194 90 255 94 189 88 255 157 211 153 255 235 245 234 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 159 220 156 255 155 214 151 255 192 225 192 255 181 220 180 255 149 203 145 255 155 203 151 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 95 195 90 255 194 226 193 255 149 210 149 255 139 204 138 255 163 212 161 255 86 161 79 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 95 192 89 255 187 223 186 255 137 204 136 255 133 202 131 255 155 208 153 255 84 153 76 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 158 214 154 255 149 204 146 255 164 212 162 255 157 208 154 255 144 194 140 255 150 184 145 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 235 246 234 255 155 206 152 255 88 166 80 255 85 157 78 255 151 186 146 255 233 239 232 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0]! ! !OBIcon methodsFor: '*ob-sunitintegration' stamp: 'lr 12/9/2011 07:47'! testOrange width := 12. height := 12. bytes := #[0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 255 244 232 255 255 200 141 255 255 162 61 255 255 156 55 255 255 193 130 255 254 242 229 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 255 200 141 255 255 198 140 255 255 225 188 255 255 216 172 255 255 189 123 255 247 185 127 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 255 161 62 255 255 225 189 255 255 203 134 255 255 193 119 255 255 204 147 255 234 134 42 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 255 160 58 255 255 222 182 255 255 192 117 255 255 188 110 255 255 198 135 255 224 126 42 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 255 195 133 255 255 192 126 255 255 204 148 255 255 197 136 255 255 181 111 255 225 170 127 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 255 242 229 255 251 189 127 255 239 137 42 255 228 129 42 255 227 170 127 255 247 236 229 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0]! ! !OBIcon methodsFor: '*ob-sunitintegration' stamp: 'lr 12/9/2011 07:47'! testRed width := 12. height := 12. bytes := #[0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 255 230 229 255 255 130 127 255 250 45 42 255 242 44 42 255 242 128 127 255 251 229 229 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 255 130 127 255 253 129 128 255 251 188 184 255 248 172 169 255 238 124 124 255 230 127 128 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 252 45 42 255 251 188 185 255 248 134 126 255 245 119 112 255 245 147 144 255 205 42 46 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 247 45 42 255 250 181 177 255 245 116 110 255 244 108 103 255 243 136 133 255 194 42 47 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 246 128 127 255 240 125 125 255 245 148 145 255 243 136 134 255 228 120 121 255 205 127 133 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 252 229 229 255 235 127 128 255 211 42 45 255 199 42 47 255 208 127 133 255 243 229 231 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0]! ! !OBMethodCategoryNode methodsFor: '*ob-sunitintegration' stamp: 'lr 12/24/2009 10:52'! hasTestSuite ^ super hasTestSuite and: [ self methods anySatisfy: [ :node | node hasTestSuite ] ]! ! !OBMethodCategoryNode methodsFor: '*ob-sunitintegration' stamp: 'lr 12/24/2009 10:50'! testSuite ^ self methods inject: TestSuite new into: [ :suite :each | each hasTestSuite ifTrue: [ suite addTest: each testSuite ]. suite ]! ! !OBMethodNode methodsFor: '*ob-sunitintegration' stamp: 'lr 9/8/2011 19:56'! hasTestSuite ^ super hasTestSuite and: [ self theClass testSelectors includes: self selector ]! ! !OBMethodNode methodsFor: '*ob-sunitintegration' stamp: 'lr 12/24/2009 10:46'! testSuite ^ self theClass selector: self selector! ! !OBNode methodsFor: '*ob-sunitintegration' stamp: 'lr 12/24/2009 10:40'! hasTestSuite ^ false! ! !OBNode methodsFor: '*ob-sunitintegration' stamp: 'lr 12/24/2009 10:49'! testSuite ^ TestSuite new! ! OBCmdFlowTests initialize!