--- /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 §'
+! !