a little package to specialize pluggable per instance behaviour for testing

[Martin Rubi]

Hi.
I've made a little package with 2 test helpers which let me define a
pluggable behaviour for a particular instance. I'm using it in some tests of
mine where I wanted to create a complex object and easily force a behaviour
for particular messages of some of its collaborators.

It can be use as this:

SomeTestCase>>testSomething
| animal |
animal := Animal name: 'cat'.
self
when: animal receives: #name answer: 3;
when: animal receives: #ask do: [self doSomethingComplexHere].

If somebody wants it here it is, and if you have comments please send them.

regards
martin

-----------------------

| package |
package := Package name: 'mr testingWithStubMethods'.
package paxVersion: 1;
basicComment: 'Copyright (c) <2008> <Martin Rubi>
Permission is hereby granted, free of charge, to any person obtaining a copy
of this software and associated documentation files (the "Software"), to
deal in the Software without restriction, including without limitation the
rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
sell copies of the Software, and to permit persons to whom the Software is
furnished to do so, subject to the following conditions:
The above copyright notice and this permission notice shall be included in
all copies or substantial portions of the Software.
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
IN THE SOFTWARE.
--------------------------
This package lets you define a *pluggable* per instance behaviour for an
instance.
I did it because in some tests I wanted to be able to setup a valid object
with all of its protocol and colaboratos, and then modify the way it (or
some colaborator) responds to a specific message.
---------
It can be used as this:
SomeTestCase>>testSomething
| animal |
animal := Animal name: ''cat''.
self when: animal receives: #name answer: 3.
---------
There are also a couple of examples in the ModifiedInstanceWrapper class
comment.'.

package classNames
add: #ModifiedInstanceWrapper;
add: #ModifiedInstanceWrapperTest;
add: #TestingWithPerInstanceBehaviorTest;
yourself.
package methodNames
add: #Object -> #onMessage:do:;
add: #TestCase -> #when:receives:answer:;
add: #TestCase -> #when:receives:do:;
yourself.
package binaryGlobalNames: (Set new
yourself).
package globalAliases: (Set new
yourself).
package setPrerequisites: (IdentitySet new
add: '..\..\Object Arts\Dolphin\Base\Dolphin';
add: '..\..\Camp Smalltalk\SUnit\SUnit';
yourself).
package!
"Class Definitions"!
TestCase subclass: #ModifiedInstanceWrapperTest
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
classInstanceVariableNames: ''!
TestCase subclass: #TestingWithPerInstanceBehaviorTest
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
classInstanceVariableNames: ''!
ProtoObject subclass: #ModifiedInstanceWrapper
instanceVariableNames: 'instance methodsTable'
classVariableNames: ''
poolDictionaries: ''
classInstanceVariableNames: ''!
"Global Aliases"!

