[squeak-dev] The Trunk: Tests-mt.347.mcz

commits at source.squeak.org commits at source.squeak.org
Sun Jul 31 08:03:33 UTC 2016


Marcel Taeumel uploaded a new version of Tests to project The Trunk:
http://source.squeak.org/trunk/Tests-mt.347.mcz

==================== Summary ====================

Name: Tests-mt.347
Author: mt
Time: 31 July 2016, 10:03:21.36749 am
UUID: 390a9533-4e83-fb43-bee0-c05731033988
Ancestors: Tests-pre.346

*** Widget Refactorings and UI Themes (Part 1 of 11) ***

Tests for the theming mechanism. And a benchmark.

=============== Diff against Tests-pre.346 ===============

Item was added:
+ TestCase subclass: #UserInterfaceThemeTest
+ 	instanceVariableNames: 'theme previous'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Tests-System-Preferences'!

Item was added:
+ ----- Method: UserInterfaceThemeTest>>setUp (in category 'running') -----
+ setUp
+ 
+ 	super setUp.
+ 	previous := UserInterfaceTheme current.
+ 	theme := UserInterfaceTheme new name: 'ui theme test'.!

Item was added:
+ ----- Method: UserInterfaceThemeTest>>tearDown (in category 'running') -----
+ tearDown
+ 
+ 	previous
+ 		ifNil: [UserInterfaceTheme reset]
+ 		ifNotNil: [UserInterfaceTheme current == previous
+ 			ifFalse: [previous apply]].
+ 		
+ 	super tearDown.!

