hg/stx-goodies-monticello: test/MCSnapshotBrowserTest.st@c5661215109c (annotated)

1121 c5661215109c Tonel: various fixes here and there (part 2) Jan Vrany <jan.vrany@labware.com> parents: 822 diff changeset	1	"
c5661215109c Tonel: various fixes here and there (part 2) Jan Vrany <jan.vrany@labware.com> parents: 822 diff changeset	2	COPYRIGHT (c) 2020 LabWare
c5661215109c Tonel: various fixes here and there (part 2) Jan Vrany <jan.vrany@labware.com> parents: 822 diff changeset	3	"
24 f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	4	"{ Package: 'stx:goodies/monticello/test' }"
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	5
1121 c5661215109c Tonel: various fixes here and there (part 2) Jan Vrany <jan.vrany@labware.com> parents: 822 diff changeset	6	"{ NameSpace: Smalltalk }"
c5661215109c Tonel: various fixes here and there (part 2) Jan Vrany <jan.vrany@labware.com> parents: 822 diff changeset	7
24 f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	8	MCTestCase subclass:#MCSnapshotBrowserTest
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	9	instanceVariableNames:'model morph'
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	10	classVariableNames:''
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	11	poolDictionaries:''
822 509715fb5cf5 Tests moved to category SCM-Monticello-Tests Jan Vrany <jan.vrany@fit.cvut.cz> parents: 24 diff changeset	12	category:'SCM-Monticello-Tests'
24 f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	13	!
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	14
1121 c5661215109c Tonel: various fixes here and there (part 2) Jan Vrany <jan.vrany@labware.com> parents: 822 diff changeset	15	!MCSnapshotBrowserTest class methodsFor:'documentation'!
c5661215109c Tonel: various fixes here and there (part 2) Jan Vrany <jan.vrany@labware.com> parents: 822 diff changeset	16
c5661215109c Tonel: various fixes here and there (part 2) Jan Vrany <jan.vrany@labware.com> parents: 822 diff changeset	17	copyright
c5661215109c Tonel: various fixes here and there (part 2) Jan Vrany <jan.vrany@labware.com> parents: 822 diff changeset	18	"
c5661215109c Tonel: various fixes here and there (part 2) Jan Vrany <jan.vrany@labware.com> parents: 822 diff changeset	19	COPYRIGHT (c) 2020 LabWare
c5661215109c Tonel: various fixes here and there (part 2) Jan Vrany <jan.vrany@labware.com> parents: 822 diff changeset	20
c5661215109c Tonel: various fixes here and there (part 2) Jan Vrany <jan.vrany@labware.com> parents: 822 diff changeset	21
c5661215109c Tonel: various fixes here and there (part 2) Jan Vrany <jan.vrany@labware.com> parents: 822 diff changeset	22	"
c5661215109c Tonel: various fixes here and there (part 2) Jan Vrany <jan.vrany@labware.com> parents: 822 diff changeset	23	! !
24 f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	24
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	25	!MCSnapshotBrowserTest class methodsFor:'as yet unclassified'!
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	26
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	27	resources
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	28	^ Array with: MCSnapshotResource
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	29	! !
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	30
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	31	!MCSnapshotBrowserTest methodsFor:'asserting'!
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	32
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	33	assertAListIncludes: anArrayOfStrings
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	34	self listMorphs
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	35	detect: [:m \| m getList includesAllOf: anArrayOfStrings]
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	36	ifNone: [self assert: false].
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	37	!
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	38
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	39	assertAListMatches: strings
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	40	\| listMorphs list \|
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	41	listMorphs _ self listMorphs.
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	42	listMorphs
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	43	detect: [:m \| list _ m getList. (list size = strings size) and: [list includesAllOf: strings]]
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	44	ifNone: [self assert: false].
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	45	!
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	46
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	47	assertButtonExists: aString
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	48	self buttonMorphs detect: [:m \| m label = aString] ifNone: [self assert: false].
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	49
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	50	!
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	51
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	52	assertButtonOn: aString
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	53	self assert: (self findButtonWithLabel: aString) getModelState.
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	54
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	55	!
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	56
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	57	assertTextIs: aString
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	58	self assert: self textMorph contents = aString.
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	59	!
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	60
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	61	denyAListHasSelection: aString
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	62	\| found \|
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	63	found _ true.
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	64	self listMorphs
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	65	detect: [:m \| m selection = aString]
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	66	ifNone: [found _ false].
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	67	self deny: found.
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	68	!
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	69
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	70	denyAListIncludesAnyOf: anArrayOfStrings
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	71	\| found \|
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	72	found _ true.
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	73	self listMorphs
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	74	detect: [:m \| m getList includesAnyOf: anArrayOfStrings]
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	75	ifNone: [found _ false].
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	76	self deny: found.
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	77	!
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	78
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	79	denyButtonOn: aString
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	80	self deny: (self findButtonWithLabel: aString) getModelState.
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	81
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	82	! !
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	83
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	84	!MCSnapshotBrowserTest methodsFor:'morphic'!
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	85
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	86	annotationTextMorph
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	87	^ (self morphsOfClass: TextMorph) first
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	88	!
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	89
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	90	buttonMorphs
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	91	^ self morphsOfClass: PluggableButtonMorph
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	92	!
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	93
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	94	findButtonWithLabel: aString
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	95	^ self buttonMorphs detect: [:m \| m label = aString]
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	96	!
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	97
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	98	findListContaining: aString
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	99	^ self listMorphs detect: [:m \| m getList includes: aString]
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	100	!
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	101
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	102	listMorphs
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	103	^ self morphsOfClass: PluggableListMorph
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	104	!
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	105
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	106	morphsOfClass: aMorphClass
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	107	\| morphs \|
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	108	morphs _ OrderedCollection new.
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	109	morph allMorphsDo: [:m \| (m isKindOf: aMorphClass) ifTrue: [morphs add: m]].
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	110	^ morphs
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	111	!
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	112
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	113	textMorph
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	114	^ (self morphsOfClass: TextMorph) last
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	115	! !
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	116
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	117	!MCSnapshotBrowserTest methodsFor:'private'!
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	118
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	119	allCategories
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	120	^ Array with: model extensionsCategory with: self mockCategoryName.
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	121	!
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	122
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	123	allMethods
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	124	^ MCSnapshotResource current definitions
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	125	select: [:def \| def isMethodDefinition]
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	126	thenCollect: [:def \| def selector]
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	127	!
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	128
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	129	allProtocols
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	130	^ MCSnapshotResource current definitions
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	131	select: [:def \| def isMethodDefinition]
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	132	thenCollect: [:def \| def category]
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	133	!
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	134
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	135	classABooleanMethods
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	136	^ #(falsehood moreTruth truth)
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	137	!
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	138
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	139	classAClassProtocols
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	140	^ self protocolsForClass: self mockClassA class.
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	141	!
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	142
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	143	classAComment
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	144	^ self mockClassA organization classComment.
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	145	!
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	146
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	147	classADefinitionString
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	148	^ self mockClassA definition
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	149	!
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	150
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	151	classAProtocols
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	152	^ self protocolsForClass: self mockClassA.
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	153	!
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	154
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	155	definedClasses
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	156	^ MCSnapshotResource current definitions
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	157	select: [:def \| def isClassDefinition]
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	158	thenCollect: [:def \| def className].
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	159	!
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	160
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	161	falsehoodMethodSource
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	162	^ 'falsehood
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	163	^ false'
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	164	!
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	165
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	166	protocolsForClass: aClass
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	167	\| protocols \|
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	168	protocols _ aClass organization categories.
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	169	protocols size > 1 ifTrue: [protocols _ protocols copyWith: '-- all --'].
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	170	^ protocols.
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	171	! !
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	172
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	173	!MCSnapshotBrowserTest methodsFor:'running'!
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	174
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	175	setUp
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	176	model _ MCSnapshotBrowser forSnapshot: MCSnapshotResource current snapshot.
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	177	morph _ model buildWindow.
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	178	! !
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	179
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	180	!MCSnapshotBrowserTest methodsFor:'selecting'!
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	181
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	182	selectMockClassA
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	183	self clickOnListItem: self mockCategoryName.
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	184	self clickOnListItem: 'MCMockClassA'.
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	185
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	186	! !
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	187
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	188	!MCSnapshotBrowserTest methodsFor:'simulating'!
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	189
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	190	clickOnButton: aString
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	191	(self findButtonWithLabel: aString) performAction.
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	192	!
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	193
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	194	clickOnListItem: aString
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	195	\| listMorph \|
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	196	listMorph _ self findListContaining: aString.
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	197	listMorph changeModelSelection: (listMorph getList indexOf: aString).
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	198	! !
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	199
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	200	!MCSnapshotBrowserTest methodsFor:'testing'!
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	201
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	202	testAnnotationPane
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	203	\| oldPref \|
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	204	oldPref _ Preferences annotationPanes.
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	205
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	206	Preferences disable: #annotationPanes.
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	207	morph _ model buildWindow.
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	208	self assert: (self morphsOfClass: TextMorph) size = 1.
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	209
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	210	Preferences enable: #annotationPanes.
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	211	morph _ model buildWindow.
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	212	self assert: (self morphsOfClass: TextMorph) size = 2.
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	213
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	214	Preferences setPreference: #annotationPanes toValue: oldPref
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	215	!
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	216
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	217	testButtonMutex
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	218	self assertButtonOn: 'instance'.
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	219	self denyButtonOn: '?'.
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	220	self denyButtonOn: 'class'.
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	221
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	222	self clickOnButton: '?'.
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	223	self assertButtonOn: '?'.
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	224	self denyButtonOn: 'instance'.
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	225	self denyButtonOn: 'class'.
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	226
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	227	self clickOnButton: 'class'.
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	228	self assertButtonOn: 'class'.
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	229	self denyButtonOn: '?'.
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	230	self denyButtonOn: 'instance'.
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	231	!
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	232
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	233	testCategorySelected
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	234	self clickOnListItem: self mockCategoryName.
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	235
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	236	self assertAListMatches: self allCategories.
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	237	self assertAListMatches: self definedClasses.
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	238	self denyAListIncludesAnyOf: self allProtocols.
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	239	self denyAListIncludesAnyOf: self allMethods.
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	240	self assertTextIs: ''.
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	241	!
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	242
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	243	testClassSelected
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	244	self selectMockClassA.
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	245
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	246	self assertAListMatches: self allCategories.
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	247	self assertAListMatches: self definedClasses.
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	248	self assertAListMatches: self classAProtocols.
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	249	self denyAListIncludesAnyOf: self allMethods.
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	250	self assertTextIs: self classADefinitionString.
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	251	!
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	252
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	253	testClassSideClassSelected
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	254	self clickOnButton: 'class'.
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	255	self selectMockClassA.
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	256
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	257	self assertAListMatches: self allCategories.
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	258	self assertAListMatches: self definedClasses.
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	259	self assertAListMatches: self classAClassProtocols.
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	260	self denyAListIncludesAnyOf: self allMethods.
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	261	self assertTextIs: self classADefinitionString.
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	262	!
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	263
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	264	testComment
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	265	self clickOnButton: '?'.
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	266	self assertTextIs: ''.
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	267
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	268	self clickOnListItem: self mockCategoryName.
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	269	self assertTextIs: ''.
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	270
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	271	self clickOnListItem: 'MCMockClassA'.
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	272	self assertTextIs: self classAComment.
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	273	!
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	274
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	275	testFourColumns
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	276	self assert: self listMorphs size = 4.
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	277	!
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	278
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	279	testMethodIsCleared
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	280	self clickOnListItem: self mockCategoryName.
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	281	self clickOnListItem: 'MCMockClassA'.
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	282	self clickOnListItem: 'boolean'.
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	283	self clickOnListItem: 'falsehood'.
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	284	self clickOnListItem: '-- all --'.
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	285
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	286	self denyAListHasSelection: 'falsehood'.
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	287	!
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	288
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	289	testMethodSelected
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	290	self clickOnListItem: self mockCategoryName.
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	291	self clickOnListItem: 'MCMockClassA'.
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	292	self clickOnListItem: 'boolean'.
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	293	self clickOnListItem: 'falsehood'.
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	294
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	295	self assertAListMatches: self allCategories.
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	296	self assertAListMatches: self definedClasses.
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	297	self assertAListMatches: self classAProtocols.
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	298	self assertAListMatches: self classABooleanMethods.
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	299	self assertTextIs: self falsehoodMethodSource.
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	300	!
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	301
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	302	testNoSelection
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	303	self assertAListMatches: self allCategories.
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	304	self denyAListIncludesAnyOf: self definedClasses.
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	305	self denyAListIncludesAnyOf: self allProtocols.
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	306	self denyAListIncludesAnyOf: self allMethods.
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	307	self assertTextIs: ''.
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	308	!
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	309
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	310	testProtocolIsCleared
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	311	self clickOnListItem: self mockCategoryName.
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	312	self clickOnListItem: 'MCMockASubclass'.
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	313	self clickOnListItem: 'as yet unclassified'.
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	314	self clickOnListItem: 'MCMockClassA'.
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	315
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	316	self denyAListHasSelection: 'as yet unclassified'.
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	317	!
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	318
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	319	testProtocolSelected
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	320	self clickOnListItem: self mockCategoryName.
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	321	self clickOnListItem: 'MCMockClassA'.
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	322	self clickOnListItem: 'boolean'.
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	323
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	324	self assertAListMatches: self allCategories.
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	325	self assertAListMatches: self definedClasses.
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	326	self assertAListMatches: self classAProtocols.
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	327	self assertAListMatches: self classABooleanMethods.
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	328	self assertTextIs: ''.
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	329	!
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	330
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	331	testTextPane
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	332	self shouldnt: [self textMorph] raise: Exception.
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	333	!
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	334
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	335	testThreeButtons
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	336	self assertButtonExists: 'instance'.
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	337	self assertButtonExists: '?'.
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	338	self assertButtonExists: 'class'.
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	339	! !
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	340
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	341	!MCSnapshotBrowserTest class methodsFor:'documentation'!
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	342
f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	343	version
822 509715fb5cf5 Tests moved to category SCM-Monticello-Tests Jan Vrany <jan.vrany@fit.cvut.cz> parents: 24 diff changeset	344	^ '$Header: /cvs/stx/stx/goodies/monticello/test/MCSnapshotBrowserTest.st,v 1.2 2013-05-29 00:02:19 vrany Exp $'
24 f42fd4d26694 initial checkin Claus Gittinger <cg@exept.de> parents: diff changeset	345	! !
822 509715fb5cf5 Tests moved to category SCM-Monticello-Tests Jan Vrany <jan.vrany@fit.cvut.cz> parents: 24 diff changeset	346

author	Jan Vrany <jan.vrany@labware.com>
	Sat, 04 Jul 2020 08:14:13 +0100
branch	jv
changeset 1121	c5661215109c
parent 822	509715fb5cf5
permissions	-rw-r--r--