Squeak 4.6: HelpSystem-Tests-mt.16.mcz

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!