Item was added:
+ ----- Method: UserInterfaceThemeTest>>test01ImplementationHooks (in category 'tests') -----
+ test01ImplementationHooks
+ 	"Any class which implements themeProperties must implement #applyUserInterfaceTheme on the instance side."
+ 	
+ 	| problematicClasses |
+ 	problematicClasses := OrderedCollection new.
+ 	Smalltalk allClassesDo: [ : each | ((each theMetaClass includesSelector: #themeProperties) not
+ 		or: [each theNonMetaClass includesSelector: #applyUserInterfaceTheme])
+ 			ifFalse: [problematicClasses add: each]].
+ 	self assert: problematicClasses isEmpty description: ('UI Theme Violations: {1}' format: {(problematicClasses collect: [:ea | ea name]) joinSeparatedBy: ' '})!

Item was added:
+ ----- Method: UserInterfaceThemeTest>>test02SetProperty (in category 'tests') -----
+ test02SetProperty
+ 
+ 	| m |
+ 	m := UserInterfaceThemeTestObject new.
+ 
+ 	theme set: #testColor for: UserInterfaceThemeTestObject to: Color white.
+ 	self assert: m testColor isNil.
+ 
+ 	theme apply.
+ 	self assert: Color white equals: m testColor.
+ !

Item was added:
+ ----- Method: UserInterfaceThemeTest>>test03RegisterAndName (in category 'tests') -----
+ test03RegisterAndName
+ 
+ 	self deny: (UserInterfaceTheme allThemes includes: theme).
+ 	theme register.
+ 	self assert: (UserInterfaceTheme allThemes includes: theme).
+ 	theme unregister.
+ 	self deny: (UserInterfaceTheme allThemes includes: theme).
+ 	
+ 	theme name: 'test03'.
+ 	theme register.
+ 	self assert: theme == (UserInterfaceTheme named: 'test03').
+ 	theme unregister.
+ 	
+ 	self assert: theme ~~ (UserInterfaceTheme named: 'testXX').
+ 	self assert:  (UserInterfaceTheme named: 'testXX') == (UserInterfaceTheme named: 'testXX').
+ 	(UserInterfaceTheme named: 'testXX') unregister.
+ 	self deny: (UserInterfaceTheme allThemes anySatisfy: [:ea | ea name = 'testXX']).!

Item was added:
+ ----- Method: UserInterfaceThemeTest>>test04SuperClassLookup (in category 'tests') -----
+ test04SuperClassLookup
+ 
+ 	| m |
+ 	m := UserInterfaceThemeTestObject new.
+ 
+ 	theme set: #testColor for: Object to: Color white.
+ 	self assert: m testColor isNil.
+ 
+ 	theme apply.
+ 	self assert: Color white equals: m testColor.
+ !

Item was added:
+ ----- Method: UserInterfaceThemeTest>>test05ClearProperty (in category 'tests') -----
+ test05ClearProperty
+ 
+ 	| m |
+ 	m := UserInterfaceThemeTestObject new.
+ 	theme set: #testColor for: UserInterfaceThemeTestObject to: Color white.
+ 	theme apply.
+ 
+ 	self assert: Color white equals: m testColor.
+ 	theme clear: #testColor for: UserInterfaceThemeTestObject.
+ 	self assert: Color white equals: m testColor.
+ 	theme apply.
+ 	
+ 	self assert: m testColor isNil.
+ !

Item was added:
+ ----- Method: UserInterfaceThemeTest>>test06SetAndClearUnkownProperty (in category 'tests') -----
+ test06SetAndClearUnkownProperty
+ 	"Unknown means not defined in #themeProperties und used in code such as #applyUserInterfaceTheme."
+ 	
+ 	| m |
+ 	m := UserInterfaceThemeTestObject new.
+ 	theme set: #unknownProperty for: UserInterfaceThemeTestObject to: #blubb.
+ 	theme apply.
+ 
+ 	self assert:#blubb equals: m unknownProperty.
+ 	theme clear: #unknownProperty for: UserInterfaceThemeTestObject.
+ 	self assert:#blubb equals: m unknownProperty.
+ 	theme apply.
+ 	
+ 	self assert: m unknownProperty isNil.
+ !

Item was added:
+ ----- Method: UserInterfaceThemeTest>>test07Merge (in category 'tests') -----
+ test07Merge
+ 
+ 	| anotherTheme |
+ 	anotherTheme := UserInterfaceTheme new.
+ 	anotherTheme set: #someColor for: Morph to: Color red.
+ 	anotherTheme set: #thirdColor for: Morph to: Color blue.
+ 
+ 	theme set: #myColor for: Morph to: Color white.
+ 	theme set: #thirdColor for: Morph to: Color yellow.
+ 	
+ 	self assert: (theme get: #someColor for: Morph) isNil.
+ 	self assert: (anotherTheme get: #myColor for: Morph) isNil.
+ 	
+ 	theme merge: anotherTheme.
+ 	
+ 	self assert: Color red equals: (theme get: #someColor for: Morph).
+ 	self assert: (anotherTheme get: #myColor for: Morph) isNil.
+ 
+ 	"No overwrite."
+ 	self assert: Color yellow equals: (theme get: #thirdColor for: Morph).
+ 	self assert: Color blue equals: (anotherTheme get: #thirdColor for: Morph).
+ !

Item was added:
+ ----- Method: UserInterfaceThemeTest>>test08MergeAndOverwrite (in category 'tests') -----
+ test08MergeAndOverwrite
+ 
+ 	| anotherTheme |
+ 	anotherTheme := UserInterfaceTheme new.
+ 	anotherTheme set: #thirdColor for: Morph to: Color blue.
+ 	theme set: #thirdColor for: Morph to: Color yellow.
+ 	
+ 	self assert: Color yellow equals: (theme get: #thirdColor for: Morph).
+ 	self assert: Color blue equals: (anotherTheme get: #thirdColor for: Morph).
+ 
+ 	theme merge: anotherTheme overwrite: true.
+ 
+ 	self assert: Color blue equals: (theme get: #thirdColor for: Morph).
+ 	self assert: Color blue equals: (anotherTheme get: #thirdColor for: Morph).!

Item was added:
+ ----- Method: UserInterfaceThemeTest>>test09Link (in category 'tests') -----
+ test09Link
+ 
+ 	| anotherTheme |
+ 	anotherTheme := UserInterfaceTheme new.
+ 	
+ 	anotherTheme set: #testColor for: Object to: Color white.	
+ 	self assert: (theme get: #testColor for: Object) isNil.
+ 
+ 	theme link: anotherTheme.
+ 	self assert: theme next == anotherTheme.
+ 	self assert: Color white equals: (theme get: #testColor for: Object).
+ !

Item was added:
+ ----- Method: UserInterfaceThemeTest>>test10Blocks (in category 'tests') -----
+ test10Blocks
+ 
+ 	theme set: #testColor for: Object to: [Color r: 1 g: 1 b: 1].
+ 	self assert: (theme get: #testColor for: Object) ~~ (theme get: #testColor for: Object).
+ 	
+ !

Item was added:
+ ----- Method: UserInterfaceThemeTest>>test11LinkAgain (in category 'tests') -----
+ test11LinkAgain
+ 
+ 	| anotherTheme yetAnotherTheme |
+ 	anotherTheme := UserInterfaceTheme new.
+ 	yetAnotherTheme := UserInterfaceTheme new.
+ 	
+ 	yetAnotherTheme set: #testColor for: Object to: Color white.
+ 	self assert: (theme get: #testColor for: Object) isNil.
+ 
+ 	theme link: anotherTheme.
+ 	anotherTheme link: yetAnotherTheme.
+ 	
+ 	self assert: Color white equals: (theme get: #testColor for: Object).!

Item was added:
+ ----- Method: UserInterfaceThemeTest>>test12RealDNU (in category 'tests') -----
+ test12RealDNU
+ 	"If we forgot to push a scope, it is a real DNU and not stack is empty."
+ 	self should: [theme perform: #undefinedMessage] raise: MessageNotUnderstood!

Item was added:
+ ----- Method: UserInterfaceThemeTest>>test13ClassName (in category 'tests') -----
+ test13ClassName
+ 	
+ 	self assert: (theme get: #testColor for: #Object) isNil.
+ 
+ 	theme set: #testColor for: #Object to: Color white.
+ 	self assert: Color white equals: (theme get: #testColor for: #Object).
+ 	
+ 	theme clear: #testColor for: #Object.
+ 	self assert: (theme get: #testColor for: #Object) isNil.
+ 
+ 	self shouldnt: [theme set: #testColor for: #SomeNonExistentClass to: Color white] raise: Error.
+ 	self assert: (theme get: #testColor for: nil) isNil.!

Item was added:
+ ----- Method: UserInterfaceThemeTest>>test14Perform (in category 'tests') -----
+ test14Perform
+ 	
+ 	| m |
+ 	m := UserInterfaceThemeTestObject new.
+ 	theme apply.
+ 
+ 	self assert: m getTestColor isNil.
+ 	self assert: m getTestColorViaPerform isNil.
+ 
+ 	theme set: #testColor for: #UserInterfaceThemeTestObject to: Color white.
+ 
+ 	self assert: Color white equals: m getTestColor.
+ 	self assert: Color white equals: m getTestColorViaPerform.!

Item was added:
+ ----- Method: UserInterfaceThemeTest>>test15DerivedProperties (in category 'tests') -----
+ test15DerivedProperties
+ 	
+ 	theme set: #fanciness for: Point to: 42.
+ 	theme derive: #fanciness for: Rectangle from: Point at: #fanciness.
+ 
+ 	self assert: 42 equals: (theme get: #fanciness for: Point).
+ 	self assert: 42 equals: (theme get: #fanciness for: Rectangle).!

Item was added:
+ ----- Method: UserInterfaceThemeTest>>test16ArraysAsProperties (in category 'tests') -----
+ test16ArraysAsProperties
+ 	"Used, for example, by Shout styling. There might be many reasons for storing arrays as properties."
+ 	
+ 	theme set: #complexSpec for: UserInterfaceThemeTestObject to: {#foo. 42. #(a b c)}.
+ 	
+ 	self assert: {#foo. 42. #(a b c)} equals: (theme get: #complexSpec for: UserInterfaceThemeTestObject).!

Item was added:
+ ----- Method: UserInterfaceThemeTest>>test17DerivedPropertiesWithBlock (in category 'tests') -----
+ test17DerivedPropertiesWithBlock
+ 	
+ 	theme set: #fanciness for: Point to: 42.
+ 	theme derive: #fanciness for: Rectangle from: Point at: #fanciness do: [:f | f + 1].
+ 
+ 	self assert: 42 equals: (theme get: #fanciness for: Point).
+ 	self assert: 43 equals: (theme get: #fanciness for: Rectangle).!

Item was added:
+ ----- Method: UserInterfaceThemeTest>>test18MergeWithDerivedProperties (in category 'tests') -----
+ test18MergeWithDerivedProperties
+ 	
+ 	| anotherTheme |
+ 	anotherTheme := UserInterfaceTheme new.
+ 	
+ 	theme set: #fanciness for: Point to: 42.
+ 	theme derive: #fanciness for: Rectangle from: Point at: #fanciness do: [:f | f + 1].
+ 
+ 	anotherTheme merge: theme.
+ 	theme set: #fanciness for: Point to: 21.
+ 
+ 	self assert: 22 equals: (theme get: #fanciness for: Rectangle).
+ 	self assert: 43 equals: (anotherTheme get: #fanciness for: Rectangle).!

Item was added:
+ ----- Method: UserInterfaceThemeTest>>test19MergeWithCopy (in category 'tests') -----
+ test19MergeWithCopy
+ 	
+ 	| anotherTheme |
+ 	anotherTheme := UserInterfaceTheme new.
+ 	
+ 	theme set: #someColor for: Object to: Color red.
+ 	anotherTheme merge: theme.
+ 
+ 	self assert: (theme get: #someColor for: Object) ~~ (anotherTheme get: #someColor for: Object).!

Item was added:
+ ----- Method: UserInterfaceThemeTest>>test20ClassSideApply (in category 'tests') -----
+ test20ClassSideApply
+ 	
+ 	UserInterfaceThemeTestObject resetApplyCounter.
+ 	self assert: 0 equals: UserInterfaceThemeTestObject applyCounter.
+ 	theme apply.
+ 	self assert: 1 equals: UserInterfaceThemeTestObject applyCounter.
+ !

Item was added:
+ ----- Method: UserInterfaceThemeTest>>test21BlocksNoDuplicateEvaluation (in category 'tests') -----
+ test21BlocksNoDuplicateEvaluation
+ 	
+ 	| anotherTheme |
+ 	anotherTheme := UserInterfaceTheme new.
+ 	anotherTheme set: #modifier for: Object to: [ [:color | color darker] ].
+ 	
+ 	theme link: anotherTheme.
+ 	self shouldnt: [theme get: #modifier for: Color] raise: Error.	
+ 	self assert: Color yellow darker equals: ((theme get: #modifier for: Color) value: Color yellow).!

Item was added:
+ ----- Method: UserInterfaceThemeTest>>test22SetAndClearConveniently (in category 'tests') -----
+ test22SetAndClearConveniently
+ 
+ 	self assert: (theme get: #foo22) isNil.
+ 	theme set: #foo22 to: 22.
+ 	self assert: 22 equals: (theme get: #foo22).
+ 	theme clear: #foo22.
+ 	self assert: (theme get: #foo22) isNil.!

Item was added:
+ ----- Method: UserInterfaceThemeTest>>test23LookUpReset (in category 'tests') -----
+ test23LookUpReset
+ 	"When nothing is found in the super-class hierarchy, try linked themes. However, start at with the original class again."
+ 
+ 	| anotherTheme |
+ 	anotherTheme := UserInterfaceTheme new.
+ 	
+ 
+ 	theme set: #fanciness for: Object to: 42.
+ 	theme set: #fanciness for: Point to: 43.
+ 	
+ 	anotherTheme link: theme.
+ 
+ 	self assert: 43 equals: (theme get: #fanciness for: Point).
+ 	self assert: 43 equals: (anotherTheme get: #fanciness for: Point).!

Item was added:
+ ----- Method: UserInterfaceThemeTest>>test24GetSimplePropertiesViaLink (in category 'tests') -----
+ test24GetSimplePropertiesViaLink
+ 
+ 	| anotherTheme |
+ 	anotherTheme := UserInterfaceTheme new.
+ 	
+ 	theme set: #fanciness to: 42.	
+ 	anotherTheme link: theme.
+ 
+ 	self assert: 42 equals: (anotherTheme get: #fanciness).!

Item was added:
+ ----- Method: UserInterfaceThemeTest>>test25DerivedPropertiesViaLink (in category 'tests') -----
+ test25DerivedPropertiesViaLink
+ 	"It is not (yet?) possible to reset the look-up for derived properties. You should merge themes if you need it."
+ 	
+ 	| anotherTheme |
+ 	anotherTheme := UserInterfaceTheme new.
+ 	
+ 	theme set: #fanciness for: Point to: 42.
+ 	theme derive: #fanciness for: Rectangle from: Point at: #fanciness do: [:f | f + 1].
+ 	
+ 	anotherTheme set: #fanciness for: Point to: 21.
+ 	anotherTheme link: theme.
+ 	
+ 	self assert: 43 equals: (theme get: #fanciness for: Rectangle).
+ 	"self assert: 22 equals: (anotherTheme get: #fanciness for: Rectangle)."
+ 	self assert: 43 equals: (anotherTheme get: #fanciness for: Rectangle).!

Item was added:
+ ----- Method: UserInterfaceThemeTest>>test26ApplyTo (in category 'tests') -----
+ test26ApplyTo
+ 
+ 	| m |
+ 	m := UserInterfaceThemeTestObject new.
+ 
+ 	theme set: #testColor for: UserInterfaceThemeTestObject to: Color white.
+ 	self assert: m testColor isNil.
+ 
+ 	theme applyTo: {m}.
+ 	self assert: Color white equals: m testColor.
+ !

Item was added:
+ Object subclass: #UserInterfaceThemeTestObject
+ 	instanceVariableNames: 'testColor unknownProperty'
+ 	classVariableNames: 'ApplyCounter'
+ 	poolDictionaries: ''
+ 	category: 'Tests-System-Preferences'!

Item was added:
+ ----- Method: UserInterfaceThemeTestObject class>>applyCounter (in category 'as yet unclassified') -----
+ applyCounter
+ 	^ ApplyCounter!

Item was added:
+ ----- Method: UserInterfaceThemeTestObject class>>applyUserInterfaceTheme (in category 'as yet unclassified') -----
+ applyUserInterfaceTheme
+ 	ApplyCounter := (ApplyCounter ifNil: [0]) + 1.!

Item was added:
+ ----- Method: UserInterfaceThemeTestObject class>>benchLookup (in category 'benchmark') -----
+ benchLookup
+ 	"
+ 	Microsoft Surface Pro 3, Windows 10 v1511, CogVM r201606301459, Squeak 5.1alpha #16138
+ 	   '210,000 per second. 4.76 microseconds per run.' -- leaves enough room for quirky morphs that keep on drawing themselves based on direct theme lookup.
+ 	
+ 	I think this setup is really heavy. Morphs should not look-up things that often. They can cache. Anyway:
+ 	- link through 3 themes
+ 	- look up superclasses up to ProtoObject (for each theme!!)
+ 	
+ 	self benchLookup"
+ 	
+ 	| c t1 t2 t3 m result |
+ 	c := UserInterfaceTheme current.
+ 	m := UserInterfaceThemeTestObject new.
+ 	t1 := UserInterfaceTheme new name: #benchmarkOne.
+ 	t2 := UserInterfaceTheme new name: #benchmarkTwo.
+ 	t3 := UserInterfaceTheme new name: #benchmarkThree.
+ 	
+ 	t3 set: #testColor for: ProtoObject to: Color white.
+ 	t1 link: t2.
+ 	t2 link: t3.
+ 	
+ 	t1 apply.
+ 	
+ 	result := OrderedCollection new.
+ 	
+ 	[
+ 		3 timesRepeat: [result add: [m getTestColor] bench].
+ 	] ensure: [c apply].
+ 
+ 	result explore.!

Item was added:
+ ----- Method: UserInterfaceThemeTestObject class>>resetApplyCounter (in category 'as yet unclassified') -----
+ resetApplyCounter
+ 	ApplyCounter := 0.!

Item was added:
+ ----- Method: UserInterfaceThemeTestObject class>>themeProperties (in category 'preferences') -----
+ themeProperties
+ 
+ 	^ super themeProperties, {
+ 		{#testColor. 'test'. 'Some test property'}
+ 	}!

Item was added:
+ ----- Method: UserInterfaceThemeTestObject>>applyUserInterfaceTheme (in category 'updating') -----
+ applyUserInterfaceTheme
+ 
+ 	self testColor: self userInterfaceTheme testColor.
+ 	self unknownProperty: self userInterfaceTheme unknownProperty.!

Item was added:
+ ----- Method: UserInterfaceThemeTestObject>>canApplyUserInterfaceTheme (in category 'visual properties') -----
+ canApplyUserInterfaceTheme
+ 	^ true!

Item was added:
+ ----- Method: UserInterfaceThemeTestObject>>getTestColor (in category 'updating') -----
+ getTestColor
+ 
+ 	^ self userInterfaceTheme testColor!

Item was added:
+ ----- Method: UserInterfaceThemeTestObject>>getTestColorViaPerform (in category 'updating') -----
+ getTestColorViaPerform
+ 
+ 	^ self userInterfaceTheme perform: #testColor!

Item was added:
+ ----- Method: UserInterfaceThemeTestObject>>testColor (in category 'accessing') -----
+ testColor
+ 
+ 	^ testColor!

Item was added:
+ ----- Method: UserInterfaceThemeTestObject>>testColor: (in category 'accessing') -----
+ testColor: anObject
+ 
+ 	testColor := anObject!

Item was added:
+ ----- Method: UserInterfaceThemeTestObject>>unknownProperty (in category 'accessing') -----
+ unknownProperty
+ 
+ 	^ unknownProperty!

Item was added:
+ ----- Method: UserInterfaceThemeTestObject>>unknownProperty: (in category 'accessing') -----
+ unknownProperty: anObject
+ 
+ 	unknownProperty := anObject!



More information about the Squeak-dev mailing list