[squeak-dev] Squeak 4.6: HelpSystem-Tests-mt.16.mcz

commits at source.squeak.org commits at source.squeak.org
Fri Jun 5 20:25:17 UTC 2015


Chris Muller uploaded a new version of HelpSystem-Tests to project Squeak 4.6:
http://source.squeak.org/squeak46/HelpSystem-Tests-mt.16.mcz

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

Name: HelpSystem-Tests-mt.16
Author: mt
Time: 25 March 2015, 11:30:13.168 am
UUID: 7a2dcc3a-6e0b-0d47-bccf-0b1bbd056a66
Ancestors: HelpSystem-Tests-fbs.15

Tests updated.

==================== Snapshot ====================

SystemOrganization addCategory: #'HelpSystem-Tests-Builders'!
SystemOrganization addCategory: #'HelpSystem-Tests-Core-Model'!
SystemOrganization addCategory: #'HelpSystem-Tests-Core-UI'!

TestCase subclass: #ClassAPIHelpBuilderTest
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'HelpSystem-Tests-Builders'!

----- Method: ClassAPIHelpBuilderTest>>testDefaultBuilding (in category 'testing') -----
testDefaultBuilding
	|topic|
	topic := CurrentReadOnlySourceFiles cacheDuring: [
		ClassAPIHelpBuilder buildHelpTopicFrom: Integer ].
	self assert: topic subtopics size = 2.
	self assert: topic subtopics first title = 'Instance side'.
	self assert: topic subtopics last title = 'Class side'
 

 !

----- Method: ClassAPIHelpBuilderTest>>testMethodsButNoSubclasses (in category 'testing') -----
testMethodsButNoSubclasses
	|topic|
	topic := CurrentReadOnlySourceFiles cacheDuring: [
		ClassAPIHelpBuilder 
			buildHierarchicalHelpTopicFrom: Integer 
			withSubclasses: false 
			withMethods: true ].
	self assert: topic subtopics size = 2.
	self assert: topic subtopics first title = 'Instance side'.
	self assert: topic subtopics last title = 'Class side'
 

 !

TestCase subclass: #HelpBrowserTest
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'HelpSystem-Tests-Core-UI'!

----- Method: HelpBrowserTest>>defaultTestClass (in category 'accessing') -----
defaultTestClass
	^HelpBrowser!

----- Method: HelpBrowserTest>>testDefaultHelpBrowser (in category 'testing') -----
testDefaultHelpBrowser
	
	| current replacement instance |
	current := self defaultTestClass defaultHelpBrowser.
	replacement := AdvancedHelpBrowserDummy.
	[
	  self defaultTestClass defaultHelpBrowser: replacement.
	  self assert: self defaultTestClass defaultHelpBrowser == replacement.
 
	  instance := self defaultTestClass open.
	  self assert: instance rootTopic notNil.
	  self assert: instance isOpen.
	] ensure: [ self defaultTestClass defaultHelpBrowser: current ]
	 !

----- Method: HelpBrowserTest>>testDefaultHelpBrowserIsReplacable (in category 'testing') -----
testDefaultHelpBrowserIsReplacable
	
	| current replacement instance |
	"save the one that is registered"
	current := self defaultTestClass defaultHelpBrowser.
	replacement := AdvancedHelpBrowserDummy.
	[
	  self defaultTestClass defaultHelpBrowser: replacement.
	  self assert: self defaultTestClass defaultHelpBrowser == replacement.	  
	  instance := self defaultTestClass open.
	  
	] ensure: [
		self defaultTestClass defaultHelpBrowser: current
	]
	 !

----- Method: HelpBrowserTest>>testLazyDefaultHelpBrowser (in category 'testing') -----
testLazyDefaultHelpBrowser
	
	self assert: self defaultTestClass defaultHelpBrowser notNil!

----- Method: HelpBrowserTest>>testOpen (in category 'testing') -----
testOpen
	|browser|
	"This should not throw an exception."
	browser := self defaultTestClass open.
	World doOneCycleNow. 
	browser changed: #close.!

