The Trunk: KernelTests-eem.323.mcz

Previous Topic Next Topic
 
classic Classic list List threaded Threaded
1 message Options
Reply | Threaded
Open this post in threaded view
|

The Trunk: KernelTests-eem.323.mcz

commits-2
Eliot Miranda uploaded a new version of KernelTests to project The Trunk:
http://source.squeak.org/trunk/KernelTests-eem.323.mcz

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

Name: KernelTests-eem.323
Author: eem
Time: 23 March 2017, 6:22:49.201957 pm
UUID: 25f68fba-22e0-4b18-b3ac-b7ac720f3f81
Ancestors: KernelTests-eem.322

Move all the tests in and class comment of BlockContextTest into BlockClosureTest and nuke BlockContextTest.

Update CompiledMethodTest>>testNew to state that CompiledMehtod>>new /should/ be an error.

Update the context tests to use isCompiledMethod, isContext etc, and to drop use of isPseudoContext.

=============== Diff against KernelTests-eem.322 ===============

Item was changed:
  TestCase subclass: #BlockClosureTest
+ instanceVariableNames: 'aBlockClosure homeOfABlockClosure'
- instanceVariableNames: ''
  classVariableNames: ''
  poolDictionaries: ''
  category: 'KernelTests-Methods'!
+
+ !BlockClosureTest commentStamp: 'eem 3/23/2017 18:07' prior: 0!
+ I am an SUnit Test of BlockClosure and some of Context's simulation machinery'.  See also MethodContextTest.
+
+ My fixtures are:
+ aBlockClosure - just some trivial block, i.e., [100@100 corner: 200@200].
+ homeOfABlockClosure - the home context of the block
+
+ NOTES ABOUT AUTOMATING USER INPUTS
+
+ When executing non-interactive programs you will inevitably run into programs (like SqueakMap or Monticello installation packages -- and other programs, to be fair) that require user input during their execution and these sort of problems shoot the whole non-interactiveness of your enclosing program.
+
+ BlockClosure helper methods have been made available and tests of these helpers are provided in this class to demonstrate that it can intercept PopUpMenu and FillInTheBlankMorph requests for user interaction.  Of course, PopUpMenu and FillInTheBlankMorph were modified to first signal a ProvideAnswerNotification and if someone handles that (e.g. the enclosing block) then the user interaction will be circumvented and the provided answer of the enclosing block will be used.  The basic syntax looks like:
+
+ [self confirm: 'Install spyware?'] valueSupplyingAnswer: #('Install spyware?' false)
+
+ There a few variants on this theme making it easy to provide a literal list of answers for the block so that you can handle a bunch of questions in a block with appropriate answers.
+
+ Additionally, it is possible to suppress Object>>inform: modal dialog boxes as these get in the way of automating anything.  After applying this changeset you should be able to tryout the following code snippets to see the variants on this theme that are available.
+
+ Examples:
+
+ So you don't need any introduction here -- this one works like usual.
+ [self inform: 'hello'. #done] value.
+
+ Now let's suppress all inform: messages.
+ [self inform: 'hello'; inform: 'there'. #done] valueSuppressingAllMessages.
+
+ Here we can just suppress a single inform: message.
+ [self inform: 'hi'; inform: 'there'. #done] valueSuppressingMessages: #('there')
+
+ Here you see how you can suppress a list of messages.
+ [self inform: 'hi'; inform: 'there'; inform: 'bill'. #done] valueSuppressingMessages: #('hi' 'there')
+
+ Enough about inform:, let's look at confirm:. As you see this one works as expected.
+ [self confirm: 'You like Squeak?'] value
+
+ Let's supply answers to one of the questions -- check out the return value.
+ [{self confirm: 'You like Smalltalk?'. self confirm: 'You like Squeak?'}]
+ valueSupplyingAnswer: #('You like Smalltalk?' true)
+
+ Here we supply answers using only substrings of the questions (for simplicity).
+ [{self confirm: 'You like Squeak?'. self confirm: 'You like MVC?'}]
+ valueSupplyingAnswers: #( ('Squeak' true) ('MVC' false) )
+
+ This time let's answer all questions exactly the same way.
+ [{self confirm: 'You like Squeak?'. self confirm: 'You like Morphic?'}]
+ valueSupplyingAnswer: true
+
+ And, of course, we can answer FillInTheBlank questions in the same manner.
+ [FillInTheBlank request: 'What day is it?']
+ valueSupplyingAnswer: 'the first day of the rest of your life'
+
+ We can also return whatever the initialAnswer of the FillInTheBlank was by using the #default answer.
+ [FillInTheBlank request: 'What day is it?' initialAnswer: DateAndTime now dayOfWeekName]
+ valueSupplyingAnswer: #default
+
+ Finally, you can also do regex matches on any of the question text (or inform text) (should you have VB-Regex enhancements in your image).
+ [FillInTheBlank request: 'What day is it?']
+ valueSupplyingAnswers: { {'What day.*\?'. DateAndTime now dayOfWeekName} }
+
+ [Comment taken from BlockContextTest last written by jrp 10/17/2004 12:22]!

Item was added:
+ ----- Method: BlockClosureTest>>setUp (in category 'running') -----
+ setUp
+ super setUp.
+ aBlockClosure := [100@100 corner: 200@200].
+ homeOfABlockClosure := thisContext!

Item was added:
+ ----- Method: BlockClosureTest>>testDecompile (in category 'tests - printing') -----
+ testDecompile
+ self assert: ([3 + 4] decompile printString = '{[3 + 4]}')!

Item was added:
+ ----- Method: BlockClosureTest>>testNew (in category 'tests') -----
+ testNew
+ self should: [ContextPart new: 5] raise: Error.
+ [ContextPart new: 5]
+ on: Error do: [:e|
+ self assert: (e messageText includesSubstring: 'newForMethod:') description: 'Error doesn''t tell you what you did wrong by calling #new:'].
+
+ self should: [ContextPart new] raise: Error.
+ [ContextPart new]
+ on: Error do: [:e|
+ self assert: (e messageText includesSubstring: 'newForMethod:') description: 'Error doesn''t tell you what you did wrong by calling #new']!

Item was added:
+ ----- Method: BlockClosureTest>>testNoArguments (in category 'tests') -----
+ testNoArguments
+ [10
+ timesRepeat: [:arg | 1 + 2]]
+ ifError: [:err :rcvr | self deny: err = 'This block requires 1 arguments.'].
+ [10
+ timesRepeat: [:arg1 :arg2 | 1 + 2]]
+ ifError: [:err :rcvr | self deny: err = 'This block requires 2 arguments.']!

Item was added:
+ ----- Method: BlockClosureTest>>testOneArgument (in category 'tests') -----
+ testOneArgument
+ | c |
+ c := OrderedCollection new.
+ c add: 'hello'.
+ [c
+ do: [1 + 2]]
+ ifError: [:err :rcvr | self deny: err = 'This block requires 0 arguments.'].
+ [c
+ do: [:arg1 :arg2 | 1 + 2]]
+ ifError: [:err :rcvr | self deny: err = 'This block requires 2 arguments.']!

Item was added:
+ ----- Method: BlockClosureTest>>testRunSimulated (in category 'tests') -----
+ testRunSimulated
+ self assert: Rectangle equals: (ContextPart runSimulated: aBlockClosure asContext) class!

Item was added:
+ ----- Method: BlockClosureTest>>testSetUp (in category 'tests') -----
+ testSetUp
+ "Note: In addition to verifying that the setUp worked the way it was expected to, testSetUp is used to illustrate the meaning of the simple access methods, methods that are not normally otherwise 'tested'"
+ self deny: aBlockClosure isContext.
+ self assert: aBlockClosure isClosure.
+ self assert: aBlockClosure home = homeOfABlockClosure.
+ self assert: aBlockClosure receiver = self.
+ self assert: aBlockClosure method isCompiledMethod!

Item was added:
+ ----- Method: BlockClosureTest>>testSupplyAnswerOfFillInTheBlank (in category 'testing') -----
+ testSupplyAnswerOfFillInTheBlank
+
+ self should: ['blue' = ([UIManager default request: 'Your favorite color?']
+ valueSupplyingAnswer: #('Your favorite color?' 'blue'))]!

Item was added:
+ ----- Method: BlockClosureTest>>testSupplyAnswerOfFillInTheBlankUsingDefaultAnswer (in category 'testing') -----
+ testSupplyAnswerOfFillInTheBlankUsingDefaultAnswer
+
+ self should: ['red' = ([UIManager default  request: 'Your favorite color?' initialAnswer: 'red']
+ valueSupplyingAnswer: #('Your favorite color?' #default))]!

Item was added:
+ ----- Method: BlockClosureTest>>testSupplyAnswerUsingOnlySubstringOfQuestion (in category 'tests') -----
+ testSupplyAnswerUsingOnlySubstringOfQuestion
+
+ self should: [false = ([self confirm: 'You like Smalltalk?']
+ valueSupplyingAnswer: #('like' false))]!

Item was added:
+ ----- Method: BlockClosureTest>>testSupplyAnswerUsingRegexMatchOfQuestion (in category 'tests') -----
+ testSupplyAnswerUsingRegexMatchOfQuestion
+
+ (String includesSelector: #matchesRegex:) ifFalse: [^ self].
+
+ self should: [true = ([self confirm: 'You like Smalltalk?']
+ valueSupplyingAnswer: #('.*Smalltalk\?' true))]!

Item was added:
+ ----- Method: BlockClosureTest>>testSupplySpecificAnswerToQuestion (in category 'tests') -----
+ testSupplySpecificAnswerToQuestion
+
+ self should: [false = ([self confirm: 'You like Smalltalk?']
+ valueSupplyingAnswer: #('You like Smalltalk?' false))]!

Item was added:
+ ----- Method: BlockClosureTest>>testSuppressInform (in category 'tests') -----
+ testSuppressInform
+
+ self should: [[nil inform: 'Should not see this message or this test failed!!'] valueSuppressingAllMessages isNil]!

Item was added:
+ ----- Method: BlockClosureTest>>testSuppressInformUsingStringMatchOptions (in category 'tests') -----
+ testSuppressInformUsingStringMatchOptions
+
+ self should: [([nil inform: 'Should not see this message or this test failed!!'] valueSuppressingMessages: #('Should not see this message or this test failed!!')) isNil].
+
+ self should: [([nil inform: 'Should not see this message or this test failed!!'] valueSuppressingMessages: #('not see this message')) isNil].
+
+ self should: [([nil inform: 'Should not see this message or this test failed!!'] valueSuppressingMessages: #('*message*failed#')) isNil]!

Item was added:
+ ----- Method: BlockClosureTest>>testTallyInstructions (in category 'tests') -----
+ testTallyInstructions
+ self assert: (ContextPart tallyInstructions: aBlockClosure asContext) size = 15!

Item was added:
+ ----- Method: BlockClosureTest>>testValueWithPossibleArgs (in category 'tests - evaluating') -----
+ testValueWithPossibleArgs
+ | block  blockWithArg blockWith2Arg |
+
+ block := [1].
+ blockWithArg  := [:arg | arg].
+ blockWith2Arg := [:arg1 :arg2 | {arg1. arg2}].
+
+ self assert: (block valueWithPossibleArgs: #()) = 1.
+ self assert: (block valueWithPossibleArgs: #(1)) = 1.
+
+ self assert: (blockWithArg valueWithPossibleArgs: #()) = nil.
+ self assert: (blockWithArg valueWithPossibleArgs: #(1)) = 1.
+ self assert: (blockWithArg valueWithPossibleArgs: #(1 2)) = 1.
+
+ self assert: (blockWith2Arg valueWithPossibleArgs: #()) = {nil .nil}.
+ self assert: (blockWith2Arg valueWithPossibleArgs: #(1)) =  {1 . nil}.
+ self assert: (blockWith2Arg valueWithPossibleArgs: #(1 2)) =  #(1 2).
+ self assert: (blockWith2Arg valueWithPossibleArgs: #(1 2 3)) = #(1 2)!

Item was added:
+ ----- Method: BlockClosureTest>>testValueWithPossibleArgument (in category 'tests - evaluating') -----
+ testValueWithPossibleArgument
+ | block  blockWithArg blockWith2Arg |
+
+ block := [1].
+ blockWithArg  := [:arg | arg].
+ blockWith2Arg := [:arg1 :arg2 | {arg1. arg2}].
+
+ self assert: (block valueWithPossibleArgument: 1) = 1.
+
+ self assert: (blockWithArg valueWithPossibleArgument: 1) = 1.
+
+ self assert: (blockWith2Arg valueWithPossibleArgument: 1) = {1 . nil}!

Item was removed:
- TestCase subclass: #BlockContextTest
- instanceVariableNames: 'aBlockContext contextOfaBlockContext'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'KernelTests-Methods'!
-
- !BlockContextTest commentStamp: 'jrp 10/17/2004 12:22' prior: 0!
- I am an SUnit Test of BlockContext and its supertype ContextPart.  See also MethodContextTest.
-
- My fixtures are:
- aBlockContext     - just some trivial block, i.e., [100@100 corner: 200@200].
-
- NOTES ABOUT AUTOMATING USER INPUTS
-
- When executing non-interactive programs you will inevitably run into programs (like SqueakMap or Monticello installation packages -- and other programs, to be fair) that require user input during their execution and these sort of problems shoot the whole non-interactiveness of your enclosing program.
-
- BlockContext helper methods have been made available and tests of these helpers are provided in this class to demonstrate that it can intercept PopUpMenu and FillInTheBlankMorph requests for user interaction.  Of course, PopUpMenu and FillInTheBlankMorph were modified to first signal a ProvideAnswerNotification and if someone handles that (e.g. the enclosing block) then the user interaction will be circumvented and the provided answer of the enclosing block will be used.  The basic syntax looks like:
-
- [self confirm: 'Install spyware?'] valueSupplyingAnswer: #('Install spyware?' false)
-
- There a few variants on this theme making it easy to provide a literal list of answers for the block so that you can handle a bunch of questions in a block with appropriate answers.
-
- Additionally, it is possible to suppress Object>>inform: modal dialog boxes as these get in the way of automating anything.  After applying this changeset you should be able to tryout the following code snippets to see the variants on this theme that are available.
-
- Examples:
-
- So you don't need any introduction here -- this one works like usual.
- [self inform: 'hello'. #done] value.
-
- Now let's suppress all inform: messages.
- [self inform: 'hello'; inform: 'there'. #done] valueSuppressingAllMessages.
-
- Here we can just suppress a single inform: message.
- [self inform: 'hi'; inform: 'there'. #done] valueSuppressingMessages: #('there')
-
- Here you see how you can suppress a list of messages.
- [self inform: 'hi'; inform: 'there'; inform: 'bill'. #done] valueSuppressingMessages: #('hi' 'there')
-
- Enough about inform:, let's look at confirm:. As you see this one works as expected.
- [self confirm: 'You like Squeak?'] value
-
- Let's supply answers to one of the questions -- check out the return value.
- [{self confirm: 'You like Smalltalk?'. self confirm: 'You like Squeak?'}]
- valueSupplyingAnswer: #('You like Smalltalk?' true)
-
- Here we supply answers using only substrings of the questions (for simplicity).
- [{self confirm: 'You like Squeak?'. self confirm: 'You like MVC?'}]
- valueSupplyingAnswers: #( ('Squeak' true) ('MVC' false) )
-
- This time let's answer all questions exactly the same way.
- [{self confirm: 'You like Squeak?'. self confirm: 'You like Morphic?'}]
- valueSupplyingAnswer: true
-
- And, of course, we can answer FillInTheBlank questions in the same manner.
- [FillInTheBlank request: 'What day is it?']
- valueSupplyingAnswer: 'the first day of the rest of your life'
-
- We can also return whatever the initialAnswer of the FillInTheBlank was by using the #default answer.
- [FillInTheBlank request: 'What day is it?' initialAnswer: DateAndTime now dayOfWeekName]
- valueSupplyingAnswer: #default
-
- Finally, you can also do regex matches on any of the question text (or inform text) (should you have VB-Regex enhancements in your image).
- [FillInTheBlank request: 'What day is it?']
- valueSupplyingAnswers: { {'What day.*\?'. DateAndTime now dayOfWeekName} }!

Item was removed:
- ----- Method: BlockContextTest>>setUp (in category 'running') -----
- setUp
- super setUp.
- aBlockContext := [100@100 corner: 200@200].
- contextOfaBlockContext := thisContext.!

Item was removed:
- ----- Method: BlockContextTest>>testDecompile (in category 'tests - printing') -----
- testDecompile
- self assert: ([3 + 4] decompile printString = '{[3 + 4]}').!

Item was removed:
- ----- Method: BlockContextTest>>testNew (in category 'tests') -----
- testNew
- self should: [ContextPart new: 5] raise: Error.
- [ContextPart new: 5]
- on: Error do: [:e|
- self assert: (e messageText includesSubstring: 'newForMethod:') description: 'Error doesn''t tell you what you did wrong by calling #new:'].
-
- self should: [ContextPart new] raise: Error.
- [ContextPart new]
- on: Error do: [:e|
- self assert: (e messageText includesSubstring: 'newForMethod:') description: 'Error doesn''t tell you what you did wrong by calling #new'].!

Item was removed:
- ----- Method: BlockContextTest>>testNoArguments (in category 'tests') -----
- testNoArguments
- [10
- timesRepeat: [:arg | 1 + 2]]
- ifError: [:err :rcvr | self deny: err = 'This block requires 1 arguments.'].
- [10
- timesRepeat: [:arg1 :arg2 | 1 + 2]]
- ifError: [:err :rcvr | self deny: err = 'This block requires 2 arguments.'] !

Item was removed:
- ----- Method: BlockContextTest>>testOneArgument (in category 'tests') -----
- testOneArgument
- | c |
- c := OrderedCollection new.
- c add: 'hello'.
- [c
- do: [1 + 2]]
- ifError: [:err :rcvr | self deny: err = 'This block requires 0 arguments.'].
- [c
- do: [:arg1 :arg2 | 1 + 2]]
- ifError: [:err :rcvr | self deny: err = 'This block requires 2 arguments.'] !

Item was removed:
- ----- Method: BlockContextTest>>testRunSimulated (in category 'tests') -----
- testRunSimulated
- self assert: Rectangle equals: (ContextPart runSimulated: aBlockContext) class.!

Item was removed:
- ----- Method: BlockContextTest>>testSetUp (in category 'tests') -----
- testSetUp
- "Note: In addition to verifying that the setUp worked the way it was expected to, testSetUp is used to illustrate the meaning of the simple access methods, methods that are not normally otherwise 'tested'"
- self deny: aBlockContext isMethodContext.
- self deny: aBlockContext isPseudoContext.
- self assert: aBlockContext home = contextOfaBlockContext.
- self assert: aBlockContext receiver = self.
- self assert: (aBlockContext method isKindOf: CompiledMethod).
- !

Item was removed:
- ----- Method: BlockContextTest>>testSupplyAnswerOfFillInTheBlank (in category 'testing') -----
- testSupplyAnswerOfFillInTheBlank
-
- self should: ['blue' = ([UIManager default request: 'Your favorite color?']
- valueSupplyingAnswer: #('Your favorite color?' 'blue'))]!

Item was removed:
- ----- Method: BlockContextTest>>testSupplyAnswerOfFillInTheBlankUsingDefaultAnswer (in category 'testing') -----
- testSupplyAnswerOfFillInTheBlankUsingDefaultAnswer
-
- self should: ['red' = ([UIManager default  request: 'Your favorite color?' initialAnswer: 'red']
- valueSupplyingAnswer: #('Your favorite color?' #default))]!

Item was removed:
- ----- Method: BlockContextTest>>testSupplyAnswerUsingOnlySubstringOfQuestion (in category 'tests') -----
- testSupplyAnswerUsingOnlySubstringOfQuestion
-
- self should: [false = ([self confirm: 'You like Smalltalk?']
- valueSupplyingAnswer: #('like' false))]!

Item was removed:
- ----- Method: BlockContextTest>>testSupplyAnswerUsingRegexMatchOfQuestion (in category 'tests') -----
- testSupplyAnswerUsingRegexMatchOfQuestion
-
- (String includesSelector: #matchesRegex:) ifFalse: [^ self].
-
- self should: [true = ([self confirm: 'You like Smalltalk?']
- valueSupplyingAnswer: #('.*Smalltalk\?' true))]!

Item was removed:
- ----- Method: BlockContextTest>>testSupplySpecificAnswerToQuestion (in category 'tests') -----
- testSupplySpecificAnswerToQuestion
-
- self should: [false = ([self confirm: 'You like Smalltalk?']
- valueSupplyingAnswer: #('You like Smalltalk?' false))]!

Item was removed:
- ----- Method: BlockContextTest>>testSuppressInform (in category 'tests') -----
- testSuppressInform
-
- self should: [[nil inform: 'Should not see this message or this test failed!!'] valueSuppressingAllMessages isNil]!

Item was removed:
- ----- Method: BlockContextTest>>testSuppressInformUsingStringMatchOptions (in category 'tests') -----
- testSuppressInformUsingStringMatchOptions
-
- self should: [([nil inform: 'Should not see this message or this test failed!!'] valueSuppressingMessages: #('Should not see this message or this test failed!!')) isNil].
-
- self should: [([nil inform: 'Should not see this message or this test failed!!'] valueSuppressingMessages: #('not see this message')) isNil].
-
- self should: [([nil inform: 'Should not see this message or this test failed!!'] valueSuppressingMessages: #('*message*failed#')) isNil].
- !

Item was removed:
- ----- Method: BlockContextTest>>testTallyInstructions (in category 'tests') -----
- testTallyInstructions
- self assert: (ContextPart tallyInstructions: aBlockContext) size = 15.!

Item was removed:
- ----- Method: BlockContextTest>>testValueWithPossibleArgs (in category 'tests - evaluating') -----
- testValueWithPossibleArgs
- | block  blockWithArg blockWith2Arg |
-
- block := [1].
- blockWithArg  := [:arg | arg].
- blockWith2Arg := [:arg1 :arg2 | {arg1. arg2}].
-
- self assert: (block valueWithPossibleArgs: #()) = 1.
- self assert: (block valueWithPossibleArgs: #(1)) = 1.
-
- self assert: (blockWithArg valueWithPossibleArgs: #()) = nil.
- self assert: (blockWithArg valueWithPossibleArgs: #(1)) = 1.
- self assert: (blockWithArg valueWithPossibleArgs: #(1 2)) = 1.
-
- self assert: (blockWith2Arg valueWithPossibleArgs: #()) = {nil .nil}.
- self assert: (blockWith2Arg valueWithPossibleArgs: #(1)) =  {1 . nil}.
- self assert: (blockWith2Arg valueWithPossibleArgs: #(1 2)) =  #(1 2).
- self assert: (blockWith2Arg valueWithPossibleArgs: #(1 2 3)) = #(1 2).
-
-
- !

Item was removed:
- ----- Method: BlockContextTest>>testValueWithPossibleArgument (in category 'tests - evaluating') -----
- testValueWithPossibleArgument
- | block  blockWithArg blockWith2Arg |
-
- block := [1].
- blockWithArg  := [:arg | arg].
- blockWith2Arg := [:arg1 :arg2 | {arg1. arg2}].
-
- self assert: (block valueWithPossibleArgument: 1) = 1.
-
- self assert: (blockWithArg valueWithPossibleArgument: 1) = 1.
-
- self assert: (blockWith2Arg valueWithPossibleArgument: 1) = {1 . nil}.
-
-
- !

Item was added:
+ ----- Method: CompiledMethodTest>>testNew (in category 'tests') -----
+ testNew
+ "This /should/ throw an exception."
+ self should: [self targetClass new] raise: Error!

Item was changed:
  ----- Method: MethodContextTest>>testMethodContext (in category 'tests') -----
  testMethodContext
- self deny: aMethodContext isPseudoContext.
  self assert: aMethodContext home notNil.
  self assert: aMethodContext receiver notNil.
+ self assert: aMethodContext method isCompiledMethod.!
- self assert: (aMethodContext method isKindOf: CompiledMethod).!

Item was changed:
  ----- Method: MethodContextTest>>testSetUp (in category 'tests') -----
  testSetUp
  "Note: In addition to verifying that the setUp worked the way it was expected to, testSetUp is used to illustrate the meaning of the simple access methods, methods that are not normally otherwise 'tested'"
+ self assert: aMethodContext isContext.
  self assert: aMethodContext isMethodContext.
  self deny: aMethodContext isClosure.
- self deny: aMethodContext isPseudoContext.
  self deny: aMethodContext isDead.
  "self assert: aMethodContext home = aReceiver."
  "self assert: aMethodContext blockHome = aReceiver."
  self assert: aMethodContext receiver = aReceiver.
+ self assert: aMethodContext method isCompiledMethod.
- self assert: (aMethodContext method isKindOf: CompiledMethod).
  self assert: aMethodContext method = aCompiledMethod.
  self assert: aMethodContext methodNode selector = #rightCenter.
  self assert: (aMethodContext methodNodeFormattedAndDecorated: true) selector = #rightCenter.
  self assert: aMethodContext client printString = 'MethodContextTest>>#testSetUp'.
  !