SystemOrganization addCategory: #'StateMachine-Core'! SystemOrganization addCategory: #'StateMachine-Tests'! Object subclass: #StateMachine instanceVariableNames: 'states current initial' classVariableNames: '' poolDictionaries: '' category: 'StateMachine-Core'! !StateMachine methodsFor: 'accessing' stamp: 'lr 1/19/2007 17:23'! current ^ current! ! !StateMachine methodsFor: 'accessing' stamp: 'lr 1/19/2007 17:23'! initial ^ initial! ! !StateMachine methodsFor: 'initialization' stamp: 'lr 1/19/2007 17:22'! initialize states := OrderedCollection new! ! !StateMachine methodsFor: 'public' stamp: 'lr 1/19/2007 17:27'! newState | state | states add: (state := self stateClass on: self). initial ifNil: [ self setInitial: state ]. ^ state! ! !StateMachine methodsFor: 'protected' stamp: 'lr 1/19/2007 17:29'! receive: anAnnouncement current ifNil: [ self start ]. current receive: anAnnouncement! ! !StateMachine methodsFor: 'actions' stamp: 'lr 1/19/2007 17:23'! reset self setCurrent: self initial! ! !StateMachine methodsFor: 'initialization' stamp: 'lr 1/19/2007 17:25'! setCurrent: aState current ifNotNil: [ current deactivate ]. current := aState. current activate! ! !StateMachine methodsFor: 'initialization' stamp: 'lr 1/19/2007 17:22'! setInitial: aState initial := aState! ! !StateMachine methodsFor: 'actions' stamp: 'lr 1/19/2007 17:27'! start self reset! ! !StateMachine methodsFor: 'private' stamp: 'lr 1/19/2007 17:29'! stateClass ^ StateMachineState! ! !StateMachine methodsFor: 'accessing' stamp: 'lr 1/19/2007 17:22'! states ^ states! ! !StateMachine methodsFor: 'public' stamp: 'lr 1/19/2007 17:56'! subscribeTo: aClass from: anAnnouncer anAnnouncer on: aClass send: #receive: to: self! ! Object subclass: #StateMachineState instanceVariableNames: 'machine actions timeout timeoutAction timeoutMutex timeoutInterrupt' classVariableNames: '' poolDictionaries: '' category: 'StateMachine-Core'! !StateMachineState class methodsFor: 'instance-creation' stamp: 'lr 1/19/2007 17:33'! on: aMachine ^ self new initializeOn: aMachine! ! !StateMachineState methodsFor: 'protected' stamp: 'lr 8/5/2008 12:15'! activate timeout ifNil: [ ^ self ]. timeoutInterrupt := [ (Delay forDuration: timeout) wait. timeoutMutex critical: [ timeoutAction value. timeoutInterrupt := nil ] ] newProcess. timeoutInterrupt priority: Processor userInterruptPriority; resume! ! !StateMachineState methodsFor: 'public' stamp: 'lr 1/19/2007 17:39'! after: aDuration do: aBlock timeout := aDuration. timeoutAction := aBlock. timeoutMutex := Semaphore forMutualExclusion! ! !StateMachineState methodsFor: 'protected' stamp: 'lr 1/19/2007 17:43'! deactivate (timeout isNil or: [ timeoutInterrupt == Processor activeProcess ]) ifTrue: [ ^ self ]. timeoutMutex critical: [ (timeoutInterrupt notNil and: [ timeoutInterrupt suspendedContext notNil ]) ifTrue: [ timeoutInterrupt terminate. timeoutInterrupt := nil ] ]! ! !StateMachineState methodsFor: 'protected' stamp: 'lr 1/19/2007 17:52'! enter machine setCurrent: self! ! !StateMachineState methodsFor: 'initialization' stamp: 'lr 1/19/2007 17:32'! initializeOn: aMachine machine := aMachine. actions := IdentityDictionary new! ! !StateMachineState methodsFor: 'accessing' stamp: 'lr 1/19/2007 17:30'! machine ^ machine! ! !StateMachineState methodsFor: 'public' stamp: 'lr 1/19/2007 17:33'! on: aClass do: aBlock actions at: aClass put: aBlock! ! !StateMachineState methodsFor: 'protected' stamp: 'lr 1/27/2007 16:03'! receive: anAnnouncement actions keysAndValuesDo: [ :class :action | (class handles: anAnnouncement) ifTrue: [ ^ action numArgs = 0 ifTrue: [ action value ] ifFalse: [ action value: anAnnouncement ] ] ]! ! Announcement subclass: #StateMachineEventA instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'StateMachine-Tests'! Announcement subclass: #StateMachineEventB instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'StateMachine-Tests'! Announcement subclass: #StateMachineEventC instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'StateMachine-Tests'! Announcement subclass: #StateMachineEventD instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'StateMachine-Tests'! TestCase subclass: #StateMachineTest instanceVariableNames: 'machine record' classVariableNames: '' poolDictionaries: '' category: 'StateMachine-Tests'! !StateMachineTest methodsFor: 'running' stamp: 'lr 3/2/2009 10:18'! setUp | stateA stateB stateC | record := OrderedCollection new. machine := StateMachine new. stateA := machine newState. stateB := machine newState. stateC := machine newState. stateA on: StateMachineEventB do: [ record add: #b. stateB enter ]; on: StateMachineEventC do: [ record add: #c. stateC enter ]. stateB on: StateMachineEventA do: [ record add: #a. stateA enter ]; on: StateMachineEventC do: [ record add: #c. stateC enter ]. stateC on: StateMachineEventA do: [ record add: #a. stateA enter ]; on: StateMachineEventB do: [ record add: #b. stateB enter ]! ! !StateMachineTest methodsFor: 'testing' stamp: 'lr 3/2/2009 10:18'! testBogusAnnouncements machine start; receive: StateMachineEventA new; receive: StateMachineEventB new; receive: StateMachineEventB new; receive: StateMachineEventA new; receive: StateMachineEventD new; receive: StateMachineEventC new. self assert: record asArray = #(b a c)! ! !StateMachineTest methodsFor: 'testing' stamp: 'lr 3/2/2009 10:18'! testReset machine start; receive: StateMachineEventB; reset. self assert: machine current == machine initial! ! !StateMachineTest methodsFor: 'testing' stamp: 'lr 3/2/2009 10:18'! testStateSwitch machine start; receive: StateMachineEventB new. self assert: record asArray = #(b)! ! !StateMachineTest methodsFor: 'testing' stamp: 'lr 3/2/2009 10:18'! testStateSwitches machine start; receive: StateMachineEventB new; receive: StateMachineEventA new. self assert: record asArray = #(b a)! ! !StateMachineTest methodsFor: 'testing' stamp: 'lr 1/19/2007 18:13'! testTimeoutExpiration machine initial after: 50 milliSeconds do: [ record add: #timeout ]. machine start. self assert: record asArray = #(). (Delay forDuration: 70 milliSeconds) wait. self assert: record asArray = #(timeout)! ! !StateMachineTest methodsFor: 'testing' stamp: 'lr 3/2/2009 10:18'! testTimeoutReset machine initial after: 50 milliSeconds do: [ record add: #timeout ]. machine start. machine receive: StateMachineEventB new. (Delay forDuration: 70 milliSeconds) wait. self assert: record asArray = #(b)! ! !StateMachineTest methodsFor: 'testing' stamp: 'lr 3/2/2009 10:18'! testTranslation | source | source := Announcer new. machine subscribeTo: StateMachineEventA from: source; subscribeTo: StateMachineEventB from: source. machine start. source announce: StateMachineEventB; announce: StateMachineEventC; announce: StateMachineEventA; announce: StateMachineEventB. self assert: record asArray = #(b a b)! !