----- Method: HelpBrowserTest>>testRegistration (in category 'testing') -----
testRegistration
	        
	TheWorldMenu registeredOpenCommands detect: [:each | each first = 'Help Browser'] ifNone: [self fail].
	!

TestCase subclass: #HelpIconsTest
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'HelpSystem-Tests-Core-UI'!

----- Method: HelpIconsTest>>defaultTestClass (in category 'accessing') -----
defaultTestClass 
	^HelpIcons!

----- Method: HelpIconsTest>>testIconCaching (in category 'testing') -----
testIconCaching
	 
	| first second |
	#(bookIcon pageIcon refreshIcon) do: [:iconSymbol |
		first := self defaultTestClass iconNamed: iconSymbol.
		second := self defaultTestClass iconNamed: iconSymbol.	
		self assert: first notNil.
		self assert: first == second.
	]
	!

TestCase subclass: #HelpTopicListItemWrapperTest
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'HelpSystem-Tests-Core-UI'!

----- Method: HelpTopicListItemWrapperTest>>defaultTestClass (in category 'accessing') -----
defaultTestClass 
	^HelpTopicListItemWrapper 
	!

----- Method: HelpTopicListItemWrapperTest>>testDisplayLabel (in category 'testing') -----
testDisplayLabel
	|instance|
	instance := self defaultTestClass with: (HelpTopic named: 'My Topic').
	self assert: instance asString = 'My Topic'
	!

TestCase subclass: #HelpTopicTest
	instanceVariableNames: 'topic'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'HelpSystem-Tests-Core-Model'!

----- Method: HelpTopicTest>>defaultTestClass (in category 'accessing') -----
defaultTestClass
	^HelpTopic !

----- Method: HelpTopicTest>>setUp (in category 'running') -----
setUp
	super setUp.
	topic := self defaultTestClass new.!

----- Method: HelpTopicTest>>testAddingSubtopic (in category 'testing') -----
testAddingSubtopic

	|subtopic returned|
	subtopic := self defaultTestClass named: 'Subtopic'.
	returned := topic addSubtopic: subtopic.
	self assert: returned == subtopic.
	self assert: (topic subtopics includes: subtopic) !

----- Method: HelpTopicTest>>testInitialization (in category 'testing') -----
testInitialization

	self assert: topic title = 'Unnamed Topic'.
	self assert: topic contents isEmpty !

----- Method: HelpTopicTest>>testInstanceCreation (in category 'testing') -----
testInstanceCreation

	|instance|
	instance := self defaultTestClass named: 'My Topic'.
	self assert: instance title = 'My Topic'.
!

----- Method: HelpTopicTest>>testSortOrder (in category 'testing') -----
testSortOrder

	|a b c sorted |
	a := self defaultTestClass named: 'A'.
	b := self defaultTestClass named: 'B'.
	c := self defaultTestClass named: 'C'.
	sorted := (OrderedCollection with: b with: c with: a) asSortedCollection.
	self assert: sorted first = a.
	self assert: sorted last = c.
	!

Object subclass: #AdvancedHelpBrowserDummy
	instanceVariableNames: 'rootTopic isOpen'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'HelpSystem-Tests-Core-UI'!

!AdvancedHelpBrowserDummy commentStamp: 'tbn 5/3/2010 19:30' prior: 0!
This is a dummy for a custom Help browser that can be registered as a replacement for the HelpBrowser class.

Instance Variables
	rootTopic:		<HelpTopic>

rootTopic
	- The root help topic
!

----- Method: AdvancedHelpBrowserDummy>>initialize (in category 'initialize-release') -----
initialize
	isOpen := false!

----- Method: AdvancedHelpBrowserDummy>>isOpen (in category 'testing') -----
isOpen
	^isOpen!

----- Method: AdvancedHelpBrowserDummy>>open (in category 'mocking') -----
open
	isOpen := true!

----- Method: AdvancedHelpBrowserDummy>>rootTopic (in category 'mocking') -----
rootTopic
	^rootTopic!

----- Method: AdvancedHelpBrowserDummy>>rootTopic: (in category 'mocking') -----
rootTopic: aTopic
	rootTopic := aTopic!



More information about the Squeak-dev mailing list