--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/MCSnapshotBrowserTest.st	Sat Aug 20 14:34:50 2011 +0200
@@ -0,0 +1,334 @@
+"{ Package: 'stx:goodies/monticello' }"
+
+MCTestCase subclass:#MCSnapshotBrowserTest
+	instanceVariableNames:'model morph'
+	classVariableNames:''
+	poolDictionaries:''
+	category:'Monticello-Tests'
+!
+
+
+!MCSnapshotBrowserTest methodsFor:'asserting'!
+
+assertAListIncludes: anArrayOfStrings
+	self listMorphs 
+			detect: [:m | m getList includesAllOf: anArrayOfStrings]
+			ifNone: [self assert: false].
+!
+
+assertAListMatches: strings
+	| listMorphs list |
+	listMorphs := self listMorphs.
+	listMorphs 
+		detect: [:m | list := m getList. (list size = strings size) and: [list includesAllOf: strings]]
+		ifNone: [self assert: false].
+!
+
+assertButtonExists: aString
+	self buttonMorphs detect: [:m | m label = aString] ifNone: [self assert: false].
+				
+!
+
+assertButtonOn: aString
+	self assert: (self findButtonWithLabel: aString) getModelState.
+	
+!
+
+assertTextIs: aString
+	self assert: self textMorph contents = aString.
+!
+
+denyAListHasSelection: aString
+	| found |
+	found := true.
+	self listMorphs 
+			detect: [:m | m selection = aString]
+			ifNone: [found := false].
+	self deny: found.
+!
+
+denyAListIncludesAnyOf: anArrayOfStrings
+	| found |
+	found := true.
+	self listMorphs 
+			detect: [:m | m getList includesAnyOf: anArrayOfStrings]
+			ifNone: [found := false].
+	self deny: found.
+!
+
+denyButtonOn: aString
+	self deny: (self findButtonWithLabel: aString) getModelState.
+	
+! !
+
+!MCSnapshotBrowserTest methodsFor:'morphic'!
+
+annotationTextMorph
+	^ (self morphsOfClass: TextMorph) first
+!
+
+buttonMorphs
+	^ self morphsOfClass: PluggableButtonMorph
+!
+
+findButtonWithLabel: aString
+	^ self buttonMorphs detect: [:m | m label = aString]
+!
+
+findListContaining: aString
+	^ self listMorphs detect: [:m | m getList includes: aString]
+!
+
+listMorphs
+	^ self morphsOfClass: PluggableListMorph
+!
+
+morphsOfClass: aMorphClass
+	| morphs |
+	morphs := OrderedCollection new.
+	morph allMorphsDo: [:m | (m isKindOf: aMorphClass) ifTrue: [morphs add: m]].
+	^ morphs
+!
+
+textMorph
+	^ (self morphsOfClass: TextMorph) last
+! !
+
+!MCSnapshotBrowserTest methodsFor:'private'!
+
+allCategories
+	^ Array with: model extensionsCategory with: self mockCategoryName.
+!
+
+allMethods
+	^ MCSnapshotResource current definitions
+		select: [:def | def isMethodDefinition]
+		thenCollect: [:def | def selector]		
+!
+
+allProtocols
+	^ MCSnapshotResource current definitions
+		select: [:def | def isMethodDefinition]
+		thenCollect: [:def | def category]		
+!
+
+classABooleanMethods
+	^ #(falsehood moreTruth truth)
+!
+
+classAClassProtocols
+	^ self protocolsForClass: self mockClassA class.
+!
+
+classAComment
+	^ self mockClassA organization classComment.
+!
+
+classADefinitionString
+	^ self mockClassA definition
+!
+
+classAProtocols
+	^ self protocolsForClass: self mockClassA.
+!
+
+definedClasses
+	^ MCSnapshotResource current definitions 
+		select: [:def | def isClassDefinition] 
+		thenCollect: [:def | def className].
+!
+
+falsehoodMethodSource
+	^ 'falsehood
+	^ false'
+!
+
+protocolsForClass: aClass
+	| protocols |
+	protocols := aClass organization categories.
+	protocols size > 1 ifTrue: [protocols := protocols copyWith: '-- all --'].
+	^ protocols.
+! !
+
+!MCSnapshotBrowserTest methodsFor:'running'!
+
+setUp
+	model := MCSnapshotBrowser forSnapshot: MCSnapshotResource current snapshot.
+	morph := model buildWindow.
+! !
+
+!MCSnapshotBrowserTest methodsFor:'selecting'!
+
+selectMockClassA
+	self clickOnListItem: self mockCategoryName.
+	self clickOnListItem: 'MCMockClassA'.
+	
+! !
+
+!MCSnapshotBrowserTest methodsFor:'simulating'!
+
+clickOnButton: aString
+	(self findButtonWithLabel: aString) performAction.
+!
+
+clickOnListItem: aString
+	| listMorph |
+	listMorph := self findListContaining: aString.
+	listMorph changeModelSelection: (listMorph getList indexOf: aString).
+! !
+
+!MCSnapshotBrowserTest methodsFor:'testing'!
+
+testAnnotationPane
+	| oldPref |
+	oldPref := Preferences annotationPanes.
+
+	Preferences disable: #annotationPanes.
+	morph := model buildWindow.
+	self assert: (self morphsOfClass: TextMorph) size = 1.
+
+	Preferences enable: #annotationPanes.
+	morph := model buildWindow.
+	self assert: (self morphsOfClass: TextMorph) size = 2.
+
+	Preferences setPreference: #annotationPanes toValue: oldPref
+!
+
+testButtonMutex
+	self assertButtonOn: 'instance'.
+	self denyButtonOn: '?'.
+	self denyButtonOn: 'class'.
+	
+	self clickOnButton: '?'.
+	self assertButtonOn: '?'.
+	self denyButtonOn: 'instance'.
+	self denyButtonOn: 'class'.
+	
+	self clickOnButton: 'class'.
+	self assertButtonOn: 'class'.
+	self denyButtonOn: '?'.
+	self denyButtonOn: 'instance'.
+
+!
+
+testCategorySelected
+	self clickOnListItem: self mockCategoryName.
+	
+	self assertAListMatches: self allCategories.
+	self assertAListMatches: self definedClasses.
+	self denyAListIncludesAnyOf: self allProtocols.
+	self denyAListIncludesAnyOf: self allMethods.
+	self assertTextIs: ''.
+!
+
+testClassSelected
+	self selectMockClassA.
+	
+	self assertAListMatches: self allCategories.
+	self assertAListMatches: self definedClasses.
+	self assertAListMatches: self classAProtocols.
+	self denyAListIncludesAnyOf: self allMethods.
+	self assertTextIs: self classADefinitionString.
+!
+
+testClassSideClassSelected
+	self clickOnButton: 'class'.
+	self selectMockClassA.
+	
+	self assertAListMatches: self allCategories.
+	self assertAListMatches: self definedClasses.
+	self assertAListMatches: self classAClassProtocols.
+	self denyAListIncludesAnyOf: self allMethods.
+	self assertTextIs: self classADefinitionString.
+!
+
+testComment
+	self clickOnButton: '?'.
+	self assertTextIs: ''.
+	
+	self clickOnListItem: self mockCategoryName.
+	self assertTextIs: ''.
+	
+	self clickOnListItem: 'MCMockClassA'.
+	self assertTextIs: self classAComment.
+!
+
+testFourColumns
+	self assert: self listMorphs size = 4.
+!
+
+testMethodIsCleared
+	self clickOnListItem: self mockCategoryName.
+	self clickOnListItem: 'MCMockClassA'.
+	self clickOnListItem: 'boolean'.
+	self clickOnListItem: 'falsehood'.
+	self clickOnListItem: '-- all --'.
+	
+	self denyAListHasSelection: 'falsehood'.
+!
+
+testMethodSelected
+	self clickOnListItem: self mockCategoryName.
+	self clickOnListItem: 'MCMockClassA'.
+	self clickOnListItem: 'boolean'.
+	self clickOnListItem: 'falsehood'.
+	
+	self assertAListMatches: self allCategories.
+	self assertAListMatches: self definedClasses.
+	self assertAListMatches: self classAProtocols.
+	self assertAListMatches: self classABooleanMethods.
+	self assertTextIs: self falsehoodMethodSource.
+!
+
+testNoSelection
+	self assertAListMatches: self allCategories.
+	self denyAListIncludesAnyOf: self definedClasses.
+	self denyAListIncludesAnyOf: self allProtocols.
+	self denyAListIncludesAnyOf: self allMethods.
+	self assertTextIs: ''.
+!
+
+testProtocolIsCleared
+	self clickOnListItem: self mockCategoryName.
+	self clickOnListItem: 'MCMockASubclass'.
+	self clickOnListItem: 'as yet unclassified'.
+	self clickOnListItem: 'MCMockClassA'.
+	
+	self denyAListHasSelection: 'as yet unclassified'.
+!
+
+testProtocolSelected
+	self clickOnListItem: self mockCategoryName.
+	self clickOnListItem: 'MCMockClassA'.
+	self clickOnListItem: 'boolean'.
+	
+	self assertAListMatches: self allCategories.
+	self assertAListMatches: self definedClasses.
+	self assertAListMatches: self classAProtocols.
+	self assertAListMatches: self classABooleanMethods.
+	self assertTextIs: ''.		
+!
+
+testTextPane
+	self shouldnt: [self textMorph] raise: Exception.
+!
+
+testThreeButtons
+	self assertButtonExists: 'instance'.
+	self assertButtonExists: '?'.
+	self assertButtonExists: 'class'.
+! !
+
+!MCSnapshotBrowserTest class methodsFor:'documentation'!
+
+version
+    ^ '$Header: /cvs/stx/stx/goodies/monticello/MCSnapshotBrowserTest.st,v 1.1 2011-08-20 12:34:50 cg Exp $'
+!
+
+version_CVS
+    ^ '$Header: /cvs/stx/stx/goodies/monticello/MCSnapshotBrowserTest.st,v 1.1 2011-08-20 12:34:50 cg Exp $'
+!
+
+version_SVN
+    ^ '§Id: MCSnapshotBrowserTest.st 5 2010-08-29 07:30:29Z vranyj1 §'
+! !