"Loose Methods"!
!Object methodsFor!
onMessage: aSymbol do: aBlock
"Mutate the receiver to a ModifiedInstanceWrapper instance, and then define
a specialization to its method aSymbol.
USE IT WITH CARE"
^(ModifiedInstanceWrapper becomeInstance: self) onMessage: aSymbol do:
aBlock! !
!Object categoriesFor: #onMessage:do:!mutating!public! !
!TestCase methodsFor!
when: anInstance receives: aSymbol answer: anObject
"Specialize anInstance to respond to aSymbol by answering anObject, ignoring
its current implementation, if it has one"
self
when: anInstance
receives: aSymbol
do: [:instance :args | anObject]!
when: anInstance receives: aSymbol do: aBinaryBlock
"Specialize anInstance to respond to aSymbol executing aBinaryBlock,
ignoring its current implementation, if it has one"
anInstance onMessage: aSymbol do: aBinaryBlock! !
!TestCase categoriesFor: #when:receives:answer:!helpers!public! !
!TestCase categoriesFor: #when:receives:do:!helpers!public! !
"End of package definition"!
"Source Globals"!
"Classes"!
ModifiedInstanceWrapperTest guid: (GUID fromString:
'{C76C23D9-66ED-4320-9EDA-6240BAA92EC2}')!
ModifiedInstanceWrapperTest comment: ''!
!ModifiedInstanceWrapperTest categoriesForClass!SUnit! !
!ModifiedInstanceWrapperTest methodsFor!
testBecomingAWrapper
| instance |
instance := String fromString: 'example instance'.
(ModifiedInstanceWrapper becomeInstance: instance)
onMessage: #asUppercase
do: [:inst :params | true].
self assert: instance asUppercase.
self assert: instance asLowercase = 'example instance'!
testModificationOfBinaryOperator
| instance wrapper |
instance := String fromString: 'Example Instance'.
wrapper := (ModifiedInstanceWrapper for: instance) onMessage: #, do: [:inst
:params | true].
self assert: wrapper , 'bla'.
self assert: wrapper < 'F'!
testModificationOfKeywordMessage1
| instance wrapper |
instance := String fromString: 'Example Instance'.
wrapper := (ModifiedInstanceWrapper for: instance)
onMessage: #subStrings:
do: [:inst :params | true].
self assert: (wrapper subStrings: $a).
self assert: (wrapper leftString: 2) = 'Ex'!
testModificationOfKeywordMessage2
| instance wrapper |
instance := String fromString: 'Example Instance'.
wrapper := (ModifiedInstanceWrapper for: instance)
onMessage: #match:ignoreCase:
do: [:inst :params | true].
self assert: (wrapper match: 'bla' ignoreCase: true)!
testModificationOfUnaryMessage
| instance wrapper |
instance := String fromString: 'Example Instance'.
wrapper := (ModifiedInstanceWrapper for: instance)
onMessage: #asUppercase
do: [:inst :params | true].
self assert: wrapper asUppercase.
self assert: wrapper asLowercase = 'example instance'!
testPassingParametersIntoTheBlockOfBinaryMessage
| instance wasExecuted wrapper |
instance := String fromString: 'Example Instance'.
wrapper := (ModifiedInstanceWrapper for: instance)
onMessage: #,
do:
[:inst :params |
self assert: params first = 'aa'.
wasExecuted := true].
wrapper , 'aa'.
self assert: wasExecuted!
testPassingParametersIntoTheBlockOfKeywordMessage
| instance wasExecuted wrapper |
instance := String fromString: 'Example Instance'.
wrapper := (ModifiedInstanceWrapper for: instance)
onMessage: #match:ignoreCase:
do:
[:inst :params |
self assert: params first = 'aa'.
self assert: params second = true.
wasExecuted := true].
wrapper match: 'aa' ignoreCase: true.
self assert: wasExecuted!
testPassingParametersIntoTheBlockOfUnaryMessage
| instance wasExecuted wrapper |
instance := String fromString: 'Example Instance'.
wrapper := (ModifiedInstanceWrapper for: instance)
onMessage: #asUppercase
do:
[:inst :params |
self assert: params isEmpty.
wasExecuted := true].
wrapper asUppercase.
self assert: wasExecuted!
testPassingTheInstanceIntoTheBlock
| instance wasExecuted wrapper |
instance := String fromString: 'Example Instance'.
wrapper := (ModifiedInstanceWrapper for: instance)
onMessage: #asUppercase
do:
[:inst :params |
self assert: inst == instance.
wasExecuted := true].
wrapper asUppercase.
self assert: wasExecuted!
testWrappingAnObject
| instance wrapper |
instance := String fromString: 'example instance'.
wrapper := ModifiedInstanceWrapper for: instance.
self deny: instance == wrapper.
self assert: instance asUppercase = 'EXAMPLE INSTANCE'.
self assert: wrapper asUppercase = 'EXAMPLE INSTANCE'.
self should: [wrapper aa] raise: MessageNotUnderstood! !
!ModifiedInstanceWrapperTest categoriesFor: #testBecomingAWrapper!public! !
!ModifiedInstanceWrapperTest categoriesFor:
#testModificationOfBinaryOperator!public! !
!ModifiedInstanceWrapperTest categoriesFor:
#testModificationOfKeywordMessage1!public! !
!ModifiedInstanceWrapperTest categoriesFor:
#testModificationOfKeywordMessage2!public! !
!ModifiedInstanceWrapperTest categoriesFor:
#testModificationOfUnaryMessage!public! !
!ModifiedInstanceWrapperTest categoriesFor:
#testPassingParametersIntoTheBlockOfBinaryMessage!public! !
!ModifiedInstanceWrapperTest categoriesFor:
#testPassingParametersIntoTheBlockOfKeywordMessage!public! !
!ModifiedInstanceWrapperTest categoriesFor:
#testPassingParametersIntoTheBlockOfUnaryMessage!public! !
!ModifiedInstanceWrapperTest categoriesFor:
#testPassingTheInstanceIntoTheBlock!public! !
!ModifiedInstanceWrapperTest categoriesFor: #testWrappingAnObject!public! !
TestingWithPerInstanceBehaviorTest guid: (GUID fromString:
'{AEC0497E-4771-4ECF-8D20-14CAD354FE8E}')!
TestingWithPerInstanceBehaviorTest comment: ''!
!TestingWithPerInstanceBehaviorTest categoriesForClass!SUnit! !
!TestingWithPerInstanceBehaviorTest methodsFor!
testAnsweringAnObject
| instance |
instance := 'example instance'.
self
when: instance
receives: #asUppercase
answer: true.
self assert: instance asUppercase!
testExecutingABlock
| instance |
instance := 'example instance'.
self
when: instance
receives: #asUppercase
do: [:object :args | true].
self assert: instance asUppercase!
testSpecializing2Methods
| instance |
instance := 'example instance'.
self
when: instance
receives: #asUppercase
answer: true;
when: instance
receives: #asLowercase
answer: false.
self assert: instance asUppercase.
self deny: instance asLowercase! !
!TestingWithPerInstanceBehaviorTest categoriesFor:
#testAnsweringAnObject!public! !
!TestingWithPerInstanceBehaviorTest categoriesFor:
#testExecutingABlock!public! !
!TestingWithPerInstanceBehaviorTest categoriesFor:
#testSpecializing2Methods!public! !
ModifiedInstanceWrapper guid: (GUID fromString:
'{65542A76-629C-4814-82D0-30CE57652BB4}')!
ModifiedInstanceWrapper comment: 'This class wraps an object, allowing you
to specialize some of its protocol to do things that it normally wouldn''t,
or to extend it.
I use this Wrapper to modify the behavior of some objects during some tests.
USE IT WITH CARE !!!!!!
Here is an example of use:
wrapper := (ModifiedInstanceWrapper for: 1 @ 2)
onMessage: #x
do: [:inst :params | inst x - 10].
wrapper x = -9. "should be true"
Also, if you want to make an instance to become a ModifedInstanceWrapper,
you could that with:
point := 1 @ 2.
(ModifiedInstanceWrapper becomeInstance: point)
onMessage: #x
do: [:inst :params | inst x - 10].
point x = -9. "should be true"'!
!ModifiedInstanceWrapper categoriesForClass!Kernel-Objects! !
!ModifiedInstanceWrapper methodsFor!
doesNotUnderstand: failedMessage
"Look if there is a specialized behaviour for the failedMessage selector.
If there is, execute its associated block.
If there isn't, forwrad the message to the underlaying instance"
^self
privateExecuteSpecializedBehaviorFor: failedMessage
ifNone: [failedMessage forwardTo: instance]!
onMessage: aSymbol do: aBinaryBlock
"Set the wrapper to execute aBinaryBlock when it receives the message
aSymbol
The block has the form:
[:receiver :params | ...]
"
methodsTable at: aSymbol put: aBinaryBlock!
privateExecuteSpecializedBehaviorFor: failedMessage ifNone: defaultBlock
"Look if there is a specialized behaviour for the failedMessage selector.
If there is, execute its associated block.
If there isn't, execute the defaultBlock"
| specializedBlock |
specializedBlock := methodsTable at: failedMessage selector ifAbsent: [].
^specializedBlock notNil
ifTrue: [specializedBlock value: instance value: failedMessage arguments]
ifFalse: [defaultBlock value]!
privateInitializeOn: anObject
methodsTable := WeakLookupTable new.
instance := anObject! !
!ModifiedInstanceWrapper categoriesFor:
#doesNotUnderstand:!exceptions!private!vm entry points! !
!ModifiedInstanceWrapper categoriesFor: #onMessage:do:!configuring!public! !
!ModifiedInstanceWrapper categoriesFor:
#privateExecuteSpecializedBehaviorFor:ifNone:!exceptions!private!vm entry
points! !
!ModifiedInstanceWrapper categoriesFor:
#privateInitializeOn:!initializing!private! !
!ModifiedInstanceWrapper class methodsFor!
becomeInstance: anObject
"USE IT WITH CARE.
Create a wrapper on anObject, and then mutate anObject to become the
wrapper"
| wrapper |
wrapper := self for: nil.
anObject become: wrapper.
^anObject privateInitializeOn: wrapper!
for: anObject
"Create a wrapper on anObject"
^self new privateInitializeOn: anObject! !
!ModifiedInstanceWrapper class categoriesFor:
#becomeInstance:!mutating!public! !
!ModifiedInstanceWrapper class categoriesFor: #for:!instance
creation!public! !
"Binary Globals"!